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