Api rasdial

Signaler
Messages postés
3
Date d'inscription
mercredi 14 mai 2003
Statut
Membre
Dernière intervention
3 mars 2008
-
Messages postés
2676
Date d'inscription
vendredi 28 juin 2002
Statut
Membre
Dernière intervention
13 janvier 2016
-
Bonjour,
Je suis debutant et j'essai de realiser un appli de gestion des connexions vpn liees avec des fichiers rdp. pour cela j'ai recupere la fonction RasFunction de mWaAtR qui fonctionne sous vb6. Mon probleme est que je n'arrive pas a la faire fonctionnee sous vb2008 a cause je pense d'un probleme de conversion, vbunicode n'existant plus sous vb2008. Voila si quelqu'un a une idee...merci d'avance.

Option Explicit

'Module de démonstration de l'API RasDial réalisé suite à une question sur le forum de VBFrance
'Vous pouvez utiliser et redistribuer ce code.
'Bug connu : ne renvoye pas le handle sous 98.
'Dans la mesure du possible, merci de laisser un petit clin d'oeil à l'auteur...
'J'me suis bien cassé la tête sur ce code

'Testé sur Win 98 SE; Win 2000 Pro,Server; Win XP Pro

'Pseudo : MatMoul
'Site : www.matmoul.ch
'Mail : mat@matmoul.ch

'Remarque concernant les constantes :
'Les valeurs des constantes ont été extraite des fichiers RAS.H, LMCONS.H
'Autre fichier à consulter RASERROR.H

'Remarque concerant les variables commentées du type RASDIALPARAMS :
'En activant ces deux lignes, la taille du buffer vas passer de 1052 à 1060.
'Cette taille n'est pas supportée par Windows 98.

Private Const RAS_MaxEntryName = 256
Private Const RAS_MaxPhoneNumber = 128
Private Const RAS_MaxCallbackNumber = 128
Private Const UNLEN = 256
Private Const DNLEN = 15
Private Const PWLEN = 256

Private Type RASEntryName
dwSize As Long
szEntryName(RAS_MaxEntryName) As Byte
End Type

Private Type RASDIALPARAMS
dwSize As Long
szEntryName(RAS_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
'dwSubEntry As Long '2K Only
'dwCallbackId As Long '2K Only
End Type

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, ByVal lpString2 As String) As Long
Private Declare Function RasDial Lib "rasapi32.dll" Alias "RasDialA" (lpRasDialExtensions As Any, ByVal lpszPhonebook As String, lprasdialparams As Any, ByVal dwNotifierType As Long, lpvNotifier As Long, lphRasConn As Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal 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 Any, ByRef lpbool As Long) As Long

'Retourne la liste des connexions disponnibles dans le dossier Connexions réseaux et Accès à distance
' Separator : Permet de définir le caractère de séparation des éléments
Public Function GetConnectionList(Optional ByVal Separator As String = ";") As String
Dim lpcb As Long, lpce As Long, I As Long
Dim ConName As String
Dim vRAS(255) As RASEntryName
vRAS(0).dwSize = LenB(vRAS(0))
lpcb = 256 * vRAS(0).dwSize
Call RasEnumEntries(vbNullString, vbNullString, vRAS(0), lpcb, lpce)
For I = 0 To lpce - 1
ConName = StrConv(vRAS(I).szEntryName(), vbUnicode)
If InStr(1, ConName, Chr(0)) > 0 Then ConName = Left(ConName, InStr(1, ConName, Chr(0)) - 1)
Debug.Print Trim(Len(ConName)) + " : " + ConName
GetConnectionList = GetConnectionList + ConName + Separator
Next I
End Function

'Appelle une connexion existante dans Connexion Réseau et accès distant.
'Retourne le handle de la connexion ou 0 si erreur
' ConName : Nom de la connexion
' UserName : Nom d'utilisateur
' Password : Mot de passe
' Domain : Nom du domaine (Optionel)
' Number : Numéro de tél ou ip (Optionel)
Public Function Dial(ByVal ConName As String, ByVal UserName As String, ByVal Password As String, Optional ByVal Domain As String "", Optional ByVal Number As String "") As Long
Dim lngRetCode As Long
Dim hRasConn As Long
Dim lngRetlstrcpy As Long
Dim lprasdialparams As RASDIALPARAMS
lprasdialparams.dwSize = LenB(lprasdialparams)
lstrcpy lprasdialparams.szEntryName(0), ConName
lstrcpy lprasdialparams.szUserName(0), UserName
lstrcpy lprasdialparams.szPassword(0), Password
lstrcpy lprasdialparams.szDomain(0), Domain
lstrcpy lprasdialparams.szPhoneNumber(0), Number
lstrcpy lprasdialparams.szCallbackNumber(0), ""
lngRetCode = RasDial(ByVal &H0, vbNullString, lprasdialparams, &H0, ByVal &H0, hRasConn)
If lngRetCode = 0 Then
AutoDial = hRasConn
Else
If Not hRasConn = 0 Then HangUp hRasConn
AutoDial = 0
End If
End Function

'Appelle une connexion existante dans Connexion Réseau et accès distant en utilisant les paramètres enregistrés.
'Retourne le handle de la connexion ou 0 si erreur
' ConName : Nom de la connexion
Public Function AutoDial(ByVal ConName As String) As Long
Dim lngRetCode As Long
Dim hRasConn As Long
Dim lngRetlstrcpy As Long
Dim lprasdialparams As RASDIALPARAMS
lprasdialparams.dwSize = LenB(lprasdialparams)
lstrcpy lprasdialparams.szEntryName(0), ConName
RasGetEntryDialParams vbNullString, lprasdialparams, 0
lngRetCode = RasDial(ByVal &H0, vbNullString, lprasdialparams, &H0, ByVal &H0, hRasConn)
If lngRetCode = 0 Then
AutoDial = hRasConn
Else
If Not hRasConn = 0 Then HangUp hRasConn
AutoDial = 0
End If
End Function

'Déconnecte une connexion
'Retourne True si réussi
' hRasConn : handle de la connexion à déconnecter
Public Function HangUp(ByVal hRasConn As Long) As Boolean
HangUp (RasHangUp(hRasConn) 0)
End Function

1 réponse

Messages postés
2676
Date d'inscription
vendredi 28 juin 2002
Statut
Membre
Dernière intervention
13 janvier 2016
21
salut,

j'ai un code qui peut te servir : il permet de lire les connexions réseaux et les mots de passes associés par l'api RASDIAL : http://www.vbfrance.com/codes/GESTION-MOTS-PASSE-INTERNET-EXPLORER-OUTLOOK-EXPRESS-MSN_33575.aspx

ShareVB