Mit diesem Modul kann man:
- Dateien auf die Festplatte herunterladen
- Dateien direkt in den Speicher herunterladen
- Dateien im Hintergrund herunterladen (Hauptfenster bekommt dann eine Message)
- Redirects benutzen
- Proxys benutzen (wenn der IE für Internet richtig konfiguriert ist)
Code: Alles auswählen
;/ === GetHTTPFileModule.pbi === [ ab PureBasic V5.3x ]
;/ ( Windows only)
;/ February 2015 by Thorsten1867
;/ based on GetHTTPFile.pbi of HeX0R
;/
;/ Version 1.3
;/ - neues Event-Management (Event: GetHTTPFile::#Download | EventTyp: GetHTTPFile::#Start / GetHTTPFile::#Update / GetHTTPFile::#Finished)
;/ - Anzeige des Fortschritts mittels ProgressBar / TextGadget / StatusBar
;/ - BugFixex
;{ ----- ConnectFlags (see MSDN: http://msdn.microsoft.com/en-us/library/aa385098%28VS.85%29.aspx) ------
;| #INTERNET_FLAG_EXISTING_CONNECT
;| #INTERNET_FLAG_HYPERLINK
;| #INTERNET_FLAG_IGNORE_CERT_CN_INVALID
;| #INTERNET_FLAG_IGNORE_CERT_DATE_INVALID
;| #INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP
;| #INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS
;| #INTERNET_FLAG_KEEP_CONNECTION
;| #INTERNET_FLAG_NEED_FILE
;| #INTERNET_FLAG_NO_AUTH
;| #INTERNET_FLAG_NO_AUTO_REDIRECT
;| #INTERNET_FLAG_NO_CACHE_WRITE
;| #INTERNET_FLAG_NO_COOKIES
;| #INTERNET_FLAG_NO_UI
;| #INTERNET_FLAG_PASSIVE
;| #INTERNET_FLAG_PRAGMA_NOCACHE
;| #INTERNET_FLAG_RAW_DATA
;| #INTERNET_FLAG_RELOAD
;| #INTERNET_FLAG_RESYNCHRONIZE
;| #INTERNET_FLAG_SECURE
;} -------------------------
DeclareModule GetHTTPFile
;{ Events für GetHTTP
#Download = #PB_Event_FirstCustomValue
Enumeration #PB_EventType_FirstCustomValue
#Start
#Update
#Finished
EndEnumeration
;}
#SYNCHRON = 0
#ASYNCHRON = 1
Enumeration
#NOGADGET = 0
#PROGRESS = 1
#TEXTMSG = 1 << 1
#STATUSBAR = 1 << 2
EndEnumeration
#FILESIZE_NOT_YET_KNOWN = -1
#FILESIZE_UNKNOWN = -2
Enumeration 0 ; Errors
#ERROR_NO_ERROR
#ERROR_CANT_CREATE_FILE
#ERROR_FILE_EXISTS_ALREADY
#ERROR_CANT_CREATE_THREAD
#ERROR_NO_MEMORY
#ERROR_NO_INTERNET
#ERROR_UNABLE_TO_OPEN_URL
#ERROR_UNABLE_TO_READ_ONLINEFILE
#ERROR_USER_ABORTED
#ERROR_IS_NO_HANDLE
EndEnumeration
Declare.s FormatFileSize(dSize.d, NbDecimals.i=2)
Declare SetProgressBarGadget(ProgressBarGId.i) ; Set GadgetID for Flag #PROGRESS
Declare SetTextGadget(TextGId.i=0, Mask.s="{F} ( {P}% )") ; Set GadgetID and Mask for Flag #TEXTMSG
Declare SetStatusBar(StatusBarId.i, Field.i=0, Mask.s="{F} ( {P}% )") ; Set GadgetID, Field and Mask for Flag #STATUSBAR
Declare.i Download(URL.s, FileName.s, AuthName.s = "", AuthPass.s = "", ConnectFlags.l = #PB_Default, Mode.l = #SYNCHRON, Flags.l = #NOGADGET, BlockSize.i = $10000, TimeOUT.i = #PB_Default)
Declare.i DownloadInMemory(URL.s, FileName.s="", AuthName.s = "", AuthPass.s = "", ConnectFlags.l = #PB_Default, Mode.l = #SYNCHRON, Flags.l = #NOGADGET, BlockSize.i = $10000, TimeOUT.i = #PB_Default)
Declare StopAsyncronDownload(*Handle)
Declare.i GetLastError(*Handle=#False)
Declare.s GetLastErrorMessage(*Handle=#False)
Declare.i GetAsyncronMemory(*Handle) ; Get the *Memory with the downloaded file (asynchronous mode)
Declare.s GetURL(*Handle) ; Get the URL of the file download (asynchronous mode)
Declare IsDownloadStillRunning(*Handle)
Declare.i BytesLoaded(*Handle)
Declare.f GetDownloadPercent(*Handle)
Declare.q GetSize(*Handle)
Declare FreeMem(*Handle, Mode.l = #True)
Declare FreeAll()
EndDeclareModule
Module GetHTTPFile
EnableExplicit
InitNetwork()
#INTERNET_OPTION_CONNECT_TIMEOUT = $00000002
#HTTP_QUERY_CONTENT_LENGTH = 5
Structure GETHTTP_INTERNAL_VALUES
ProgressGId.i ; ID ProgressBarGadget
StatusBarId.i ; ID StatusBar
TextGId.i ; ID TextGadget
Mask.s ; Mask for Text: {F} = Filename / {P} = Percent / {S} = Size
StatusBarIdx.i ; StatusBar Field
LastError.i
List Handles.i()
EndStructure
Global Intern.GETHTTP_INTERNAL_VALUES
Intern\LastError = #ERROR_NO_ERROR
Structure GETHTTP_VALUES
ThreadID.i
Flags.l
BytesLoaded.i
*URL
*AuthBuffer
AuthBufferLength.i
ConnectFlags.i
BlockSize.i
FileName.s
FileHandle.i
FileSize.q
StopThread.i
Error.i
ErrorMSG.c[256]
TimeOUT.i
*Memory
*Intern.GETHTTP_INTERNAL_VALUES
EndStructure
Procedure GetHTTPFile_IsHandle(*Handle)
Define.l Result
ForEach Intern\Handles()
If Intern\Handles() = *Handle
Result = #True
Break
EndIf
Next
If Result = #False
Intern\LastError = #ERROR_IS_NO_HANDLE
EndIf
ProcedureReturn Result
EndProcedure
Procedure.s GetHTTPFile_API_Error(Error.i, *Buffer=#False)
Protected Msg$, *Msg
If *Buffer
*Msg = *Buffer
Else
Msg$ = Space(256)
*Msg = @Msg$
EndIf
If Error >= 12000 And Error <= 12174
FormatMessage_(#FORMAT_MESSAGE_FROM_HMODULE, GetModuleHandle_(@"wininet.dll"), Error, 0, *Msg, 256, 0)
Else
FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, Error, 0, *Msg, 256, 0)
EndIf
ProcedureReturn Msg$
EndProcedure
Procedure.i GetLastError(*Handle=#False)
Define *Thread.GETHTTP_VALUES
Define.i Result
If *Handle = #False
Result = Intern\LastError
ElseIf GetHTTPFile_IsHandle(*Handle)
*Thread = *Handle
Result = *Thread\Error
EndIf
ProcedureReturn Result
EndProcedure
Procedure.s GetHTTPFile_GetApiError(Error.i, *Handle=#False)
Define *Thread.GETHTTP_VALUES
Define.s Result$
If *Handle And GetHTTPFile_IsHandle(*Handle)
*Thread = *Handle
Result$ = PeekS(*Thread + OffsetOf(GETHTTP_VALUES\ErrorMSG), SizeOf(GETHTTP_VALUES\ErrorMSG))
Else
Result$ = GetHTTPFile_API_Error(Error)
EndIf
ProcedureReturn Result$
EndProcedure
Procedure.s GetLastErrorMessage(*Handle=#False)
Define.s Msg$, Result$ = "No Error"
Define.i Error
Error = GetLastError(*Handle)
Select Error
Case #ERROR_CANT_CREATE_FILE
Result$ = "Unable to create File"
Case #ERROR_FILE_EXISTS_ALREADY
Result$ = "File already exist"
Case #ERROR_CANT_CREATE_THREAD
Result$ = "Unable to create Thread"
Case #ERROR_NO_MEMORY
Result$ = "Not enough Memory"
Case #ERROR_USER_ABORTED
Result$ = "User aborted!"
Case #ERROR_NO_INTERNET
Result$ = "WinINet-Init failed; " + GetHTTPFile_GetApiError(Error, *Handle)
Case #ERROR_UNABLE_TO_OPEN_URL
Result$ = "Unable to connect to URL; " + GetHTTPFile_GetApiError(Error, *Handle)
Case #ERROR_UNABLE_TO_READ_ONLINEFILE
Result$ = "Unable to open File on Server; " + GetHTTPFile_GetApiError(Error, *Handle)
Case #ERROR_IS_NO_HANDLE
Result$ = "This was no valid Handle!"
Default
Result$ = "Win-Error: " + GetHTTPFile_GetApiError(Error, *Handle)
EndSelect
ProcedureReturn Result$
EndProcedure
Procedure.s FormatFileSize(dSize.d, NbDecimals.i=2)
If dSize < 1024
If dSize < 0 : ProcedureReturn "0 Byte" : EndIf
ProcedureReturn Str(dSize)+" Byte"
ElseIf dSize >= 1<<40
ProcedureReturn StrD(dSize/1<<40, NbDecimals)+" TB"
ElseIf dSize >= 1<<30
ProcedureReturn StrD(dSize/1<<30, NbDecimals)+" GB"
ElseIf dSize >= 1<<20
ProcedureReturn StrD(dSize/1<<20, NbDecimals)+" MB"
Else
ProcedureReturn StrD(dSize/1024, NbDecimals)+" KB"
EndIf
EndProcedure
Procedure GetHTTPFile_Thread(*Thread.GETHTTP_VALUES)
Define *Buffer, L
Define.s TextMsg$
Define.i hINet, hData, TimeOUT, Lenght, HeaderNum, i, Percent, Bytes = 0, Size = 0
Define.l Flags, Send = #True
;{ ----- Description -----
;| Main procedure to download something from the internet.
;| We use the WinAPI, because it makes sure
;| it will also work, when the user is behind a proxy.
;| (and he/she configures his/her IE correctly)
;| and even redirected files will be catched.
;|
;| This procedure is called as thread, to make sure
;| there won't be any lags, when the host is not reachable
;| or something like this.
;|
;| This procedure can download directly into memory or in a file.
;} ------------
*Thread\Memory = #False
hINet = InternetOpen_(?GVI_Agent, 0, 0, 0, 0)
If hInet
PostEvent(#Download, #Null, #Null, #Start, *Thread)
Flags = *Thread\Flags ; #PROGRESS | #TEXTMSG
;{ Init ProgressGadgets
If Flags & #PROGRESS
SetGadgetState(*Thread\Intern\ProgressGId, 0)
EndIf
If Flags & #TEXTMSG
If IsGadget(*Thread\Intern\TextGId)
TextMsg$ = ReplaceString(ReplaceString(ReplaceString(*Thread\Intern\Mask, "{P}", "0"), "{S}", "0 Byte"), "{F}", *Thread\FileName)
SetGadgetText(*Thread\Intern\TextGId, TextMsg$)
EndIf
EndIf
If Flags & #STATUSBAR
If IsStatusBar(*Thread\Intern\StatusBarId)
TextMsg$ = ReplaceString(ReplaceString(ReplaceString(*Thread\Intern\Mask, "{P}", "0"), "{S}", "0 Byte"), "{F}", *Thread\FileName)
StatusBarText(*Thread\Intern\StatusBarId, *Thread\Intern\StatusBarIdx, TextMsg$)
EndIf
EndIf ;}
If *Thread\TimeOUT <> #PB_Default ;{ Set TimeOUT
If InternetSetOption_(hINet, #INTERNET_OPTION_CONNECT_TIMEOUT, *Thread + OffsetOf(GETHTTP_VALUES\TimeOUT), SizeOf(INTEGER)) = #False
*Thread\Error = GetLastError_()
GetHTTPFile_API_Error(*Thread\Error, *Thread + OffsetOf(GETHTTP_VALUES\ErrorMSG))
EndIf
EndIf ;}
If *Thread\AuthBuffer And *Thread\AuthBufferLength ;{ Authorization (htaccess)
hData = InternetOpenUrl_(hINet, *Thread\URL, *Thread\AuthBuffer, *Thread\AuthBufferLength, *Thread\ConnectFlags, 0)
Else
hData = InternetOpenUrl_(hINet, *Thread\URL, 0, 0, *Thread\ConnectFlags, 0)
EndIf ;}
If hData
;{ Get File Length
*Buffer = AllocateMemory(2048)
If *Buffer
Lenght = 2048
HeaderNum = 0
If HttpQueryInfo_(hData, #HTTP_QUERY_CONTENT_LENGTH, *Buffer, @Lenght, @HeaderNum)
*Thread\FileSize = Val(PeekS(*Buffer, Lenght))
Else
*Thread\FileSize = #FILESIZE_UNKNOWN
EndIf
FreeMemory(*Buffer)
EndIf ;}
If *Thread\BlockSize <= 0 : *Thread\BlockSize = $10000 : EndIf
*Thread\Memory = AllocateMemory(*Thread\BlockSize)
If *Thread\Memory
Repeat
If *Thread\StopThread ;{ Stop Thread
*Thread\StopThread = 2
*Thread\Intern\LastError = #ERROR_USER_ABORTED
*Thread\Error = #ERROR_USER_ABORTED
FreeMemory(*Thread\Memory)
*Thread\Memory = 0
Send = #False
Break
EndIf ;}
If InternetReadFile_(hData, *Thread\Memory + Size, *Thread\BlockSize, @Bytes) = #False ;{ Error
FreeMemory(*Thread\Memory)
*Thread\Memory = 0
*Thread\Intern\LastError = #ERROR_UNABLE_TO_READ_ONLINEFILE
*Thread\Error = GetLastError_()
GetHTTPFile_API_Error(*Thread\Error, *Thread + OffsetOf(GETHTTP_VALUES\ErrorMSG))
Break
;}
ElseIf *Thread\FileHandle = -1 ;{ Download to Memory
Size + Bytes
If Bytes
*Thread\Memory = ReAllocateMemory(*Thread\Memory, Size + *Thread\BlockSize)
If Not *Thread\Memory
*Thread\Intern\LastError = #ERROR_NO_MEMORY
*Thread\Error = #ERROR_NO_MEMORY
Break
EndIf
*Thread\BytesLoaded = Size
EndIf ;}
Else ;{ Download to File
If Bytes
WriteData(*Thread\FileHandle, *Thread\Memory, Bytes)
*Thread\BytesLoaded + Bytes
EndIf ;}
EndIf
;{ Update ProgressGadgets
If Flags & #PROGRESS
If IsGadget(*Thread\Intern\ProgressGId)
If *Thread\FileSize > 0
SetGadgetState(*Thread\Intern\ProgressGId, Round((*Thread\BytesLoaded / *Thread\FileSize)*100, #PB_Round_Nearest))
Else
SetGadgetState(*Thread\Intern\ProgressGId, 0)
EndIf
EndIf
EndIf
If Flags & #TEXTMSG
If IsGadget(*Thread\Intern\TextGId)
If *Thread\FileSize > 0
Percent = ( *Thread\BytesLoaded / *Thread\FileSize ) * 100
EndIf
TextMsg$ = ReplaceString(ReplaceString(ReplaceString(*Thread\Intern\Mask, "{P}", StrF(Percent, 0)), "{S}", FormatFileSize(*Thread\BytesLoaded)), "{F}", *Thread\FileName)
SetGadgetText(*Thread\Intern\TextGId, TextMsg$)
EndIf
EndIf
If Flags & #STATUSBAR
If IsStatusBar(*Thread\Intern\StatusBarId)
If *Thread\FileSize > 0
Percent = ( *Thread\BytesLoaded / *Thread\FileSize ) * 100
EndIf
TextMsg$ = ReplaceString(ReplaceString(ReplaceString(*Thread\Intern\Mask, "{P}", StrF(Percent, 0)), "{S}", FormatFileSize(*Thread\BytesLoaded)), "{F}", *Thread\FileName)
StatusBarText(*Thread\Intern\StatusBarId, *Thread\Intern\StatusBarIdx, TextMsg$)
EndIf
EndIf ;}
PostEvent(#Download, #Null, #Null, #Update, *Thread)
Until Bytes <= 0
Else
*Thread\Intern\LastError = #ERROR_NO_MEMORY
*Thread\Error = #ERROR_NO_MEMORY
EndIf
InternetCloseHandle_(hData)
Else
*Thread\Intern\LastError = #ERROR_UNABLE_TO_OPEN_URL
*Thread\Error = GetLastError_()
GetHTTPFile_API_Error(*Thread\Error, *Thread + OffsetOf(GETHTTP_VALUES\ErrorMSG))
EndIf
InternetCloseHandle_(hINet)
Else
*Thread\Intern\LastError = #ERROR_NO_INTERNET
*Thread\Error = GetLastError_()
EndIf
If *Thread\FileHandle <> -1 ; Download to File
*Thread\FileSize = Lof(*Thread\FileHandle)
CloseFile(*Thread\FileHandle)
If *Thread\Memory
FreeMemory(*Thread\Memory)
*Thread\Memory = #True
EndIf
ElseIf *Thread\Memory
*Thread\FileSize = Size
If Size <> MemorySize(*Thread\Memory)
;Shrink Buffer to real size
If Size > 0
*Thread\Memory = ReAllocateMemory(*Thread\Memory, Size)
Else
FreeMemory(*Thread\Memory)
*Thread\Memory = 0
EndIf
EndIf
EndIf
PostEvent(#Download, #Null, #Null, #Finished, *Thread)
ProcedureReturn *Thread\Memory
EndProcedure
Procedure StopAsyncronDownload(*Handle)
Define *Thread.GETHTTP_VALUES
Define.l Result = #True
If GetHTTPFile_IsHandle(*Handle)
*Thread = *Handle
If *Thread\ThreadID And IsThread(*Thread\ThreadID)
*Thread\StopThread = 1
If WaitThread(*Thread\ThreadID, 1000) = #False
If *Thread\StopThread = 1 Or WaitThread(*Thread\ThreadID, 100) = 0
KillThread(*Thread\ThreadID)
Result = #False
EndIf
EndIf
*Thread\Error = #ERROR_USER_ABORTED
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure FreeMem(*Handle, Mode.l = #True)
Protected *Thread.GETHTTP_VALUES
;{ ----- Description -----
;| Procedure to free the memory of one GetHTTP-Request
;|
;| Mode = #true => also free the ResultBuffer, otherwise you can still use the memory
;| (but you have to copy the pointer)
;} -----------
If GetHTTPFile_IsHandle(*Handle)
*Thread = *Handle
If *Thread\ThreadID = IsThread(*Thread\ThreadID)
StopAsyncronDownload(*Thread)
EndIf
If *Thread\URL : FreeMemory(*Thread\URL) : EndIf
If *Thread\AuthBuffer : FreeMemory(*Thread\AuthBuffer) : EndIf
If *Thread\Memory < 0 Or *Thread\Memory > 1
If Mode : FreeMemory(*Thread\Memory) : EndIf
EndIf
FreeMemory(*Thread)
DeleteElement(Intern\Handles())
EndIf
EndProcedure
Procedure SetStatusBar(StatusBarId.i, Field.i=0, Mask.s="{F} ( {P}% )") ; Set GadgetID, Field and Mask for Flag #STATUSBAR
Intern\StatusBarId = StatusBarId
Intern\StatusBarIdx = Field
Intern\Mask = Mask
EndProcedure
Procedure SetTextGadget(TextGId.i=0, Mask.s="{F} ( {P}% )") ; Set GadgetID and Mask for Flag #TEXTMSG
Intern\TextGId = TextGId
Intern\Mask = Mask
EndProcedure
Procedure SetProgressBarGadget(ProgressBarGId.i) ; Set GadgetID for Flag #PROGRESS
Intern\ProgressGId = ProgressBarGId
EndProcedure
Procedure.i Download(URL.s, FileName.s, AuthName.s = "", AuthPass.s = "", ConnectFlags.l = #PB_Default, Mode.l = #SYNCHRON, Flags.l = #NOGADGET, BlockSize.i = $10000, TimeOUT.i = #PB_Default)
Define *Auth, *Thread.GETHTTP_VALUES
Define.s Auth$, Output$
Define.i Result, FileID, outLen
;{ ----- Description -----
;| Procedure to Download a file to your harddisk
;|
;| Parameters:
;| URL => The Url of the file
;| FileName => The Name of the file on your harddisk (inclusive Path)
;| !!Will NOT overwright any existing file!!
;| AuthName => Username of authorization (if needed, otherwise leave empty)
;| AuthPass => Password of authorization (if needed, otherwise leave empty)
;| !!This is just for very simple htaccess secured areas!!
;| ConnectFlags => See MSDN: http://msdn.microsoft.com/en-us/library/aa385098%28VS.85%29.aspx
;| Flags => Possible values:
;| #SYNCHRON : Procedure will block your program till the file is downloaded.
;| #ASYNCHRON : Procedure will not block your program, but will send a Message to your Window.
;| #PROGRESS : Update ProgressBarGadget
;| #TEXTMSG : Update TextGadget (Mask: {F} = Filename / {P} = Percent / {S} = Size)
;| #STATUSBAR : Update StatusBar (Mask: {F} = Filename / {P} = Percent / {S} = Size)
;| WindowID => If in asynchronous mode, this Window will receive a message, when download is ready.
;| WindowMessage => If in asynchronous mode, this Message will be sent to the above WindowID, when download is ready.
;| BlockSize => This is the amount of Bytes, the procedure tries to read at once.
;| TimeOUT => Timeout in ms for the connection-trial. (Default is 60000 = one minute)
;|
;| Result => Returns #False, if anything went wrong, anything other then 0, when o.k.
;| When in asynchronous mode, your window will receive a message, where the
;| wParam is a pointer to a _GETHTTP_THREAD_VALUES_-Structure
;| If you are finished, you should send this pointer to \FreeMem
;|
;} -------------------
If FileSize(FileName) = -1 ; File not exist
FileID = CreateFile(#PB_Any, FileName)
If FileID
*Thread = AllocateMemory(SizeOf(GETHTTP_VALUES))
If *Thread
If AuthName ;{ Authorization (htaccess)
*Auth = AllocateMemory(StringByteLength(AuthName + ":" + AuthPass) + 1)
If *Auth
PokeS(*Auth, AuthName + ":" + AuthPass, -1, #PB_Ascii)
outLen = (Len(AuthName) + Len(AuthPass)) * 2
Output$ = Space(outLen)
Base64Encoder(*Auth, MemorySize(*Auth), @Output$, outLen * SizeOf(CHARACTER))
Auth$ = "Authorization: Basic " + PeekS(@Output$, -1, #PB_Ascii)
FreeMemory(*Auth)
*Thread\AuthBuffer = AllocateMemory(StringByteLength(Auth$) + SizeOf(CHARACTER))
PokeS(*Thread\AuthBuffer, Auth$)
*Thread\AuthBufferLength = Len(Auth$)
EndIf
EndIf ;}
If ConnectFlags = #PB_Default
ConnectFlags = #INTERNET_FLAG_NO_CACHE_WRITE | #INTERNET_FLAG_PRAGMA_NOCACHE
EndIf
*Thread\FileName = GetFilePart(FileName)
*Thread\FileHandle = FileID
*Thread\ConnectFlags = ConnectFlags
*Thread\Flags = Flags
*Thread\Intern = @Intern
*Thread\URL = AllocateMemory(StringByteLength(URL) + SizeOf(CHARACTER))
*Thread\BlockSize = BlockSize
*Thread\FileSize = #FILESIZE_NOT_YET_KNOWN
PokeS(*Thread\URL, URL)
If Mode & #ASYNCHRON
*Thread\ThreadID = CreateThread(@GetHTTPFile_Thread(), *Thread)
Result = *Thread
AddElement(Intern\Handles())
Intern\Handles() = *Thread
Else
Result = GetHTTPFile_Thread(*Thread)
FreeMem(*Thread)
EndIf
Else
CloseFile(FileID)
Intern\LastError = #ERROR_NO_MEMORY
EndIf
Else
Intern\LastError = #ERROR_CANT_CREATE_FILE
EndIf
Else
Intern\LastError = #ERROR_FILE_EXISTS_ALREADY
EndIf
ProcedureReturn Result
EndProcedure
Procedure.i DownloadInMemory(URL.s, FileName.s="", AuthName.s = "", AuthPass.s = "", ConnectFlags.l = #PB_Default, Mode.l = #SYNCHRON, Flags.l = #NOGADGET, BlockSize.i = $10000, TimeOUT.i = #PB_Default)
Define *Auth, *Thread.GETHTTP_VALUES
Define.s Auth$, Output$
Define.i Result, FileID, outLen
;{ ----- Description -----
;| Procedure to Download a file to the memory
;|
;| Parameters:
;| URL => The Url of the file
;| FileName => The Name of the File
;| AuthName => Username of authorization (if needed, otherwise leave empty)
;| AuthPass => Password of authorization (if needed, otherwise leave empty)
;| !!This is just for very simple htaccess secured areas!!
;| ConnectFlags => See MSDN: http://msdn.microsoft.com/en-us/library/aa385098%28VS.85%29.aspx
;| WindowID => If in asynchronous mode, this Window will receive a message, when download is ready.
;| WindowMessage => If in asynchronous mode, this Message will be sent to the above WindowID, when download is ready.
;| Flags => Possible values:
;| #SYNCHRON : Procedure will block your program till the file is downloaded.
;| #ASYNCHRON : Procedure will not block your program, but will send a Message to your Window.
;| #PROGRESS : Update ProgressBarGadget
;| #TEXTMSG : Update TextGadget (Mask: {F} = Filename / {P} = Percent / {S} = Size)
;| #STATUSBAR : Update StatusBar (Mask: {F} = Filename / {P} = Percent / {S} = Size)
;| BlockSize => This is the amount of Bytes, the procedure tries to read at once.
;| TimeOUT => Timeout in ms for the connection-trial. (Default is 60000 = one minute)
;|
;| Result => Returns #False, if anything went wrong, anything other then 0, when o.k.
;| When in asynchronous mode, your window will receive a message, where the
;| wParam is a pointer to a _GETHTTP_THREAD_VALUES_-Structure
;| If you are finished, you should send this pointer to \FreeMem
;|
;} -------------------
*Thread = AllocateMemory(SizeOf(GETHTTP_VALUES))
If *Thread
If AuthName ;{ Authorization (htaccess)
*Auth = AllocateMemory(StringByteLength(AuthName + ":" + AuthPass) + 1)
If *Auth
PokeS(*Auth, AuthName + ":" + AuthPass, -1, #PB_Ascii)
outLen = (Len(AuthName) + Len(AuthPass)) * 2
Output$ = Space(outLen)
Base64Encoder(*Auth, MemorySize(*Auth), @Output$, outLen * SizeOf(CHARACTER))
Auth$ = "Authorization: Basic " + PeekS(@Output$, -1, #PB_Ascii)
FreeMemory(*Auth)
*Thread\AuthBuffer = AllocateMemory(StringByteLength(Auth$) + SizeOf(CHARACTER))
PokeS(*Thread\AuthBuffer, Auth$)
*Thread\AuthBufferLength = Len(Auth$)
EndIf
EndIf ;}
If ConnectFlags = #PB_Default
ConnectFlags = #INTERNET_FLAG_NO_CACHE_WRITE | #INTERNET_FLAG_PRAGMA_NOCACHE
EndIf
*Thread\FileName = GetFilePart(FileName)
*Thread\FileHandle = -1
*Thread\ConnectFlags = ConnectFlags
*Thread\Flags = Flags
*Thread\Intern = @Intern
*Thread\URL = AllocateMemory(StringByteLength(URL) + SizeOf(CHARACTER))
*Thread\BlockSize = BlockSize
*Thread\FileSize = #FILESIZE_NOT_YET_KNOWN
PokeS(*Thread\URL, URL)
If Mode & #ASYNCHRON
*Thread\ThreadID = CreateThread(@GetHTTPFile_Thread(), *Thread)
Result = *Thread
AddElement(Intern\Handles())
Intern\Handles() = *Thread
Else
Result = GetHTTPFile_Thread(*Thread) ; Result = *Memory with Download
FreeMem(*Thread, #False)
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure.i GetAsyncronMemory(*Handle)
Define *Thread.GETHTTP_VALUES
Define.i Result
;{ ----- Description -----
;| Get the Result of this File download (when in asynchronous mode)
;} ------------
If GetHTTPFile_IsHandle(*Handle)
*Thread = *Handle
Result = *Thread\Memory
EndIf
ProcedureReturn Result
EndProcedure
Procedure.s GetURL(*Handle)
Define *Thread.GETHTTP_VALUES
Define.s Result$
;{ ----- Description -----
;| Get the URL of this file download (in asynchronous mode, this helps to know, which file this is)
;} ------------
If GetHTTPFile_IsHandle(*Handle)
*Thread = *Handle
If *Thread\URL
Result$ = PeekS(*Thread\URL)
EndIf
EndIf
ProcedureReturn Result$
EndProcedure
Procedure IsDownloadStillRunning(*Handle)
Define *Thread.GETHTTP_VALUES
Define.l Result = #False
If GetHTTPFile_IsHandle(*Handle)
*Thread = *Handle
If *Thread\ThreadID And IsThread(*Thread\ThreadID)
Result = #True
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure.i BytesLoaded(*Handle)
Define *Thread.GETHTTP_VALUES
Define.i Result
If GetHTTPFile_IsHandle(*Handle)
*Thread = *Handle
Result = *Thread\BytesLoaded
EndIf
ProcedureReturn Result
EndProcedure
Procedure.f GetDownloadPercent(*Handle)
Define *Thread.GETHTTP_VALUES
Define.f Result
If GetHTTPFile_IsHandle(*Handle)
*Thread = *Handle
If *Thread\FileSize > 0
Result = *Thread\BytesLoaded / *Thread\FileSize
EndIf
EndIf
ProcedureReturn Result
EndProcedure
Procedure.q GetSize(*Handle)
Protected Result.q, *Thread.GETHTTP_VALUES
If GetHTTPFile_IsHandle(*Handle)
*Thread = *Handle
Result = *Thread\FileSize
EndIf
ProcedureReturn Result
EndProcedure
Procedure FreeAll()
ForEach Intern\Handles()
FreeMem(Intern\Handles())
Next
EndProcedure
DataSection
;Mozilla/4.0 (compatible; ST)
GVI_Agent:
Data.l $697A6F4D, $2F616C6C, $20302E34, $6D6F6328, $69746170, $3B656C62, $29545320
Data.b 0
EndDataSection
EndModule
CompilerIf #PB_Compiler_IsMainFile
InitNetwork()
UseJPEGImageDecoder()
#JSON = 1
#Window = 0
#StatusBar = 0
#Picture = 0
#Image = 0
Enumeration 1
#Text1
#Text2
#Text3
#Button1
#Button2
#Button3
#Gadget_ProgressBar
#Gadget_FileList
#Gadget_Text
#Gadget_Download
EndEnumeration
Procedure.i WindowSynchron()
If OpenWindow(#Window,266,150,400,300,"Synchron Download (Memory)",#PB_Window_SystemMenu|#PB_Window_Tool|#PB_Window_ScreenCentered|#PB_Window_Invisible)
ListViewGadget(#Gadget_FileList,5,5,390,260)
ButtonGadget(#Gadget_Download,160,270,80,25,"Download")
HideWindow(#Window,0)
ProcedureReturn WindowID(#Window)
EndIf
EndProcedure
Procedure.i WindowDownload()
If OpenWindow(#Window,0,0,300,105,"Download",#PB_Window_SystemMenu|#PB_Window_Tool|#PB_Window_ScreenCentered|#PB_Window_Invisible)
TextGadget(#Gadget_Text,10,10,280,18,"-----",#PB_Text_Center|#PB_Text_Border)
ProgressBarGadget(#Gadget_ProgressBar,10,40,280,20,0,100)
ButtonGadget(#Gadget_Download,110,73,80,22,"Download")
HideWindow(#Window,0)
ProcedureReturn WindowID(#Window)
EndIf
EndProcedure
Procedure DownloadSynchron()
Define.s URL$
Define.l quitWindow = #False
Structure FileStructure
Version.s
VDate.i
Path.s
Name.s
Pack.s
CRC.i
Date.i
Size.i
Type.s
Attrib.i
Flags.l
Update.l
EndStructure
NewMap JSON.FileStructure()
URL$ = "http://thprogs.de/KvGS4/thIUpd/thIUpdater.uif" ; JSON-File with Update-Informations
If WindowSynchron()
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
If EventWindow() = #Window
quitWindow = #True
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case #Gadget_Download
*FileMemory = GetHTTPFile::DownloadInMemory(URL$, "thIUpdater.uif", "", "", #INTERNET_FLAG_RESYNCHRONIZE)
If *FileMemory
If CatchJSON(#JSON, *FileMemory, MemorySize(*FileMemory))
ExtractJSONMap(JSONValue(#JSON), JSON())
FreeJSON(#JSON)
EndIf
ForEach JSON()
AddGadgetItem(#Gadget_FileList, -1, JSON()\Name + " ("+GetHTTPFile::FormatFileSize(JSON()\Size)+" / "+FormatDate("%dd.%mm.%yyyy", JSON()\Date)+")")
Next
FreeMemory(*FileMemory)
EndIf
DisableGadget(#Gadget_Download, #True)
EndSelect
EndSelect
Until quitWindow
CloseWindow(#Window)
EndIf
EndProcedure
Procedure DownloadProgressBar()
Define *Handle
Define.s FileName$, URL$, File$
Define.d Bytes
Define.l Finished = #True
URL$ = "http://download.thinkbroadband.com/10MB.zip"
File$ = GetTemporaryDirectory() + "10MB.zip"
If WindowDownload()
Define.l quitWindow = #False
GetHTTPFile::SetProgressBarGadget(#Gadget_ProgressBar)
GetHTTPFile::SetTextGadget(#Gadget_Text, "{F} ( {S} )")
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow ;{ Close Window
If EventWindow() = #Window
quitWindow = #True
EndIf ;}
Case #PB_Event_Gadget ;{ Gadget Event
Select EventGadget()
Case #Gadget_Download ;{ Download
If FileSize(File$) >= 0 : DeleteFile(File$) : EndIf
*Handle = GetHTTPFile::Download(URL$, File$, "", "", #INTERNET_FLAG_RESYNCHRONIZE, GetHTTPFile::#ASYNCHRON, GetHTTPFile::#PROGRESS)
If *Handle
DisableGadget(#Gadget_Download, #True)
Else
Debug GetHTTPFile::GetLastErrorMessage()
EndIf ;}
EndSelect ;}
Case GetHTTPFile::#Download
Select EventType()
Case GetHTTPFile::#Start
SetGadgetText(#Gadget_Text, GetFilePart(File$) + " ( 0 Byte )")
Case GetHTTPFile::#Update
Bytes = GetHTTPFile::BytesLoaded(EventData())
SetGadgetText(#Gadget_Text, GetFilePart(File$) + " ( "+GetHTTPFile::FormatFileSize(Bytes)+" )")
Case GetHTTPFile::#Finished ;{ Download beendet
DisableGadget(#Gadget_Download, #False)
Finished = #True
;}
EndSelect
EndSelect
Until quitWindow
If GetHTTPFile::IsDownloadStillRunning(*Handle) : GetHTTPFile::StopAsyncronDownload(*Handle) : EndIf
GetHTTPFile::FreeMem(*Handle)
CloseWindow(#Window)
EndIf
EndProcedure
Procedure DownloadPicture()
Define *Buffer, *Handle
Define.i wParam, w, h, Num = 0
Define.f factor
OpenWindow(#Window, 0, 0, 1026, 780, "GetHTTP - Test", #PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
ImageGadget(#Picture, 0, 0, 1024, 768, 0, #PB_Image_Border)
CreateStatusBar(#StatusBar, WindowID(#Window))
AddStatusBarField(#PB_Ignore)
Dim URLs.s(3)
URLs(0) = "https://upload.wikimedia.org/wikipedia/commons/e/ec/Il_Gatto_e_il_Topo_2.jpg"
URLs(1) = "https://upload.wikimedia.org/wikipedia/commons/thumb/4/47/Lion_female.jpg/1280px-Lion_female.jpg"
URLs(2) = "https://upload.wikimedia.org/wikipedia/commons/thumb/a/a5/MiezeSchindler.JPG/1280px-MiezeSchindler.JPG"
GetHTTPFile::SetStatusBar(#StatusBar, 0, " Lade ... ({S})")
If GetHTTPFile::DownloadInMemory(URLs(Num), "", "", "", #INTERNET_FLAG_RESYNCHRONIZE, GetHTTPFile::#ASYNCHRON, GetHTTPFile::#STATUSBAR)
StatusBarText(#StatusBar, 0, " Lade ...")
Else
StatusBarText(#StatusBar, 0, GetHTTPFile::GetLastErrorMessage())
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #Picture ;{ Klick auf Bild
If EventType() = #PB_EventType_LeftClick
Num + 1
If Num > 2 : Num = 0 : EndIf
GetHTTPFile::SetStatusBar(#StatusBar, 0, " Lade ... ({S})" )
If GetHTTPFile::DownloadInMemory(URLs(Num), "", "", "", #INTERNET_FLAG_RESYNCHRONIZE, GetHTTPFile::#ASYNCHRON, GetHTTPFile::#STATUSBAR)
StatusBarText(#StatusBar, 0, " Lade ...")
EndIf
EndIf ;}
EndSelect
Case GetHTTPFile::#Download
Select EventType()
;Case GetHTTPFile::#Start
;Case GetHTTPFile::#Update
Case GetHTTPFile::#Finished ;{ Download beendet
*Handle = EventData() ; Handle der Thread von PostEvent()
StatusBarText(#StatusBar, 0, "Bild geladen - Klicke für nächstes Bild!")
*Buffer = GetHTTPFile::GetAsyncronMemory(*Handle)
If *Buffer
If CatchImage(#Image, *Buffer, MemorySize(*Buffer))
w = ImageWidth(#Image)
h = ImageHeight(#Image)
If w > WindowWidth(#Window) - 4
factor = (WindowWidth(#Window) - 4) / w
EndIf
If h > WindowHeight(#Window) - 22
If factor > ((WindowHeight(#Window) - 22) / h)
factor = (WindowHeight(#Window) - 22) / h
EndIf
EndIf
ResizeImage(#Image, w * factor, h * factor)
SetGadgetState(#Picture, ImageID(#Image))
EndIf
EndIf
GetHTTPFile::FreeMem(*Handle)
;}
EndSelect
EndSelect
ForEver
CloseWindow(#Window)
EndProcedure
Procedure DownloadFile()
Define *Handle
Define.s Msg$, Txt$, b$
Define.i i, Bytes, Error
Define.l Disable
Dim URLs.s(4)
Dim *Handle(4)
Msg$ = "DL#{N} ({B}, {P}%)"
OpenWindow(#Window, 0, 0, 520, 118, "GetHTTP Test", #PB_Window_SystemMenu|#PB_Window_TitleBar|#PB_Window_ScreenCentered)
TextGadget(#Text1, 5, 27, 450, 20, "DL#1 ("+GetHTTPFile::FormatFileSize(0)+", 0%)")
ButtonGadget(#Button1, 460, 27, 40, 20, "X")
TextGadget(#Text2, 5, 49, 450, 20, "DL#2 ("+GetHTTPFile::FormatFileSize(0)+", 0%)")
ButtonGadget(#Button2, 460, 49, 40, 20, "X")
TextGadget(#Text3, 5, 71, 450, 20, "DL#3 ("+GetHTTPFile::FormatFileSize(0)+", 0%)")
ButtonGadget(#Button3, 460, 71, 40, 20, "X")
While WindowEvent() : Wend
URLs(0) = "http://download.thinkbroadband.com/5MB.zip"
URLs(1) = "http://download.thinkbroadband.com/10MB.zip"
URLs(2) = "ftp://ftp.freenet.de/pub/freenet-ag.de/100MB"
For i = 0 To 2 ; Downloads anstoßen
*Handle(i) = GetHTTPFile::DownloadInMemory(URLs(i), "", "", "", #INTERNET_FLAG_RESYNCHRONIZE, GetHTTPFile::#ASYNCHRON, GetHTTPFile::#NOGADGET, 1024)
Next
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #Button1 ;{ Download abbrechen
If GetHTTPFile::IsDownloadStillRunning(*Handle(0))
GetHTTPFile::StopAsyncronDownload(*Handle(0))
EndIf
Case #Button2
If GetHTTPFile::IsDownloadStillRunning(*Handle(1))
GetHTTPFile::StopAsyncronDownload(*Handle(1))
EndIf
Case #Button3
If GetHTTPFile::IsDownloadStillRunning(*Handle(2))
GetHTTPFile::StopAsyncronDownload(*Handle(2))
EndIf
;}
EndSelect
Case GetHTTPFile::#Download
Select EventType()
;Case GetHTTPFile::#Start
;Case GetHTTPFile::#Finished
Case GetHTTPFile::#Update
*Handle = EventData() ; Handle der Thread von PostEvent()
Bytes = GetHTTPFile::BytesLoaded(*Handle) ;{ Bytes / Prozent ermitteln
If GetHTTPFile::IsDownloadStillRunning(*Handle)
If Bytes
Txt$ = ReplaceString(Msg$, "{N}", Str(i+1))
Txt$ = ReplaceString(Txt$, "{B}", GetHTTPFile::FormatFileSize(Bytes))
Txt$ = ReplaceString(Txt$, "{P}", StrF(GetHTTPFile::GetDownloadPercent(*Handle) * 100, 1))
Disable = #False
EndIf
Else
Txt$ = "DL#" + Str(i) + ": finished! (" + GetHTTPFile::FormatFileSize(Bytes) + ")"
If GetHTTPFile::GetLastError(*Handle)
Txt$ + " [" + GetHTTPFile::GetLastErrorMessage(Error) + "]"
EndIf
Disable = #True
EndIf ;}
Select *Handle ;{ Update TextGadget
Case *Handle(0)
SetGadgetText(#Text1, Txt$)
If Disable : DisableGadget(#Button1, #True) : EndIf
Case *Handle(1)
SetGadgetText(#Text2, Txt$)
If Disable : DisableGadget(#Button2, #True) : EndIf
Case *Handle(2)
SetGadgetText(#Text3, Txt$)
If Disable : DisableGadget(#Button3, #True) : EndIf
EndSelect ;}
While WindowEvent() : Wend
EndSelect
EndSelect
ForEver
; Aufräumen
For i = 0 To 2
If GetHTTPFile::IsDownloadStillRunning(*Handle(i))
GetHTTPFile::StopAsyncronDownload(*Handle(i))
While WindowEvent() : Wend
EndIf
GetHTTPFile::FreeMem(*Handle(i))
Next
CloseWindow(#Window)
EndProcedure
;DownloadFile() ; Download 3 Files asynchron with abort download
;DownloadPicture() ; Download Pictures to memory and show
DownloadProgressBar() ; Download file to HDD with percent and ProgressBar
;DownloadSynchron() ; Download JSON-file (synchron) in memory and extract it to Map()
CompilerEndIf
) eingebaut.