Отправка/получение файлов на FTP с прогресс баром

Option Explicit
 
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInternet As Long) As Boolean
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenW" (ByVal lpszAgent As Long, ByVal dwAccessType As Long, ByVal lpszProxy As Long, ByVal lpszProxyBypass As Long, ByVal dwFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectW" (ByVal hInternetSession As Long, ByVal sServerName As Long, ByVal nServerPort As Integer, ByVal sUserName As Long, ByVal sPassword As Long, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileW" (ByVal hFtpSession As Long, ByVal sBuff As Long, ByVal Access As Long, ByVal Flags As Long, ByVal Context As Long) As Long
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Long
Private Declare Function InternetWriteFile Lib "wininet" (ByVal hFile As Long, lpBuffer As Any, ByVal dwNumberOfBytesToWrite As Long, ByRef lpdwNumberOfBytesWritten As Long) As Long
Private Declare Function PathFindFileName Lib "shlwapi" Alias "PathFindFileNameW" (ByVal pPath As Long) As Long
 
Private Const INTERNET_OPEN_TYPE_PRECONFIG  As Long = 0
Private Const INTERNET_DEFAULT_FTP_PORT     As Long = 21
Private Const INTERNET_SERVICE_FTP          As Long = 1
Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000
Private Const INTERNET_FLAG_PASSIVE         As Long = &H8000000
Private Const GENERIC_WRITE                 As Long = &H40000000
Private Const FTP_TRANSFER_TYPE_BINARY      As Long = &H2
Private Const USERNAME                      As String = ""    ' Èìÿ ïîëüçîâàòåëÿ
Private Const PASSWORD                      As String = ""   ' Ïàðîëü
Private Const GRANULARITY                   As Long = &H10000
 
Private Sub cmdUpload_Click()
    Dim fileTitle   As String
    Dim offset      As Long
    Dim fileName    As String
    
    fileName = txtSourceFile.Text
    
    If Len(fileName) Then
        fileTitle = Mid$(fileName, (PathFindFileName(StrPtr(fileName)) - StrPtr(fileName)) \ 2 + 1)
        UploadFile fileName, fileTitle, txtServerName
    End If
    
End Sub
 
' // Çàãðóçèòü ôàéë
Private Function UploadFile(srcFile As String, dstPath As String, serverName As String) As Long
    Dim hInet   As Long
    Dim hFtp    As Long
    Dim hFile   As Long
    
    ' Èíèöèàëèçèðóåì WinInet
    hInet = InternetOpen(StrPtr(App.ProductName), INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0)
    
    If hInet Then
        ' Îòêðûâàåì FTP ñåññèþ
        hFtp = InternetConnect(hInet, StrPtr(serverName), INTERNET_DEFAULT_FTP_PORT, _
                          StrPtr(USERNAME), StrPtr(PASSWORD), INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0)
        If hFtp Then
            ' Ñîçäàåì ôàéë
            hFile = FtpOpenFile(hFtp, StrPtr(dstPath), GENERIC_WRITE, FTP_TRANSFER_TYPE_BINARY Or INTERNET_FLAG_RELOAD, 0)
    
            If hFile Then
                Dim fNum    As Integer
                Dim size    As Long
                Dim length  As Long
                Dim buf()   As Byte
                Dim numByt  As Long
                Dim totWrt  As Long
                Dim retval  As Long
                ' Îòêðûâàåì ôàéë
                ' Ïðîñòîé ñïîñîá (äëÿ ïðèìåðà), íî ïðàâèëüíî äåëàòü ÷åðåç GetFileSizeEx, CreateFileW, ReadFile
                fNum = FreeFile
                Open srcFile For Binary As fNum
                size = LOF(fNum):   length = size
                ReDim buf(GRANULARITY - 1)
                picProgress.Cls:    picProgress.Scale (0, 0)-(1, 1)
                
                Do
                    ' Ñ÷èòûâàåì ïîðöèþ äàííûõ èç ôàéëà
                    Get fNum, , buf()
                    If size - GRANULARITY > 0 Then numByt = GRANULARITY Else numByt = size
                    ' Çàïèñûâàåì â ôàéë
                    retval = InternetWriteFile(hFile, buf(0), numByt, totWrt)
                    ' Ïðîâåðÿåì ñòàòóñ
                    If retval = 0 Or numByt <> totWrt Then
                        MsgBox "Error writing into file"
                        Exit Do
                    End If
                    
                    size = size - GRANULARITY
                    picProgress.Line (0, 0)-((length - size) / length, 1), vbRed, BF
                    DoEvents
                    
                Loop While size > 0
                
                Close fNum
                
                InternetCloseHandle hFile
                ' Óñïåõ
                UploadFile = 1
                
            Else
                MsgBox "Error creating file"
            End If
            
            InternetCloseHandle hFtp
        Else
            MsgBox "Error connection"
        End If
        
        InternetCloseHandle hInet
    Else
        MsgBox "Initialize error"
    End If
 
End Function
 
Private Sub Form_Load()
 
End Sub

Option Explicit
 
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) As Long
 
Const MAX_PATH As Long = 260&
 
Private Sub Form_Load()
    Dim HRESULT     As String
    Dim ErrNumber   As Long
    
    'например. Код 5 - отаказ в доступе
    ErrNumber = 5
    HRESULT = MessageText(ErrNumber)
    Debug.Print HRESULT
End Sub
 
Private Function MessageText(lCode As Long) As String
    On Error Resume Next
    Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000&
    
    Dim sRtrnCode   As String
    Dim lRet        As Long
 
    sRtrnCode = Space$(MAX_PATH)
    lRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, lCode, ByVal 0&, sRtrnCode, MAX_PATH, ByVal 0&)
    If lRet > 0 Then
        MessageText = Left$(sRtrnCode, lRet)
        MessageText = Replace$(MessageText, vbNewLine, vbNullString)
    End If
End Function

Option Explicit
 
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
 
Const MAX_PATH As Long = 260&
 
Private Sub Form_Load()
    Dim HRESULT     As String
    Dim ErrNumber   As Long
 
    ErrNumber = 12002
    HRESULT = MessageText(ErrNumber)
    Debug.Print HRESULT
End Sub
 
Private Function MessageText(lCode As Long) As String
    On Error Resume Next
    Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000&
    Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800&
    
    Dim sRtrnMsg   As String
    Dim lRet        As Long
 
    sRtrnMsg = Space$(MAX_PATH)
    
    If lCode >= 12000 And lCode <= 12175 Then
        lRet = FormatMessage(FORMAT_MESSAGE_FROM_HMODULE, ByVal GetModuleHandle("wininet.dll"), lCode, ByVal 0&, sRtrnMsg, MAX_PATH, ByVal 0&)
    Else
        lRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, lCode, ByVal 0&, sRtrnMsg, MAX_PATH, ByVal 0&)
    End If
    If lRet > 0 Then
        MessageText = Left$(sRtrnMsg, lRet)
        MessageText = Replace$(MessageText, vbNewLine, vbNullString)
    End If
End Function

Dim retVal As Long, pID As Long, pHandle, msWait As Long
  msWait = 1000000000#
   
  Call Update(strPath_to_VER, strPath_to_LST, strUPDEngineORgame)
  
  pHandle = OpenProcess(&H100000, True, pID)
  Do While WaitForSingleObject(pHandle, 500&) = &H102
    DoEvents
  Loop