Как скачать файл с rghost? - VB

Узнай цену своей работы

Формулировка задачи:

Не качает с rghost качает только по прямым ссылкам с расширением и полным путем к файлу например www.test.ru/1.exe

Решение задачи: «Как скачать файл с rghost?»

textual
Листинг программы
  1. Option Explicit
  2. '
  3. '   © Антихакер32 ..2014
  4. '
  5. Private Type Rect
  6.         Left As Long
  7.         Top As Long
  8.         Right As Long
  9.         Bottom As Long
  10. End Type
  11. 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
  12. Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
  13. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long
  14. Private Declare Function GetDesktopWindow Lib "user32" () As Long
  15. Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef IpdwFlags As Long, ByVal dwReserved As Long) As Long
  16. 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
  17. '
  18. Function CheckFiles(ByVal ZipUrl$, ByVal Folder$, ParamArray ParseNames()) As Long
  19.     'Проверяет наличие файлов, указанных в аргументах ParseNames
  20.    'И при необходимости докачивает их в указанную папку Folder
  21.    'Если папка не указанна, то отсутствующие файлы будут скопированны в текущую папку
  22.    '
  23.    Const Promt0 = "Отсутствуют необходимые компоненты" & vbCrLf
  24.     Const Promt1 = Promt0 & "Отсутствует соединение с интернетом, для того чтоб их скачать"
  25.     Const Promt2 = Promt0 & "Указанный URL не является ZIP-папкой с компонентами"
  26.     Const Promt3 = Promt0 & "URL Zip-папки, указан неправильно"
  27.     Dim vEach, OldDir$, ArcName$, f&, zExists As Boolean, s$, i&, b() As Byte
  28.     Dim ShellApp As Object, Zip As Object, Rect As Rect, MinWin&, Fso As Object
  29.     Set Fso = CreateObject("Scripting.FileSystemObject"): OldDir = CurDir$
  30.     If Fso.FolderExists(Folder) Then ChDir Fso.GetAbsolutePathName(Folder) Else ChDir App.Path
  31.     For Each vEach In ParseNames
  32.         If Fso.FileExists(vEach) Or Fso.FolderExists(vEach) Then
  33.             CheckFiles = CheckFiles + 1: GoTo NextEach
  34.         ElseIf Len(ZipUrl) Then On Error Resume Next
  35.             If Not zExists Then 'Обращение к интернету и закачка необходимых файлов
  36.                GetWindowRect GetDesktopWindow, Rect 'Маленькая надпись
  37.                MinWin = CreateWindowEx(0&, "STATIC", ">>--- Загрузка ---<<", &H50800000, _
  38.                 (Rect.Right - 150) / 2, (Rect.Bottom - 20) / 2, 150, 20, GetDesktopWindow, 0&, 0, ByVal 0&)
  39.                 '
  40.                i = Len(ZipUrl): ArcName = ZipUrl
  41.                 For f = 1 To i: If Mid$(ArcName, f, 1) Like "[!0-9!A-Z!a-z]" Then Mid$(ArcName, f, 1) = "_":
  42.                 Next: ArcName = ArcName & "_": Randomize Timer 'Добавление своих цифр
  43.                For f = 1 To 10: ArcName = ArcName & Fix(Rnd * 10): Next: ArcName = ArcName & ".zip"
  44.                 If InternetGetConnectedState(0&, 0&) = 0 Then MsgBox Promt1, vbInformation: End
  45.                 If URLDownloadToFile(0, ZipUrl, ArcName, 0, 0) Then MsgBox Promt3, vbInformation: End
  46.                 Set ShellApp = CreateObject("Shell.Application")
  47.                 Set Zip = ShellApp.NameSpace(Fso.GetAbsolutePathName(ArcName)): zExists = Zip.Items.Count
  48.                 If Not zExists Then MsgBox Promt2, vbInformation: Kill ArcName: End
  49.             End If: 'On Error GoTo 0
  50.            If Zip.ParseName((vEach)) Is Nothing Then GoTo NextEach
  51.             ShellApp.NameSpace((CurDir$)).CopyHere Zip.ParseName((vEach))
  52.             f = FreeFile: Open CStr(vEach) For Binary As #f: ReDim b(LOF(f) - 1)
  53.             Do: DoEvents: s = b: Get #f, 1, b: Loop While s <> CStr(b) 'пока есть разница данных
  54.            Close #f: CheckFiles = CheckFiles + 1 'Файл из архива успешно скопирован, переход к следующему файлу
  55.        Else: MsgBox Promt3, vbInformation: End
  56.         End If
  57. NextEach:
  58.     Next: If Len(ArcName) Then Kill ArcName
  59.     If MinWin Then DestroyWindow MinWin
  60.     If CurDir$ <> OldDir Then ChDir OldDir 'Если папка была изменена, то возврат в прежнюю папку
  61. End Function

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

5   голосов , оценка 3.6 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы