pr0sper0
17-09-2014, 23:32:22
Option Explicit
Const RAS95_MaxEntryName = 256
Private Type RASENTRYNAME95
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type
Private Type RASDIALPARAMS
dwSize As Long
szEntryName As String * 257
szPhoneNumber As String * 129
szCallbackNumber As String * 129
szUserName As String * 257
szPassword As String * 257
szDomain As String * 16
filler As String * 16
End Type
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 Type RASCONN
dwSize As Long
hRasConn As Long
szEntryName(0 To 256) As Byte
szDeviceType(0 To 16) As Byte
szDeviceName(0 To 128) As Byte
pad As Byte
End Type
Private Declare Function RasEnumConnections Lib "rasapi32" Alias "RasEnumConnectionsA" ( _
ByVal lprasconn As Long, _
ByVal lpcb As Long, _
ByVal lpcConnections As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal miliseg As Long)
Private Declare Sub strcpyn Lib "kernel32.dll" Alias "lstrcpynA" _
(ByVal a As String, _
ByVal de As String, _
ByVal N As Long)
Private Declare Function strlen Lib "kernel32.dll" Alias "lstrlenA" _
(ByVal texto As String) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" _
(ByVal handle As Long) As Integer
Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" _
(ByVal p1 As Long, _
ByVal p2 As Long, _
rd As RASDIALPARAMS, _
ByVal p4 As Long, _
ByVal p5 As Long, _
handle As Long) As Integer
Private Declare Sub RasGetErrorString Lib "rasapi32.dll" Alias "RasGetErrorStringA" _
(ByVal nmumer As Long, _
ByVal buffer As String, _
ByVal sizebuf As Long)
Private Declare Function InternetGetConnectedState Lib "wininet.dll" ( _
ByRef lpdwFlags As Long, _
ByVal dwReserved As Long) As Long
Dim hDial As Long
Function Conectar(Entry As String, _
User As String, _
Pass As String) As Integer
Dim Rdp As RASDIALPARAMS
Rdp.dwSize = 1052
strcpyn Rdp.szEntryName, Entry + Chr$(0), 256
strcpyn Rdp.szPhoneNumber, Chr$(0), 128
strcpyn Rdp.szCallbackNumber, Chr$(0), 128
strcpyn Rdp.szUserName, User + Chr$(0), 256
strcpyn Rdp.szPassword, Pass + Chr$(0), 256
strcpyn Rdp.szDomain, Chr$(0), 15
Conectar = RasDial(0, 0, Rdp, 0, 0, hDial)
End Function
Function Desconectar() As Long
Dim N As Long
N = RasHangUp(hDial)
hDial = GetHandleConnection
Sleep (3000)
Desconectar = N
End Function
Function TextoError(Num As Long) As String
Dim Txt As String * 128
Txt = Chr$(0)
RasGetErrorString Num, Txt, 127
TextoError = Left$(Txt, strlen(Txt))
End Function
Private Sub Command1_Click()
Dim N As Long
Me.MousePointer = vbHourglass
If IsOnline = False Then
MsgBox "Ya se estaba conectado a internet", vbInformation
Else
N = Conectar(List1, Text1, Text2)
If N = 0 Then
MsgBox "Conectado a internet", vbInformation
Else
MsgBox TextoError(N), vbCritical
End If
End If
Me.MousePointer = 0
End Sub
Private Sub Command2_Click()
Dim N As Long
Me.MousePointer = vbHourglass
hDial = GetHandleConnection
If IsOnline = False Then
MsgBox "No se estaba conectado a internet", vbExclamation
Else
N = Desconectar
If N = 0 Then
MsgBox "Desconectado", vbInformation
Else
MsgBox TextoError(N), vbCritical, "Mensaje de error"
End If
End If
hDial = GetHandleConnection
Me.MousePointer = 0
End Sub
Private Sub ListarConexiones()
Dim s As Long, l As Long, ln As Long, a$
ReDim r(255) As RASENTRYNAME95
r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(r(l).szEntryName(), vbUnicode)
List1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If List1.ListCount > 0 Then
List1.ListIndex = 0
End If
hDial = GetHandleConnection
End Sub
Function GetHandleConnection() As Long
Dim conn As RASCONN
Dim y As Long, z As Long
Dim ret As Long
conn.dwSize = Len(conn)
y = conn.dwSize
ret = RasEnumConnections(VarPtr(conn), _
VarPtr(y), _
VarPtr(z))
GetHandleConnection = conn.hRasConn
End Function
Public Function IsOnline() As Boolean
IsOnline = InternetGetConnectedState(0&, 0&)
End Function
Private Sub Form_Load()
Text1.Visible = False
Text2.Visible = False
Call ListarConexiones
Me.Caption = " Acceso RAS, " & _
"conectar y desconectar"
Command1.Caption = "Conectar"
Command2.Caption = "Desconectar"
End Sub
Const RAS95_MaxEntryName = 256
Private Type RASENTRYNAME95
dwSize As Long
szEntryName(RAS95_MaxEntryName) As Byte
End Type
Private Type RASDIALPARAMS
dwSize As Long
szEntryName As String * 257
szPhoneNumber As String * 129
szCallbackNumber As String * 129
szUserName As String * 257
szPassword As String * 257
szDomain As String * 16
filler As String * 16
End Type
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 Type RASCONN
dwSize As Long
hRasConn As Long
szEntryName(0 To 256) As Byte
szDeviceType(0 To 16) As Byte
szDeviceName(0 To 128) As Byte
pad As Byte
End Type
Private Declare Function RasEnumConnections Lib "rasapi32" Alias "RasEnumConnectionsA" ( _
ByVal lprasconn As Long, _
ByVal lpcb As Long, _
ByVal lpcConnections As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal miliseg As Long)
Private Declare Sub strcpyn Lib "kernel32.dll" Alias "lstrcpynA" _
(ByVal a As String, _
ByVal de As String, _
ByVal N As Long)
Private Declare Function strlen Lib "kernel32.dll" Alias "lstrlenA" _
(ByVal texto As String) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" _
(ByVal handle As Long) As Integer
Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" _
(ByVal p1 As Long, _
ByVal p2 As Long, _
rd As RASDIALPARAMS, _
ByVal p4 As Long, _
ByVal p5 As Long, _
handle As Long) As Integer
Private Declare Sub RasGetErrorString Lib "rasapi32.dll" Alias "RasGetErrorStringA" _
(ByVal nmumer As Long, _
ByVal buffer As String, _
ByVal sizebuf As Long)
Private Declare Function InternetGetConnectedState Lib "wininet.dll" ( _
ByRef lpdwFlags As Long, _
ByVal dwReserved As Long) As Long
Dim hDial As Long
Function Conectar(Entry As String, _
User As String, _
Pass As String) As Integer
Dim Rdp As RASDIALPARAMS
Rdp.dwSize = 1052
strcpyn Rdp.szEntryName, Entry + Chr$(0), 256
strcpyn Rdp.szPhoneNumber, Chr$(0), 128
strcpyn Rdp.szCallbackNumber, Chr$(0), 128
strcpyn Rdp.szUserName, User + Chr$(0), 256
strcpyn Rdp.szPassword, Pass + Chr$(0), 256
strcpyn Rdp.szDomain, Chr$(0), 15
Conectar = RasDial(0, 0, Rdp, 0, 0, hDial)
End Function
Function Desconectar() As Long
Dim N As Long
N = RasHangUp(hDial)
hDial = GetHandleConnection
Sleep (3000)
Desconectar = N
End Function
Function TextoError(Num As Long) As String
Dim Txt As String * 128
Txt = Chr$(0)
RasGetErrorString Num, Txt, 127
TextoError = Left$(Txt, strlen(Txt))
End Function
Private Sub Command1_Click()
Dim N As Long
Me.MousePointer = vbHourglass
If IsOnline = False Then
MsgBox "Ya se estaba conectado a internet", vbInformation
Else
N = Conectar(List1, Text1, Text2)
If N = 0 Then
MsgBox "Conectado a internet", vbInformation
Else
MsgBox TextoError(N), vbCritical
End If
End If
Me.MousePointer = 0
End Sub
Private Sub Command2_Click()
Dim N As Long
Me.MousePointer = vbHourglass
hDial = GetHandleConnection
If IsOnline = False Then
MsgBox "No se estaba conectado a internet", vbExclamation
Else
N = Desconectar
If N = 0 Then
MsgBox "Desconectado", vbInformation
Else
MsgBox TextoError(N), vbCritical, "Mensaje de error"
End If
End If
hDial = GetHandleConnection
Me.MousePointer = 0
End Sub
Private Sub ListarConexiones()
Dim s As Long, l As Long, ln As Long, a$
ReDim r(255) As RASENTRYNAME95
r(0).dwSize = 264
s = 256 * r(0).dwSize
l = RasEnumEntries(vbNullString, vbNullString, r(0), s, ln)
For l = 0 To ln - 1
a$ = StrConv(r(l).szEntryName(), vbUnicode)
List1.AddItem Left$(a$, InStr(a$, Chr$(0)) - 1)
Next
If List1.ListCount > 0 Then
List1.ListIndex = 0
End If
hDial = GetHandleConnection
End Sub
Function GetHandleConnection() As Long
Dim conn As RASCONN
Dim y As Long, z As Long
Dim ret As Long
conn.dwSize = Len(conn)
y = conn.dwSize
ret = RasEnumConnections(VarPtr(conn), _
VarPtr(y), _
VarPtr(z))
GetHandleConnection = conn.hRasConn
End Function
Public Function IsOnline() As Boolean
IsOnline = InternetGetConnectedState(0&, 0&)
End Function
Private Sub Form_Load()
Text1.Visible = False
Text2.Visible = False
Call ListarConexiones
Me.Caption = " Acceso RAS, " & _
"conectar y desconectar"
Command1.Caption = "Conectar"
Command2.Caption = "Desconectar"
End Sub