أهلا بالعمالقة الفريق العربي للبرمجة ...
بعد بحث ممل وتجربة للأكواد أعلن استسلامي وسرد موضوعي ....
وجدت موضوع في المنتدى في مكتبة الأكواد به الكود التالي :
Option Explicit
Dim Ret As Long
Private Const INTERNET_CONNECTION_CONFIGURED = &H40
Private Const INTERNET_CONNECTION_LAN = &H2
Private Const INTERNET_CONNECTION_MODEM = &H1
Private Const INTERNET_CONNECTION_OFFLINE = &H20
Private Const INTERNET_CONNECTION_PROXY = &H4
Private Const INTERNET_RAS_INSTALLED = &H10
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
Private Const RAS_MAXENTRYNAME = 256
Private Const RAS_MAXDEVICETYPE = 16
Private Const RAS_MAXDEVICENAME = 128
Private Const RAS_RASCONNSIZE = 412
Private Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type
Private Const RAS95_MaxEntryName = 256
Private Const RAS_MaxPhoneNumber = 128
Private Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber
Private Const UNLEN = 256
Private Const PWLEN = 256
Private Const DNLEN = 12
Private Type RASDIALPARAMS
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
szPhoneNumber(RAS_MaxPhoneNumber) As Byte
szCallbackNumber(RAS_MaxCallbackNumber) As Byte
szUserName(UNLEN) As Byte
szPassword(PWLEN) As Byte
szDomain(DNLEN) 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 RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (ByVal lprasdialextensions As Long, ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, lpvoid As Any, ByRef lphrasconn As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
Private Sub GetConnectionState()
InternetGetConnectedState Ret, 0&
End Sub
Public Function ConnectionConfigured() As Boolean
GetConnectionState
If (Ret And INTERNET_CONNECTION_CONFIGURED) = INTERNET_CONNECTION_CONFIGURED Then
ConnectionConfigured = True
Else
ConnectionConfigured = False
End If
End Function
Public Function ConnectedByLAN() As Boolean
GetConnectionState
If (Ret And INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN Then
ConnectedByLAN = True
Else
ConnectedByLAN = False
End If
End Function
Public Function ConnectedByModem() As Boolean
GetConnectionState
If (Ret And INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM Then
ConnectedByModem = True
Else
ConnectedByModem = False
End If
End Function
Public Function OnLine() As Boolean
GetConnectionState
If (Ret And INTERNET_CONNECTION_OFFLINE) = INTERNET_CONNECTION_OFFLINE Then
OnLine = False
Else
OnLine = True
End If
End Function
Public Function ConnectedByProxy() As Boolean
GetConnectionState
If (Ret And INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY Then
ConnectedByProxy = True
Else
ConnectedByProxy = False
End If
End Function
Public Function RASInstalled() As Boolean
GetConnectionState
If (Ret And INTERNET_RAS_INSTALLED) = INTERNET_RAS_INSTALLED Then
RASInstalled = True
Else
RASInstalled = False
End If
End Function
Public Sub DialUp_Disconnect()
Dim i As Long, lpRasConn(255) As RasConn, lpcb As Long
Dim lpcConnections As Long, hRasConn As Long
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
returncode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
If returncode = 0 Then
For i = 0 To lpcConnections - 1
hRasConn = lpRasConn(i).hRasConn
returncode = RasHangUp(ByVal hRasConn)
Next i
End If
End Sub
Private Function ChangeBytes(ByVal str As String, Bytes() As Byte) As Boolean
' Changes a Visual Basic unicode string to an byte array ' Returns True if it truncates str Dim lenBs As Long ' length of the byte array Dim lenStr As Long ' length of the string lenBs = UBound(Bytes) - LBound(Bytes)
lenStr = LenB(StrConv(str, vbFromUnicode))
If lenBs > lenStr Then
CopyMemory Bytes(0), str, lenStr
ZeroMemory Bytes(lenStr), lenBs - lenStr
ElseIf lenBs = lenStr Then
CopyMemory Bytes(0), str, lenStr
Else
CopyMemory Bytes(0), str, lenBs
ChangeBytes = True
End If
End Function
Public Sub DialUp_Connect(ByVal Number As String, Optional UserName As String = "", Optional Password As String = "")
Dim RP As RASDIALPARAMS, H As Long, Resp As Long
RP.dwSize = Len(RP) + 6
ChangeBytes Number, RP.szEntryName
ChangeBytes "", RP.szPhoneNumber
ChangeBytes "*", RP.szCallbackNumber
ChangeBytes UserName, RP.szUserName
ChangeBytes Password, RP.szPassword
ChangeBytes "*", RP.szDomain
Resp = RasDial(ByVal 0, ByVal 0, RP, 0, ByVal 0, H)
Dial = (Resp = 0)
End Sub
لكن لم أفهم الكود ... هذا الكود يوضح كيف يمكن انشاء اتصال جديد .... هل يمكن وضعه في مثال للفائدة
الأمر الآخر كيف يمكن وضع قائمة الإتصلات في Combo أو List Box مثلا ....
وجدت كود لعمل قائمة بالإتصلات ولكن أيضا لم أفهمه
في قسم التصريحات
Private Type RASENTRYNAME95
dwSize As Long
szEntryname(256) As Byte
End Type
Private Declare Function RasEnumEntriesA Lib "RasApi32.dll" _
(ByVal reserved As String, ByVal lpszPhonebook As String, _
lprasentryname As Any, lpcb As Long, lpcEntries As Long) _
As Long
في الكود
Public Sub DUN_Services(DUN_Array() As String)
'Pass in Empty array for DUN_Array
Dim s As Long, ln As Long, conname As String, i As Long
Dim r(255) As RASENTRYNAME95
r(0).dwSize = 264
s = 256 * r(0).dwSize
Call RasEnumEntriesA(vbNullString, vbNullString, r(0), s, ln)
ln = ln - 1
ReDim DUN_Array(ln)
For i = 0 To ln
conname = StrConv(r(i).szEntryname(), vbUnicode)
DUN_Array(i) = Left$(conname, InStr(conname, _
vbNullChar) - 1)
Next i
End Sub
الأمر الأخير كيف يمكن الإتصال - بالإتصال المحدد من ذلك Combo أو List Box ....
أحتاج إلى الطريقة بشكل ملح