Форум программистов, компьютерный форум, киберфорум
Наши страницы
Visual Basic
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.84/32: Рейтинг темы: голосов - 32, средняя оценка - 4.84
Rad0n
-19 / 2 / 0
Регистрация: 12.01.2014
Сообщений: 162
1

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

12.06.2014, 21:26. Просмотров 6107. Ответов 22
Метки нет (Все метки)

Не качает с rghost
качает только по прямым ссылкам с расширением и полным путем к файлу например www.test.ru/1.exe
0
Лучшие ответы (1)
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
12.06.2014, 21:26
Ответы с готовыми решениями:

Как скачать файл из интернета?
Как скачать файл из интернета?

Скачать файл с файлообменника
Ребята привет! Я ваш постоянный клиент! Скажите пожалуйста, как можно или если...

Скачать файл vb6ide.dll
Чп... глюки бешенные ... народ скачайте пожалуйста vb6ide.dll очень нужно мое...

Скачать и открыть txt файл
Здравствуйте. Решил отказаться от библиотеки msinet.ocx, так как она есть не во...

Скачать файл с помощью WinSock через FTP
Надо скачать файл с помощью WinSock через FTP и при этом авторизоваться....

22
Антихакер32
20.06.2014, 21:45     Как скачать файл с rghost?
  #21

Не по теме:

да это все ерунда, ну не хочет пользователь, чтото у себя
непроверенное подключать, ну и не надо, я уже упоминал
что рядовому юзеру до фени, как это заработает, лижбы заработало
ничего не поломало, и дало результат, а как это там оно делается без разницы,
а если некоторые файлы храняться удаленно, и к которым
я имею доступ, то это обеспечит их заменяемость и обновляемость
и мне тоже без разницы, какое мнение составил обо мне далекий юзер




0
The trick
Модератор
7384 / 2646 / 759
Регистрация: 22.02.2013
Сообщений: 3,823
Записей в блоге: 76
22.06.2014, 14:13 22
Антихакер32, я тебе могу назвать много причин почему твой код кривой, и назвать ситуации в которых твой код не будет работать. Я так и не понял для чего нужно использовать нативную DLL и внешний EXE. Для чего делать End при неудачном подключении? Чтобы программа не работала без твоих "суперкодов"? Что ты будешь делать если твой код будет запускаться в папке, имя которой около MAX_PATH символов?
Что это такое?
Visual Basic
1
Do: DoEvents: s = b: Get #f, 1, b: Loop While s <> CStr(b)
У меня это вообще не работает.
0
Антихакер32
22.06.2014, 15:32     Как скачать файл с rghost?
  #23

Не по теме:

я сейчас основательно все переделываю вот часть кода утилиты...

Модуль

Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Option Explicit
Global Const r = "/", z = ",", k = "\", NameFilter = "[!0-9!a-z!A-Z!а-я!А-Я!Ё!ё!_]"
Dim clsSInst As New clsSInst
 
Sub CallArg(ByVal ArgLine As String)
    Dim f&, J$(1), Arg(), Result As Variant
    On Error Resume Next
    For f = 1 To Len(ArgLine):  If Mid$(ArgLine, f, 1) Like NameFilter Then Exit For
        J(0) = J(0) & Mid$(ArgLine, f, 1)
    Next: J(1) = Trim(Mid$(ArgLine, f))
    If Asc(J(1)) = Asc("=") Then
        Result = CallByName(clsSInst, J(0), VbLet, Trim$(Mid$(J(1), 2)))
    Else
        Arg = TrimArrVar(Split(J(1), z))
        Result = CallByName(clsSInst, J(0), VbMethod, Arg)
        If Err.Number = 450 Then
            Result = CallByName(clsSInst, J(0), VbLet, Arg(0))
            Exit Sub
        End If
    End If
End Sub
 
Sub Main()
    Dim Arg() As Variant, J$(), f&, u&
 
    '----------------------------------
    On Error Resume Next: DeleteSetting App.Path
    On Error GoTo 0
    J = TrimArrStr(Split(Command$, r))
    For f = 0 To UBound(J):  If Len(J(f)) Then CallArg J(f)
    Next
 
End Sub
 
Function TrimArrVar(Arr) As Variant()
    'Удаляет передние и задние пробелы в массиве
    '
    Dim f&: ReDim v(UBound(Arr)): For f = 0 To UBound(Arr): v(f) = Trim(Arr(f)): Next: TrimArrVar = v
    TrimArrVar = v
End Function
 
Function TrimArrStr(Arr) As String()
    'Удаляет передние и задние пробелы в списке
    '
    Dim f&, J$(): J = Arr: For f = 0 To UBound(Arr): J(f) = Trim(Arr(f)): Next: TrimArrStr = J
End Function


класс
Кликните здесь для просмотра всего текста


Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
Option Explicit
 
Const TH32CS_SNAPTHREAD = &H4
Const SYNCHRONIZE = &H100000
'
Private Type THREADENTRY32
    dwSize As Long
    cntUsage As Long
    th32ThreadID As Long
    th32OwnerProcessID As Long
    tpBasePri As Long
    tpDeltaPri As Long
    dwFlags As Long
End Type
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function OpenThread Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwThreadId As Long) As Long
Private Declare Function Thread32First Lib "kernel32" (ByVal hSnapshot As Long, ByRef lpte As THREADENTRY32) As Long
Private Declare Function Thread32Next Lib "kernel32" (ByVal hSnapshot As Long, ByRef lpte As THREADENTRY32) As Long
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'
Dim FSO As FileSystemObject ' Object
Dim ShellApp As Shell, LogStream As TextStream, LogStreamRead As TextStream
'
Dim FileVB6_EXE$, m_OutDir$, m_ZipName$, m_InitDir$, OldDir$
 
Public Function CreateFolder(ByVal AbsPath$) As Boolean
    'Проверяет путь и при не обходимости создаёт недостающие папки
    '
    Dim f&, J$(), S$, LS$
    CreateFolder = FSO.FolderExists(AbsPath)
    If CreateFolder Then Exit Function
    '---------------
    J = Split(AbsPath, k)
    On Error GoTo Errr
    For f = 0 To UBound(J)
        S = S & J(f) & k
        If Not FSO.FolderExists(S) And f = 0 Then
            Exit Function 'Драйвер указан не верно
        ElseIf Not FSO.FolderExists(S) Then
            Call FSO.CreateFolder(S): LS = S
        End If
    Next
    CreateFolder = FSO.FolderExists(AbsPath)
    If Len(LS) Then LogStream.WriteLine Now & "[CreateFolder]" & FSO.GetAbsolutePathName(LS)
Errr:
End Function
 
 
Public Property Let InitDir(ByVal vNewValue As String)
    If FSO.FolderExists(vNewValue) Then
        m_InitDir = FSO.GetAbsolutePathName(vNewValue)
        ChDir m_InitDir
        LogStream.WriteLine Now & "[InitDir]" & m_InitDir
    End If
End Property
 
Public Property Let ZipName(ByVal vNewValue As String)
    If LCase(FSO.GetExtensionName(vNewValue)) = "zip" Then
        m_ZipName = FSO.GetAbsolutePathName(vNewValue)
        LogStream.WriteLine Now & "[ZipName]" & m_ZipName
    End If
End Property
 
Public Property Let OutDir(ByVal vNewValue As String)
    m_OutDir = FSO.GetAbsolutePathName(vNewValue)
    LogStream.WriteLine Now & "[OutDir]" & m_OutDir
End Property
 
Function GetThreadsList() As Long()
    'Возвращает список потоков
    '
    Dim hSnap&, TE As THREADENTRY32, PID&, Lst&(), u&, i&
    hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0)
    If hSnap = -1 Then Exit Function
    u = 10: i = -1: ReDim Preserve Lst(u)
    TE.dwSize = Len(TE)
    PID = GetCurrentProcessId()
    If Thread32First(hSnap, TE) Then
        Do
            If TE.th32OwnerProcessID = PID Then
                i = i + 1: Lst(i) = TE.th32ThreadID
                If i > u Then u = i * 2: ReDim Preserve Lst(u)
            End If
        Loop While Thread32Next(hSnap, TE)
        ReDim Preserve Lst(i)
    End If
    CloseHandle hSnap
    GetThreadsList = Lst
End Function
 
 
Public Function ToZip(Paths()) As Long
    Const LenRandName = 10
    Dim Zip As Folder3, Path$, f&, oldThreads&(), newThreads&(), hTrd&
    LogStream.WriteLine Now & "[ToZip]"
    If Len(m_ZipName) = 0 Then
        Randomize Timer: m_ZipName = Space$(LenRandName)
        For f = 1 To LenRandName: Mid$(m_ZipName, f, 1) = Chr$(97 + Fix(Rnd * 26))
        Next: m_ZipName = m_OutDir & k & m_ZipName & ".zip": GoTo NewZip
    ElseIf CreateFolder(FSO.GetParentFolderName(m_ZipName)) Then
NewZip:
        If Not FSO.FileExists(m_ZipName) Then
            FSO.CreateTextFile(m_ZipName, True).Write "PK" & Chr(5) & Chr(6) & String(18, 0)
            LogStream.WriteLine Now & "[CreateZip]" & FSO.GetAbsolutePathName(m_ZipName)
        End If
    End If
 
    Set Zip = ShellApp.NameSpace(FSO.GetAbsolutePathName(m_ZipName))
    For f = 0 To UBound(Paths)
        Paths(f) = FSO.GetAbsolutePathName(Paths(f))
        If FSO.FileExists(Paths(f)) Or FSO.FolderExists(Paths(f)) Then Else GoTo Next_F
        If GetAttr(Paths(f)) And vbDirectory Then _
        If ShellApp.NameSpace((Paths(f))).Items.Count = 0 Then GoTo Next_F 'Пропускать пустые папки
        'Сравнение старых и новых потоков
        oldThreads = GetThreadsList: Zip.CopyHere ((Paths(f))): newThreads = GetThreadsList
        If UBound(newThreads) > UBound(oldThreads) Then
            hTrd = OpenThread(SYNCHRONIZE, False, newThreads(UBound(newThreads)))
            WaitForSingleObject hTrd, -1 'Ждать завершения операции сжатия
            CloseHandle hTrd
        End If
        ToZip = ToZip + 1
Next_F:
    Next
End Function
 
Public Function Make(Files()) As Long
    'Автокомпиляция проекта
    'Files = Список компилируемых файлов
    Dim FileName$, mDir$, ShellNum&, hProc&, f&
    LogStream.WriteLine Now & "[Make]"
    If Not CreateFolder(m_OutDir) Then LogStream.WriteLine Now & "[Error]" & m_OutDir: Exit Function
    mDir = """" & m_OutDir & """"
    For f = 0 To UBound(Files)
        Files(f) = FSO.GetAbsolutePathName(Files(f))
        If Not FSO.FileExists(Files(f)) Then GoTo Next_F
        Select Case LCase(FSO.GetExtensionName(Files(f)))
        Case "vbp", "vbg": Case Else: GoTo Next_F
        End Select: FileName = """" & Files(f) & """"
        ShellNum = Shell(FileVB6_EXE & " /Make " & FileName & " /OutDir " & mDir)
        hProc = OpenProcess(SYNCHRONIZE, False, ShellNum)
        Call WaitForSingleObject(hProc, -1)
        CloseHandle hProc
        Make = Make + 1
Next_F:
    Next
    
End Function
 
Private Sub Class_Initialize()
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set LogStream = FSO.CreateTextFile(App.Path & "\LogStream.txt", 1)
    LogStream.WriteLine Now & "[Start]" 'Начало ведение лога
    Set ShellApp = CreateObject("Shell.Application")
    FileVB6_EXE = """" & Environ("ProgramFiles") & "\Microsoft Visual Studio\VB98\VB6.EXE" & """"
    OldDir = CurDir$: m_OutDir = OldDir: m_InitDir = OldDir
End Sub
 
Private Sub Class_Terminate()
    ChDir OldDir
    LogStream.Close 'Закрытие потока записи лога
End Sub


Добавлено через 7 минут
Вобщем там есть еще откат действий, при неудачной попытке..
и еще болшую часть кода я не стану пока демонстрировать

там запуск программы от имени администратора
такой вот говнокод...

Добавлено через 8 минут
утилита запускается обычным способом через шелл
общается через лог, а код создания иконки я тоже нашел..
там правда километровая портянка получилась... тоже как-то надо
все упаковатт и Downloader тоже отдельная dll, но она зашифрованна в ресурсе
алгоритм шифра постарался сделать максимально быстрым.

Добавлено через 6 минут
..вчера весь день потратил на поиск решения
как в своем-же почтовом акаунте, программно обновлять аттачменты..
так и не нашел, и в интернети почти нет инфы

0
22.06.2014, 15:32
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
22.06.2014, 15:32
Привет! Вот еще темы с ответами:

Как с помощью VB скачать GIF, JPG ?
Kto podskazet kak mozno s pomosju VB skacat GIF, JPG iz seti. Na masinu

Как скачать OLE объект с SQL Server
Как скачать OLE объект с SQL Server? При размещении OLE на форме не удается...

Как открыть файл в VB (именно файл с расширением .bat)?
Это часть неисправного кода: Private Sub Command1_Click() Dim F As Long F =...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
23
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru