prelevato da http://free.imd.it/giazack/sorgenti/Maggio%201998/T18.htm
Permette di richiamare la finestra per la connessione ad Internet Const REG_NONE = 0& Public Const REG_SZ = 1& Const REG_EXPAND_SZ = 2& Const REG_BINARY = 3& Public Const REG_DWORD = 4& Const REG_DWORD_LITTLE_ENDIAN = 4& Const REG_DWORD_BIG_ENDIAN = 5& Const REG_LINK = 6& Const REG_MULTI_SZ = 7& Const REG_RESOURCE_LIST = 8& Const REG_FULL_RESOURCE_DESCRIPTOR = 9& Const REG_RESOURCE_REQUIREMENTS_LIST = 10& Public rgeEntry$ Public rgeDataType& Public rgeValue$ Public rgeMainKey& Public rgeSubKey$ Const KEY_QUERY_VALUE = &H1& Const KEY_SET_VALUE = &H2& Const KEY_CREATE_SUB_KEY = &H4& Const KEY_ENUMERATE_SUB_KEYS = &H8& Const KEY_NOTIFY = &H10& Const KEY_CREATE_LINK = &H20& Const READ_CONTROL = &H20000 Const WRITE_DAC = &H40000 Const WRITE_OWNER = &H80000 Const SYNCHRONIZE = &H100000 Const STANDARD_RIGHTS_REQUIRED = &HF0000 Const STANDARD_RIGHTS_READ = READ_CONTROL Const STANDARD_RIGHTS_WRITE = READ_CONTROL Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Const KEY_EXECUTE = KEY_READ Type FILETIME lLowDateTime As Long lHighDateTime As Long End Type Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_USERS = &H80000003 Public Const HKEY_PERFORMANCE_DATA = &H80000004 Public Const HKEY_CURRENT_CONFIG = &H80000005 Public Const HKEY_DYN_DATA = &H80000006 DICHIARAZIONE FUNZIONI API ' Vengono incluse solo le funzioni richieste per lo scopo proposto e quelle simili. Declare Function RegOpenKeyEx& Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey&, ByVal lpszSubKey$, _ dwOptions&, ByVal samDesired&, lpHKey&) Declare Function RegCloseKey& Lib "advapi32.dll" (ByVal hKey&) Declare Function RegQueryValueEx& Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpszValueName$, _ ByVal lpdwRes&, lpdwType&, ByVal lpDataBuff$, nSize&) Declare Function RegEnumKeyEx& Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey&, ByVal dwIndex&, _ ByVal lpname$, lpcbName&, ByVal lpReserved&, ByVal lpClass$, lpcbClass&, lpftLastWriteTime As FILETIME) Declare Function RegQueryInfoKey& Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey&, ByVal lpClass$, _ lpcbClass&, ByVal lpReserved&, lpcSubKeys&, lpcbMaxSubKeyLen&, lpcbMaxClassLen&, lpcValues&, _ lpcbMaxValueNameLen&, lpcbMaxValueLen&, lpcbSecurityDescriptor&, lpftLastWriteTime As FILETIME) CODICE FUNZIONI PUBBLICHE Public Function GetRegValue(keyroot As Variant, subkey As Variant, valname As String) Const KEY_ALL_ACCESS As Long = &HF00e' Const ERROR_SUCCESS As Long = 0 Const REG_SZ As Long = 1 Dim hsubkey As Long, dwType As Long, sz As Long Dim R As Long R = RegOpenKeyEx(keyroot, subkey, 0, KEY_ALL_ACCESS, hsubkey) sz = 256 v$ = String$(sz, 0) R = RegQueryValueEx(hsubkey, valname, 0, dwType, ByVal v$, sz) If R = ERROR_SUCCESS And dwType = REG_SZ Then retval = Left$(v$, sz) GetRegValue = retval Else retval = "--Not String--" End If R = RegCloseKey(hsubkey) End Function Public Sub rgeClear() rgeMainKey = 0 rgeSubKey = "" rgeValue = "" rgeDataType = 0 rgeEntry = "" End Sub Function RegEnumKeys&(bFullEnumeration As Boolean) Dim sRoot$, sRoot2$ Dim lRtn& Dim hKey& Dim strucLastWriteTime As FILETIME Dim sSubKeyName$ Dim sClassString$ Dim lLenSubKey& Dim lLenClass& Dim lKeyIndx& Dim lRet& Dim hKey2& Dim sSubKey2$ Dim sNewKey$ Dim sClassName$ Dim lClassLen& Dim lSubKeys& Dim lMaxSubKey& Dim sMaxSubKey$ Dim lMaxClass& Dim sMaxClass$ Dim lValues& Dim lMaxValueName& Dim lMaxValueData& Dim lSecurityDesc& lRtn = RegOpenKeyEx(rgeMainKey, rgeSubKey, 0&, KEY_READ, hKey) sClassName = Space$(255) lClassLen = CLng(Len(sClassName)) lRet = RegQueryInfoKey(hKey, sClassName, lClassLen, 0&, lSubKeys, lMaxSubKey, lMaxClass, lValues, lMaxValueName, lMaxValueData, lSecurityDesc, strucLastWriteTime) sMaxSubKey = Space$(lMaxSubKey + 1) sMaxClass = Space$(lMaxClass + 1) lKeyIndx = 0& Do While lRtn = ERROR_SUCCESS ReTryKeyEnumeration: sSubKeyName = sMaxSubKey lLenSubKey = lMaxSubKey sClassString = sMaxClass lLenClass = lMaxClass lRtn = RegEnumKeyEx(hKey, lKeyIndx, sSubKeyName, lLenSubKey, 0&, sClassString, lLenClass, strucLastWriteTime) If InStr(sSubKeyName, Chr$(0)) > 1 Then sSubKeyName = Left$(sSubKeyName, InStr(sSubKeyName, Chr$(0)) - 1) End If If lRtn = ERROR_SUCCESS Then Form1.List1.AddItem sSubKeyName lNewKey = lNewKey + 1 sNewKey = "A" & Format$(lNewKey, "000000") If bFullEnumeration = True Then sSubKey2 = sSubKeyName If rgeSubKey <> "" Then sSubKey2 = Trim(rgeSubKey) & "\" & sSubKeyName End If lRet = RegOpenKeyEx(rgeMainKey, sSubKey2, 0&, KEY_READ, hKey2) Else Exit Do End If lKeyIndx = lKeyIndx + 1 ElseIf lRtn = ERROR_MORE_DATA Then lMaxSubKey = lMaxSubKey + 5 lMaxClass = lMaxClass + 5 sMaxSubKey = Space$(lMaxSubKey + 1) sMaxClass = Space$(lMaxClass + 1) GoTo ReTryKeyEnumeration ElseIf lRtn = ERROR_NO_MORE_ITEMS Then lRtn = ERROR_SUCCESS Exit Do Exit Do End If Loop RegEnumKeys = lRtn lRtn = RegCloseKey(hKey) End Function CODICE DA INSERIRE NEL FORM Creare un Form con: 1. Quattro controlli Command-Button chiamati "Command1", "Command2" .... Impostare le seguenti properties Command1: Caption = "Fill" Command2: Caption = "Fill" Command3: Caption = "Show Dialog" Command4: Caption = "&Close": Cancel = True 2. Un controllo ListBox chiamato "List1" 3. Un controllo TextBox chiamato "Text1" Incollare nell' area Dichiarazioni Generali del form il seguente codice: Private Sub Command1_Click() Text1.Text = GetRegValue(HKEY_CURRENT_USER, "RemoteAccess", "Default") End Sub Private Sub Command2_Click() rgeMainKey = HKEY_CURRENT_USER rgeSubKey$ = "RemoteAccess\Profile" RegEnumKeys True End Sub Private Sub Command3_Click() Shell "rundll32.exe rnaui.dll,RnaDial " + Text1.Text End Sub Private Sub Command4_Click() Unload Me End Sub Private Sub List1_DblClick() Shell "rundll32.exe rnaui.dll,RnaDial " + List1.List(List1.ListIndex) End Sub Tutti i nomi delle dichiarazioni sono estratti dal registro. Fare un doppio click per lanciare la connessione. Se e' impostata in automatico non viene visualizzata la finestra, ma viene lanciata immediatamente. |