Tweet
What am I doing wrong here? This is the working code for the
download manager I am writing. If your on high bandwidth connection
and you load an M3u file or a txt file you will see what I'm
talking about.
Any suggestions on making it use less CPU would be appreciated.
I know it isn't the threads because if you take out all TCP
functions, everything is good. Something with my TCP code maybe.
Lance, I also know, this isn't thread safe yet
if you need an M3U file you can get one here:
http://play.mp3.com/cgi-bin/play/play.c gi/AAIBQgAAAADABG5vcm1QBAAAAFItDAMAUQoAAABYAQAAAFktDAMAQ4800TtHmsiK8JO1KU87PXfW4WzQ/mlm_king.m3u
------------------
-Greg
[This message has been edited by Gregery D Engle (edited October 20, 2001).]
download manager I am writing. If your on high bandwidth connection
and you load an M3u file or a txt file you will see what I'm
talking about.
Any suggestions on making it use less CPU would be appreciated.
I know it isn't the threads because if you take out all TCP
functions, everything is good. Something with my TCP code maybe.
Lance, I also know, this isn't thread safe yet
if you need an M3U file you can get one here:
http://play.mp3.com/cgi-bin/play/play.c gi/AAIBQgAAAADABG5vcm1QBAAAAFItDAMAUQoAAABYAQAAAFktDAMAQ4800TtHmsiK8JO1KU87PXfW4WzQ/mlm_king.m3u
Code:
#COMPILE EXE
#INCLUDE "win32api.inc"
#INCLUDE "commctrl.inc"
#INCLUDE "comdlg32.inc"
#RESOURCE "d:\pbdll60\samples\tray\tray.pbr"
GLOBAL pbStep AS LONG, OldLvProc AS LONG
GLOBAL hListView AS LONG
%LISTVIEW1 = 100
%MNU_LOAD_DOWNLOADLIST = 500
%MNU_OPTIONS = 501
%MNU_EXIT = 502
%WM_PRINT = &H317
TYPE UrlStruct
sURL AS STRING * 512
nProgress AS LONG
nSize AS LONG
END TYPE
GLOBAL gURL() AS UrlStruct
GLOBAL ofn AS OPENFILENAME
GLOBAL gCommand$ 'global command line params
'------------------------------------------------------------------------------
FUNCTION GetFileNameProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
LOCAL rc1 AS Rect, rc2 AS Rect, hWnd1 AS LONG, hWnd2 AS LONG
SELECT CASE wMsg
CASE %WM_SIZE
hWnd1 = GetParent(hWnd)
' Center
hWnd2 = ofn.hWndOwner: IF hWnd2 = 0 THEN hWnd2 = GetDesktopWindow
GetWindowRect hWnd1, rc1: GetWindowRect hWnd2, rc2
SetWindowPos hWnd1, %HWND_TOPMOST, _
rc2.nLeft + ((rc2.nRight - rc2.nLeft) - (rc1.nRight - rc1.nLeft)) / 2, _
rc2.nTop + ((rc2.nBottom - rc2.nTop) - (rc1.nBottom - rc1.nTop)) / 2, _
0, 0, %SWP_NOSIZE
' Set names
SetWindowText hWnd1, "Please Select Download File List"
DIM TmpAsciiz AS ASCIIZ * 255
TmpAsciiz = "Folder" : _
SendMessage hwnd1, %CDM_SETCONTROLTEXT, &H443, VARPTR(TmpAsciiz)
TmpAsciiz = "Download List": _
SendMessage hwnd1, %CDM_SETCONTROLTEXT, &H442, VARPTR(TmpAsciiz)
TmpAsciiz = "Type": _
SendMessage hwnd1, %CDM_SETCONTROLTEXT, &H441, VARPTR(TmpAsciiz)
TmpAsciiz = "&Okay" : SendMessage hwnd1, %CDM_SETCONTROLTEXT, _
%IDOK, VARPTR(TmpAsciiz)
TmpAsciiz = "&Exit" : SendMessage hwnd1, %CDM_SETCONTROLTEXT, _
%IDCANCEL, VARPTR(TmpAsciiz)
END SELECT
FUNCTION = DefWindowProc(hWnd, wMsg, wParam, lParam)
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION GetFileName(hWnd AS LONG) AS STRING
STATIC szCurDir1 AS ASCIIZ * %MAX_PATH, szCurDir2 AS ASCIIZ * %MAX_PATH
STATIC szTitleName AS ASCIIZ * %MAX_PATH, _
szFilter AS ASCIIZ * %MAX_PATH
IF ofn.lStructSize = 0 THEN
ofn.lStructSize = SIZEOF(ofn)
ofn.hWndOwner = hWnd
szFilter = "M3U Files (*.m3u)" + CHR$(0) + "*.m3u" + CHR$(0) + _
"All Files (*.*)" + CHR$(0) + "*.*" + CHR$(0)
ofn.lpstrFilter = VARPTR(szFilter)
ofn.lpstrFileTitle = VARPTR(szTitleName)
ofn.nMaxFileTitle = SIZEOF(szTitleName)
ofn.lpfnHook = CODEPTR(GetFileNameProc)
ofn.Flags = %OFN_HIDEREADONLY OR %OFN_CREATEPROMPT OR %OFN_EXPLORER OR %OFN_ENABLEHOOK
END IF
GetCurrentDirectory SIZEOF(szCurDir1), szCurDir1
GetOpenFileName ofn
GetCurrentDirectory SIZEOF(szCurDir2), szCurDir2
IF RIGHT$(szCurDir2, 1) <> "\" THEN szCurDir2 = szCurDir2 + "\"
IF szTitleName = "" THEN FUNCTION = "" ELSE FUNCTION = szCurDir2 + szTitleName
SetCurrentDirectory szCurDir1
END FUNCTION
'------------------------------------------------------------------------------
SUB LV_AddItem(hListView&, sTitle$, lMask&, lStateMask&, lPos&)
LOCAL azItemText AS ASCIIZ * %MAX_PATH
LOCAL lvITEM AS LV_ITEM
azItemText = sTitle$
lvITEM.iImage = 0
lvITEM.iItem = ListView_GetItemCount(hListView)
lvITEM.mask = %LVCF_FMT OR %LVCF_WIDTH OR %LVCF_TEXT OR %LVCF_SUBITEM
lvITEM.stateMask = lStateMask&
lvITEM.pszText = VARPTR(azItemText)
lStatus& = ListView_InsertItem (hListView, lvITEM)
END SUB
'------------------------------------------------------------------------------
SUB LV_CreateColumn(hListView&, sTitle$, lMask&, lWidth&, lPos&)
LOCAL azTitle AS ASCIIZ * 25
LOCAL Column AS LV_COLUMN
azTitle = sTitle$
Column.mask = lMask&
Column.fmt = %LVCFMT_LEFT
Column.cx = lWidth&
Column.pszText = VARPTR(azTitle)
ListView_InsertColumn hListView, lPos&, Column
END SUB
'------------------------------------------------------------------------------
FUNCTION LVW_GetSelected(hListView&) AS LONG
ListCount& = ListView_GetItemCount(hListView)
FOR a& = 0 TO ListCount&
r& = ListView_GetItemState(hListView,a&,%LVIS_FOCUSED)
IF r& = %LVIS_FOCUSED THEN
FUNCTION = a&
EXIT FUNCTION
END IF
NEXT
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION GetHost(URL$) AS STRING
sBuffer$ = UCASE$(URL$)
sBuffer$ = REMAIN$(sBuffer$, "HTTP://")
sBuffer$ = EXTRACT$(sBuffer$, "/")
FUNCTION = sBuffer$
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION GetHTTPFileSize(URL$, FileNum&) AS LONG
STATIC Count&
IF Count& > 5 THEN
DO UNTIL count& < 5
SLEEP 1
LOOP
END IF
INCR Count&
LOCAL ff AS LONG, rtn AS STRING, dsp AS STRING
rtn=TRIM$(URL$)
IF rtn = "" THEN
FUNCTION = -1: EXIT FUNCTION
END IF
sHost$ = GetHost(URL$)
REPLACE "http://" WITH "" IN rtn
ff=FileNum&
TCP OPEN PORT 80 AT sHost$ AS ff
TCP PRINT ff, "GET <A HREF="http://"" TARGET=_blank>http://"</A> & rtn & " HTTP/1.0" & CHR$(13,10,13,10)
TCP RECV ff, 500, rtn
TCP CLOSE ff
'MSGBOX rtn
IF INSTR(rtn,CHR$(13)) = 0 THEN REPLACE CHR$(10) WITH CHR$(13,10) IN rtn
rtn = UCASE$(rtn)
rtn = REMAIN$(rtn, "CONTENT-LENGTH:")
rtn = EXTRACT$(rtn, CHR$(13))
FUNCTION = VAL(TRIM$(rtn))
DECR Count&
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION GetURL(BYVAL x AS LONG) AS LONG
LOCAL FF AS LONG
LOCAL I AS LONG, zTxt AS ASCIIZ * 20
STATIC Count&
sText$ = TRIM$(gURL(x).sURL)
sText$ = PARSE$(sText$, "/", PARSECOUNT(sText$, "/"))
LV_AddItem hListView, BYCOPY sText$, %LVCF_FMT OR %LVCF_WIDTH OR %LVCF_TEXT OR %LVCF_SUBITEM, %LVIS_FOCUSED, 0
ListView_SetItemText hListView, x, 1, "quead"
ListView_SetItemText hListView, x, 2, "getting filesize"
SLEEP RND(1000, 3000)
FileSize& = GetHTTPFileSize(TRIM$(gURL(x).sURL), x)
gURL(x).nSize = FileSize&
ListView_SetItemText hListView, x, 2, FORMAT$(FileSize&\1024) & "K"
'We want it to wait till we are free
IF Count& > 5 THEN
DO UNTIL count& < 5
SLEEP 1000
LOOP
END IF
INCR Count&
'Get Host Name
pbStep = 1
sURL$ = TRIM$(gURL(x).sURL)
sHost$ = GetHost(TRIM$(gURL(x).sURL))
REPLACE "http://" WITH "" IN sURL$
ff=X 'Use Array Pointer for FileNumber
TCP OPEN PORT 80 AT sHost$ AS ff
TCP PRINT ff, "GET <A HREF="http://"" TARGET=_blank>http://"</A> & sURL$ & " HTTP/1.0" & CHR$(13,10,13,10)
DO
TCP RECV ff, 4096, sBuffer$
sTemp$ = sTemp$ & sBuffer$
PerCentage& = (LEN(sTemp$) / gURL(x).nSize) * 100
ListView_SetItemText hListView, x, 1, FORMAT$(PerCentage&)
SLEEP 100
LOOP WHILE LEN(sBuffer$)
sBuffer$ = REMAIN$(sTemp$, $CRLF & $CRLF)
TCP CLOSE ff
OPEN "C:\TEMP" & "\" & sText$ FOR BINARY AS ff
SETEOF ff
PUT$ ff, sBuffer$
CLOSE ff
ListView_SetItemText hListView, x, 1, "Done!"
DECR Count&
END FUNCTION
'------------------------------------------------------------------------------
SUB AddURL(URL$)
STATIC qID&
gURL(qID&).sURL = URL$
THREAD CREATE GetUrl(qID&) TO woot&
THREAD CLOSE woot& TO woot&
INCR qID&
END SUB
'------------------------------------------------------------------------------
SUB ProcessList(sPath$)
FileNum& = FREEFILE
OPEN sPath$ FOR BINARY AS FileNum&
GET$ FileNum&, LOF(FileNum&), sBuffer$
CLOSE FileNum&
REPLACE CHR$(10, 13) WITH CHR$(13) IN sBuffer$
REPLACE CHR$(13, 10) WITH CHR$(13) IN sBuffer$
REPLACE CHR$(10) WITH CHR$(13) IN sBuffer$
FOR lCounter& = 0 TO PARSECOUNT(sBuffer$, CHR$(13))
sURL$ = PARSE$(sBuffer$, CHR$(13), lCounter&)
sURL$ = UCASE$(sURL$)
IF LEFT$(sURL$, 4) = "HTTP" THEN
AddURL(PARSE$(sBuffer$, CHR$(13), lCounter&))
END IF
NEXT
END SUB
'------------------------------------------------------------------------------
FUNCTION WndProc (BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _
BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG
LOCAL rect AS rect, zTxt AS ASCIIZ * 260
LOCAL LV_LpLvNm AS NM_LISTVIEW PTR
SELECT CASE wMsg
CASE %WM_NOTIFY
SELECT CASE LOWRD(wParam)
CASE %LISTVIEW1
LV_LPLVNM = lParam
SELECT CASE @LV_LPLVNM.HDR.CODE
CASE %NM_CLICK
CASE %NM_RCLICK
CASE %LVN_COLUMNCLICK
END SELECT
END SELECT
'================================================
CASE %WM_CREATE
MENU NEW BAR TO hMenu0&
MENU NEW POPUP TO hMenu1&
MENU ADD POPUP, hMenu0& ,"&File", hMenu1&, %MF_ENABLED
MENU ADD STRING, hMenu1&, "&Load Download List", %MNU_LOAD_DOWNLOADLIST, %MF_ENABLED
MENU ADD STRING, hMenu1&, "-", 0, %MF_ENABLED
MENU ADD STRING, hMenu1&, "Options", %MNU_OPTIONS, %MF_ENABLED
MENU ADD STRING, hMenu1&, "E&xit", %MNU_EXIT, %MF_ENABLED
MENU ATTACH hMenu0&, hWnd
GETCLIENTRECT hWnd, rect
hListView = CREATEWINDOW ( "SysListView32", _
"", _
%WS_border OR %WS_Child OR %WS_visible OR _
%LVS_Report OR %LVS_SINGLESEL OR %LVS_SHOWSELALWAYS OR %LVS_OWNERDRAWFIXED OR %LVS_NOCOLUMNHEADER, _
0, _
0, _
rect.nRight - 1, _
rect.nBottom - 1, _
hWnd, _
%LISTVIEW1, _
GETMODULEHANDLE(BYVAL 0&), _
%Null )
OldLvProc = SetWindowLong(hListView, %GWL_WNDPROC, CODEPTR(LvSubClass))
LV_CreateColumn hListView, "Downloading", %LVCF_FMT OR %LVCF_WIDTH OR %LVCF_TEXT OR %LVCF_SUBITEM, 300, 0
LV_CreateColumn hListView, "Progress", %LVCF_FMT OR %LVCF_WIDTH OR %LVCF_TEXT OR %LVCF_SUBITEM, 200, 1
LV_CreateColumn hListView, "Size", %LVCF_FMT OR %LVCF_WIDTH OR %LVCF_TEXT OR %LVCF_SUBITEM, 100, 2
IF LEN(DIR$(gCOMMAND$)) = 0 THEN
gCOMMAND$ = GetFileName(hWnd)
END IF
IF LEN(DIR$(gCOMMAND$)) > 0 THEN
ProcessList gCOMMAND$
ELSE
POSTQUITMESSAGE 0
END IF
'================================================
CASE %WM_DRAWITEM
IF wParam = %LISTVIEW1 THEN
LOCAL cw1 AS LONG, cw2 AS LONG, cw3 AS LONG, cw4 AS LONG, rc AS RECT
LOCAL ClientArea AS RECT
LOCAL lpdis AS DRAWITEMSTRUCT PTR
lpdis = lParam
SELECT CASE @lpdis.itemAction
CASE %ODA_DRAWENTIRE, %ODA_SELECT
'CLEAR BACKGROUND
ListView_GetItemRect hListView, @lpdis.itemID, rc, %LVIR_BOUNDS
cw1 = ListView_GetColumnWidth(hListView, 0)
cw2 = ListView_GetColumnWidth(hListView, 1)
cw3 = ListView_GetColumnWidth(hListView, 2)
rc.nLeft = 0 : rc.nRight = cw1+cw2+cw3
IF (@lpdis.itemState AND %ODS_SELECTED) THEN
FillRect @lpdis.hDC, rc, GetSysColorBrush(%COLOR_HIGHLIGHT)
SetBkColor @lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHT)
SetTextColor @lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHTTEXT)
ELSE
FillRect @lpdis.hDC, rc, GetSysColorBrush(%COLOR_WINDOW)
SetBkColor @lpdis.hDC, GetSysColor(%COLOR_WINDOW)
SetTextColor @lpdis.hDC, GetSysColor(%COLOR_WINDOWTEXT)
END IF
'COLUMN 1
CALL ListView_GetItemText(hListView, @lpdis.itemID, 0, zTxt, SIZEOF(zTxt))
rc.nLeft = 2
DrawText @lpdis.hDC, zTxt, LEN(zTxt), rc, %DT_LEFT OR %DT_SINGLELINE OR %DT_VCENTER
'DRAW FOCUSRECT (if control has focus)
IF (@lpdis.itemState AND %ODS_SELECTED) AND GetFocus = hListView THEN 'if selected + focus
rc.nLeft = 0
CALL DrawFocusRect(@lpdis.hDC, rc) 'draw focus rectangle
END IF
'COLUMN 2
CALL ListView_GetItemText(hListView, @lpdis.itemID, 1, zTxt, SIZEOF(zTxt))
IF VAL(zTxt) > 0 THEN
rc.nLeft = cw1
rc.nRight = cw1 + cw2 * VAL(zTxt) / 100
FillRect @lpdis.hDC, rc, GetSysColorBrush(%COLOR_3DFACE)
DrawEdge @lpdis.hDC, rc, %BDR_RAISEDINNER, %BF_RECT
rc.nLeft = rc.nRight
rc.nRight = cw1 + cw2
FillRect @lpdis.hDC, rc, GetSysColorBrush(%COLOR_WINDOW)
rc.nLeft = cw1
SetBkMode @lpdis.hDC, %TRANSPARENT
SetTextColor @lpdis.hDC, %BLUE
zTxt = zTxt + "%"
INCR rc.nTop
DrawText @lpdis.hDC, zTxt, LEN(zTxt), rc, %DT_CENTER OR %DT_SINGLELINE OR %DT_VCENTER
ELSE
rc.nLeft = cw1
rc.nRight = cw1 + cw2 * VAL(zTxt) / 100
FillRect @lpdis.hDC, rc, GetSysColorBrush(%COLOR_WINDOW)
rc.nLeft = rc.nRight
rc.nRight = cw1 + cw2
FillRect @lpdis.hDC, rc, GetSysColorBrush(%COLOR_WINDOW)
rc.nLeft = cw1
SetBkMode @lpdis.hDC, %TRANSPARENT
SetTextColor @lpdis.hDC, %Gray
DrawText @lpdis.hDC, zTxt, LEN(zTxt), rc, %DT_CENTER OR %DT_SINGLELINE OR %DT_VCENTER
END IF
'COLUMN 3
IF (@lpdis.itemState AND %ODS_SELECTED) THEN
SetBkColor @lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHT)
SetTextColor @lpdis.hDC, GetSysColor(%COLOR_HIGHLIGHTTEXT)
ELSE
SetBkColor @lpdis.hDC, GetSysColor(%COLOR_WINDOW)
SetTextColor @lpdis.hDC, %RED 'GetSysColor(%COLOR_WINDOWTEXT)
END IF
CALL ListView_GetItemText(hListView, @lpdis.itemID, 2, zTxt, SIZEOF(zTxt))
rc.nLeft = cw1+cw2
rc.nRight = cw1+cw2+cw3
DrawText @lpdis.hDC, zTxt, LEN(zTxt), rc, %DT_CENTER OR %DT_SINGLELINE OR %DT_VCENTER
'COLUMN.. the rest..
GetClientRect hListView, rc
rc.nLeft = cw1 + cw2 + cw3 'add up column widths and see if we have something left to paint
IF rc.nLeft < rc.nRight THEN FillRect @lpdis.hDC, rc, GetSysColorBrush(%COLOR_WINDOW)
FUNCTION = %TRUE : EXIT FUNCTION
END SELECT
END IF
'================================================
CASE %WM_DESTROY
IF OldLvProc THEN SETWINDOWLONG hListView, %GWL_WNDPROC, OldLvProc
POSTQUITMESSAGE 0
END SELECT
FUNCTION = DEFWINDOWPROC(hWnd, wMsg, wParam, lParam)
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
LOCAL Msg AS tagMsg
LOCAL wndclass AS WndClassEx
LOCAL szClassName AS ASCIIZ * 80
LOCAL hWnd AS LONG
LOCAL CC1 AS INIT_COMMON_CONTROLSEX
REDIM gURL(10000) AS UrlStruct
gCommand$ = COMMAND$
REPLACE CHR$(34) WITH "" IN gCommand$
CC1.dwSize=SIZEOF(CC1)
CC1.dwICC=%ICC_WIN95_CLASSES
INITCOMMONCONTROLSEX CC1
szClassName = "SDK_LISTVIEW"
wndclass.cbSize = SIZEOF(WndClass)
wndclass.style = %CS_HREDRAW OR %CS_VREDRAW
wndclass.lpfnWndProc = CODEPTR( WndProc )
wndclass.cbClsExtra = 0
wndclass.cbWndExtra = 0
wndclass.hInstance = hInstance
wndclass.hIcon = LOADICON( hInstance, "FACE1")
wndclass.hCursor = LOADCURSOR( %NULL, BYVAL %IDC_ARROW )
wndclass.hbrBackground = GETSTOCKOBJECT( %GRAY_BRUSH )
wndclass.lpszMenuName = %NULL
wndclass.lpszClassName = VARPTR( szClassName )
wndclass.hIconSm = 0
REGISTERCLASSEX wndclass
'
hWnd = CREATEWINDOWEX(%WS_EX_TOPMOST, _
szClassName, _
"WebGet 1.0", _
%DS_CENTER _
OR %WS_CAPTION _
OR %WS_SYSMENU , _
0, _
0, _
700&, _
300&, _
%NULL, _
%NULL, _
hInstance, _
BYVAL %NULL)
SHOWWINDOW hWnd, iCmdShow
ghWnd& = hWnd
UPDATEWINDOW hWnd
WHILE ISTRUE GETMESSAGE(Msg, %NULL, 0, 0)
TRANSLATEMESSAGE msg
DISPATCHMESSAGE msg
WEND
SLEEP 1
FUNCTION = msg.wParam
END FUNCTION
'------------------------------------------------------------------------------
CALLBACK FUNCTION LvSubClass
SELECT CASE CBMSG
CASE %WM_NCPAINT 'something triggered repaint, allow it to happen
pbStep = 0
CASE %WM_ERASEBKGND
IF pbStep THEN 'prevent repaints during progress
FUNCTION = 1 : EXIT FUNCTION
ELSE 'but sometimes need to ignore and repaint..
pbStep = 1
END IF
END SELECT
FUNCTION = CallWindowProc(OldLvProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
END FUNCTION
-Greg
[This message has been edited by Gregery D Engle (edited October 20, 2001).]
Comment