28 |
|
|
29 |
|
|
30 |
'API function declarations |
'API function declarations |
31 |
Private Declare Function RasEnumConnections Lib "RasApi32.DLL" Alias "RasEnumConnectionsA" (lprasconn As Any, _ |
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lprasconn As Any, _ |
32 |
lpcb As Long, _ |
lpcb As Long, _ |
33 |
lpcConnections As Long) As Long |
lpcConnections As Long) As Long |
34 |
|
|
35 |
Private Declare Function RasGetProjectionInfo Lib "RasApi32.DLL" Alias "RasGetProjectionInfoA" (ByVal hRasConn As Long, _ |
Private Declare Function RasGetProjectionInfo Lib "rasapi32.dll" Alias "RasGetProjectionInfoA" (ByVal hRasConn As Long, _ |
36 |
ByVal rasprojection As Long, _ |
ByVal rasprojection As Long, _ |
37 |
lpprojection As Any, _ |
lpprojection As Any, _ |
38 |
lpcb As Long) As Long |
lpcb As Long) As Long |
39 |
|
|
40 |
Private Declare Function RasHangUp Lib "RasApi32.DLL" Alias "RasHangUpA" ( _ |
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" ( _ |
41 |
ByVal hRasConn As Long) As Long |
ByVal hRasConn As Long) As Long |
42 |
|
|
43 |
|
|
75 |
End Function |
End Function |
76 |
|
|
77 |
|
|
78 |
Private Function getIpInfo() As RASPPPIP |
Private Function getIpInfo(conName As String) As RASPPPIP |
79 |
Dim lConnection As Long |
Dim lConnection As Long |
80 |
Dim lProjection As Long |
Dim lProjection As Long |
81 |
Dim tIpInfo As RASPPPIP |
Dim tIpInfo As RASPPPIP |
88 |
lSize = tIpInfo.dwSize |
lSize = tIpInfo.dwSize |
89 |
|
|
90 |
'retrieve connection |
'retrieve connection |
91 |
lConnection = lRetrieveConnectionHandler() |
lConnection = RasRetrieveConnectionHandler(conName) |
92 |
If lConnection = 0 Then |
If lConnection = 0 Then |
93 |
Exit Function |
Exit Function |
94 |
End If |
End If |
104 |
End Function |
End Function |
105 |
|
|
106 |
|
|
107 |
Public Function DetermineServerIP() As String |
Public Function DetermineServerIP(conName As String) As String |
108 |
|
|
109 |
Dim tIpInfo As RASPPPIP |
Dim tIpInfo As RASPPPIP |
110 |
|
|
111 |
DetermineServerIP = vbNullString |
DetermineServerIP = vbNullString |
112 |
|
|
113 |
tIpInfo = getIpInfo() |
tIpInfo = getIpInfo(conName) |
114 |
|
|
115 |
'MsgBox "abc" |
'MsgBox "abc" |
116 |
|
|
121 |
|
|
122 |
End Function |
End Function |
123 |
|
|
124 |
Public Function DetermineClientIP() As String |
Public Function DetermineClientIP(conName As String) As String |
125 |
|
|
126 |
Dim tIpInfo As RASPPPIP |
Dim tIpInfo As RASPPPIP |
127 |
|
|
128 |
DetermineClientIP = vbNullString |
DetermineClientIP = vbNullString |
129 |
|
|
130 |
tIpInfo = getIpInfo() |
tIpInfo = getIpInfo(conName) |
131 |
|
|
132 |
'check return code |
'check return code |
133 |
'If lRetCode = 0 Then |
'If lRetCode = 0 Then |
181 |
Next i |
Next i |
182 |
End Function |
End Function |
183 |
|
|
184 |
|
Private Function RasRetrieveConnectionHandler(conName As String) As Long |
185 |
|
Dim lRetCode As Long |
186 |
|
Dim lSize As Long |
187 |
|
Dim tConnections(255) As RASCONN |
188 |
|
Dim lConnections As Long |
189 |
|
|
190 |
|
Dim i As Long |
191 |
|
Dim cConnection As RASCONN |
192 |
|
Dim strRASConName As String |
193 |
|
|
194 |
|
'init |
195 |
|
tConnections(0).dwSize = 412 |
196 |
|
lSize = (UBound(tConnections) + 1) * tConnections(0).dwSize |
197 |
|
RasRetrieveConnectionHandler = 0 |
198 |
|
|
199 |
|
'retreive connections |
200 |
|
lRetCode = RasEnumConnections(tConnections(0), lSize, lConnections) |
201 |
|
|
202 |
|
'check return code |
203 |
|
If lRetCode = 0 Then |
204 |
|
'call successfull -> any connections? |
205 |
|
If lConnections > 0 Then |
206 |
|
For i = 0 To lConnections - 1 |
207 |
|
'lRetrieveConnectionHandler = tConnections(0).hRasConn |
208 |
|
cConnection = tConnections(i) |
209 |
|
strRASConName = StrConv(cConnection.szEntryName(), vbUnicode) |
210 |
|
strRASConName = Left$(strRASConName, InStr(strRASConName, vbNullChar) - 1) |
211 |
|
'MsgBox strRASConName |
212 |
|
If strRASConName = conName Then |
213 |
|
'MsgBox cConnection.hRasConn |
214 |
|
RasRetrieveConnectionHandler = cConnection.hRasConn |
215 |
|
End If |
216 |
|
Next i |
217 |
|
End If |
218 |
|
End If |
219 |
|
End Function |
220 |
|
|
221 |
|
Public Function RasIsOnline(conName As String) As Boolean |
222 |
|
Dim handle As Long |
223 |
|
handle = RasRetrieveConnectionHandler(conName) |
224 |
|
'MsgBox handle |
225 |
|
If handle <> 0 Then RasIsOnline = True |
226 |
|
End Function |