Делал год назад такую прогу. Удачно. Но код недам.

т.к. за такие проги можно $ получать.

Вот модуль как узнать есть ли соединение с инетомна большее не надейся)

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInet As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
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 ReleaseCapture Lib "user32" () As Long
Public Check1Ckd As Boolean
Public BeginnTime
Public EndTime
Public MakeMeHide As Boolean
Public MyPath As String, NewLocation As String, u
Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Public Type Point
    X As Long
    Y As Long
End Type
Public IsConnected1 As Boolean
Public IsConnected2 As Boolean
Public Type Counter
    Hor As Long
    Min As Long
    Sec As Long
End Type
Public Today As Counter
Public Count As Counter
Public FlagForContSave As Long
Public Pos As Point
Public FlagMakeIconConnect As Boolean
Public FlagMakeIconNoConnect As Boolean
Public FlagSaveLogFile As Boolean
Public MakeMeTheMiddle As Boolean
Public Hor As Long
Public Min As Long
Public Sec As Long
Public SecsPP As Boolean
Public RectCoord As RECT
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Public Const SM_CXSCREEN = 0 'X Size of screen
Public Const SM_CYSCREEN = 1 'Y Size of Screen
Public Reg As Object
Public TRasCon(255) As RASCONN95
Public lg As Long
Public lpcon As Long
Public RetVal As Long
Public Tstatus As RASCONNSTATUS95
'--------ConnectionCheckerAndLogger-------------
Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32
Public 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
'End--------ConnectionCheckerAndLogger-------------

Public Function IsConnected() As Boolean
If Form3.OptionChkd(0).Value = Checked Then Call CheckConnection1
If Form3.OptionChkd(1).Value = Checked Then Call CheckConnection2
If IsConnected1 = True Or IsConnected2 = True Then IsConnected = True
If IsConnected1 = False And IsConnected2 = False Then IsConnected = False
End Function

Private Sub CheckConnection1()
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = &H2000 Then
    IsConnected1 = True
Else
    IsConnected1 = False
End If
Tstatus.RasConnState = Empty
End Sub

Private Sub CheckConnection2()
Dim sTmp As String
Dim hInet As Long
Dim hUrl As Long
Dim Flags As Long
Dim url As Variant
hInet = InternetOpen(App.Title, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0&

If hInet Then
    Flags = INTERNET_FLAG_KEEP_CONNECTION Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_RELOAD
    hUrl = InternetOpenUrl(hInet, "http://www.yahoo.com", vbNullString, 0, Flags, 0)
    If hUrl Then
        IsConnected2 = True
'        Call InternetCloseHandle(hUrl)
    Else
        IsConnected2 = False
    End If
End If
  
Call InternetCloseHandle(hInet)
End Sub

Ответить

Danger2002

Зря ты так!

•••••••••••••••

Aid>

Скорость можно посчитать во время скачки, смотришь сколько байтиков за определённый промежуток времени скаталось, делаешь расчёты и выводишь на дивайс для зрячих!

░▒▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▒░

Ответить

Danger2002 зажопил какой код на VB .... а людям помогать надо ....

P.S. ну что ты за неё много $ получил ? ... наверное что-то в районе одного доллара ))))

Ответить

Ответить

Ну не знаю, доллара-не доллара, а людям действительно помогать надо. Человек же у тебя не машину просит и не программу написать, а ПОМОЩИ...

не, не по-программерски это :о(((

Ответить

Ответить