PureBoard

Code: Alles auswählen

;/--------------------------
;| GetHTTPFile.pbi
;| ©HeX0R 2012
;|
;| V1.08 [25.06.2012]
;|
;| WINDOWS ONLY Include
;| No Demo supported!
;| Minimum PB-Version needed is 4.50!
;| This include is based on my CheckForUpdates.pbi, which can be found here:
;| http://www.purebasic.fr/german/viewtopic.php?f=8&t=18904
;|
;| With this include you can easily download content from the internet.
;| If the user can download through his IE, you can do with this also.
;| Through proxies, redirects, download more files at once, etc..
;| You also can download your files in the background
;| When one download has finished, you get informed through a message.
;|
;| Free to use
;|
;/--------------------------
CompilerIf #PB_Compiler_Version < 450
	CompilerError "You need at least PB 4.50 for this include!"
CompilerEndIf

Enumeration
	#GETHTTP_ERROR_NO_ERROR
	#GETHTTP_ERROR_CANT_CREATE_FILE
	#GETHTTP_ERROR_CANT_CREATE_THREAD
	#GETHTTP_ERROR_NO_MEMORY
	#GETHTTP_ERROR_NO_INTERNET
	#GETHTTP_ERROR_UNABLE_TO_OPEN_URL
	#GETHTTP_ERROR_UNABLE_TO_READ_ONLINEFILE
	#GETHTTP_ERROR_USER_ABORTED
	#GETHTTP_ERROR_IS_NO_HANDLE
EndEnumeration

#GETHTTP_MODE_ASYNCHRON                 = 0
#GETHTTP_MODE_SYNCHRON                  = 1
#GETHTTP_FILESIZE_NOT_YET_KNOWN         = -1
#GETHTTP_FILESIZE_UNKNOWN               = -2


#INTERNET_FLAG_EXISTING_CONNECT         = $20000000
#INTERNET_FLAG_HYPERLINK                = $00000400
#INTERNET_FLAG_IGNORE_CERT_CN_INVALID   = $00001000
#INTERNET_FLAG_IGNORE_CERT_DATE_INVALID = $00002000
#INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP  = $00008000
#INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS = $00004000
#INTERNET_FLAG_KEEP_CONNECTION          = $00400000
#INTERNET_FLAG_NEED_FILE                = $00000010
#INTERNET_FLAG_NO_AUTH                  = $00040000
#INTERNET_FLAG_NO_AUTO_REDIRECT         = $00200000
#INTERNET_FLAG_NO_CACHE_WRITE           = $04000000
#INTERNET_FLAG_NO_COOKIES               = $00080000
#INTERNET_FLAG_NO_UI                    = $00000200
#INTERNET_FLAG_PASSIVE                  = $08000000
#INTERNET_FLAG_PRAGMA_NOCACHE           = $00000100
#INTERNET_FLAG_RAW_DATA                 = $40000000
#INTERNET_FLAG_RELOAD                   = $80000000
#INTERNET_FLAG_RESYNCHRONIZE            = $00000800
#INTERNET_FLAG_SECURE                   = $00800000

#INTERNET_OPTION_CONNECT_TIMEOUT        = $00000002
#HTTP_QUERY_CONTENT_LENGTH              = 5

Structure _GETHTTP_INTERFACE_VALUES_
	VTable.i
	;Data
	LastError.i
	List Handles.i()
EndStructure

Structure _GETHTTP_VALUES_
	ThreadID.i
	BytesLoaded.i
	*URL
	*AuthBuffer
	AuthBufferLength.i
	ConnectFlags.i
	BlockSize.i
	WindowHandle.i
	Message.i
	FileHandle.i
	FileSize.q
	StopThread.i
	Error.i
	ErrorMSG.c[256]
	TimeOUT.i
	*Result
	*GHIV._GETHTTP_INTERFACE_VALUES_
EndStructure

Interface _GETHTTP_INTERFACE_
	GetLastError.i(Handle = 0)
	GetLastErrorMessage.s(Handle = 0)
	GetFile.i(URL.s, FileName.s, AuthName.s = "", AuthPass.s = "", ConnectFlags = #PB_Default, WindowID = 0, WindowMessage = 0, Mode = #GETHTTP_MODE_SYNCHRON, BlockSize = $10000, TimeOUT = #PB_Default)
	GetFileInMemory.i(URL.s,     AuthName.s = "", AuthPass.s = "", ConnectFlags = #PB_Default, WindowID = 0, WindowMessage = 0, Mode = #GETHTTP_MODE_SYNCHRON, BlockSize = $10000, TimeOUT = #PB_Default)
	GetResult.i(Handle.i)
	GetURL.s(Handle.i)
	FreeMem(Handle.i, Mode = #True)
	StopAsyncDownload(Handle.i)
	IsAyncDownloadRunning.i(Handle.i)
	AsyncDownloadBytesLoaded.i(Handle.i)
	AsyncDownloadPercentLoaded.f(Handle.i)
	GetFileSize.q(Handle.i)
	FreeAll()
EndInterface

Procedure GetHTTPFile_IsHandle(*GH._GETHTTP_INTERFACE_VALUES_, Handle)
	Protected Result

	ForEach *GH\Handles()
		If *GH\Handles() = Handle
			Result = #True
			Break
		EndIf
	Next
	If Result = 0
		*GH\LastError = #GETHTTP_ERROR_IS_NO_HANDLE
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure.s GetHTTPFile_API_Error(Error, *Buffer = 0)
	Protected Msg.s, *B

	If *Buffer
		*B = *Buffer
	Else
		Msg = Space(256)
		*B  = @Msg
	EndIf
	If Error >= 12000 And Error <= 12174
		FormatMessage_(#FORMAT_MESSAGE_FROM_HMODULE, GetModuleHandle_(@"wininet.dll"), Error, 0, *B, 256, 0)
	Else
		FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, Error, 0, *B, 256, 0)
	EndIf
	
	ProcedureReturn Msg
EndProcedure

Procedure GetHTTPFile_GetLastError(*GH._GETHTTP_INTERFACE_VALUES_, Handle = 0)
	Protected Result, *B._GETHTTP_VALUES_

	If Handle = 0
		Result = *GH\LastError
	ElseIf GetHTTPFile_IsHandle(*GH, Handle)
		*B     = Handle
		Result = *B\Error
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure.s GetHTTPFile_GetApiError(*GH._GETHTTP_INTERFACE_VALUES_, Error.i, Handle.i = 0)
	Protected Result.s, *B._GETHTTP_VALUES_
	
	If Handle And GetHTTPFile_IsHandle(*GH, Handle)
		*B     = Handle
		Result = PeekS(*B + OffsetOf(_GETHTTP_VALUES_\ErrorMSG), SizeOf(_GETHTTP_VALUES_\ErrorMSG))
	Else
		Result = GetHTTPFile_API_Error(Error)
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure.s GetHTTPFile_GetLastErrorMessage(*GH._GETHTTP_INTERFACE_VALUES_, Handle = 0)
	Protected Result.s = "No Error", Error, Msg.s

	Error = GetHTTPFile_GetLastError(*GH, Handle)

	Select Error
		Case #GETHTTP_ERROR_CANT_CREATE_FILE
			Result = "Unable to create File"
		Case #GETHTTP_ERROR_CANT_CREATE_THREAD
			Result = "Unable to create Thread"
		Case #GETHTTP_ERROR_NO_MEMORY
			Result = "Not enough Memory"
		Case #GETHTTP_ERROR_USER_ABORTED
			Result = "User aborted!"
		Case #GETHTTP_ERROR_NO_INTERNET
			Result = "WinINet-Init failed;" + GetHTTPFile_GetApiError(*GH, Error, Handle)
		Case #GETHTTP_ERROR_UNABLE_TO_OPEN_URL
			Result = "Unable to connect to URL;" + GetHTTPFile_GetApiError(*GH, Error, Handle)
		Case #GETHTTP_ERROR_UNABLE_TO_READ_ONLINEFILE
			Result = "Unable to open File on Server;" + GetHTTPFile_GetApiError(*GH, Error, Handle)
		Case #GETHTTP_ERROR_IS_NO_HANDLE
			Result = "This was no real GetFile-Handle!"
		Default
			Result = "Win-Error;" + GetHTTPFile_GetApiError(*GH, Error, Handle)
	EndSelect

	ProcedureReturn Result
EndProcedure

Structure _INTERNET_CACHE_ENTRY_INFO
	dwStructSize.l
	*lpszSourceUrlName;
	*lpszLocalFileName;
	CacheEntryType.l
	dwUseCount.l
	dwHitRate.l
	dwSizeLow.l
	dwSizeHigh.l
	LastModifiedTime.FILETIME
	ExpireTime.FILETIME
	LastAccessTime.FILETIME
	LastSyncTime.FILETIME
	*lpHeaderInfo.BYTE
	dwHeaderInfoSize.l
	*lpszFileExtension;
	StructureUnion
		dwReserved.l
		dwExemptDelta.l
	EndStructureUnion
EndStructure


Procedure GetHTTPFile_Thread(*B._GETHTTP_VALUES_)
	Protected hINet, hData, Bytes, Size, TimeOUT, i, Send = #True
	Protected *R, K, L

	;/------
	;| 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.
	;/-------

	*B\Result   = 0
	Size        = 0
	hINet       = InternetOpen_(?GVI_Agent, 0, 0, 0, 0)
	Bytes       = 0

	If Not hInet
		*B\GHIV\LastError = #GETHTTP_ERROR_NO_INTERNET
		*B\Error          = GetLastError_()
	Else
		If *B\TimeOUT <> #PB_Default
			If InternetSetOption_(hINet, #INTERNET_OPTION_CONNECT_TIMEOUT, *B + OffsetOf(_GETHTTP_VALUES_\TimeOUT), SizeOf(INTEGER)) = 0
				*B\Error = GetLastError_()
				GetHTTPFile_API_Error(*B\Error, *B + OffsetOf(_GETHTTP_VALUES_\ErrorMSG))
			EndIf
		EndIf
		If *B\AuthBuffer And *B\AuthBufferLength
			hData = InternetOpenUrl_(hINet, *B\URL, *B\AuthBuffer, *B\AuthBufferLength, *B\ConnectFlags, 0)
		Else
			hData = InternetOpenUrl_(hINet, *B\URL, 0, 0, *B\ConnectFlags, 0)
		EndIf
		If Not hData
			*B\GHIV\LastError = #GETHTTP_ERROR_UNABLE_TO_OPEN_URL
			*B\Error          = GetLastError_()
			GetHTTPFile_API_Error(*B\Error, *B + OffsetOf(_GETHTTP_VALUES_\ErrorMSG))
		Else
			;Get File Length
			*R = AllocateMemory(2048)
			K  = 2048
			L  = 0
			If HttpQueryInfo_(hData, #HTTP_QUERY_CONTENT_LENGTH, *R, @K, @L)
				*B\FileSize = Val(PeekS(*R, K))
			Else
				*B\FileSize = #GETHTTP_FILESIZE_UNKNOWN
			EndIf
			FreeMemory(*R)

			If *B\BlockSize <= 0
				*B\BlockSize = $10000
			EndIf
			*B\Result = AllocateMemory(*B\BlockSize)
			If Not *B\Result
				*B\GHIV\LastError = #GETHTTP_ERROR_NO_MEMORY
				*B\Error          = #GETHTTP_ERROR_NO_MEMORY
			Else
				Repeat
					If *B\StopThread
						*B\StopThread     = 2
						*B\GHIV\LastError = #GETHTTP_ERROR_USER_ABORTED
						*B\Error          = #GETHTTP_ERROR_USER_ABORTED
						FreeMemory(*B\Result)
						*B\Result = 0
						Send      = #False
						Break
					EndIf
					If InternetReadFile_(hData, *B\Result + Size, *B\BlockSize, @Bytes) = #False
						FreeMemory(*B\Result)
						*B\Result         = 0
						*B\GHIV\LastError = #GETHTTP_ERROR_UNABLE_TO_READ_ONLINEFILE
						*B\Error          = GetLastError_()
						GetHTTPFile_API_Error(*B\Error, *B + OffsetOf(_GETHTTP_VALUES_\ErrorMSG))
						Break
					ElseIf *B\FileHandle = -1
						Size + Bytes
						If Bytes
							*B\Result = ReAllocateMemory(*B\Result, Size + *B\BlockSize)
							If Not *B\Result
								*B\GHIV\LastError = #GETHTTP_ERROR_NO_MEMORY
								*B\Error          = #GETHTTP_ERROR_NO_MEMORY
								Break
							EndIf
							*B\BytesLoaded = Size
						EndIf
					Else
						If Bytes
							WriteData(*B\FileHandle, *B\Result, Bytes)
							*B\BytesLoaded + Bytes
						EndIf
					EndIf
				Until Bytes = 0

			EndIf
			InternetCloseHandle_(hData)
		EndIf
		InternetCloseHandle_(hINet)
	EndIf


	If *B\FileHandle <> -1
		*B\FileSize = Lof(*B\FileHandle)
		CloseFile(*B\FileHandle)
		If *B\Result
			FreeMemory(*B\Result)
			*B\Result = #True
		EndIf
	ElseIf *B\Result
		*B\FileSize = Size
		If Size <> MemorySize(*B\Result)
			;Shrink Buffer to real size
			If Size > 0
				*B\Result = ReAllocateMemory(*B\Result, Size)
			Else
				FreeMemory(*B\Result)
				*B\Result = 0
			EndIf
		EndIf
	EndIf

	If Send And *B\WindowHandle And *B\Message And IsWindow_(*B\WindowHandle)
		PostMessage_(*B\WindowHandle, *B\Message, *B, #Null)
	EndIf

	ProcedureReturn *B\Result
EndProcedure

Procedure GetHTTPFile_StopAsyncronDownload(*GH._GETHTTP_INTERFACE_VALUES_, Handle)
	Protected Result = #True, *B._GETHTTP_VALUES_

	If GetHTTPFile_IsHandle(*GH, Handle)
		*B = Handle
		If *B\ThreadID And IsThread(*B\ThreadID)
			*B\StopThread = 1
			If WaitThread(*B\ThreadID, 1000) = 0
				If *B\StopThread = 1 Or WaitThread(*B\ThreadID, 100) = 0
					KillThread(*B\ThreadID)
					Result   = #False
				EndIf
			EndIf
			*B\Error = #GETHTTP_ERROR_USER_ABORTED
		EndIf
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure GetHTTPFile_FreeMem(*GH._GETHTTP_INTERFACE_VALUES_, Handle, Mode = #True)
	Protected *B._GETHTTP_VALUES_
	
	;/-----------
	;| 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(*GH, Handle)
		;Handle is known!
		*B = Handle
		If *B\ThreadID = IsThread(*B\ThreadID)
			GetHTTPFile_StopAsyncronDownload(*GH, *B)
		EndIf
		If *B\URL
			FreeMemory(*B\URL)
		EndIf
		If *B\AuthBuffer
			FreeMemory(*B\AuthBuffer)
		EndIf
		If *B\Result < 0 Or *B\Result > 1
			If Mode
				FreeMemory(*B\Result)
			EndIf
		EndIf
		FreeMemory(*B)
		DeleteElement(*GH\Handles())
	EndIf

EndProcedure

Procedure GetHTTPFile_GetFile(*GH._GETHTTP_INTERFACE_VALUES_, URL.s, FileName.s, AuthName.s = "", AuthPass.s = "", ConnectFlags = #PB_Default, WindowID = 0, WindowMessage = 0, Mode = #GETHTTP_MODE_SYNCHRON, BlockSize = $10000, TimeOUT = #PB_Default)
	Protected Result, FID, *A, *B._GETHTTP_VALUES_, i, a$, b$

	;/------------------
	;| 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
	;| 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.
	;| Mode          => Possible values:
	;|                  #GETHTTP_MODE_SYNCHRON  : Procedure will block your program till the file is downloaded.
	;|                  #GETHTTP_MODE_ASYNCHRON : Procedure will not block your program, but will send a Message to your Window.
	;| 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
		FID = CreateFile(#PB_Any, FileName)
		If FID
			*B = AllocateMemory(SizeOf(_GETHTTP_VALUES_))
			If Not *B
				CloseFile(FID)
				*GH\LastError = #GETHTTP_ERROR_NO_MEMORY
			Else
				If AuthName
					*A  = AllocateMemory(StringByteLength(AuthName + ":" + AuthPass) + 1)
					If *A
						PokeS(*A, AuthName + ":" + AuthPass, -1, #PB_Ascii)
						i  = (Len(AuthName) + Len(AuthPass)) * 2
						b$ = Space(i)
						Base64EncoderBuffer(*A, MemorySize(*A), @b$, i * SizeOf(CHARACTER))
						a$ = "Authorization: Basic " + PeekS(@b$, -1, #PB_Ascii)
						FreeMemory(*A)
						*B\AuthBuffer = AllocateMemory(StringByteLength(a$) + SizeOf(CHARACTER))
						PokeS(*B\AuthBuffer, a$)
						*B\AuthBufferLength = Len(a$)
					EndIf
				EndIf
				If ConnectFlags = #PB_Default
					ConnectFlags = #INTERNET_FLAG_NO_CACHE_WRITE | #INTERNET_FLAG_PRAGMA_NOCACHE
				EndIf
				*B\FileHandle   = FID
				*B\ConnectFlags = ConnectFlags
				*B\GHIV         = *GH
				*B\URL          = AllocateMemory(StringByteLength(URL) + SizeOf(CHARACTER))
				*B\WindowHandle = WindowID
				*B\Message      = WindowMessage
				*B\BlockSize    = BlockSize
				*B\FileSize     = #GETHTTP_FILESIZE_NOT_YET_KNOWN
				PokeS(*B\URL, URL)
				If Mode = #GETHTTP_MODE_ASYNCHRON
					*B\ThreadID = CreateThread(@GetHTTPFile_Thread(), *B)
					Result      = *B
					AddElement(*GH\Handles())
					*GH\Handles() = *B
				Else
					Result = GetHTTPFile_Thread(*B)
					GetHTTPFile_FreeMem(*GH, *B)
				EndIf
			EndIf
		EndIf
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure GetHTTPFile_GetFileInMemory(*GH._GETHTTP_INTERFACE_VALUES_, URL.s, AuthName.s = "", AuthPass.s = "", ConnectFlags = #PB_Default,  WindowID = 0, WindowMessage = 0, Mode = #GETHTTP_MODE_SYNCHRON, BlockSize = $10000, TimeOUT = #PB_Default)
	Protected *Result, *A, *B._GETHTTP_VALUES_, i, a$, b$

	;/------------------
	;| Procedure to Download a file to the memory
	;|
	;| Parameters:
	;| URL           => The Url 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.
	;| Mode          => Possible values:
	;|                  #GETHTTP_MODE_SYNCHRON  : Procedure will block your program till the file is downloaded.
	;|                  #GETHTTP_MODE_ASYNCHRON : Procedure will not block your program, but will send a Message to your Window.
	;| 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 the Pointer to the Memory, where the file has been downloaded, or 0, if anything went wrong.
	;|                  When in asynchronous mode, your window will receive a message, where the
	;|                  wParam is a pointer to an internal structure.
	;|                  To get the pointer to the downloaded file, call \GetResult(wParam)
	;|                  if \GetResult(wParam) = 0, there went something wrong, otherwise whis will be the pointer to the downloaded file.
	;|                  If you have finished, you should call \FreeMem(wParam).
	;|                  If you need the Memory for longer, you can save the result like this:
	;|                  *CopyMem = \GetResult(wParam)
	;|                  and call \FreeMem(wParam, 0) to not destroy the result memory (you then should free it on your own)
	;|                  When you downloaded more then just one file, you can get the URL of this file through
	;|                  URL.s = \GetURL(wParam), otherwise you probably don't know for sure, which file this is.
	;|
	;/-------------------

	*B = AllocateMemory(SizeOf(_GETHTTP_VALUES_))
	If Not *B
		*GH\LastError = #GETHTTP_ERROR_NO_MEMORY
	Else
		If AuthName
			*A  = AllocateMemory(StringByteLength(AuthName + ":" + AuthPass) + 1)
			If *A
				PokeS(*A, AuthName + ":" + AuthPass, -1, #PB_Ascii)
				i  = (Len(AuthName) + Len(AuthPass)) * 2
				b$ = Space(i)
				Base64EncoderBuffer(*A, MemorySize(*A), @b$, i * SizeOf(CHARACTER))
				a$ = "Authorization: Basic " + PeekS(@b$, -1, #PB_Ascii)
				FreeMemory(*A)
				*B\AuthBuffer = AllocateMemory(StringByteLength(a$) + SizeOf(CHARACTER))
				PokeS(*B\AuthBuffer, a$)
				*B\AuthBufferLength = Len(a$)
			EndIf
		EndIf
		If ConnectFlags = #PB_Default
			ConnectFlags = #INTERNET_FLAG_NO_CACHE_WRITE | #INTERNET_FLAG_PRAGMA_NOCACHE
		EndIf
		*B\FileHandle   = -1
		*B\ConnectFlags = ConnectFlags
		*B\GHIV         = *GH
		*B\URL          = AllocateMemory(StringByteLength(URL) + SizeOf(CHARACTER))
		*B\WindowHandle = WindowID
		*B\Message      = WindowMessage
		*B\BlockSize    = BlockSize
		*B\TimeOUT      = TimeOUT
		*B\FileSize     = #GETHTTP_FILESIZE_NOT_YET_KNOWN
		PokeS(*B\URL, URL)
		If Mode = #GETHTTP_MODE_ASYNCHRON
			*B\ThreadID = CreateThread(@GetHTTPFile_Thread(), *B)
			*Result     = *B
			AddElement(*GH\Handles())
			*GH\Handles() = *B
		Else
			*Result     = GetHTTPFile_Thread(*B)
			GetHTTPFile_FreeMem(*GH, *B, 0)
		EndIf
	EndIf

	ProcedureReturn *Result
EndProcedure

Procedure GetHTTPFile_GetResult(*GH._GETHTTP_INTERFACE_VALUES_, Handle)
	Protected Result, *B._GETHTTP_VALUES_

	;/------------
	;| Get the Result of this File download (when in asynchronous mode)
	;/------------

	If GetHTTPFile_IsHandle(*GH, Handle)
		*B     = Handle
		Result = *B\Result
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure.s GetHTTPFile_GetURL(*GH._GETHTTP_INTERFACE_VALUES_, Handle)
	Protected Result.s, *B._GETHTTP_VALUES_

	;/------------
	;| Get the URL of this file download (in asynchronous mode, this helps to know, which file this is)
	;/------------

	If GetHTTPFile_IsHandle(*GH, Handle)
		*B = Handle
		If *B\URL
			Result = PeekS(*B\URL)
		EndIf
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure GetHTTPFile_IsDownloadStillRunning(*GH._GETHTTP_INTERFACE_VALUES_, Handle)
	Protected Result, *B._GETHTTP_VALUES_

	If GetHTTPFile_IsHandle(*GH, Handle)
		*B = Handle
		If *B\ThreadID And IsThread(*B\ThreadID)
			Result = #True
		EndIf
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure GetHTTPFile_BytesLoaded(*GH._GETHTTP_INTERFACE_VALUES_, Handle)
	Protected Result, *B._GETHTTP_VALUES_

	If GetHTTPFile_IsHandle(*GH, Handle)
		*B     = Handle
		Result = *B\BytesLoaded
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure.f GetHTTPFile_GetDownloadPercent(*GH._GETHTTP_INTERFACE_VALUES_, Handle)
	Protected Result.f, *B._GETHTTP_VALUES_

	If GetHTTPFile_IsHandle(*GH, Handle)
		*B     = Handle
		If *B\FileSize > 0
			Result = *B\BytesLoaded / *B\FileSize
		EndIf
	EndIf

	ProcedureReturn Result
EndProcedure

Procedure.q GetHTTPFile_GetSize(*GH._GETHTTP_INTERFACE_VALUES_, Handle)
	Protected Result.q, *B._GETHTTP_VALUES_
	
	If GetHTTPFile_IsHandle(*GH, Handle)
		*B     = Handle
		Result = *B\FileSize
	EndIf
	
	ProcedureReturn Result
EndProcedure

Procedure GetHTTPFile_FreeAll(*GH._GETHTTP_INTERFACE_VALUES_)

	ForEach *GH\Handles()
		GetHTTPFile_FreeMem(*GH, *GH\Handles())
	Next

EndProcedure

Procedure GetHTTP_CreateInterface()
	Protected *GH._GETHTTP_INTERFACE_VALUES_

	*GH = AllocateMemory(SizeOf(_GETHTTP_INTERFACE_VALUES_))
	If *GH = 0
		*GH\LastError = #GETHTTP_ERROR_NO_MEMORY
		ProcedureReturn #False
	EndIf
	InitializeStructure(*GH, _GETHTTP_INTERFACE_VALUES_)
	*GH\VTable = ?_VTABLE_GETHTTP_DATA_

	;Constructor
	*GH\LastError = #GETHTTP_ERROR_NO_ERROR

	ProcedureReturn *GH
EndProcedure

DataSection
	;Mozilla/4.0 (compatible; ST)
	GVI_Agent:
	Data.l $697A6F4D, $2F616C6C, $20302E34, $6D6F6328, $69746170, $3B656C62, $29545320
	Data.b 0
	_VTABLE_GETHTTP_DATA_:
	Data.i @GetHTTPFile_GetLastError()
	Data.i @GetHTTPFile_GetLastErrorMessage()
	Data.i @GetHTTPFile_GetFile()
	Data.i @GetHTTPFile_GetFileInMemory()
	Data.i @GetHTTPFile_GetResult()
	Data.i @GetHTTPFile_GetURL()
	Data.i @GetHTTPFile_FreeMem()
	Data.i @GetHTTPFile_StopAsyncronDownload()
	Data.i @GetHTTPFile_IsDownloadStillRunning()
	Data.i @GetHTTPFile_BytesLoaded()
	Data.i @GetHTTPFile_GetDownloadPercent()
	Data.i @GetHTTPFile_GetSize()
	Data.i @GetHTTPFile_FreeAll()
EndDataSection

Code: Alles auswählen

UseJPEGImageDecoder()

XIncludeFile "GetHTTPFile.pbi"

Procedure main()
	Protected wParam, *Buffer, GetFile._GETHTTP_INTERFACE_, w, h, f.f, Num

	OpenWindow(0, 0, 0, 1026, 780, "GetHTTP Test", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
	ImageGadget(0, 0, 0, 1024, 768, 0, #PB_Image_Border)
	
	CreateStatusBar(0, WindowID(0))
	AddStatusBarField(#PB_Ignore)
	
	Dim URLs.s(10)
	URLs(0) =  "http://www.belladonnarealm.com/wallpapers/Scherzinger,%20Nicole/downloads/1920x1200.jpg"
	URLs(1) =  "http://hires-desktop-wallpapers.com/babes/kate-beckinsale-00007.jpg"
	URLs(2) =  "https://s3.amazonaws.com/wanabo3/pics/9/original-jessica-alba-wallpapers-3.jpg"
	URLs(3) =  "http://www.aideordi.com/uploads/wallpapers/public-photo/large/large_halle-berry1_1e869d.jpg"
	URLs(4) =  "http://www.comicbookmovie.com/images/users/uploads/10959/natalie_portman_18.jpg"
	URLs(5) =  "http://images2.fanpop.com/image/photos/8800000/Scarlett-Johansson-scarlett-johansson-8836700-1920-1200.jpg"
	URLs(6) =  "http://www.indiantvtoday.com/wp-content/uploads/2009/08/charlize-theron28945709233.jpg"
	URLs(7) =  "http://img.wallpaperstock.net:81/grace-park-wallpapers_4057_1280.jpg"
	URLs(8) =  "http://wallpapers.skins.be/eva-padberg/eva-padberg-1024x768-23005.jpg"
	URLs(9) =  "http://www.wallpaperweb.org/wallpaper/babes/1600x1200/tab05vot002AlessandraAmbrosio.jpg"
	URLs(10) = "http://www.celebs101.com/gallery/Lexa_Doig/160353/Lexa_Doig26.jpg"
	
	
	GetFile = GetHTTP_CreateInterface()
	Num     = 0
	
	GetFile\GetFileInMemory(URLs(Num), "", "", #INTERNET_FLAG_RESYNCHRONIZE, WindowID(0), #WM_APP, #GETHTTP_MODE_ASYNCHRON)
	StatusBarText(0, 0, "Lade...")
	
	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_CloseWindow
				Break
			Case #PB_Event_Gadget
				Select EventGadget()
					Case 0
						If EventType() = #PB_EventType_LeftClick
							Num + 1
							If Num > 10
								Num = 0
							EndIf
							If GetFile\GetFileInMemory(URLs(Num), "", "", #INTERNET_FLAG_RESYNCHRONIZE, WindowID(0), #WM_APP, #GETHTTP_MODE_ASYNCHRON)
								StatusBarText(0, 0, "Lade...")
							EndIf
						EndIf
				EndSelect
			Case #WM_APP
				StatusBarText(0, 0, "Pic Ready!")
				wParam  = EventwParam()
				*Buffer = GetFile\GetResult(wParam)
				If *Buffer
					If CatchImage(0, *Buffer, MemorySize(*Buffer))
						w = ImageWidth(0)
						h = ImageHeight(0)
						If w > WindowWidth(0) - 4
							f = (WindowWidth(0) - 4) / w
						EndIf
						If h > WindowHeight(0) - 22
							If f > ((WindowHeight(0) - 22) / h)
								f = (WindowHeight(0) - 22) / h
							EndIf
						EndIf
						ResizeImage(0, w * f, h * f)
						SetGadgetState(0, ImageID(0))
					EndIf
				EndIf
				GetFile\FreeMem(wParam)
		EndSelect
	ForEver

EndProcedure

main()

Code: Alles auswählen

Procedure GetHTTPFile_Thread(*B._GETHTTP_VALUES_)
  Protected hINet, hData, Bytes, Size
  Protected *A._INTERNET_CACHE_ENTRY_INFO, C, D.SYSTEMTIME
  ;    Protected *R, K, L
  Protected Processed.i, MaxSize.q
  ;/------
  ;| 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.
  ;/-------
  
  *B\Result   = 0
  *B\FileSize = 0
  Size        = 0
  hINet       = InternetOpen_(?GVI_Agent, 0, 0, 0, 0)
  Bytes       = 0
  Debug "1. Thread Start"
  If Not hInet
    *B\GHIV\LastError = #GETHTTP_ERROR_NO_INTERNET
    Debug "2. No Internet"
  Else
    If *B\AuthBuffer And *B\AuthBufferLength
      hData = InternetOpenUrl_(hINet, *B\URL, *B\AuthBuffer, *B\AuthBufferLength, *B\ConnectFlags, 0)
    Else
      hData = InternetOpenUrl_(hINet, *B\URL, 0, 0, *B\ConnectFlags, 0)
    EndIf
    If Not hData
      *B\GHIV\LastError = #GETHTTP_ERROR_UNABLE_TO_OPEN_URL
      Debug "3. Unable To Open URL"
    Else
      ;Get Header Information
      ;          *R = AllocateMemory(4096)
      ;          K  = 4096
      ;          L  = 0
      ;          If HttpQueryInfo_(hData, 9, *R, @K, @L)
      ;             Debug K
      ;             Debug PeekS(*R, K)
      ;          EndIf
      ;          FreeMemory(*R)
      *A = AllocateMemory(4096)
      C  = 4096
      If GetUrlCacheEntryInfo_(*B\URL, *A, @C)
        ;            Debug *A\dwHitRate
        
        MaxSize=*A\dwSizeHigh*$100000000+*A\dwSizeLow
        ;             If FileTimeToSystemTime_(*A + OffsetOf(_INTERNET_CACHE_ENTRY_INFO\LastSyncTime), @D)
        ;                Debug Str(D\wHour) + ":" + Str(D\wMinute) + ":" + Str(D\wSecond) + "." + Str(D\wMilliseconds)
        ;             EndIf
      EndIf
      FreeMemory(*A)
      Debug "FileSize: "+StrU(MaxSize)
      
      If *B\BlockSize = 0
        *B\BlockSize = $10000
      EndIf
      *B\Result = AllocateMemory(*B\BlockSize)
      If Not *B\Result
        *B\GHIV\LastError = #GETHTTP_ERROR_NO_MEMORY
        Debug "4. No Memory"
      Else
        Repeat
          If *B\StopThread
            Debug "5. Abbruch initiiert"
            *B\GHIV\LastError = #GETHTTP_ERROR_USER_ABORTED
            FreeMemory(*B\Result)
            *B\Result = 0
            Debug "6. Execute Break"
            Break
          EndIf
          If InternetReadFile_(hData, *B\Result + Size, *B\BlockSize, @Bytes) = #False
            FreeMemory(*B\Result)
            *B\Result     = 0
            *B\GHIV\LastError = #GETHTTP_ERROR_UNABLE_TO_READ_ONLINEFILE
            Debug "7. Unable To Read Onlinefile"
            Break
          ElseIf *B\FileHandle = -1
            Size + Bytes
            If MaxSize
              Processed=Size*30/MaxSize
              StatusBarText(1,1, RSet("|",Processed,"|"))
            EndIf
            If Bytes
              *B\Result = ReAllocateMemory(*B\Result, Size + *B\BlockSize)
              If Not *B\Result
                *B\GHIV\LastError = #GETHTTP_ERROR_NO_MEMORY
                Debug "8. No Memory after ReAllocateMemory"
                Break
              EndIf
            EndIf
          Else
            If Bytes
              WriteData(*B\FileHandle, *B\Result, Bytes)
            EndIf
          EndIf
        Until Bytes = 0
        Debug "9. Loop End"  
        
      EndIf
      InternetCloseHandle_(hData)
    EndIf
    InternetCloseHandle_(hINet)
  EndIf
  Debug "10. INetHandle closed"
  
  If *B\FileHandle <> -1
    CloseFile(*B\FileHandle)
    If *B\Result
      FreeMemory(*B\Result)
      *B\Result = #True
    EndIf
  ElseIf *B\Result
    *B\FileSize = Size
    If Size <> MemorySize(*B\Result)
      ;Shrink Buffer to real size
      *B\Result = ReAllocateMemory(*B\Result, Size)
    EndIf
  EndIf
  
  If *B\WindowHandle And *B\Message And IsWindow_(*B\WindowHandle)
    PostMessage_(*B\WindowHandle, *B\Message, *B, #Null)
  EndIf
  StatusBarText(1,1,"")
  
  Debug "11. Thread Closed"
  ProcedureReturn *B\Result
EndProcedure

Code: Alles auswählen

*GFThread=GetFile\GetFileInMemory(Path, "", "", #INTERNET_FLAG_RESYNCHRONIZE|#INTERNET_FLAG_NO_COOKIES, WindowID(1), #WM_APP, #GETHTTP_MODE_ASYNCHRON)

Code: Alles auswählen

If *GFThread
  GetFile\StopAsyncDownload(*GFThread)
EndIf

Code: Alles auswählen

XIncludeFile "GetHTTPFile.pbi"

Procedure.s ByteRechner(dSize.d)
	Protected Namen = $4B4D4754, i = 24, C.c, Result.s = "0"

	If dSize > 0.0
		While dSize > 1024 And i >= 0
			dSize / 1024
			C = (Namen >> i) & $FF
			i - 8
		Wend
		Result = StrD(dSize, 2) + " " + Chr(C) + "Byte"
	EndIf
	ProcedureReturn Result
EndProcedure

Procedure main()
	Protected GetFile._GETHTTP_INTERFACE_
	Protected MS.s, i, j, k, a$, b$
	
	MS = "DL#{N} ({B}, {P}%)"
	OpenWindow(0, 0, 0, 520, 260, "GetHTTP Test", #PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
	For i = 1 To 10
		TextGadget(i * 2 - 1, 5, 5 + 22 * i, 450, 20, ReplaceString(ReplaceString(ReplaceString(MS, "{N}", Str(i)), "{B}", ByteRechner(0)), "{P}", "0"))
		ButtonGadget(i * 2, 460, 5 + 22 * i, 40, 20, "X")
	Next i
	
	Dim URLs.s(10)
	Dim DL_Handles.i(10)
	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/1MB"
	URLs(3) = "ftp://ftp.freenet.de/pub/freenet-ag.de/100MB"
	URLs(4) = "http://speedtest.qsc.de/50kB.qsc"
	URLs(5) = "http://speedtest.qsc.de/100kB.qsc"
	URLs(6) = "http://speedtest.qsc.de/500kB.qsc"
	URLs(7) = "http://speedtest.qsc.de/1MB.qsc"
	URLs(8) = "http://speedtest.qsc.de/5MB.qsc"
	URLs(9) = "hxxp://speedtest.qsc.de/10MB.qsc"
	
	GetFile = GetHTTP_CreateInterface()
	
	For i = 0 To 9
		DL_Handles(i) = GetFile\GetFileInMemory(URLs(i), "", "", #INTERNET_FLAG_RESYNCHRONIZE, WindowID(0), #WM_APP, #GETHTTP_MODE_ASYNCHRON, 1024)
	Next i
	
	Repeat
		Select WaitWindowEvent(20)
			Case 0
				For i = 1 To 10
					k = GetFile\AsyncDownloadBytesLoaded(DL_Handles(i - 1))
					If GetFile\IsAyncDownloadRunning(DL_Handles(i - 1)) = 0
						a$ = "DL#" + Str(i) + ": finished! (" + ByteRechner(k) + ")"
						j  = GetFile\GetLastError(DL_Handles(i - 1))
						If j <>  #GETHTTP_ERROR_NO_ERROR
							a$ + " [" + GetFile\GetLastErrorMessage(j) + "]"
						EndIf
						SetGadgetText(i * 2 - 1, a$)
						DisableGadget(i * 2, 1)
					Else
						If k
							a$ = ReplaceString(MS, "{N}", Str(i))
							a$ = ReplaceString(a$, "{B}", ByteRechner(k))
							a$ = ReplaceString(a$, "{P}", StrF(GetFile\AsyncDownloadPercentLoaded(DL_Handles(i - 1)) * 100, 1))
							SetGadgetText(i * 2 - 1, a$)
						EndIf
					EndIf
				Next i
			Case #PB_Event_CloseWindow
				Break
			Case #PB_Event_Gadget
				i = EventGadget() / 2
				If GetFile\IsAyncDownloadRunning(DL_Handles(i - 1))
					GetFile\StopAsyncDownload(DL_Handles(i - 1))
				EndIf
		EndSelect
	ForEver
	
	;Aufräumen
	For i = 1 To 10
		If GetFile\IsAyncDownloadRunning(DL_Handles(i - 1))
			GetFile\StopAsyncDownload(DL_Handles(i - 1))
			DisableGadget(i * 2, 1)
			While WindowEvent() : Wend
		EndIf
		GetFile\FreeMem(DL_Handles(i - 1))
	Next i

EndProcedure

main()