-------------------------------------------------
Private m_GettingFileSize As Boolean
Private m_DownloadingFile As Boolean
Private m_DownloadingFileSize As Long
Private m_LocalSaveFile As String
Private m_FileSize As String
Private FirstResponse As Boolean
Dim ff As Integer
Dim exe As String
dim filesize as string
Private Sub cmdCancel_Click()
'On Error Resume Next
Inet1.Cancel
Unload Me
End Sub
Private Sub Form_Load()
filesize = # ' Okay this is how i do it, make filesize a number, compile your program and upload it. Then see how big it is on the ftp. Type the number in the filesize re-compile and upload. Then it will have the correct filesize.
If App.PrevInstance Then
End
End If
Dim RemoteFileToGet As String
'Name of the updated exe
RemoteFileToGet = "www.bazooka.com" 'THIS IS THE DOWNLOAD
FirstResponse = False
m_FileSize = GetHTTPFileSize(RemoteFileToGet)
lstStat.AddItem "Establishing file size & location..."
lblStatus.Caption = "0/" & Int(m_FileSize) \ 1024 ' \/
If Int(m_FileSize) \ 1024 <> filesize Then 'shows in kb instead of other stuff
MsgBox Int(m_FileSize) \ 1024 & "Download size" & filesize & "Your size"
m_LocalSaveFile = App.Path & "\rarfile or zip.rar"
Inet1.Execute RemoteFileToGet, "GET " & Chr(34) & App.Path & "\name of .exe" & Chr(34)
Else
MsgBox "Your exe is updated as can be :) "
lstStat.AddItem "Done."
lblStatus.Caption = "0/0"
End If
End Sub
Private Function GetHTTPFileSize(strHTTPFile As String) As Long
On Error GoTo ErrorHandler
Dim GetValue As String
Dim GetSize As Long
m_GettingFileSize = True
Inet1.Execute strHTTPFile, "HEAD " & Chr(34) & strHTTPFile & Chr(34)
Do Until Inet1.StillExecuting = False
DoEvents
Loop
GetValue = Inet1.GetHeader("Content-length")
Do Until Inet1.StillExecuting = False
DoEvents
Loop
If IsNumeric(GetValue) = True Then
GetSize = CLng(GetValue)
Else
GetSize = -1
End If
If GetSize <= 0 Then GetSize = -1
m_GettingFileSize = False
GetHTTPFileSize = GetSize
Exit Function
ErrorHandler:
m_GettingFileSize = False
GetHTTPFileSize = -1
' MsgBox err.Number & err.Description
End Function
Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim vtData() As Byte
Dim FreeNr As Integer
Dim SizeDone As Long
Dim bDone As Boolean
Dim GetPerc As Integer
Select Case State
Case 1
lstStat.AddItem "Trying to find file..."
Case 2
lstStat.AddItem "File found"
Case 3
lstStat.AddItem "Asking for approval..."
Case 4
lstStat.AddItem "Accepted"
Case 5
lstStat.AddItem "Requesting file..."
Case 6
lstStat.AddItem "Request sent"
Case 7
If FirstResponse = False Then
lstStat.AddItem "Receiving response..."
FirstResponse = True
End If
Case 8
If FirstResponse = False Then
lstStat.AddItem "Response received"
FirstResponse = True
End If
Case 9
lstStat.AddItem "Disconnecting..."
Case 10
lstStat.AddItem "Disconnected"
Case 11
lstStat.AddItem "Error downloading file"
Call cmdCancel_Click
Case 12
If m_GettingFileSize = True Then
Exit Sub
End If
FreeNr = FreeFile
Open App.Path & "\file your downloading.rar" For Binary Access Write As FreeNr
'this shows the status in real time
'kinda fancy
Do While Not bDone
vtData = Inet1.GetChunk(1024, icByteArray) ' Get next chunk.
SizeDone = SizeDone + UBound(vtData)
lblStatus.Caption = SizeDone \ 1024 & "kb" & "/" & m_FileSize \ 1024 & "kb" 'lets it be shown in kb instead of bytes
GetPerc = (SizeDone / m_FileSize) * 100
If GetPerc > 100 Then GetPerc = 100
If GetPerc < 0 Then GetPerc = 0
Me.Caption = "AutoUpdater - " & GetPerc & "%"
Put #FreeNr, , vtData() 'chunk wegschrijven naar bestand
If UBound(vtData) = -1 Then
bDone = True 'Er zijn geen chunks meer, KLAAR DUS
Else
DoEvents 'Yield to other processes
End If
Loop
Close FreeNr
End Select
lstStat.ListIndex = lstStat.ListCount - 1
If GetPerc = 100 Then
Call cmdCancel_Click
End If
' If Len(err.Description) & Len(err.Source) = 0 Then
'Print vbNullString
' Else
' MsgBox err.Description & " Source : " & err.Source
' End If
End Sub
Reply With Quote