Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Закладки » Visual Basic 6: Проверка Public IP/смена dynamic IP

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки

Открыть новую тему     Написать ответ в эту тему

UriF

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Проверка внешнего IP и смена dynamic IP для модема Westell 6100  
Internet APIs, regular expressions, Router Web interface, WebBrowser Control  
 
 
Код использует wininet.dll APIs  regular expressions для проверки Public IP.  В случае, если один из "What is my IP" сайтов отключен, программа пытается достучаться до следующего. В случае, если wininet.dll API возвращает ошибку, программа преобразует код ошибки в текст.
 
WebBrowser control используется для имитации нажима клавиш "disconnect/reconnect" пользователем.  После нажатия клавиши программа ждет, пока не получит ответ на event DocumentComplete, а затем пока статус Web документа не становится "complete".
 
Время на запрос изменения IP получено экспвриментально.  Замечено, что иногда модем реконнектится "сам по себе", не получив новый IP.  В связи с этим в процессе ожидания вводена дополнительная проверка на статус в документе (innertext).
 
Программа может быть вызвана из .bat файла.  Комманда start /wait (в окне MS DOS) висит и ожидает завершония процесса.
 
Можно задать статус визибл/не визибл в .ini файле Rou.ini
 
Если есть вопросы, с удовольствием отвечу
 

Код:
 
 
. ini file - Rou.ini
[General]
Visible=1
InitTimeOut=210
Increment=30
ConnectionName=verizon high speed
 
In project references:  
MIcrosoft VB Script Regular expressions 5.5 - C:\winnt\system32\vbscript.dll\3  
 
On form - WebBrowser Control name - brwProxy  
for testing purposes are used labels (Label1, Label2, Label3, Label4), i.e. old/new IP comparisons, time out, seconds' counter  
 
Code in module:  
 
Option Explicit
Public OldIP  As String
Public NewIP  As String
Public gInitTimeOut As Integer
Public gintIncrement As Integer
Public gsConnection As String
Dim intVisible As Integer
Private Declare Function GetPrivateProfileStringA Lib "kernel32" (ByVal lpApplicationName As String, _
                ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
 
Public Sub Main()
    Dim TimeStart As Date
    TimeStart = Now
    ReadINI
     
    Load frmRouter
    If intVisible = 1 Then
        frmRouter.Show
    End If
    OldIP = frmRouter.GetPublicIP
    frmRouter.ChangeIP
    NewIP = frmRouter.GetPublicIP
    Unload frmRouter
    'MsgBox DateDiff("s", TimeStart, Now) & _
        vbCrLf & OldIP & _
        vbCrLf & NewIP
End Sub
 
Private Sub ReadINI()
    Dim AppIni As String
    Dim AppPath As String
    Dim temp As String
    Dim Ret As Integer
    AppIni = Mid$(App.EXEName, 1, 3) & ".ini"
    AppPath = App.Path
    If Right$(AppPath, 1) <> "\" Then AppPath = AppPath & "\"
    AppPath = AppPath & AppIni
    temp = Space(255)
    Ret = GetPrivateProfileStringA("General", "Visible", "", temp, Len(temp), AppPath)
    If Ret > 0 Then
        intVisible = Left$(temp, Ret)
    Else
        intVisible = 1
    End If
    Ret = GetPrivateProfileStringA("General", "InitTimeOut", "", temp, Len(temp), AppPath)
    If Ret > 0 Then
        gInitTimeOut = Left$(temp, Ret)
    Else
        gInitTimeOut = 90
    End If
    Ret = GetPrivateProfileStringA("General", "Increment", "", temp, Len(temp), AppPath)
    If Ret > 0 Then
        gintIncrement = Left$(temp, Ret)
    Else
        gintIncrement = 15
    End If
    Ret = GetPrivateProfileStringA("General", "ConnectionName", "", temp, Len(temp), AppPath)
    If Ret > 0 Then
        gsConnection = Left$(temp, Ret)
    Else
        gsConnection = "verizon high speed"
    End If
    'WriteToLog 50
End Sub
 
Public Sub WriteToLog(PassString As String)
    Dim strFileName As String
    Dim strTemp As String
    Dim iFile As Integer
    strFileName = Mid$(App.EXEName, 1, 3) & ".log"
    strTemp = App.Path
    If Right$(strTemp, 1) <> "\" Then strTemp = strTemp & "\"
    strFileName = strTemp & strFileName
    iFile = FreeFile
    Open strFileName For Append As iFile
    Print #iFile, PassString & vbCrLf
    Close iFile
End Sub
 
code in form:  
 
Option Explicit
'http://vbnet.mvps.org/index.html?code/internet/getpublicip.htm
 
Dim bStatus  As Boolean
Dim mintReminder As Integer
Dim ErrConnect As Long
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 INTERNET_FLAG_KEEP_CONNECTION = &H400000
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 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
 
Private Sub WaitForBrowser(Link As String)
    '2 - navNoHistory
    bStatus = False
    brwProxy.Navigate2 Link, 2
    Do While bStatus = False
        DoEvents
    Loop
     
    MySleep 1, True
 
    Do While brwProxy.Document.ReadyState <> "complete"
        DoEvents
    Loop
 
End Sub
 
Private Sub WaitForModemStatus(Status As Integer)
    'Disconnect - 2
    'Connect - 1
    On Error GoTo Error_Handler
    Dim bContinue As Boolean
 
    ChangeRouterStatus Status
    bContinue = True
 
    Do While bContinue
        If VerifyStatus(Status) Then
            bContinue = False
        Else
            MySleep 1
        End If
     
    Loop
    On Error GoTo 0
    Exit Sub
Error_Handler:
    If Err.Number = 91 Then
        MySleep 5
    End If
    Err.Clear
    Resume
End Sub
 
Private Sub WaitInterval(Seconds As Integer, _
        Release As Boolean, CheckConnect As Boolean)
    Dim Date1 As Date
    Dim DateTemp As Date
    Dim intDiff As Integer
    mintReminder = 0
    Date1 = Now
    Do While brwProxy.Document.ReadyState <> "complete"
        DoEvents
    Loop
    On Error GoTo Error_Handler
    DateTemp = DateAdd("s", Seconds, Date1)
    Do While Now < DateTemp
        DoEvents
        MySleep 1, True
        DoEvents
 
        intDiff = DateDiff("s", Now, DateTemp)
        Label4.Caption = intDiff
        mintReminder = intDiff
        If CheckConnect Then
            If intDiff < Seconds And intDiff Mod 10 = 0 Then
                If VerifyStatus(1) Then
                    Exit Do
                End If
            End If
        End If
 
    Loop
 
    On Error GoTo 0
    Exit Sub
Error_Handler:
    If Err.Number = 91 Then
        MySleep 5
    End If
    Err.Clear
    Resume
End Sub
 
Public Sub ChangeIP()
    Dim strTemp As String
    Dim Date1 As Date
    Dim strOldIP As String
    Dim strNewIP As String
    Dim initTimeOut As Integer
    Dim incrementTimeOut As Integer
    Dim bIncrement As Boolean
    On Error GoTo Error_Handler
    mintReminder = 0
    strOldIP = GetPublicIP
    strNewIP = strOldIP
    Label1.Caption = strOldIP
    initTimeOut = gInitTimeOut
    Label2.Caption = strNewIP
    incrementTimeOut = gintIncrement
    bIncrement = True
    Do While strOldIP = strNewIP
        'Disconnect
        WaitForModemStatus 2
 
        Label3.Caption = initTimeOut
        Date1 = Now
        Date1 = DateAdd("s", initTimeOut, Date1)
 
        WaitInterval initTimeOut, True, True
        If mintReminder > 10 Then
            bIncrement = False
        End If
 
        If bIncrement Then
            initTimeOut = initTimeOut + incrementTimeOut
            incrementTimeOut = CInt(incrementTimeOut * 1.5)
        End If
        bIncrement = True
        If VerifyStatus(2) Then
            'connect
            WaitForModemStatus 1
             
            WaitInterval 5, True, False
        Else
            bIncrement = False
        End If
        strNewIP = GetPublicIP
        Label2.Caption = strNewIP
    Loop
    WriteToLog CStr(initTimeOut)
    On Error GoTo 0
    Exit Sub
Error_Handler:
    If Err.Number = 91 Then
        MySleep 5
    End If
    Err.Clear
    Resume
End Sub
 
Public Function GetPublicIP() As String
    Dim WebSites(6) As String
    Dim strPublicIP As String
    Dim I As Integer
    ' if disconnected from internet exit function
    If VerifyStatus(2) Then
        GetPublicIP = ""
        Exit Function
    End If
    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))
        If ErrConnect <> 0 Then
            Exit Do
        End If
        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
    ErrConnect = lErrorCode
    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
    ErrConnect = 0
    '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"
        ErrConnect = -1
    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
 
 
Private Sub brwProxy_DocumentComplete(ByVal pDisp As Object, url As Variant)
    bStatus = True
End Sub
 
 
Private Sub Form_Load()
    Dim strTemp As String
 
    strTemp = "http://192.168.1.1"
    WaitForBrowser strTemp
End Sub
 
 
Private Sub MySleep(Seconds As Integer, Optional UseSleep As Boolean = False)
    Dim Date1 As Date
    Dim DateTemp As Date
    Dim intDiff As Integer
  '  Dim I As Long
    Date1 = Now
 
    DateTemp = DateAdd("s", Seconds, Date1)
    Do While Now < DateTemp
        DoEvents
        If UseSleep Then
            Sleep 1000
            DoEvents
        End If
    Loop
 
End Sub
 
Private Function VerifyStatus(Status As Integer) As Boolean
    On Error GoTo Error_Handler
    Dim strTemp As String
    Dim strStatusText As String
     
    Dim bContinue As Boolean
    VerifyStatus = False
 
    'Disconnect - 2
    'Connect - 1
     
    On Error GoTo Error_Handler
    Do While brwProxy.Document.ReadyState <> "complete"
        DoEvents
    Loop
    Select Case Status
        Case 2
            strStatusText = gsConnection & "DOWN"
        Case 1
            strStatusText = gsConnection & "UP"
    End Select
    DoEvents
    strTemp = brwProxy.Document.frames(0).Document.body.innerText
    If InStr(strTemp, strStatusText) > 0 Then
        VerifyStatus = True
    End If
 
    On Error GoTo 0
    Exit Function
     
Error_Handler:
    If Err.Number = 91 Then
        MySleep 5
    End If
    Err.Clear
    Resume
     
End Function
 
Private Sub ChangeRouterStatus(Status As Integer)
    On Error GoTo Error_Handler
    Dim strTemp As String
    Dim bContinue As Boolean
    Dim strStatusText As String
 
    'Disconnect - 2
    'Connect - 1
     
    bStatus = False
    With brwProxy.Document.frames(0).Document
        strTemp = .body.innerText
        .PPPAction.PPPRequest.Value = Status
        .PPPAction.currentCnIndex.Value = 0
        .PPPAction.submit
    End With
    Do While bStatus = False
        DoEvents
    Loop
 
    MySleep 10, True
    DoEvents
    Do While brwProxy.Document.ReadyState <> "complete"
        DoEvents
    Loop
    On Error GoTo 0
    Exit Sub
Error_Handler:
    If Err.Number = 91 Then
        MySleep 5
    End If
    Err.Clear
    Resume
End Sub
 
 
bat file:  
 
@echo off  
start /wait C:\VBprojects\routervb\routervb.exe  
ping 127.0.0.1 -n 1 >nul  
 
 





и к чему это здесь?

Всего записей: 816 | Зарегистр. 14-06-2004 | Отправлено: 21:19 14-05-2007 | Исправлено: UriF, 07:22 24-04-2008
UriF

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Программу переделал, т.к. для Win XP SP2 + IE7 Internet Browser Control ведет себя по другому, кроме того ввел возможность пошагового увелечения тайм-аута, если провайдер его меняет в течении суток.  Убрал reference на HTML библиотеку, т.к. в в связке Win XP SP2 + IE7 при переподключении/отключении создается новый объект, и, как следствие, программа пыталась найти старый и вылетала. Естественно, все будет работать и на старых версиях.  На машине с Win 2000 + IE6 Sp1 программа вылетала с ошибкой "ActiveX Component Can't Create Object" после примерно 14-15 запуска, в чем причина - не нашел, полагаю, что это происходило т.к. комп сдыхал(пара людей, кто это использовал, но на Win XP SP2 + IE6 проблем не было).  На новом компе еще не пробовал, т.к. только переписал сегодня

Всего записей: 816 | Зарегистр. 14-06-2004 | Отправлено: 06:31 03-12-2007
UriF

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Наконец поймал ситуацию, когда не создавался объект.  Рповайдер междду 3 и 5 ночи проводит профилактику, поэту таймаут увеличивает в разы и программа подвисает. Поэтому добавил начальный интервал и инкремент.  У каждого имя соединения (да и статус соединено/отключено) могут быть иными.  Поэтому все это, чтобы не захламлять программу, сбросил в .ini файл

Всего записей: 816 | Зарегистр. 14-06-2004 | Отправлено: 07:29 24-04-2008
UriF

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Провайдер поменял интерфейс и добавил авторизацию.  Если

Код:
 
http://<UserName>:<Password>@192.168.1.1/indexConWan.htm
 

 
не поддерживается, то мною написан следующий код.  Создаем новый модуль, а в нем пишем код по поиску Base Authorization Window, в котором автоматом вводим UserName, Password и жмем на кнопку OK.  
 
Вызов процедуры может производиться из Timer, который мы устанавливаем Enabled
 

Код:
 
Timer1.Enabled = True
  strTemp = "http://192.168.1.1/indexConWan.htm"  
     
    WaitForAccessWindow (strTemp)
 
Private Sub WaitForAccessWindow(Link As String)
    Dim DateTemp As Date
    brwProxy.Navigate2 Link, 2
    DateTemp = DateAdd("s", 5, Now)
    Do While Now < DateTemp
        DoEvents
    Loop
End Sub
 

 
В модуле пишем следующее

Код:
 
Option Explicit
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Const BM_CLICK As Long = &HF5
 
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, lParam As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Count As Integer
Public lngOK As Long
Public lngUser As Long
Public lngPassword As Long
 
 
Public Declare Function SetWindowText Lib "user32.dll" Alias _
"SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
 
 
 
Public Sub AccessToDSL()
    Dim lngHandle As Long
    Dim lngTemp As Long
    Dim retVal As Long
    Count = 1
    lngTemp = 0
    lngHandle = FindWindow(vbNullString, "Connect to 192.168.1.1")
    If lngHandle > 0 Then
        Call EnumChildWindows(lngHandle, AddressOf EnumChildProc, lngTemp)
        'Pass login info
        retVal = SetWindowText(lngUser, "<UserName>")
        retVal = SetWindowText(lngPassword, "<Password>")
        retVal = SendMessage(lngOK, BM_CLICK, 0, 0&)
    End If
End Sub
 
Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
    Dim sReturn As String
    Dim retVal As Long
    'Get the windowtext length
    sReturn = Space$(GetWindowTextLength(hwnd) + 1)
    'get the window text
    GetWindowText hwnd, sReturn, Len(sReturn)
    'remove the last Chr$(0)
    sReturn = Left$(sReturn, Len(sReturn) - 1)
    'write test text into login windows and get window number
    'because input windows are empty
    If sReturn <> "" Then Debug.Print sReturn & " " & Count
    If Count = 4 Then
        lngUser = hwnd
    End If
    If Count = 8 Then
        lngPassword = hwnd
    End If
    'Button "OK" handle
    If InStr(sReturn, "OK") > 0 Then
        lngOK = hwnd
     
    End If
    Count = Count + 1
    'continue enumeration
    EnumChildProc = 1
End Function
 
 

 
 
 

Всего записей: 816 | Зарегистр. 14-06-2004 | Отправлено: 22:10 01-05-2009 | Исправлено: UriF, 05:20 02-05-2009
UriF

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Если же код  

Код:
 
http://<UserName>:<Password>@192.168.1.1/indexConWan.htm
 

поддерживается, то задача упрощается.  Для простоты разбил на модули, .ini файл тот же

Код:
 
[General]
Visible=1
InitTimeOut=10
Increment=30
StartMaintTime=03:30:00 AM
EndMaintTime=06:00:00 AM
MaxTimeOut=16
 
 

Подробнее...
И последний момент - Microsoft подтвердил баг, что если WebBrowserControl невидим, то не всегда мы попадаем в event DocumentComplete, а, следовательно, попадаем в бесконечный цикл, из которого можно выбраться по таймеру

Всего записей: 816 | Зарегистр. 14-06-2004 | Отправлено: 05:20 02-05-2009 | Исправлено: ShIvADeSt, 12:52 07-05-2009
Открыть новую тему     Написать ответ в эту тему

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Закладки » Visual Basic 6: Проверка Public IP/смена dynamic IP


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru