hier der code
Code: Alles auswählen
; English forum: http://purebasic.myforums.net/viewtopic.php?t=8331&highlight=
; Author: V2
; Date: 13. November 2003
Enumeration
#Window
#cmdStart
#progressbar
#Frame
#cmdExit
#Label
#Label2
#URL
EndEnumeration
Procedure.s Reverse(s.s)
O.s=Mid(s,Len(s),1)
P=Len(s)-1
While P>0
O.s=O+Mid(s,P,1)
P=P-1
Wend
ProcedureReturn O
EndProcedure
Procedure SetProgressbarRange(Gadget.l, Minimum.l, Maximum.l)
;? SetProgressbarRange(#progressbar, 0, 100)
PBM_SETRANGE32 = $400 + 6
SendMessage_(GadgetID(Gadget), PBM_SETRANGE32, Minimum, Maximum)
EndProcedure
Procedure DoEvents()
msg.MSG
If PeekMessage_(msg,0,0,0,1)
TranslateMessage_(msg)
DispatchMessage_(msg)
Else
Sleep_(1)
EndIf
EndProcedure
Procedure.s GetQueryInfo(hHttpRequest.l, iInfoLevel.l)
lBufferLength.l=0
lBufferLength = 1024
sBuffer.s=Space(lBufferLength)
HttpQueryInfo_(hHttpRequest, iInfoLevel, sBuffer, @lBufferLength, 0)
ProcedureReturn Left(sBuffer, lBufferLength)
EndProcedure
Procedure UrlToFileWithProgress(myFile.s, URL.s)
isLoop.b=1
Bytes.l=0
fBytes.l=0
Buffer.l=4096
res.s=""
tmp.s=""
OpenType.b=1
INTERNET_FLAG_RELOAD.l = $80000000
INTERNET_DEFAULT_HTTP_PORT.l = 80
INTERNET_SERVICE_HTTP.l = 3
HTTP_QUERY_STATUS_CODE.l = 19
HTTP_QUERY_STATUS_TEXT.l = 20
HTTP_QUERY_RAW_HEADERS.l = 21
HTTP_QUERY_RAW_HEADERS_CRLF.l = 22
AllocateMemory(0,Buffer)
UseMemory(0)
Result = CreateFile(1, myFile)
hInet = InternetOpen_("", OpenType, #Null, #Null, 0)
hURL = InternetOpenUrl_(hInet, URL, #Null, 0, INTERNET_FLAG_RELOAD, 0)
;get Filesize
domain.s = ReplaceString(Left(URL,(FindString(URL, "/",8) - 1)),"http://","")
hInetCon = InternetConnect_(hInet,domain, INTERNET_DEFAULT_HTTP_PORT, #Null, #Null, INTERNET_SERVICE_HTTP, 0, 0)
If hInetCon > 0
hHttpOpenRequest = HttpOpenRequest_(hInetCon, "HEAD", ReplaceString(URL,"http://"+domain+"/",""), "http/1.1", #Null, 0, INTERNET_FLAG_RELOAD, 0)
If hHttpOpenRequest > 0
iretval = HttpSendRequest_(hHttpOpenRequest, #Null, 0, 0, 0)
If iretval > 0
tmp = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_STATUS_CODE)
If Trim(tmp) = "200"
tmp = GetQueryInfo(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF)
If FindString(tmp,"Content-Length:",1)>0
ii.l=FindString(tmp, "Content-Length:",1) + Len("Content-Length:")
tmp = Mid(tmp, ii, Len(tmp)-ii)
myMax = Val(Trim(tmp))
EndIf
EndIf
EndIf
EndIf
EndIf
SetGadgetText(#Label, "Filesize: " + Str(myMax))
SetProgressbarRange(#progressbar,0,myMax)
;start downloading
Repeat
InternetReadFile_(hURL, MemoryID(), Buffer, @Bytes)
If Bytes = 0
isLoop=0
Else
fBytes=fBytes+Bytes
SetGadgetText(#Label2, "Received Bytes: " + Str(fBytes))
If myMax >= fBytes: SetGadgetState(#progressbar, fBytes): EndIf
UseFile(1)
WriteData(MemoryID(), Bytes)
EndIf
DoEvents()
Until isLoop=0
InternetCloseHandle_(hURL)
InternetCloseHandle_(hInet)
SetGadgetState(#progressbar, 0)
CloseFile(1)
FreeMemory(0)
EndProcedure
If OpenWindow(#Window, 0, 0, 400, 175, #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered , "Download with Progress")
If CreateGadgetList(WindowID())
StringGadget(#URL, 10, 10, 380, 20, "http://www.largeformatphotography.info/qtluong/sequoias.big.jpeg")
ProgressBarGadget(#progressbar, 10, 40, 380, 30, 0,100 , #PB_ProgressBar_Smooth)
TextGadget(#Label, 10, 80,300,20,"Filesize:")
TextGadget(#Label2, 10, 100,300,20,"Bytes received:")
Frame3DGadget(#Frame, -10, 120, 420, 110, "")
ButtonGadget(#cmdExit, 160, 140, 110, 25, "Exit")
ButtonGadget(#cmdStart, 280, 140, 110, 25, "Start", #PB_Button_Default)
EndIf
Repeat
EventID.l = WaitWindowEvent()
If EventID = #PB_EventGadget
Select EventGadgetID()
Case #cmdStart
URL.s = GetGadgetText(#URL)
;get filename (checking /)
myFile.s= Right(URL, FindString(Reverse(URL),"/",1)-1)
;request path
myFolder.s = PathRequester ("Where do you want to save '" + myFile + "'?", "C:\")
UrlToFileWithProgress(myFolder + myFile, URL)
Case #cmdExit
End
EndSelect
EndIf
Until EventID = #PB_EventCloseWindow
EndIf
End
; ExecutableFormat=Windows
; EnableXP
; EOF
http://www.purearea.net/pb/CodeArchiv/I ... ressBar.pb
Edit by NicTheQuick: Code-Tags gesetzt
