Как скачать файл с rghost? - VB - Ответ 6337464

Option Explicit
'
'   © Антихакер32™ ..2014
'
Private Type Rect
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Declare Function CreateWindowEx Lib "user32.dll" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef IpdwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
'
Function CheckFiles(ByVal ZipUrl$, ByVal Folder$, ParamArray ParseNames()) As Long
    'Проверяет наличие файлов, указанных в аргументах ParseNames
    'И при необходимости докачивает их в указанную папку Folder
    'Если папка не указанна, то отсутствующие файлы будут скопированны в текущую папку
    '
    Const Promt0 = "Отсутствуют необходимые компоненты" & vbCrLf
    Const Promt1 = Promt0 & "Отсутствует соединение с интернетом, для того чтоб их скачать"
    Const Promt2 = Promt0 & "Указанный URL не является ZIP-папкой с компонентами"
    Const Promt3 = Promt0 & "URL Zip-папки, указан неправильно"
    Dim vEach, OldDir$, ArcName$, f&, zExists As Boolean, s$, i&, b() As Byte
    Dim ShellApp As Object, Zip As Object, Rect As Rect, MinWin&, Fso As Object
    Set Fso = CreateObject("Scripting.FileSystemObject"): OldDir = CurDir$
    If Fso.FolderExists(Folder) Then ChDir Fso.GetAbsolutePathName(Folder) Else ChDir App.Path
    For Each vEach In ParseNames
        If Fso.FileExists(vEach) Or Fso.FolderExists(vEach) Then
            CheckFiles = CheckFiles + 1: GoTo NextEach
        ElseIf Len(ZipUrl) Then On Error Resume Next
            If Not zExists Then 'Обращение к интернету и закачка необходимых файлов
                GetWindowRect GetDesktopWindow, Rect 'Маленькая надпись
                MinWin = CreateWindowEx(0&, "STATIC", ">>--- Загрузка ---<<", &H50800000, _
                (Rect.Right - 150) / 2, (Rect.Bottom - 20) / 2, 150, 20, GetDesktopWindow, 0&, 0, ByVal 0&)
                '
                i = Len(ZipUrl): ArcName = ZipUrl
                For f = 1 To i: If Mid$(ArcName, f, 1) Like "[!0-9!A-Z!a-z]" Then Mid$(ArcName, f, 1) = "_":
                Next: ArcName = ArcName & "_": Randomize Timer 'Добавление своих цифр
                For f = 1 To 10: ArcName = ArcName & Fix(Rnd * 10): Next: ArcName = ArcName & ".zip"
                If InternetGetConnectedState(0&, 0&) = 0 Then MsgBox Promt1, vbInformation: End
                If URLDownloadToFile(0, ZipUrl, ArcName, 0, 0) Then MsgBox Promt3, vbInformation: End
                Set ShellApp = CreateObject("Shell.Application")
                Set Zip = ShellApp.NameSpace(Fso.GetAbsolutePathName(ArcName)): zExists = Zip.Items.Count
                If Not zExists Then MsgBox Promt2, vbInformation: Kill ArcName: End
            End If: 'On Error GoTo 0
            If Zip.ParseName((vEach)) Is Nothing Then GoTo NextEach
            ShellApp.NameSpace((CurDir$)).CopyHere Zip.ParseName((vEach))
            f = FreeFile: Open CStr(vEach) For Binary As #f: ReDim b(LOF(f) - 1)
            Do: DoEvents: s = b: Get #f, 1, b: Loop While s <> CStr(b) 'пока есть разница данных
            Close #f: CheckFiles = CheckFiles + 1 'Файл из архива успешно скопирован, переход к следующему файлу
        Else: MsgBox Promt3, vbInformation: End
        End If
NextEach:
    Next: If Len(ArcName) Then Kill ArcName
    If MinWin Then DestroyWindow MinWin
    If CurDir$ <> OldDir Then ChDir OldDir 'Если папка была изменена, то возврат в прежнюю папку
End Function