Как скачать файл с rghost? - VB
Формулировка задачи:
Не качает с rghost
качает только по прямым ссылкам с расширением и полным путем к файлу например www.test.ru/1.exe
Решение задачи: «Как скачать файл с rghost?»
textual
Листинг программы
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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д