| Вопрос: Проверка соединения | Добавлено: 08.10.04 12:56 |
Автор вопроса:  Alexey333 | ICQ: 127708322 |
| Как узнать подключен запустивший прогу к инету или инет? |
| Ответы | Всего ответов: 18 |
|
Номер ответа: 1 Автор ответа:  freeloader  ICQ: 50804884 Вопросов: 72 Ответов: 642 |
Web-сайт: Профиль | | #1 | Добавлено: 08.10.04 15:12 |
| в примерах есть пример как это определить аж трями способами! | ||
|
Номер ответа: 2 Автор ответа: sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | | #2 | Добавлено: 08.10.04 20:23 |
| см. поиск по форуму и ЧаВо, ответ найдешь точно! | ||
|
Номер ответа: 3 Автор ответа: Alexey333 ICQ: 127708322 Вопросов: 4 Ответов: 29 |
Профиль | | #3 | Добавлено: 09.10.04 07:41 |
Поиск не работает, в Чаво (http://vbnet.ru/unfaq/showall.asp) такого вопроса нет, а в рубрике "Примеры" после долгого поиска не нашел. Поэтому зря вы так на меня нападаете. Может пример где-то и есть, но он очень хитро запрятан 
А пример просто как определить IP я и так знаю. Но дело в том, что не у всех при подключении к инету IP меняется. У тех, кто пользуется, например, кабелем, он не меняется. |
||
|
Номер ответа: 4 Автор ответа: АлександрРазработчик Offline Client ICQ: 204034 Вопросов: 106 Ответов: 1919 |
Профиль | | #4 | Добавлено: 09.10.04 11:14 |
| Alexey333, надо базу unfaq'a? Потом в оффе поищешь? | ||
|
Номер ответа: 5 Автор ответа: Alexey333ICQ: 127708322 Вопросов: 4 Ответов: 29 |
Профиль | | #5 | Добавлено: 09.10.04 11:28 |
|
Если она не супер много весит, то кидай мне на goods2000@mail.ru
Спасибо. |
||
|
Номер ответа: 6 Автор ответа: sneРазработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | | #6 | Добавлено: 09.10.04 11:30 |
Ладно, сами напросились 
1.VB VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable  ataBindingBehavior = 0 'vbNone
ataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = " ata"
Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = True Option Explicit Private Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long Private Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long Private Declare Function GetProfStr Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal sSection As String, ByVal sKey As Any, ByVal sDefault As String, ByVal sValue As String, ByVal nSize As Long, ByVal sFileName As String) As Long Private Const RAS95_MaxEntryName = 256 Private Const RAS95_MaxDeviceType = 16 Private Const RAS95_MaxDeviceName = 32 Private Type RASCONN95 dwSize As Long hRasCon As Long szEntryName(RAS95_MaxEntryName) As Byte szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type Private Type RASCONNSTATUS95 dwSize As Long RasConnState As Long dwError As Long szDeviceType(RAS95_MaxDeviceType) As Byte szDeviceName(RAS95_MaxDeviceName) As Byte End Type Private sConName As String, bIsConnected As Boolean, sDeviceName As String, sDeviceType As String Public Sub UpdateData() im TRasCon(255) As RASCONN95, Tstatus As RASCONNSTATUS95, TempBuffer As String
im lg As Long, lpcon As Long
TRasCon(0).dwSize = 412 lg = 256 * TRasCon(0).dwSize Call RasEnumConnections(TRasCon(0), lg, lpcon) Tstatus.dwSize = 160 Call RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus) If Tstatus.RasConnState = &H2000 Then bIsConnected = True TempBuffer = StrConv(TRasCon(0).szEntryName, vbUnicode) sConName = Left(TempBuffer, InStr(TempBuffer, vbNullChar) - 1) TempBuffer = StrConv(TRasCon(0).szDeviceName, vbUnicode) sDeviceName = Left(TempBuffer, InStr(TempBuffer, vbNullChar) - 1) TempBuffer = StrConv(TRasCon(0).szDeviceType, vbUnicode) sDeviceType = Left(TempBuffer, InStr(TempBuffer, vbNullChar) - 1) End Sub Public Function IsConnected() As Boolean IsConnected = bIsConnected End Function Public Function GetConName() As String GetConName = sConName End Function Public Function GetDeviceType() As String GetDeviceType = sDeviceType End Function Public Function GetDeviceName() As String GetDeviceName = sDeviceName End Function Public Function GetNumInfo() As String GetNumInfo = "ALL" End Function Public Function GetDescription(lng As String) As String GetDescription = GetINI("Lib", " escription", vbNullString, IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\" & App.EXEName & lng & ".ini"
End Function Private Function GetINI(strSection As String, strKey As String, strDefault As String, strFileName As String) As String im uname As String, slength As Long
uname = Space(512) slength = GetProfStr(strSection, strKey, strDefault, uname, 512, strFileName) uname = Left(uname, slength) If Left(uname, 6) = " " Then GetINI = Right(uname, slength - 6) Else GetINI = uname End Function 1.PB #Compile Dll "RasApi.dll" #Dim All #Include "RAS32.INC" #Include "WIN32API.INC" Global tStatus As RASCONNSTATUS, TRasCon() As RASCONN Global g_hInstance As Long Sub UpdateData Alias "UpdateData"  ) Export
im lg As Long, lpcon As Long
lg = 256 * TRasCon(0).dwSize Call RasEnumConnections(TRasCon(0), lg, lpcon) End Sub Function IsConnected Alias "IsConnected" ) Export As Long
im tStatus As RASCONNSTATUS
Call RasGetConnectStatus(TRasCon(0).hRasConn, Tstatus) If Tstatus.RasConnState = %RASCS_DONE Then Function = 1& Else Function = 0& End Function Function GetConName Alias "GetConName" ) Export As String
Function = TRasCon(0).szEntryName End Function Function GetDeviceName Alias "GetDeviceName" ) Export As String
GetDeviceName = TRasCon(0).szDeviceName End Function Function GetDeviceType Alias "GetDeviceType" ) Export As String
GetDeviceType = LCase$(TRasCon(0).szDeviceType) End Function Function GetNumInfo Alias "GetNumInfo" ) Export As String
Function = "ALL" End Function Function GetDescr Alias "GetDescription" ByVal lng As String) Export As String
Local iniFile As Asciiz * %MAX_PATH, lRes As Long, outStr As Asciiz * &H400 Call GetModuleFileName(g_hInstance, iniFile, %MAX_PATH) iniFile = Left$(iniFile, Len(iniFile) - 4& & lng & ".ini"
lRes = GetPrivateProfileString("Lib", " escription", "", outStr, &H400, iniFile)
If lRes Then Function = outStr End Function Function GetData Alias "GetData" ByVal hWnd As Long, _
ByVal uMsg As Long, _ ByVal wParam As String, _ ByVal lParam As Long) Export As String Select Case uMsg Case &H1 ' UpdateData Call UpdateData() Function = "1" Exit Function Case &H2 ' IsConnected Function = Str$(IsConnected()) Exit Function Case &H3 ' GetConName Function = GetConName Exit Function Case &H4 ' GetDeviceName Function = GetDeviceName Exit Function Case &H5 ' GetDeviceType Function = GetDeviceType Exit Function Case &H6 ' GetNumInfo Function = GetNumInfo Exit Function Case &H7 ' GetDesctr Function = GetDescr(wParam) Exit Function End Select End Function ' ----------------------------- Инициализация dll библиотеки ----------------------------------- Function DllMain(ByVal hInstance As Long, ByVal Reason As Long, ByVal Reserved As Long) As Long If Reason = %DLL_PROCESS_ATTACH Then ReDim TRasCon(255) TRasCon(0).dwSize = Len(RASCONN) tStatus.dwSize = Len(RASCONNSTATUS) g_hInstance = hInstance End If Function = 1& End Function 1.MASM .386 .model flat, stdcall option casemap :none ; case sensitive ; ######################################################################### include c:\\masm32\include\windows.inc include c:\masm32\include\user32.inc include c:\masm32\include\kernel32.inc include c:\masm32\include\rasapi32.inc include c:\masm32\include\oleaut32.inc includelib c:\masm32\lib\user32.lib includelib c:\masm32\lib\kernel32.lib includelib c:\masm32\lib\rasapi32.lib includelib c:\masm32\lib\oleaut32.lib ; ######################################################################### .data? hInstance dd ? tStatus RASCONNSTATUS <?> TRasCon RASCONN 100h dup(<?>
.code start: LibMain proc hInstDLL:DWORD, reason:DWORD, unused:DWORD .if reason == DLL_PROCESS_ATTACH push hInstDLL pop hInstance mov TRasCon.dwSize, 412 ; sizeof RASCONN + 1 mov tStatus.dwSize, 160 ; sizeof RASCONNSTATUS mov eax, TRUE .endif ret LibMain Endp UpdateData proc LOCAL lg:DWORD, lpcon:DWORD mov lg, 412 * 100h invoke RasEnumConnections, addr TRasCon, addr lg, addr lpcon ret UpdateData endp IsConnected proc invoke RasGetConnectStatus, TRasCon[0].hrasconn, addr tStatus .If tStatus.rasconnstate == RASCS_DONE mov eax, TRUE .else mov eax, FALSE .endif ret IsConnected endp GetConName proc lea eax, TRasCon.szEntryName ret GetConName endp GetDeviceName proc lea eax, TRasCon.szDeviceName ret GetDeviceName endp GetDeviceType proc invoke CharLower, addr TRasCon.szDeviceType ret GetDeviceType endp GetNumInfo proc .data all db "ALL",0 .code lea eax, all ret GetNumInfo endp GetDescription proc uses edi esi lng:DWORD Local iniFile[MAX_PATH]:BYTE, outStr[400h]:BYTE .data iniext db ".ini",0 inicapt db "Lib",0 inikey db " escription",0
.code invoke GetModuleFileName, hInstance, addr iniFile, MAX_PATH lea edi, iniFile ; Установка указателей lea esi, lng ; На идентификатор языка invoke lstrlen, addr iniFile ; Получение длитнны пути sub eax, 4h ; Отрезаем .ini add edi, eax xor eax, eax ; путем занесения нуля mov [edi], eax ; в нужное место... ; Доводим до ума путь к иньке invoke lstrcat, addr iniFile, lng invoke lstrcat, addr iniFile, addr iniext invoke GetPrivateProfileString, addr inicapt, addr inikey, NULL, addr outStr, 400h, addr iniFile or eax, eax jz ext lea eax, outStr ext: ret GetDescription endp GetData proc hWnd:DWORD, uMsg:DWORD, wParam:DWORD, lParam:DWORD Local retVal[400h]:BYTE .if uMsg==1h ; UpdateData call UpdateData mov eax, TRUE .elseif uMsg==2h ; IsConnected call IsConnected .elseif uMsg==3h ; GetConName call GetConName .elseif uMsg==4h ; GetDeviceName call GetDeviceName .elseif uMsg==5h ; GetDeviceType call GetDeviceType .elseif uMsg==6h ; GetNumInfo call GetNumInfo .elseif uMsg==7h ; GetDesctr invoke GetDescription, wParam .endif ret GetData endp ; ########################################################################## End start 2.VB VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable ataBindingBehavior = 0 'vbNone
ataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = " ata"
Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = True Option Explicit Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, ByVal lpszConnectionName As String, ByVal dwNameLen As Long, ByVal dwReserved As Long) As Long Private Declare Function GetProfStr Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal sSection As String, ByVal sKey As Any, ByVal sDefault As String, ByVal sValue As String, ByVal nSize As Long, ByVal sFileName As String) As Long Private Const INTERNET_CONNECTION_MODEM = &H1& Private Const INTERNET_CONNECTION_LAN = &H2& Private sConName As String, bIsConnected As Boolean, sDeviceName As String, sDeviceType As String Public Sub UpdateData() im dwFlags As Long, Msg As String, lPos As Long
sConName = String$(513, 0) If InternetGetConnectedStateEx(dwFlags, sConName, 512, 0& Then
bIsConnected = True lPos = InStr(sConName, vbNullChar) sConName = Left$(sConName, lPos - 1) If dwFlags And INTERNET_CONNECTION_LAN Then sDeviceType = "LAN" ElseIf dwFlags And INTERNET_CONNECTION_MODEM Then sDeviceType = "Modem" End If Else bIsConnected = False sConName = "" sDeviceName = "" sDeviceType = "" End If End Sub Public Function IsConnected() As Boolean 'Подключены ли мы к инету IsConnected = bIsConnected End Function Public Function GetConName() As String 'Получаем имя текущего соединения GetConName = sConName End Function Public Function GetDeviceType() As String 'Тип устройства GetDeviceType = sDeviceType End Function Public Function GetDeviceName() As String 'Имя устройства GetDeviceName = sDeviceName End Function Public Function GetNumInfo() As String 'Служебная информация для программы GetNumInfo = "IE5" End Function Public Function GetDescription(lng As String) As String GetDescription = GetINI("Lib", " escription", vbNullString, IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\" & App.EXEName & lng & ".ini"
End Function Private Function GetINI(strSection As String, strKey As String, strDefault As String, strFileName As String) As String im uname As String, slength As Long
uname = Space(512) slength = GetProfStr(strSection, strKey, strDefault, uname, 512, strFileName) uname = Left(uname, slength) If Left(uname, 6) = " " Then GetINI = Right(uname, slength - 6) Else GetINI = uname End Function 2.PB #Compile Dll "IGetConState.dll" #Dim All #Include "WININET.INC" #Include "WIN32API.INC" Global sConName As Asciiz * 513, bIsConnected As Byte, sDeviceType As String Global g_hInstance As Long Sub UpdateData Alias "UpdateData" ) Export
im dwFlags As Long, Msg As String, lPos As Long
If Not InternetGetConnectedStateEx(dwFlags, sConName, 512, 0& = 0& Then
bIsConnected = 1& If (dwFlags And %INTERNET_CONNECTION_LAN) = %INTERNET_CONNECTION_LAN Then sDeviceType = "LAN" ElseIf (dwFlags And %INTERNET_CONNECTION_MODEM) = %INTERNET_CONNECTION_MODEM Then sDeviceType = "Modem" End If Else bIsConnected = 0& sConName = "" sDeviceType = "" End If End Sub Function IsConnected Alias "IsConnected" ) Export As Long
IsConnected = bIsConnected End Function Function GetConName Alias "GetConName" ) Export As String
Function = sConName End Function Function GetDeviceName Alias "GetDeviceName" ) Export As String
GetDeviceName = "" End Function Function GetDeviceType Alias "GetDeviceType" ) Export As String
GetDeviceType = sDeviceType End Function Function GetNumInfo Alias "GetNumInfo" ) Export As String
Function = "IE5" End Function Function GetDescr Alias "GetDescription" lng As String) Export As String
Local iniFile As Asciiz * %MAX_PATH, lRes As Long, outStr As Asciiz * &H400 Call GetModuleFileName(g_hInstance, iniFile, %MAX_PATH) iniFile = Left$(iniFile, Len(iniFile) - 4& & lng & ".ini"
lRes = GetPrivateProfileString("Lib", " escription", "", outStr, &H400, iniFile)
If lRes Then Function = outStr End Function Function GetData Alias "GetData" ByVal hWnd As Long, _
ByVal uMsg As Long, _ ByVal wParam As String, _ ByVal lParam As Long) Export As String Select Case uMsg Case &H1 ' UpdateData Call UpdateData() Function = "1" Exit Function Case &H2 ' IsConnected Function = Str$(IsConnected()) Exit Function Case &H3 ' GetConName Function = GetConName Exit Function Case &H4 ' GetDeviceName Function = GetDeviceName Exit Function Case &H5 ' GetDeviceType Function = GetDeviceType Exit Function Case &H6 ' GetNumInfo Function = GetNumInfo Exit Function Case &H7 ' GetDesctr Function = GetDescr(wParam) Exit Function End Select End Function ' ----------------------------- Инициализация dll библиотеки ----------------------------------- Function DllMain(ByVal hInstance As Long, ByVal Reason As Long, ByVal Reserved As Long) As Long If Reason = %DLL_PROCESS_ATTACH Then g_hInstance = hInstance Function = 1& End Function 2.MASM .386 .model flat, stdcall option casemap :none ; case sensitive ; ######################################################################### include c:\\masm32\include\windows.inc include c:\masm32\include\user32.inc include c:\masm32\include\kernel32.inc include c:\masm32\include\wininet.inc include c:\masm32\include\oleaut32.inc includelib c:\masm32\lib\user32.lib includelib c:\masm32\lib\kernel32.lib includelib c:\masm32\lib\wininet.lib includelib c:\masm32\lib\oleaut32.lib ; ######################################################################### .data? hInstance dd ? sConName db 100h dup(?) bIsConnected dw ? sDeviceType db 20h dup(?) sDeviceName db ? .code start: LibMain proc hInstDLL:DWORD, reason:DWORD, unused:DWORD .if reason == DLL_PROCESS_ATTACH push hInstDLL pop hInstance mov eax, TRUE .endif ret LibMain Endp ; ######################################################################### UpdateData proc Local dwFlags:DWORD .data ConLan db "LAN",0 ConMod db "Modem",0 .code invoke InternetGetConnectedStateEx, addr dwFlags, addr sConName, 100h, 0h or eax, eax jz if_2 mov bIsConnected, TRUE mov eax, dwFlags and eax, INTERNET_CONNECTION_LAN cmp eax, INTERNET_CONNECTION_LAN jne if_1 invoke lstrcpy, sDeviceType, ConLan jmp ext if_1: mov eax, dwFlags and eax, INTERNET_CONNECTION_MODEM cmp eax, INTERNET_CONNECTION_MODEM jne if_2 invoke lstrcpy, addr sDeviceType, addr ConMod jmp ext if_2: mov bIsConnected, FALSE lea eax, sConName mov eax, 0h lea eax, sDeviceType mov eax, 0h ext: ret UpdateData endp IsConnected proc .If bIsConnected mov eax, TRUE .else mov eax, FALSE .endif ret IsConnected endp GetConName proc lea eax, sConName ret GetConName endp GetDeviceName proc lea eax, sDeviceName ret GetDeviceName endp GetDeviceType proc lea eax, sDeviceType ret GetDeviceType endp GetNumInfo proc .data all db "IE5",0 .code lea eax, all ret GetNumInfo endp GetDescription proc uses edi esi lng:DWORD Local iniFile[MAX_PATH]:BYTE, outStr[400h]:BYTE .data iniext db ".ini",0 inicapt db "Lib",0 inikey db " escription",0
.code invoke GetModuleFileName, hInstance, addr iniFile, MAX_PATH lea edi, iniFile ; Установка указателей lea esi, lng ; На идентификатор языка invoke lstrlen, addr iniFile ; Получение длитнны пути sub eax, 4h ; Отрезаем .ini add edi, eax xor eax, eax ; путем занесения нуля mov [edi], eax ; в нужное место... ; Доводим до ума путь к иньке invoke lstrcat, addr iniFile, lng invoke lstrcat, addr iniFile, addr iniext invoke GetPrivateProfileString, addr inicapt, addr inikey, NULL, addr outStr, 400h, addr iniFile or eax, eax jz ext lea eax, outStr ext: ret GetDescription endp GetData proc hWnd:DWORD, uMsg:DWORD, wParam:DWORD, lParam:DWORD Local retVal[400h]:BYTE .if uMsg==1h ; UpdateData call UpdateData mov eax, TRUE .elseif uMsg==2h ; IsConnected call IsConnected .elseif uMsg==3h ; GetConName call GetConName .elseif uMsg==4h ; GetDeviceName call GetDeviceName .elseif uMsg==5h ; GetDeviceType call GetDeviceType .elseif uMsg==6h ; GetNumInfo call GetNumInfo .elseif uMsg==7h ; GetDesctr invoke GetDescription, wParam .endif ret GetData endp ; ########################################################################## End start 3.VB VERSION 1.0 CLASS BEGIN MultiUse = -1 'True Persistable = 0 'NotPersistable ataBindingBehavior = 0 'vbNone
ataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject END Attribute VB_Name = " ata"
Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = True Option Explicit Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasconn As Any, lpcb As Long, lpcConnections As Long) As Long Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Type VBRASCONN hRasConn As Long sEntryName As String sDeviceType As String sDeviceName As String sPhonebook As String lngSubEntry As Long guidEntry(15) As Byte End Type Private Declare Function GetProfStr Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal sSection As String, ByVal sKey As Any, ByVal sDefault As String, ByVal sValue As String, ByVal nSize As Long, ByVal sFileName As String) As Long Private sConName As String, bIsConnected As Boolean, sDeviceName As String, sDeviceType As String Public Sub UpdateData() im rtn As Long, b() As Byte, ras_i As Long
im aLens As Variant, dwSize As Long
im lpcb As Long, lpConns As Long
im aVBRasConns() As VBRASCONN
bIsConnected = False sConName = vbNullString sDeviceName = vbNullString sDeviceType = vbNullString ReDim b(3) aLens = Array(692&, 676&, 412&, 32&
For ras_i = 0 To 3 dwSize = aLens(ras_i) Call CopyMemory(b(0), dwSize, &H4): lpcb = 4 rtn = RasEnumConnections(b(0), lpcb, lpConns) If Not rtn = 632 And Not rtn = 610 Then Exit For Next If lpConns = 0 Then Exit Sub lpcb = dwSize * lpConns ReDim b(lpcb - 1) Call CopyMemory(b(0), dwSize, &H4) Call RasEnumConnections(b(0), lpcb, lpConns) ReDim aVBRasConns(lpConns - 1) For ras_i = 0 To lpConns - 1 With aVBRasConns(ras_i) Call CopyMemory(.hRasConn, b(ras_i * dwSize + 4), &H4) If dwSize = 32& Then Call CopyByteToTrimmedString(.sEntryName, b(ras_i * dwSize + 8), 21&
Else Call CopyByteToTrimmedString(.sEntryName, b(ras_i * dwSize + 8), 257&
Call CopyByteToTrimmedString(.sDeviceType, b(ras_i * dwSize + 265), 17&
Call CopyByteToTrimmedString(.sDeviceName, b(ras_i * dwSize + 282), 129&
If dwSize > 412& Then Call CopyByteToTrimmedString(.sPhonebook, b(ras_i * dwSize + 411), 260&
Call CopyMemory(.lngSubEntry, b(ras_i * dwSize + 672), 4) If dwSize > 676& Then Call CopyMemory(.guidEntry(0), b(ras_i * dwSize + 676), 16) End If End If bIsConnected = True sConName = .sEntryName sDeviceName = .sDeviceName sDeviceType = .sDeviceType End With Next End Sub Public Function IsConnected() As Boolean 'Подключены ли мы к инету IsConnected = bIsConnected End Function Public Function GetConName() As String 'Получаем имя текущего соединения GetConName = sConName End Function Public Function GetDeviceType() As String 'Тип устройства GetDeviceType = sDeviceType End Function Public Function GetDeviceName() As String 'Имя устройства GetDeviceName = sDeviceName End Function Public Function GetDescription(lng As String) As String GetDescription = GetINI("Lib", " escription", vbNullString, IIf(Right$(App.Path, 1) = "\", App.Path, App.Path & "\" & App.EXEName & lng & ".ini"
End Function Private Function GetINI(strSection As String, strKey As String, strDefault As String, strFileName As String) As String im uname As String, slength As Long
uname = Space$(512) slength = GetProfStr(strSection, strKey, strDefault, uname, 512, strFileName) uname = Left$(uname, slength) If Left$(uname, 6) = " " Then GetINI = Right$(uname, slength - 6) Else GetINI = uname End Function Private Sub CopyByteToTrimmedString(strToCopyTo As String, bPos As Byte, lngMaxLen As Long) im strTemp As String, lngLen As Long
strTemp = String$(lngMaxLen + 1, 0) Call CopyMemory(ByVal strTemp, bPos, lngMaxLen) lngLen = InStr(strTemp, Chr$(0)) - 1 strToCopyTo = Left$(strTemp, lngLen) End Sub 3.PB #Compile Dll "AuthGCS.dll" #Dim All #Include "RAS32.INC" #Include "WIN32API.INC" Global g_hInstance As Long Global lpRasConn() As RASCONN Global sBuffer As String Function WinErrorMsg(ByVal dError As Dword) As String Local pBuffer As Asciiz Ptr Local ncbBuffer As Dword ncbBuffer = FormatMessage( _ %FORMAT_MESSAGE_ALLOCATE_BUFFER _ Or %FORMAT_MESSAGE_FROM_SYSTEM _ Or %FORMAT_MESSAGE_IGNORE_INSERTS, _ ByVal %NULL, _ dError, _ ByVal MAKELANGID(%LANG_NEUTRAL, %SUBLANG_DEFAULT), _ ByVal VarPtr(pBuffer), _ 0, _ ByVal %NULL) If ncbBuffer Then Function = Peek$(pBuffer, ncbBuffer) LocalFree pBuffer End If End Function ' ---------------------------- Code ----------------------------------- Sub UpdateData Alias "UpdateData" ) Export
im nRet As Long
im lpcb As Dword, lpcConnections As Dword
ReDim lpRasConn(255) lpRasConn(0).dwSize = SizeOf(RASCONN) lpcb = SizeOf(RASCONN) nRet = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections) If Not nRet = 0 Then MsgBox WinErrorMsg(nRet) End If End Sub Function IsConnected Alias "IsConnected" ) Export As Long
Function = Not (lpRasConn(0).hRasConn = 0&
End Function Function GetConName Alias "GetConName" ) Export As String
Function = lpRasConn(0).szEntryName End Function Function GetDeviceName Alias "GetDeviceName" ) Export As String
GetDeviceName = lpRasConn(0).szDeviceName End Function Function GetDeviceType Alias "GetDeviceType" ) Export As String
GetDeviceType = LCase$(lpRasConn(0).szDeviceTYPE) End Function Function GetNumInfo Alias "GetNumInfo" ) Export As String
Function = "All" End Function Function GetDescr Alias "GetDescription" lng As String) Export As String
Local iniFile As Asciiz * %MAX_PATH, lRes As Long, outStr As Asciiz * &H400 Call GetModuleFileName(g_hInstance, iniFile, %MAX_PATH) iniFile = Left$(iniFile, Len(iniFile) - 4& & lng & ".ini"
lRes = GetPrivateProfileString("Lib", " escription", "", outStr, &H400, iniFile)
If lRes Then Function = outStr End Function Function GetData Alias "GetData" ByVal hWnd As Long, _
ByVal uMsg As Long, _ ByVal wParam As String, _ ByVal lParam As Long) Export As String Select Case uMsg Case &H1 ' UpdateData Call UpdateData() Function = "1" Exit Function Case &H2 ' IsConnected Function = Str$(IsConnected()) Exit Function Case &H3 ' GetConName Function = GetConName Exit Function Case &H4 ' GetDeviceName Function = GetDeviceName Exit Function Case &H5 ' GetDeviceType Function = GetDeviceType Exit Function Case &H6 ' GetNumInfo Function = GetNumInfo Exit Function Case &H7 ' GetDesctr Function = GetDescr(wParam) Exit Function End Select End Function ' ----------------------------- Инициализация dll библиотеки ----------------------------------- Function DllMain(ByVal hInstance As Long, ByVal Reason As Long, ByVal Reserved As Long) As Long If Reason = %DLL_PROCESS_ATTACH Then g_hInstance = hInstance End If Function = 1& End Function 3.MASM .386 .model flat, stdcall option casemap :none ; case sensitive ; ######################################################################### include c:\\masm32\include\windows.inc include c:\masm32\include\user32.inc include c:\masm32\include\kernel32.inc include c:\masm32\include\rasapi32.inc include c:\masm32\include\oleaut32.inc includelib c:\masm32\lib\user32.lib includelib c:\masm32\lib\kernel32.lib includelib c:\masm32\lib\rasapi32.lib includelib c:\masm32\lib\oleaut32.lib ; ######################################################################### .data? hInstance dd ? lpRasConn RASCONN 100h dup(<?>
.code start: LibMain proc hInstDLL:DWORD, reason:DWORD, unused:DWORD .if reason == DLL_PROCESS_ATTACH push hInstDLL pop hInstance mov lpRasConn.dwSize, 412 ; sizeof RASCONN + 1 mov eax, TRUE .endif ret LibMain Endp UpdateData proc Local lpcb:DWORD, lpcConnections:DWORD mov lpcb, 412 * 100h invoke RasEnumConnections, addr lpRasConn, addr lpcb, addr lpcConnections ret UpdateData endp IsConnected proc .If lpRasConn.hrasconn == 0h mov eax, FALSE .else mov eax, TRUE .endif ret IsConnected endp GetConName proc lea eax, lpRasConn.szEntryName ret GetConName endp GetDeviceName proc lea eax, lpRasConn.szDeviceName ret GetDeviceName endp GetDeviceType proc invoke CharLower, addr lpRasConn.szDeviceType ret GetDeviceType endp GetNumInfo proc .data all db "ALL",0 .code lea eax, all ret GetNumInfo endp GetDescription proc uses edi esi lng:DWORD Local iniFile[MAX_PATH]:BYTE, outStr[400h]:BYTE .data iniext db ".ini",0 inicapt db "Lib",0 inikey db " escription",0
.code invoke GetModuleFileName, hInstance, addr iniFile, MAX_PATH lea edi, iniFile ; Установка указателей lea esi, lng ; На идентификатор языка invoke lstrlen, addr iniFile ; Получение длитнны пути sub eax, 4h ; Отрезаем .ini add edi, eax xor eax, eax ; путем занесения нуля mov [edi], eax ; в нужное место... ; Доводим до ума путь к иньке invoke lstrcat, addr iniFile, lng invoke lstrcat, addr iniFile, addr iniext invoke GetPrivateProfileString, addr inicapt, addr inikey, NULL, addr outStr, 400h, addr iniFile or eax, eax jz ext lea eax, outStr ext: ret GetDescription endp GetData proc hWnd:DWORD, uMsg:DWORD, wParam:DWORD, lParam:DWORD Local retVal[400h]:BYTE .if uMsg==1h ; UpdateData call UpdateData mov eax, TRUE .elseif uMsg==2h ; IsConnected call IsConnected .elseif uMsg==3h ; GetConName call GetConName .elseif uMsg==4h ; GetDeviceName call GetDeviceName .elseif uMsg==5h ; GetDeviceType call GetDeviceType .elseif uMsg==6h ; GetNumInfo call GetNumInfo .elseif uMsg==7h ; GetDesctr invoke GetDescription, wParam .endif ret GetData endp ; ########################################################################## End start ЗЫ Лично я знаю еще два спомоба, но мне их было писать лень... ЗЗЫ Последний способ считает что мы в инете уже в тот момент когда происходит авторизация... |
||
|
Номер ответа: 7 Автор ответа: Alexey333ICQ: 127708322 Вопросов: 4 Ответов: 29 |
Профиль | | #7 | Добавлено: 09.10.04 13:29 |
|
Ужас. Я же еще слабо разбираюсь!
Неужели нет способа попроще в пару строк?! |
||
|
Номер ответа: 8 Автор ответа: sneРазработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445 |
Web-сайт: Профиль | | #8 | Добавлено: 09.10.04 16:32 |
|
куда уж проще, бери любой код копируя (для VB) в класс, создавай, используй... для PB - в модуль, для ассемблера - в inc/asm - без разницы Можешь и в dll'ку это чудо откомпилировать и вызывать... в чем проблемма-то...
Это же 3 способа на 3 языках, по отдельности каждый из них маленький! Т.е. то что тут это в 9 раз больше того что тебе необходимо! |
||
|
Номер ответа: 9 Автор ответа: dNWВопросов: 30 Ответов: 683 |
Профиль | | #9 | Добавлено: 09.10.04 17:29 |
|
Private Declare Function IsNetworkAlive Lib "SENSAPI.DLL" (ByRef lpdwFlags As Long) As Long
Private Sub Form_Load() Dim Ret As Long,Res As Long Res = IsNetworkAlive(Ret) If Res = 1 And Ret = 2 Then MsgBox "Есть соединение" End Sub Вот и все... |
||
|
Номер ответа: 10 Автор ответа: Alexey333ICQ: 127708322 Вопросов: 4 Ответов: 29 |
Профиль | | #10 | Добавлено: 09.10.04 18:02 |
|
Не работает твой пример. Пишет "Sub or Function not defined"
|
||
|
Номер ответа: 11 Автор ответа: dNWВопросов: 30 Ответов: 683 |
Профиль | | #11 | Добавлено: 10.10.04 14:49 |
|
У меня все работает
Какая у тебя ОС. Есть ли Internet Explorer? |
||
|
Номер ответа: 12 Автор ответа: Alexey333ICQ: 127708322 Вопросов: 4 Ответов: 29 |
Профиль | | #12 | Добавлено: 10.10.04 18:39 |
| Windows 98, Internet Explorer 6.0 | ||
|
Номер ответа: 13 Автор ответа: dNWВопросов: 30 Ответов: 683 |
Профиль | | #13 | Добавлено: 11.10.04 15:55 |
| Все ясно. IsNetworkAlive глючит в 98. Тебе повезло, что комп не завис. Значит иди в vbnet.ru/faq/ Там есть ответ | ||
|
Номер ответа: 14 Автор ответа: BarsikРазработчик Offline Client ICQ: 343368641 Вопросов: 17 Ответов: 686 |
Web-сайт: Профиль | | #14 | Добавлено: 11.10.04 20:52 |
| дык а че на сайте пример ломает посмотреть... | ||
|
Номер ответа: 15 Автор ответа: Alexey333ICQ: 127708322 Вопросов: 4 Ответов: 29 |
Профиль | | #15 | Добавлено: 12.10.04 05:42 |
| Так я же написал, что не нашел его в разделе "Примеры"! | ||