r@nger

Bu vereceğim kod internete bağlı olup olmadığınızı kontrol eder.

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

Const RAS_MaxEntryName = 256
Const RAS_MaxDeviceType = 16
Const RAS_MaxDeviceName = 32

Private Type RASType
dwSize As Long
hRasCon As Long
szEntryName(RAS_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type

Private Type RASStatusType
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS_MaxDeviceName) As Byte
End Type

Private Sub Form_Load()
Timer1.Interval = 200
Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
DFÜStatus
End Sub

Private Function DFÜStatus() As Boolean
Dim RAS(255) As RASType, RASStatus As RASStatusType
Dim lg&, lpcon&, Result&

RAS(0).dwSize = 412
lg = 256 * RAS(0).dwSize
Result = RasEnumConnections(RAS(0), lg, lpcon)
If lpcon = 0 Then
Label1.Caption = "Offline" '###
DFÜStatus = False
Else
RASStatus.dwSize = 160
Result = RasGetConnectStatus(RAS(0).hRasCon, RASStatus)
If RASStatus.RasConnState = &H2000 Then
Label1.Caption = "Online" '###
DFÜStatus = True
Else
Label1.Caption = "Baglanti Kopuk" '###
DFÜStatus = False
End If
End If
End Function

INTERNET BAĞLANTISI OLUŞTURMAK - KESMEK
Bu kod sayesinde internete bagli olup olmadigimiz ögrenilebilir.

Option Explicit

Const RAS_MaxDeviceType = 16
Const RAS95_MaxDeviceName = 128
Const RAS95_MaxEntryName = 256

Private Type RASENTRYNAME95
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type

Private Type RASCONN95
dwSize As Long
hRasConn As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type

Private Declare Function RasEnumConnections Lib "RasApi32.DLL" _
Alias "RasEnumConnectionsA" (lprasconn As Any, lpcb As _
Long, lpcConnections As Long) As Long

Private Declare Function RasEnumEntries Lib "RasApi32.DLL" _
Alias "RasEnumEntriesA" (ByVal reserved$, ByVal _
lpszPhonebook$, lprasentryname As Any, lpcb As Long, _
lpcEntries As Long) As Long

Private Declare Function RasHangUp Lib "RasApi32.DLL" _
Alias "RasHangUpA" (ByVal hRasConn As Long) As Long

Dim DFÜname$, RCon As Long

Private Sub HangUp(ByVal Verbindung$)
Dim s As Long, l As Long, ln As Long, aa$
ReDim r(255) As RASCONN95

r(0).dwSize = 412
s = 256 * r(0).dwSize
l = RasEnumConnections(r(0), s, ln)
For l = 0 To ln - 1
aa = StrConv(r(l).szEntryName(), vbUnicode)
aa = Left$(aa, InStr(aa, Chr$(0)) - 1)
If aa = Verbindung Then
RCon = r(l).hRasConn
Dim rec As Long
rec = RasHangUp(RCon)
End If
Next l
End Sub

Private Sub Command1_Click()
If List1.ListIndex = -1 Then Exit Sub
DFÜname = List1.List(List1.ListIndex)
Shell "rundll32.exe rnaui.dll,RnaDial " & DFÜname

SendKeys "{ENTER}", True
SendKeys "{ENTER}", True
Me.SetFocus
End Sub

Private Sub Command2_Click()
Call HangUp(DFÜname)
End Sub

Private Sub Form_Load()
Dim s As Long, ln As Long, i%, conname$
Dim r(255) As RASENTRYNAME95

r(0).dwSize = 264
s = 256 * r(0).dwSize
Call RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)

For i = 0 To ln - 1
conname = StrConv(r(i).szEntryName(), vbUnicode)
List1.AddItem Left$(conname, InStr(conname, vbNullChar) - 1)
Next i

If List1.ListCount <> 0 Then List1.ListIndex = 0
End Sub

FARE GÖSTERGESİNİ GİZLEMEK
Bu kod sayesinde farenizin göstergesini gizleyebilirsiniz.

Option Explicit

Private Declare Function ShowCursor Lib "user32" (ByVal _
bShow As Long) As Long

Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 3000
End Sub

Private Sub Command1_Click()
Timer1.Enabled = True
ShowCursor (0)
End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
ShowCursor (1)
End Sub

Alıntıdır.

__________________
Geri döndüm