подскажите, а где можно посмотреть опции к добавлению ссылок на thanks-файлы? бывает второй раз за день захожу в USD, они заново добавляются, просто не успеваю качать
» Universal Share Downloader
Рапид чтото поменял усебя Уже ничего не качает.
Blackmanos,
If I had installed ur wersion sborka_9.exe, and I wanna to install sborka11, what should i download?
Full version of sborka_11 or onlu update_11??
Thanx.
If I had installed ur wersion sborka_9.exe, and I wanna to install sborka11, what should i download?
Full version of sborka_11 or onlu update_11??
Thanx.
Цитата:
07.05.2007 19:50:10 %Can't find link!
что за ботва, люди, рапида что нашла способ определять USD?
2Sup
Я по три раза к ряду делаю разрыв-коннект.
Всегда катит.
(на всю процедуру уходит около 20 сек)
Я по три раза к ряду делаю разрыв-коннект.
Всегда катит.
(на всю процедуру уходит около 20 сек)
07.05.2007 21:51:32 Found rapidshare bonus - no download ticket
07.05.2007 21:51:32 %Can't find link!
07.05.2007 21:51:32 Ссылку получить не удалось
Сруктуру html поменяли небось ....
07.05.2007 21:51:32 %Can't find link!
07.05.2007 21:51:32 Ссылку получить не удалось
Сруктуру html поменяли небось ....
exprime
cap.exe /thank /ini capRS.ini
Или создай в каталоге пустой файл saythank.txt. При первом же распознавании выскочит окно с никами .....
А можешь просто из очереди убрать, если мешает .... спецом имена файлам давали такие, чтобы понятно было - что где ...
cap.exe /thank /ini capRS.ini
Или создай в каталоге пустой файл saythank.txt. При первом же распознавании выскочит окно с никами .....
А можешь просто из очереди убрать, если мешает .... спецом имена файлам давали такие, чтобы понятно было - что где ...
Цитата:
Рапид чтото поменял усебя Уже ничего не качает.
Да, действительно. В USDownloader.log появились строки:
Получение ссылки на файл из ...
Rapidshare: can't find <<script>var c=>
Found rapidshare bonus - no download ticket
%Can't find link!
Ссылку получить не удалось
Цитата:
wanderer176
через ipconfig ты не сменишь IP, потому что, внешний IP у модема, а сетевой адаптер получает внутренний от модема, тебе нужно найти способ программно реконектить модем, а не сетевой адаптер через ipconfig /release
у него соединение по lan сети, нет ни пароля ни логина, только сетевые настройки
модем как лан карта, а по usb эмулятор ethertnet
это так предполагаю, так как данных других нет и в руками
кабельного модема не трогал.
Цитата:
Sup
ожидал некоторое время, а только после вводил ipconfig /renew ... то что-то да должно получится...
так вводи команды по очереди, смысла паузу в батфайле нет делать пока, так как способ не проверенный, wanderer176 может быть прав.
А ее сделать не сложно. Паузу делать длинее времени сессии не вижу смысла.
Чему она равна не скажу. У многих по разному.
Отследи состояние светодидов модема если есть на панели,
главное, что бы после выполнения команд они меняли состояние.
Если есть мануал к модему дай почитать.
Рапида не качает больше. Оборвалось на половине файла. Дальше только: "Ссылку получить не удалось". Через браузер все нормально.
Sup
У меня тоже USB (DSL) и routerconnect не поддерживает мой Westell 6100. Никакие советы dimonius faq не прокатывали. Поэтому пришлось идти своим путем
1. в MS DoS окне прогони магические строки ipconfig /flaushdns /release /renew
2. после /renew посмтри, что у тебя стоит на Default Gateway - у меня 192.168.1.1
3. набери в любом браузере http://192.168.1.1 (твой Default Gateway) - выйдешь на Web Interface. Там будет кнопка "Disconnect", после нажатия ждешь n- минут, после чего жмешь "Connect". Любопытно, что при физическом отключении модема для смены IP требовалось ~5 min, а при этом <1 min
6. Испосьзуя этот трюк, скопровал "Web Site" модема off-line и открыл в Notepad
7. Нашел во frame java script functions "Disconnect" и "Reconnect", а в них параметры, которые принимает модем, т.е. возможноть автоматизировать переход от страницы к странице и, передав параметры, имитировать нажатие кнопок
8. После этого написал код на VB6, в котором запустил бесконечный цикл - проверка IP - disconnect - ожидание - connect - проверка и сравнение IP, если получил новыйIP - закрываем программу, нет повторяем снова
9. В .bat файле .exe вызывается коммандой start /wait C:\directory\myexe.exe. Эта комманда ждет пока процесс не закончится. Комманда ping 127.0.0.1 -n 1 >nul вызывается в ютом случае ПОСЛЕ, а НЕ ВО ВРЕМЯ процесса
Я уже выкладывал на форуме этот код, но сейчас довел его до ума. Если интересует, могу снова выложиь
У меня тоже USB (DSL) и routerconnect не поддерживает мой Westell 6100. Никакие советы dimonius faq не прокатывали. Поэтому пришлось идти своим путем
1. в MS DoS окне прогони магические строки ipconfig /flaushdns /release /renew
2. после /renew посмтри, что у тебя стоит на Default Gateway - у меня 192.168.1.1
3. набери в любом браузере http://192.168.1.1 (твой Default Gateway) - выйдешь на Web Interface. Там будет кнопка "Disconnect", после нажатия ждешь n- минут, после чего жмешь "Connect". Любопытно, что при физическом отключении модема для смены IP требовалось ~5 min, а при этом <1 min
6. Испосьзуя этот трюк, скопровал "Web Site" модема off-line и открыл в Notepad
7. Нашел во frame java script functions "Disconnect" и "Reconnect", а в них параметры, которые принимает модем, т.е. возможноть автоматизировать переход от страницы к странице и, передав параметры, имитировать нажатие кнопок
8. После этого написал код на VB6, в котором запустил бесконечный цикл - проверка IP - disconnect - ожидание - connect - проверка и сравнение IP, если получил новыйIP - закрываем программу, нет повторяем снова
9. В .bat файле .exe вызывается коммандой start /wait C:\directory\myexe.exe. Эта комманда ждет пока процесс не закончится. Комманда ping 127.0.0.1 -n 1 >nul вызывается в ютом случае ПОСЛЕ, а НЕ ВО ВРЕМЯ процесса
Я уже выкладывал на форуме этот код, но сейчас довел его до ума. Если интересует, могу снова выложиь
Каптчи пока те_же но не качает
Качает плохо Плагин от DVD Вибор сервера недайот
Цитата:
UriF
3. набери в любом браузере http://192.168.1.1 (твой Default Gateway) -
UriF, ты пробовал Universal RouterReconnect
он ищет Gateway и перегружает.(в винде)
Одно не понятно как работает, испытывал его на
одних и тех же моделях роутеров но на различных конфигурациях
ОС(с установленым софтом провайдера и без).
В одних случаях срабатывает, в других нет.
Если есть доступ к Gateway, часто рядом с Сетевым соединением появляется,
то всегда срабатывает. Если нет, то не всгда.
Твой способ "копки" в html коде делает редактор программы routercontrol.
По сути ты пошел тем же путем.
А вот есть ли вообще интерфейс у Terayon TJ716x автор не указал, так как дергает
провода. Было бы не плохо, если бы кнопка Disconnect был, Ghost прикрутить можно было.
ps
кстати, на моем speedporte при беглом осмотре нет такой кнопки.
на fritzbox есть
Вижу не только у меня проблема...
Код: 07.05.2007 20:56:53 Получение ссылки на файл из "http://rapidshare.com/files/29349563/thank_DVK_004.rar"
07.05.2007 20:56:55 Rapidshare: can't find <<script>var c=>
07.05.2007 20:56:55 Found rapidshare bonus - no download ticket
07.05.2007 20:56:55 %Can't find link!
07.05.2007 20:56:55 Ссылку получить не удалось
Код: 07.05.2007 20:56:53 Получение ссылки на файл из "http://rapidshare.com/files/29349563/thank_DVK_004.rar"
07.05.2007 20:56:55 Rapidshare: can't find <<script>var c=>
07.05.2007 20:56:55 Found rapidshare bonus - no download ticket
07.05.2007 20:56:55 %Can't find link!
07.05.2007 20:56:55 Ссылку получить не удалось
Kis_s
Большое спасибо
Большое спасибо
Цитата:
Tjomich
Кто знает, что бы это значило?
Цитата:
misha1950
Качает плохо Плагин от DVD Вибор сервера недайот
Цитата:
Robby
Рапида не качает больше. Оборвалось на половине файла. Дальше только: "Ссылку получить не удалось". Через браузер все нормально.
Цитата:
erka23
что за ботва, люди, рапида что нашла способ определять USD?
что вы как маленькие?
интерфейс изменилися страницы, невооруженным глазом видно.
Плагин обновит Dimonius и DVK и будет вам счастье.
Вчера здесь были резкие высказывания в стороноу рапиды
за грамматические ошибки,- вот они их и "исправили" ))
Mpa3b
на UniversalRouterReconnect у меня, кажется, Norton стал ругаться (не помню), но мой старый комп с Windows 2000 иногда вдруг начинает глючить в совершенно непонятных местах - как говорят - лучше не трогай, к тому же я много писал на VB6 имитаций движений пользователя, решил, почему бы не попробовать что-то для себя
Я перепутал - имел в виду немецкий routercontrol (а не routerconnect)
на UniversalRouterReconnect у меня, кажется, Norton стал ругаться (не помню), но мой старый комп с Windows 2000 иногда вдруг начинает глючить в совершенно непонятных местах - как говорят - лучше не трогай, к тому же я много писал на VB6 имитаций движений пользователя, решил, почему бы не попробовать что-то для себя
Я перепутал - имел в виду немецкий routercontrol (а не routerconnect)
Народ!!!!!
Только что поставил плагин от DVK (рапида) всё-ОК
Только что поставил плагин от DVK (рапида) всё-ОК
как зделатъ так чтоби ети "thanks" файлы болше не вставлялись
захламлю чуток форум, добавлю полный [more=лог]07.05.2007 21:07:35 Получение ссылки на файл из "http://rapidshare.com/files/29349563/thank_DVK_004.rar"
07.05.2007 21:07:35 Для получения ссылки использую плагин: "D:\USDownloader\plugins\RapidShareCom.plg"
07.05.2007 21:07:35 RapidshareCom.plg version 19.8
07.05.2007 21:07:35 Rapidshare_Link: http://rapidshare.com/files/29349563/thank_DVK_004.rar
07.05.2007 21:07:35 GET URL: <http://rapidshare.com/files/29349563/thank_DVK_004.rar>
07.05.2007 21:07:35 Header: GET /files/29349563/thank_DVK_004.rar HTTP/1.0
07.05.2007 21:07:35 Header: Accept: text/html, application/xml, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*
07.05.2007 21:07:35 Header: User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322; MEGAUPLOAD 1.0)
07.05.2007 21:07:35 Header: Host: rapidshare.com
07.05.2007 21:07:36 POST to <http://rs114.rapidshare.com/files/29349563/thank_DVK_004.rar/>, data: <dl.start=Free>
07.05.2007 21:07:36 POST URL: <http://rs114.rapidshare.com/files/29349563/thank_DVK_004.rar/> (MIME)
07.05.2007 21:07:36 Header: POST /files/29349563/thank_DVK_004.rar/ HTTP/1.1
07.05.2007 21:07:36 Header: Accept: text/html, application/xml, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*
07.05.2007 21:07:36 Header: Referer: http://rapidshare.com/files/29349563/thank_DVK_004.rar
07.05.2007 21:07:36 Header: Content-Type: multipart/form-data; boundary=----------3GoxAA2dF6BUT9hLAesYYf
07.05.2007 21:07:36 Header: User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322; MEGAUPLOAD 1.0)
07.05.2007 21:07:36 Header: Host: rs114.rapidshare.com
07.05.2007 21:07:36 Header: Content-Length: 131
07.05.2007 21:07:37 Rapidshare: Get Download Ticket value
07.05.2007 21:07:37 Rapidshare: can't find <<script>var c=>
07.05.2007 21:07:37 Rapidshare: DownloadTicket is: 220 sec (3,7 min)>
07.05.2007 21:07:37 Rapidshare: Find crypted part
07.05.2007 21:07:37 Found rapidshare bonus - no download ticket
07.05.2007 21:07:37 Downloading from Maximum free network
07.05.2007 21:07:37 %Can't find link!
07.05.2007 21:07:37 Ссылку получить не удалось
07.05.2007 21:07:37 Смена прокси на: ":80" (логин: "", пароль: "")
[/more]...
07.05.2007 21:07:35 Для получения ссылки использую плагин: "D:\USDownloader\plugins\RapidShareCom.plg"
07.05.2007 21:07:35 RapidshareCom.plg version 19.8
07.05.2007 21:07:35 Rapidshare_Link: http://rapidshare.com/files/29349563/thank_DVK_004.rar
07.05.2007 21:07:35 GET URL: <http://rapidshare.com/files/29349563/thank_DVK_004.rar>
07.05.2007 21:07:35 Header: GET /files/29349563/thank_DVK_004.rar HTTP/1.0
07.05.2007 21:07:35 Header: Accept: text/html, application/xml, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*
07.05.2007 21:07:35 Header: User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322; MEGAUPLOAD 1.0)
07.05.2007 21:07:35 Header: Host: rapidshare.com
07.05.2007 21:07:36 POST to <http://rs114.rapidshare.com/files/29349563/thank_DVK_004.rar/>, data: <dl.start=Free>
07.05.2007 21:07:36 POST URL: <http://rs114.rapidshare.com/files/29349563/thank_DVK_004.rar/> (MIME)
07.05.2007 21:07:36 Header: POST /files/29349563/thank_DVK_004.rar/ HTTP/1.1
07.05.2007 21:07:36 Header: Accept: text/html, application/xml, application/xhtml+xml, image/png, image/jpeg, image/gif, image/x-xbitmap, */*
07.05.2007 21:07:36 Header: Referer: http://rapidshare.com/files/29349563/thank_DVK_004.rar
07.05.2007 21:07:36 Header: Content-Type: multipart/form-data; boundary=----------3GoxAA2dF6BUT9hLAesYYf
07.05.2007 21:07:36 Header: User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; .NET CLR 1.1.4322; MEGAUPLOAD 1.0)
07.05.2007 21:07:36 Header: Host: rs114.rapidshare.com
07.05.2007 21:07:36 Header: Content-Length: 131
07.05.2007 21:07:37 Rapidshare: Get Download Ticket value
07.05.2007 21:07:37 Rapidshare: can't find <<script>var c=>
07.05.2007 21:07:37 Rapidshare: DownloadTicket is: 220 sec (3,7 min)>
07.05.2007 21:07:37 Rapidshare: Find crypted part
07.05.2007 21:07:37 Found rapidshare bonus - no download ticket
07.05.2007 21:07:37 Downloading from Maximum free network
07.05.2007 21:07:37 %Can't find link!
07.05.2007 21:07:37 Ссылку получить не удалось
07.05.2007 21:07:37 Смена прокси на: ":80" (логин: "", пароль: "")
[/more]...
apsikus
А без разницы можешь хоть полную поверх накатывать хоть только обновление, и так и так должно работать!!!
А без разницы можешь хоть полную поверх накатывать хоть только обновление, и так и так должно работать!!!
Цитата:
chengachkuk
как зделатъ так чтоби ети "thanks" файлы болше не вставлялись
сменить распознаватель, например, на Finereader, AntiCaptcha,gocr,executer...
самому все настроить и с чистой совестью говорить себе спасибо.
Правда,как насчет Dimonius?
Сменить USD на что либо другое.
Бля, ну западло же спасибо сказать,хотя бы автору этой программы.
Всего минута времени на ожидание добавится.
Извините, не удержался.
you can use the dvk plugin, it works
Добавлено позже ...
Цитата:
Чтобы перейти на плагин DVK:
Проверил - плагин от DVK работает.
Для тех, у кого родной плагин с Капом (для Киреевской сборки Cap 1.6.8, точно подойдет):
Заплаточка - переводит на плагин DVK и изменяет параметры.
http://dump.ru/files/3/37956767647/
Чуть более полный вариант (Приложил Cap, может не у всех он есть нужной версии и описалово плагина):
http://dump.ru/files/3/3900129078/
В архиве есть Read.me:
1. Все файлы положить в каталог USD (заменит плагин).
2. Запустить CapDVK.bat (изменит параметры)
3. Заново запущенный USD должен начать качать.
Прочие параметры плагина, типа предпочтительные сети, скрытие окна команды распознавалки, ожидание и т.д. настраиваются в файле USDownloader.ini в секции [Plugin_RapidShareCom]. Отдельно скачать плагин (описание параметров внутри) можно из шапки: Ссылка
Чтобы все вернуть на типовой плагин
1. Обновить плагины ....
2. В файле capRS.ini поправить
[CAP]
SaveToFile=Rapid.txt
Цитата:
Родной плагин Димониус обновил - он тоже работает !!! Обновите плагины !!!
Чтобы перейти на плагин DVK:
Проверил - плагин от DVK работает.
Для тех, у кого родной плагин с Капом (для Киреевской сборки Cap 1.6.8, точно подойдет):
Заплаточка - переводит на плагин DVK и изменяет параметры.
http://dump.ru/files/3/37956767647/
Чуть более полный вариант (Приложил Cap, может не у всех он есть нужной версии и описалово плагина):
http://dump.ru/files/3/3900129078/
В архиве есть Read.me:
1. Все файлы положить в каталог USD (заменит плагин).
2. Запустить CapDVK.bat (изменит параметры)
3. Заново запущенный USD должен начать качать.
Прочие параметры плагина, типа предпочтительные сети, скрытие окна команды распознавалки, ожидание и т.д. настраиваются в файле USDownloader.ini в секции [Plugin_RapidShareCom]. Отдельно скачать плагин (описание параметров внутри) можно из шапки: Ссылка
Чтобы все вернуть на типовой плагин
1. Обновить плагины ....
2. В файле capRS.ini поправить
[CAP]
SaveToFile=Rapid.txt
Kis_s
;Кусок нарезки каптчей на буквы (а букв на цифры ;о))) ...)
;Запускается ключом /shred
;На самом деле резалка так себе, больше даже поганенькая. Для себя делалась.
;Работает по дурацкому алгоритму. Посмотрим, если время будет - может и переделаю.
Зделай такой батник что-б от сель стартовал : E:\USD_KISS_168\_Set
;Кусок нарезки каптчей на буквы (а букв на цифры ;о))) ...)
;Запускается ключом /shred
;На самом деле резалка так себе, больше даже поганенькая. Для себя делалась.
;Работает по дурацкому алгоритму. Посмотрим, если время будет - может и переделаю.
Зделай такой батник что-б от сель стартовал : E:\USD_KISS_168\_Set
мой код на VB6 для Westell 6100 (Verizon DSL) для смены dynamic IP
не знаю, есть ли смысл класть в шапку, и, если да, то просьба, копию вопросов и замечаний писать в личный ящик
Код:
In project references:
Microsoft HTML Object Library - C:\winnt\system32\mshtml.tlb
MIcrosoft VB Script Regular expressions 5.5 - C:\winnt\system32\vbscript.dll\3
On form - WebBrowser Control name - brwProxy
Code in module:
Option Explicit
Public Sub Main()
frmRouter.Show
frmRouter.ChangeIP
Unload frmRouter
End Sub
code in form:
Option Explicit
Dim bStatus As Boolean
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 ' don't write this item to the cache
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_PRAGMA_NOCACHE = &H100
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const SCUSERAGENT = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
(ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, _
ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, _
ByVal lpBuffer As String, ByVal dwNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long) _
As Boolean
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Private Sub brwProxy_DocumentComplete(ByVal pDisp As Object, URL As Variant)
bStatus = True
End Sub
Private Sub WaitForBrowser(Link As String)
'2 - navNoHistory
bStatus = False
brwProxy.Navigate2 Link, 2
Do While bStatus = False
DoEvents
Loop
Do While brwProxy.Document.ReadyState <> "complete"
DoEvents
Loop
End Sub
Private Sub WaitForModemStatus(Status As Integer, HTMLDocFR As HTMLDocument)
'Disconnect - 2
'connect - 1
bStatus = False
HTMLDocFR.PPPAction.PPPRequest.Value = Status
HTMLDocFR.PPPAction.currentCnIndex.Value = 0
HTMLDocFR.PPPAction.submit
Do While bStatus = False
DoEvents
Loop
Do While brwProxy.Document.ReadyState <> "complete"
DoEvents
Loop
End Sub
Private Sub WaitInterval(Seconds As Integer, _
Release As Boolean, HTMLDocFR As HTMLDocument, CheckConnect As Boolean)
Dim Date1 As Date
Dim DateTemp As Date
Dim intDiff As Integer
Date1 = Now
DateTemp = DateAdd("s", Seconds, Date1)
Do While Now < DateTemp
DoEvents
intDiff = DateDiff("s", Now, DateTemp)
If CheckConnect Then
If intDiff < Seconds And intDiff Mod 10 = 0 Then
If VerifyDisconnect(HTMLDocFR) Then
Exit Do
End If
End If
End If
Loop
End Sub
Public Sub ChangeIP()
Dim strTemp As String
Dim HTMLDocFR As MSHTML.HTMLDocument
Dim HTMLDoc As MSHTML.HTMLDocument
Dim strOldIP As String
Dim strNewIP As String
strTemp = "http://192.168.1.1"
WaitForBrowser strTemp
Set HTMLDoc = brwProxy.Document
Set HTMLDocFR = HTMLDoc.frames(0).Document
strOldIP = GetPublicIP
strNewIP = strOldIP
Do While strOldIP = strNewIP
'Disconnect
WaitForModemStatus 2, HTMLDocFR
WaitInterval 55, True, HTMLDocFR, True
If Not VerifyDisconnect(HTMLDocFR) Then
'connect
WaitForModemStatus 1, HTMLDocFR
WaitInterval 5, True, HTMLDocFR, False
End If
strNewIP = GetPublicIP
Loop
End Sub
Private Function VerifyDisconnect(HTMLDocFR As HTMLDocument) As Boolean
On Error GoTo Error_Handler
VerifyDisconnect = False
If InStr(HTMLDocFR.body.innerText, "Auto RegistrationUP") > 0 Then
VerifyDisconnect = True
End If
Exit Function
Error_Handler:
End Function
Public Function GetPublicIP() As String
Dim WebSites(6) As String
Dim strPublicIP As String
Dim I As Integer
strPublicIP = ""
WebSites(0) = "http://vbnet.mvps.org/resources/tools/getpublicip.shtml"
WebSites(1) = "http://whatismyip.com"
WebSites(2) = "http://www.whatismyip.org"
WebSites(3) = "http://www.showmyip.com"
WebSites(4) = "http://www.auditmypc.com/whats-my-ip.asp"
WebSites(5) = "http://myip.dk"
WebSites(6) = "http://formyip.com"
I = 0
Do While Len(Trim(strPublicIP)) = 0
strPublicIP = GetPublicIPSingle(WebSites(I))
I = I + 1
If I > 6 Then I = 0
Loop
GetPublicIP = strPublicIP
End Function
Private Function GetPublicIPSingle(WebSite As String) As String
Dim strRet As String
strRet = OpenCurUrl(WebSite)
GetPublicIPSingle = ""
With New RegExp
.MultiLine = True
.Pattern = "(\d{1,4}.\d{1,4}.\d{1,4}.\d{1,4})"
If .Test(strRet) Then
GetPublicIPSingle = .Execute(strRet).Item(0).SubMatches(0)
End If
End With
End Function
Private Function TranslateErrorCode(ByVal lErrorCode As Long) As String
Select Case lErrorCode
Case 0
Case 12001: TranslateErrorCode = "No more handles could be generated at this time"
Case 12002: TranslateErrorCode = "The request has timed out."
Case 12003: TranslateErrorCode = "An extended error was returned from the server."
Case 12004: TranslateErrorCode = "An internal error has occurred."
Case 12005: TranslateErrorCode = "The URL is invalid."
Case 12006: TranslateErrorCode = "The URL scheme could not be recognized, or is not supported."
Case 12007: TranslateErrorCode = "The server name could not be resolved."
Case 12008: TranslateErrorCode = "The requested protocol could not be located."
Case 12009: TranslateErrorCode = "A request to InternetQueryOption or InternetSetOption specified an invalid option value."
Case 12010: TranslateErrorCode = "The length of an option supplied to InternetQueryOption or InternetSetOption is incorrect for the type of option specified."
Case 12011: TranslateErrorCode = "The request option can not be set, only queried. "
Case 12012: TranslateErrorCode = "The Win32 Internet support is being shutdown or unloaded."
Case 12013: TranslateErrorCode = "The request to connect and login to an FTP server could not be completed because the supplied user name is incorrect."
Case 12014: TranslateErrorCode = "The request to connect and login to an FTP server could not be completed because the supplied password is incorrect. "
Case 12015: TranslateErrorCode = "The request to connect to and login to an FTP server failed."
Case 12016: TranslateErrorCode = "The requested operation is invalid. "
Case 12017: TranslateErrorCode = "The operation was canceled, usually because the handle on which the request was operating was closed before the operation completed."
Case 12018: TranslateErrorCode = "The type of handle supplied is incorrect for this operation."
Case 12019: TranslateErrorCode = "The requested operation can not be carried out because the handle supplied is not in the correct state."
Case 12020: TranslateErrorCode = "The request can not be made via a proxy."
Case 12021: TranslateErrorCode = "A required registry value could not be located. "
Case 12022: TranslateErrorCode = "A required registry value was located but is an incorrect type or has an invalid value."
Case 12023: TranslateErrorCode = "Direct network access cannot be made at this time. "
Case 12024: TranslateErrorCode = "An asynchronous request could not be made because a zero context value was supplied."
Case 12025: TranslateErrorCode = "An asynchronous request could not be made because a callback function has not been set."
Case 12026: TranslateErrorCode = "The required operation could not be completed because one or more requests are pending."
Case 12027: TranslateErrorCode = "The format of the request is invalid."
Case 12028: TranslateErrorCode = "The requested item could not be located."
Case 12029: TranslateErrorCode = "The attempt to connect to the server failed."
Case 12030: TranslateErrorCode = "The connection with the server has been terminated."
Case 12031: TranslateErrorCode = "The connection with the server has been reset."
Case 12036: TranslateErrorCode = "The request failed because the handle already exists."
Case Else: TranslateErrorCode = "Error details not available."
End Select
End Function
Private Function OpenCurUrl(ByVal sURL As String) As String
Dim hInet As Long 'inet handle
Dim hFile As Long 'url handle
Dim lFlags As Long
'read file vars
On Error GoTo ErrHandler
Dim bDoLoop As Boolean
Dim bRet As Boolean
Dim sReadBuffer As String * 1024
Dim sBuffer As String
Dim lNumberOfBytesRead As Long
lFlags = INTERNET_FLAG_NO_CACHE_WRITE Or _
INTERNET_FLAG_RELOAD Or _
INTERNET_FLAG_PRAGMA_NOCACHE
'connect
hInet = InternetOpen(SCUSERAGENT, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hInet <> 0 Then
hFile = InternetOpenUrl(hInet, sURL, vbNullString, 0, lFlags, 0)
If CBool(hFile) Then
'read file
bDoLoop = True
While bDoLoop
sReadBuffer = vbNullString
bRet = InternetReadFile(hFile, sReadBuffer, 1024, lNumberOfBytesRead)
sBuffer = sBuffer & Left(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend
OpenCurUrl = sBuffer
Else
OpenCurUrl = TranslateErrorCode(Err.LastDllError)
End If
Else
OpenCurUrl = "Failed to initialize INET"
End If
ErrHandler:
If hFile <> 0 Then InternetCloseHandle hFile
If hInet <> 0 Then InternetCloseHandle hInet
If Err.Number > 0 Then
OpenCurUrl = "Error " & Err.Number & ": " & Err.Description
End If
End Function
bat file:
@echo off
start /wait C:\VBprojects\routervb\routervb.exe
ping 127.0.0.1 -n 1 >nul
не знаю, есть ли смысл класть в шапку, и, если да, то просьба, копию вопросов и замечаний писать в личный ящик
Код:
In project references:
Microsoft HTML Object Library - C:\winnt\system32\mshtml.tlb
MIcrosoft VB Script Regular expressions 5.5 - C:\winnt\system32\vbscript.dll\3
On form - WebBrowser Control name - brwProxy
Code in module:
Option Explicit
Public Sub Main()
frmRouter.Show
frmRouter.ChangeIP
Unload frmRouter
End Sub
code in form:
Option Explicit
Dim bStatus As Boolean
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 ' don't write this item to the cache
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const INTERNET_FLAG_PRAGMA_NOCACHE = &H100
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const SCUSERAGENT = "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
(ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, _
ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, _
ByVal lpBuffer As String, ByVal dwNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long) _
As Boolean
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Private Sub brwProxy_DocumentComplete(ByVal pDisp As Object, URL As Variant)
bStatus = True
End Sub
Private Sub WaitForBrowser(Link As String)
'2 - navNoHistory
bStatus = False
brwProxy.Navigate2 Link, 2
Do While bStatus = False
DoEvents
Loop
Do While brwProxy.Document.ReadyState <> "complete"
DoEvents
Loop
End Sub
Private Sub WaitForModemStatus(Status As Integer, HTMLDocFR As HTMLDocument)
'Disconnect - 2
'connect - 1
bStatus = False
HTMLDocFR.PPPAction.PPPRequest.Value = Status
HTMLDocFR.PPPAction.currentCnIndex.Value = 0
HTMLDocFR.PPPAction.submit
Do While bStatus = False
DoEvents
Loop
Do While brwProxy.Document.ReadyState <> "complete"
DoEvents
Loop
End Sub
Private Sub WaitInterval(Seconds As Integer, _
Release As Boolean, HTMLDocFR As HTMLDocument, CheckConnect As Boolean)
Dim Date1 As Date
Dim DateTemp As Date
Dim intDiff As Integer
Date1 = Now
DateTemp = DateAdd("s", Seconds, Date1)
Do While Now < DateTemp
DoEvents
intDiff = DateDiff("s", Now, DateTemp)
If CheckConnect Then
If intDiff < Seconds And intDiff Mod 10 = 0 Then
If VerifyDisconnect(HTMLDocFR) Then
Exit Do
End If
End If
End If
Loop
End Sub
Public Sub ChangeIP()
Dim strTemp As String
Dim HTMLDocFR As MSHTML.HTMLDocument
Dim HTMLDoc As MSHTML.HTMLDocument
Dim strOldIP As String
Dim strNewIP As String
strTemp = "http://192.168.1.1"
WaitForBrowser strTemp
Set HTMLDoc = brwProxy.Document
Set HTMLDocFR = HTMLDoc.frames(0).Document
strOldIP = GetPublicIP
strNewIP = strOldIP
Do While strOldIP = strNewIP
'Disconnect
WaitForModemStatus 2, HTMLDocFR
WaitInterval 55, True, HTMLDocFR, True
If Not VerifyDisconnect(HTMLDocFR) Then
'connect
WaitForModemStatus 1, HTMLDocFR
WaitInterval 5, True, HTMLDocFR, False
End If
strNewIP = GetPublicIP
Loop
End Sub
Private Function VerifyDisconnect(HTMLDocFR As HTMLDocument) As Boolean
On Error GoTo Error_Handler
VerifyDisconnect = False
If InStr(HTMLDocFR.body.innerText, "Auto RegistrationUP") > 0 Then
VerifyDisconnect = True
End If
Exit Function
Error_Handler:
End Function
Public Function GetPublicIP() As String
Dim WebSites(6) As String
Dim strPublicIP As String
Dim I As Integer
strPublicIP = ""
WebSites(0) = "http://vbnet.mvps.org/resources/tools/getpublicip.shtml"
WebSites(1) = "http://whatismyip.com"
WebSites(2) = "http://www.whatismyip.org"
WebSites(3) = "http://www.showmyip.com"
WebSites(4) = "http://www.auditmypc.com/whats-my-ip.asp"
WebSites(5) = "http://myip.dk"
WebSites(6) = "http://formyip.com"
I = 0
Do While Len(Trim(strPublicIP)) = 0
strPublicIP = GetPublicIPSingle(WebSites(I))
I = I + 1
If I > 6 Then I = 0
Loop
GetPublicIP = strPublicIP
End Function
Private Function GetPublicIPSingle(WebSite As String) As String
Dim strRet As String
strRet = OpenCurUrl(WebSite)
GetPublicIPSingle = ""
With New RegExp
.MultiLine = True
.Pattern = "(\d{1,4}.\d{1,4}.\d{1,4}.\d{1,4})"
If .Test(strRet) Then
GetPublicIPSingle = .Execute(strRet).Item(0).SubMatches(0)
End If
End With
End Function
Private Function TranslateErrorCode(ByVal lErrorCode As Long) As String
Select Case lErrorCode
Case 0
Case 12001: TranslateErrorCode = "No more handles could be generated at this time"
Case 12002: TranslateErrorCode = "The request has timed out."
Case 12003: TranslateErrorCode = "An extended error was returned from the server."
Case 12004: TranslateErrorCode = "An internal error has occurred."
Case 12005: TranslateErrorCode = "The URL is invalid."
Case 12006: TranslateErrorCode = "The URL scheme could not be recognized, or is not supported."
Case 12007: TranslateErrorCode = "The server name could not be resolved."
Case 12008: TranslateErrorCode = "The requested protocol could not be located."
Case 12009: TranslateErrorCode = "A request to InternetQueryOption or InternetSetOption specified an invalid option value."
Case 12010: TranslateErrorCode = "The length of an option supplied to InternetQueryOption or InternetSetOption is incorrect for the type of option specified."
Case 12011: TranslateErrorCode = "The request option can not be set, only queried. "
Case 12012: TranslateErrorCode = "The Win32 Internet support is being shutdown or unloaded."
Case 12013: TranslateErrorCode = "The request to connect and login to an FTP server could not be completed because the supplied user name is incorrect."
Case 12014: TranslateErrorCode = "The request to connect and login to an FTP server could not be completed because the supplied password is incorrect. "
Case 12015: TranslateErrorCode = "The request to connect to and login to an FTP server failed."
Case 12016: TranslateErrorCode = "The requested operation is invalid. "
Case 12017: TranslateErrorCode = "The operation was canceled, usually because the handle on which the request was operating was closed before the operation completed."
Case 12018: TranslateErrorCode = "The type of handle supplied is incorrect for this operation."
Case 12019: TranslateErrorCode = "The requested operation can not be carried out because the handle supplied is not in the correct state."
Case 12020: TranslateErrorCode = "The request can not be made via a proxy."
Case 12021: TranslateErrorCode = "A required registry value could not be located. "
Case 12022: TranslateErrorCode = "A required registry value was located but is an incorrect type or has an invalid value."
Case 12023: TranslateErrorCode = "Direct network access cannot be made at this time. "
Case 12024: TranslateErrorCode = "An asynchronous request could not be made because a zero context value was supplied."
Case 12025: TranslateErrorCode = "An asynchronous request could not be made because a callback function has not been set."
Case 12026: TranslateErrorCode = "The required operation could not be completed because one or more requests are pending."
Case 12027: TranslateErrorCode = "The format of the request is invalid."
Case 12028: TranslateErrorCode = "The requested item could not be located."
Case 12029: TranslateErrorCode = "The attempt to connect to the server failed."
Case 12030: TranslateErrorCode = "The connection with the server has been terminated."
Case 12031: TranslateErrorCode = "The connection with the server has been reset."
Case 12036: TranslateErrorCode = "The request failed because the handle already exists."
Case Else: TranslateErrorCode = "Error details not available."
End Select
End Function
Private Function OpenCurUrl(ByVal sURL As String) As String
Dim hInet As Long 'inet handle
Dim hFile As Long 'url handle
Dim lFlags As Long
'read file vars
On Error GoTo ErrHandler
Dim bDoLoop As Boolean
Dim bRet As Boolean
Dim sReadBuffer As String * 1024
Dim sBuffer As String
Dim lNumberOfBytesRead As Long
lFlags = INTERNET_FLAG_NO_CACHE_WRITE Or _
INTERNET_FLAG_RELOAD Or _
INTERNET_FLAG_PRAGMA_NOCACHE
'connect
hInet = InternetOpen(SCUSERAGENT, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hInet <> 0 Then
hFile = InternetOpenUrl(hInet, sURL, vbNullString, 0, lFlags, 0)
If CBool(hFile) Then
'read file
bDoLoop = True
While bDoLoop
sReadBuffer = vbNullString
bRet = InternetReadFile(hFile, sReadBuffer, 1024, lNumberOfBytesRead)
sBuffer = sBuffer & Left(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend
OpenCurUrl = sBuffer
Else
OpenCurUrl = TranslateErrorCode(Err.LastDllError)
End If
Else
OpenCurUrl = "Failed to initialize INET"
End If
ErrHandler:
If hFile <> 0 Then InternetCloseHandle hFile
If hInet <> 0 Then InternetCloseHandle hInet
If Err.Number > 0 Then
OpenCurUrl = "Error " & Err.Number & ": " & Err.Description
End If
End Function
bat file:
@echo off
start /wait C:\VBprojects\routervb\routervb.exe
ping 127.0.0.1 -n 1 >nul
Kis_s
Оперативно
Спасибо
Оперативно
Спасибо
Kis_s
сенкс.
сенкс.
UriF
помести код в теги code и затем в more
может ссылку на отктомпиллированый файл дать?
помести код в теги code и затем в more
может ссылку на отктомпиллированый файл дать?
Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143
Предыдущая тема: Proxy Vampire v.2.0 Freeware
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.