'=============================================================================================================================== ' >>>>>>>> Download file with progressbar <<<<<<<<< '=============================================================================================================================== $USE "wininet.lib" '$USE "zoltest.lib" AUTODEFINE "OFF" DECLARE IMPORT, CloseHandle(hObject:uint),int DECLARE IMPORT, CreateThread(lpThreadAttributes As Int, dwStackSize As Int, lpStartAddress As UInt, lpParameter As UINT, dwCreationFlags As Int, lpThreadId As Pointer),Int DECLARE IMPORT, TerminateThread(hThread:uint, dwExitCode As Int),Int DECLARE IMPORT, ExitThread(dwExitCode As Int) DECLARE "wininet",InternetOpen ALIAS InternetOpenA(agent:STRING,access:INT,proxyname:STRING,proxybypass:STRING,flags:INT),INT DECLARE "wininet",InternetConnect ALIAS InternetConnectA(session:INT,server:STRING,port:WORD,username:STRING,pass:STRING,service:INT,flags:INT,context:INT),INT DECLARE "wininet",InternetCloseHandle(handle:INT),INT DECLARE "wininet",HttpOpenRequest ALIAS HttpOpenRequestA(session:INT,verb:STRING,name:STRING,version:STRING,referer:STRING,types:POINTER,flags:INT,context:INT),INT DECLARE "wininet",HttpSendRequest ALIAS HttpSendRequestA(handle:INT,headers:POINTER,headerlength:INT,option:POINTER,optionlength:INT),INT DECLARE "wininet",HttpQueryInfo ALIAS HttpQueryInfoA(hRequest:INT, dwInfoLevel:INT, lpvBuffer:POINTER, lpdwBufferLength:POINTER, lpdwIndex:INT),INT DECLARE "wininet",InternetReadFile(hfile:INT,buffer:STRING,count:INT,bytesread:POINTER),INT DECLARE "wininet",InternetQueryDataAvailable(hfile:INT,bytesavail:POINTER,flags:INT,context:INT),INT 'DECLARE "zoltest",zol_ToolTip(zol_Win:WINDOW,zol_Id:INT,zol_Style:INT,zol_Icon:INT,zol_Caption:STRING,zol_Tip:STRING) WINDOW DownWin:BFILE zol_DownFile:INT threadID,hThread,zol_down,zol_Cdown,zol_DMode '=============================================================================================================================== GLOBAL SUB zol_DownWin(zol_DownURL:STRING,zol_LocPath:STRING,zol_downMode:INT),INT INT a:zol_down=False:zol_Cdown=False:zol_DMode=zol_downMode OPENWINDOW DownWin,100,100,540,140,@TOPMOST|@TOOLWINDOW,0," Letöltés",&winsub_DownWin:CENTERWINDOW DownWin:SETWINDOWCOLOR DownWin,0xafdfdf CONTROL DownWin,@STATIC,"Forrás:",10,8,60,20,@CTEDITRIGHT,1:CONTROL DownWin,@STATIC,"Mentés:",10,30,60,20,@CTEDITRIGHT,2 CONTROL DownWin,@STATIC,"Folyamat:",10,56,60,20,@CTEDITRIGHT,3:CONTROL DownWin,@STATIC,"",80,85,220,20,0,4 CONTROL DownWin,@STATIC,zol_DownURL,80,8,420,20,@CTEDITAUTOH,5:CONTROL DownWin,@STATIC,zol_LocPath,80,30,420,20,@CTEDITAUTOH,6 FOR a=1 TO 6:SETFONT DownWin,"Ms Sans Serif",9,400,0x00EE0000,a:SETCONTROLCOLOR DownWin,a,0x000040,0xafdfdf:NEXT a CONTROL DownWin,@SYSBUTTON,"Letöltés",330,85,80,22,@TABSTOP,7:SETFONT DownWin,"Ms Sans Serif",9,400,0x00EE0000,7 CONTROL DownWin,@SYSBUTTON,"Kilépés",420,85,80,22,@TABSTOP,8:SETFONT DownWin,"Ms Sans Serif",9,400,0x00EE0000,8 ProgressBar(DownWin,80,55,420,20,@PBS_SMOOTH,0,10):IF zol_DMode=1 zol_down=True:zol_Cdown=False:ENABLECONTROL DownWin,7,0:hThread=CreateThread(0,0,&DownloadThread,0,0,&threadID):IF hThread=0 CloseHandle(hThread):zol_down=False:ENABLECONTROL DownWin,7,1:SETCONTROLTEXT DownWin,4,"Kapcsolat nem hozható létre" ENDIF ENDIF:'zol_ToolTip(DownWin,7,1,1,"Letöltés ","Letöltés indítása"):zol_ToolTip(DownWin,8,1,1,"Kilépés vagy Rendben","A letöltés megszakítása, vagy kilépés"):'Rendben STARTTIMER DownWin,100:WAITUNTIL DownWin=0:STOPTIMER DownWin:RETURN zol_Cdown ENDSUB '------------------------------------------------------------------------------------------------------------------------------- SUB winsub_DownWin SELECT @MESSAGE CASE @IDCLOSEWINDOW IF zol_down TerminateThread(hThread,0):CloseHandle(hThread):CLOSEFILE(zol_DownFile) ENDIF:CLOSEWINDOW DownWin CASE @IDCONTROL IF @NOTIFYCODE=0 SELECT @CONTROLID CASE 7:'Letöltés zol_down=True:zol_Cdown=False:ENABLECONTROL DownWin,7,0:hThread=CreateThread(0,0,&DownloadThread,0,0,&threadID):IF hThread=0 CloseHandle(hThread):zol_down=False:ENABLECONTROL DownWin,7,1:SETCONTROLTEXT DownWin,4,"Kapcsolat nem hozható létre" ENDIF CASE 8:'Kilépés IF zol_down zol_Cdown=True:SETCONTROLTEXT(DownWin,4,"A letöltés megszakadt...") ELSE CLOSEWINDOW DownWin ENDIF ENDSELECT ENDIF CASE @IDTIMER IF zol_DMode=2 THEN CLOSEWINDOW DownWin ENDSELECT:RETURN ENDSUB '------------------------------------------------------------------------------------------------------------------------------- SUB DownloadThread() STRING text:DownloadUrl():zol_down=false:IF zol_Cdown=False Text=GETCONTROLTEXT(DownWin,4):SETCONTROLTEXT(DownWin,4,Text+" - Rendben"):SETCONTROLTEXT DownWin,8,"Rendben":ENABLECONTROL DownWin,8,1:IF zol_DMode=1 THEN zol_DMode=2 ELSE SETCONTROLTEXT(DownWin, 4, "A letöltés megszakadt..."):pbSetPosition(DownWin,10,0):ENABLECONTROL DownWin,7,1 ENDIF:ExitThread(0):SETFOCUS DownWin:RETURN ENDSUB '------------------------------------------------------------------------------------------------------------------------------- SUB DownloadUrl() CONST bufferLength=4096:POINTER NULL:ISTRING fs[1024],buffer[bufferLength]:buffer="" STRING site,doc,ref:site=GetSiteFromURL():doc=GetDocFromURL():ref="" INT hopen,hconnect,hhttp,fsLength,filesize,Bytes,fBytes:fsLength=1024:filesize=-1:Bytes=0:fBytes=0 IF OPENFILE(zol_DownFile,GETCONTROLTEXT(DownWin,6),"W")=0 hopen=InternetOpen(ref,0,"","",0):IF hopen hconnect=InternetConnect(hopen,site,80,"","",3,0,0):IF hconnect hhttp=HttpOpenRequest(hconnect,"GET",doc,"","",NULL,0x80000000,0):IF hhttp IF HttpSendRequest(hhttp,NULL,0,NULL,0) IF HttpQueryInfo(hhttp,5,fs,fsLength,0):'get the file size filesize=VAL(LEFT$(fs,fsLength)):pbSetRange(DownWin,10,0,1000):pbSetPosition(DownWin,10,0):pbSetStep(DownWin,10,1) DO:InternetReadFile(hhttp,buffer,bufferLength,Bytes):'read the document in packages of 4096 bytes (if bufferLength=4096) IF Bytes:'write these bytes to the file __write(zol_DownFile,buffer,Bytes) fBytes += Bytes:pbSetPosition(DownWin,10,ABS(fBytes)*1000/ABS(filesize)):'show information in the dialog SETCONTROLTEXT DownWin,4,"Letöltött bájtok: "+Str$(fBytes)+" ("+USING("#.",ABS(fBytes)*100/ABS(filesize)) + "%)" ENDIF UNTIL Bytes=0 OR zol_Cdown=True ELSE filesize=-1:'PRINT "file size: Unknown" ENDIF ENDIF:InternetCloseHandle(hhttp) ENDIF:InternetCloseHandle(hconnect) ENDIF:InternetCloseHandle(hopen) ENDIF:CLOSEFILE(zol_DownFile) IF zol_Cdown=False IF filesize<0 OR fBytes0 THEN site=RIGHT$(site,LEN(site)-7):'remove "HTTP://" from the string n=INSTR(UCASE$(site),"/"):IF n>0 THEN site=LEFT$(site,n-1):'site="www.speqmath.com" RETURN site ENDSUB '------------------------------------------------------------------------------------------------------------------------------- SUB GetDocFromURL(),STRING INT n:STRING doc:doc=GETCONTROLTEXT(DownWin,5):'url="http://www.speqmath.com/files/speq.zip" n=INSTR(UCASE$(doc),"HTTP://"):IF n>0 THEN doc=RIGHT$(doc,LEN(doc)-7) n=INSTR(UCASE$(doc),"/"):IF n>0 THEN doc=RIGHT$(doc,LEN(doc)-n) ELSE doc="":'doc="files/speq.zip" RETURN doc ENDSUB '===============================================================================================================================