VpnDial/src/RasEntry.bas

Attribute VB_Name = "RasEntry"
' RasConnect
' http://www.mentalis.org/apilist/RasDial.shtml
' example created by Daniel Kaufmann (daniel@i.com.uy)

' RasDisconnect
' http://www.activevb.de/tipps/vb6tipps/tipp0009.html


Option Explicit
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)

Const RAS95_MaxEntryName = 256
Const RAS_MaxPhoneNumber = 128
Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber

Const UNLEN = 256
Const PWLEN = 256
Const DNLEN = 12

Private Type RASDIALPARAMS
   dwSize As Long ' 1052
   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 Type RASENTRYNAME95
    'set dwsize to 264
    dwSize As Long
    szEntryName(RAS95_MaxEntryName) As Byte
End Type


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 Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" _
    (ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, _
    lpcb As Long, lpcEntries As Long) As Long
    
Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" _
    (ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As Long

Private Declare Function RasSetEntryDialParams _
      Lib "rasapi32.dll" Alias "RasSetEntryDialParamsA" _
        (ByVal lpszPhonebook As String, _
        lpRasDialParams As RASDIALPARAMS, _
        ByVal blnRemovePassword As Long) As Long
        
Private Function Dial(ByVal Connection As String, ByVal phoneBook As String, ByVal username As String, ByVal password As String) As Integer
    
    Dim rp As RASDIALPARAMS, h As Long, resp As Long
    rp.dwSize = Len(rp) + 6
    ChangeBytes Connection, rp.szEntryName
    ChangeBytes "", rp.szPhoneNumber 'Phone number stored for the connection
    ChangeBytes "*", rp.szCallbackNumber 'Callback number stored for the connection
    ChangeBytes username, rp.szUserName
    ChangeBytes password, rp.szPassword
    ChangeBytes "*", rp.szDomain 'Domain stored for the connection
    
    'Dial
    resp = RasDial(ByVal 0, ByVal phoneBook, rp, 0, ByVal 0, h)   'AddressOf RasDialFunc
    Dial = resp
    
End Function

Private Function ChangeToStringUni(Bytes() As Byte) As String
    'Changes an byte array to a Visual Basic unicode string
    Dim temp As String
    temp = StrConv(Bytes, vbUnicode)
    ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1)
End Function

Private Function ChangeBytes(ByVal str As String, ByRef 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 'Queda truncado
        ChangeBytes = True
    End If
End Function


Public Function RasConnect(conName As String, phoneBook As String) As Boolean
    
    Dim rdp As RASDIALPARAMS, t As Long
    Dim username As String, password As String
    
    rdp.dwSize = Len(rdp) + 6
    ChangeBytes conName, rdp.szEntryName
    
    ' Get User name and password for the connection
    t = RasGetEntryDialParams(phoneBook, rdp, 0)
    If t = 0 Then
        username = ChangeToStringUni(rdp.szUserName)
        password = ChangeToStringUni(rdp.szPassword)
    End If
    
    Dim errorCode As Integer
    errorCode = Dial(conName, phoneBook, username, password)

    If (errorCode <> 0) Then
        MsgBox "Error-Code: " & errorCode & vbCrLf & "http://www.admins-tipps.net/glossar/ras_errorcode.htm"
    End If
    
    RasConnect = (errorCode = 0)

End Function

' VpnDial.exe --setup {connection} --user {username} --pass {password}
Public Function SetupRasEntry(conName As String, phoneBook As String, username As String, password As String)
    
    Dim rdp As RASDIALPARAMS
    Dim result As Long
    
    rdp.dwSize = Len(rdp) + 6
    ChangeBytes conName, rdp.szEntryName
    
    ChangeBytes username, rdp.szUserName
    ChangeBytes password, rdp.szPassword
    
    ' Set User name and password for the connection
    RasSetEntryDialParams phoneBook, rdp, 0
    
End Function
1	joko	1.1	Attribute VB_Name = "RasEntry"
2			' RasConnect
3			' http://www.mentalis.org/apilist/RasDial.shtml
4			' example created by Daniel Kaufmann (daniel@i.com.uy)
5
6			' RasDisconnect
7			' http://www.activevb.de/tipps/vb6tipps/tipp0009.html
8
9
10			Option Explicit
11			Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, ByVal pSrc As String, ByVal ByteLen As Long)
12			Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (Destination As Any, ByVal Length As Long)
13
14			Const RAS95_MaxEntryName = 256
15			Const RAS_MaxPhoneNumber = 128
16			Const RAS_MaxCallbackNumber = RAS_MaxPhoneNumber
17
18			Const UNLEN = 256
19			Const PWLEN = 256
20			Const DNLEN = 12
21
22			Private Type RASDIALPARAMS
23			dwSize As Long ' 1052
24			szEntryName(RAS95_MaxEntryName) As Byte
25			szPhoneNumber(RAS_MaxPhoneNumber) As Byte
26			szCallbackNumber(RAS_MaxCallbackNumber) As Byte
27			szUserName(UNLEN) As Byte
28			szPassword(PWLEN) As Byte
29			szDomain(DNLEN) As Byte
30			End Type
31
32			Private Type RASENTRYNAME95
33			'set dwsize to 264
34			dwSize As Long
35			szEntryName(RAS95_MaxEntryName) As Byte
36			End Type
37
38
39	joko	1.2	Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" _
40	joko	1.1	(ByVal lprasdialextensions As Long, ByVal lpcstr As String, _
41			ByRef lprasdialparamsa As RASDIALPARAMS, ByVal dword As Long, _
42			lpvoid As Any, ByRef lphrasconn As Long) As Long
43
44	joko	1.2	Private Declare Function RasEnumEntries Lib "rasapi32.dll" Alias "RasEnumEntriesA" _
45	joko	1.1	(ByVal reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, _
46			lpcb As Long, lpcEntries As Long) As Long
47
48	joko	1.2	Private Declare Function RasGetEntryDialParams Lib "rasapi32.dll" Alias "RasGetEntryDialParamsA" _
49	joko	1.1	(ByVal lpcstr As String, ByRef lprasdialparamsa As RASDIALPARAMS, ByRef lpbool As Long) As Long
50
51	joko	1.2	Private Declare Function RasSetEntryDialParams _
52			Lib "rasapi32.dll" Alias "RasSetEntryDialParamsA" _
53			(ByVal lpszPhonebook As String, _
54			lpRasDialParams As RASDIALPARAMS, _
55			ByVal blnRemovePassword As Long) As Long
56
57	joko	1.1	Private Function Dial(ByVal Connection As String, ByVal phoneBook As String, ByVal username As String, ByVal password As String) As Integer
58
59			Dim rp As RASDIALPARAMS, h As Long, resp As Long
60			rp.dwSize = Len(rp) + 6
61			ChangeBytes Connection, rp.szEntryName
62			ChangeBytes "", rp.szPhoneNumber 'Phone number stored for the connection
63			ChangeBytes "*", rp.szCallbackNumber 'Callback number stored for the connection
64			ChangeBytes username, rp.szUserName
65			ChangeBytes password, rp.szPassword
66			ChangeBytes "*", rp.szDomain 'Domain stored for the connection
67
68			'Dial
69			resp = RasDial(ByVal 0, ByVal phoneBook, rp, 0, ByVal 0, h) 'AddressOf RasDialFunc
70			Dial = resp
71
72			End Function
73
74			Private Function ChangeToStringUni(Bytes() As Byte) As String
75			'Changes an byte array to a Visual Basic unicode string
76			Dim temp As String
77			temp = StrConv(Bytes, vbUnicode)
78			ChangeToStringUni = Left(temp, InStr(temp, Chr(0)) - 1)
79			End Function
80
81			Private Function ChangeBytes(ByVal str As String, ByRef Bytes() As Byte) As Boolean
82			'Changes a Visual Basic unicode string to an byte array
83			'Returns True if it truncates str
84			Dim lenBs As Long 'length of the byte array
85			Dim lenStr As Long 'length of the string
86			lenBs = UBound(Bytes) - LBound(Bytes)
87			lenStr = LenB(StrConv(str, vbFromUnicode))
88			If lenBs > lenStr Then
89			CopyMemory Bytes(0), str, lenStr
90			ZeroMemory Bytes(lenStr), lenBs - lenStr
91			ElseIf lenBs = lenStr Then
92			CopyMemory Bytes(0), str, lenStr
93			Else
94			CopyMemory Bytes(0), str, lenBs 'Queda truncado
95			ChangeBytes = True
96			End If
97			End Function
98
99
100
101			Public Function RasConnect(conName As String, phoneBook As String) As Boolean
102
103			Dim rdp As RASDIALPARAMS, t As Long
104			Dim username As String, password As String
105
106			rdp.dwSize = Len(rdp) + 6
107			ChangeBytes conName, rdp.szEntryName
108
109			' Get User name and password for the connection
110			t = RasGetEntryDialParams(phoneBook, rdp, 0)
111			If t = 0 Then
112			username = ChangeToStringUni(rdp.szUserName)
113			password = ChangeToStringUni(rdp.szPassword)
114			End If
115
116			Dim errorCode As Integer
117			errorCode = Dial(conName, phoneBook, username, password)
118
119			If (errorCode <> 0) Then
120			MsgBox "Error-Code: " & errorCode & vbCrLf & "http://www.admins-tipps.net/glossar/ras_errorcode.htm"
121			End If
122
123			RasConnect = (errorCode = 0)
124
125			End Function
126
127	joko	1.2	' VpnDial.exe --setup {connection} --user {username} --pass {password}
128			Public Function SetupRasEntry(conName As String, phoneBook As String, username As String, password As String)
129
130			Dim rdp As RASDIALPARAMS
131			Dim result As Long
132
133			rdp.dwSize = Len(rdp) + 6
134			ChangeBytes conName, rdp.szEntryName
135
136			ChangeBytes username, rdp.szUserName
137			ChangeBytes password, rdp.szPassword
138
139			' Set User name and password for the connection
140			RasSetEntryDialParams phoneBook, rdp, 0
141
142			End Function
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26