Как скачать файл с 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д