Date: 02-16-2022
Return to Index
created by gbSnippets
'When reading a larger file, multiple reads (use of InternetReadFile) are required.
'The reads can be handled in a separate thread to allow background execution and
'status messages.
'Primary Code:
'Credit: Semen Matusovski
'The InternetOpen, InternetOpenURL, InternetReadURL and InternetCloseHandle API
'are needed to perform the task. For size reasons, the primary Code is shown only
'once in the compilable example below.
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc"
#Include "WinInet.Inc"
%BlockSize = 4096
Type tagDownloadInfo
hWndParent As Dword
wMsg As Dword
URLPath As Asciiz * 128 ' Enough
Result As Long
BytesRead As Dword
lpBuf As String Ptr
End Type
Thread Function MyThread (ByVal lpDownloadInfo As tagDownloadInfo Ptr) As Long
Local hInternetSession As Dword, hFile As Long
Local BytesRead As Dword
Do
@lpDownloadInfo.BytesRead = 0
@lpDownloadInfo.Result = 0
hInternetSession = InternetOpen("PowerBASIC", %INTERNET_OPEN_TYPE_PRECONFIG, ByVal 0, ByVal 0, 0)
If hInternetSession = 0 Then @lpDownloadInfo.Result = -1: Exit Do
hFile = InternetOpenUrl(hInternetSession, @lpDownloadInfo.URLPath, _
ByVal 0, ByVal 0, %INTERNET_FLAG_PRAGMA_NOCACHE Or _
%INTERNET_FLAG_NO_CACHE_WRITE Or %INTERNET_FLAG_RELOAD, 0)
If hFile = 0 Then @lpDownloadInfo.Result = -2: Exit Do
While @lpDownloadInfo.Result <> 2
SendMessage @lpDownloadInfo.hWndParent, @lpDownloadInfo.wMsg, 0, 0
If (@lpDownloadInfo.BytesRead + %BlockSize) > Len(@lpDownloadInfo.@lpBuf) Then _
If Len(@lpDownloadInfo.@lpBuf) = 0 Then _
@lpDownloadInfo.@lpBuf = Space$(10 * %BlockSize) Else _
@lpDownloadInfo.@lpBuf = @lpDownloadInfo.@lpBuf + @lpDownloadInfo.@lpBuf
If InternetReadFile (hFile, ByVal StrPTR(@lpDownloadInfo.@lpBuf) + @lpDownloadInfo.BytesRead, _
%BlockSize, ByRef BytesRead) = 0 Then @lpDownloadInfo.Result = -1: Exit Do 'Error
@lpDownloadInfo.BytesRead = @lpDownloadInfo.BytesRead + BytesRead
If BytesRead = 0 Then Exit Do
Wend
If @lpDownloadInfo.Result <> 2 Then @lpDownloadInfo.Result = 1
InternetCloseHandle hFile
Exit Do
Loop
SendMessage @lpDownloadInfo.hWndParent, @lpDownloadInfo.wMsg, 0, 0
If hInternetSession Then InternetCloseHandle hInternetSession
End Function
CallBack Function DlgProc
Select Case CB.Msg
Case %WM_InitDialog
Control Add Button, CB.Hndl, %IdOk, "Load", 10, 30, 80, 14
Control Add Button, CB.Hndl, %IdCancel, "Stop", 130, 30, 80, 14
Control Add TextBox, CB.Hndl, 101, "http://www.garybeene.com/files/gbsnippets.zip" ,10, 10, 200, 12
Control Disable CB.Hndl, %IdCancel
Case %WM_Command
Static DownloadInfo As tagDownloadInfo, sBuffer As String, x As Long
If CB.Ctl = %IdOk Then
Control Get Text CB.Hndl, 101 To DownloadInfo.URLPath
DownloadInfo.hWndParent = CB.Hndl
DownloadInfo.wMsg = %WM_User + 1001
DownloadInfo.lpBuf = VarPTR(sBuffer)
Control Disable CB.Hndl, %IdOk: Control Enable CB.Hndl, %IdCancel
Thread Create MyThread(VarPTR(DownloadInfo)) To x
Thread Close x To x
ElseIf CB.Ctl = %IdCancel Then
DownloadInfo.Result = 2
End If
Case %WM_User + 1001
If DownloadInfo.Result < 0 Then SetWindowText CB.Hndl, " Error" Else _
If DownloadInfo.Result = 0 Then SetWindowText CB.Hndl, " Loaded" + Str$(DownloadInfo.BytesRead) + " bytes" Else _
If DownloadInfo.Result = 1 Then SetWindowText CB.Hndl, " Finished, " + Str$(DownloadInfo.BytesRead) + " bytes" Else _
If DownloadInfo.Result = 2 Then SetWindowText CB.Hndl, " Canceled" + Str$(DownloadInfo.BytesRead) + " bytes"
If DownloadInfo.Result <> 0 Then Control Disable CB.Hndl, %IdCancel: Control Enable CB.Hndl, %IdOk
End Select
End Function
Function PBMain
Local hDlg As Long
Dialog New 0, " Download ", , , 220, 55, %WS_Caption Or %DS_ModalFrame Or %WS_SysMenu To hDlg
Dialog Show Modal hDlg Call DlgProc
End Function
'gbs_00364
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm