'in un file BAS
Private Const KEY_QUERY_VALUE = &H1 Private Const ERROR_SUCCESS = 0& Private Const REG_SZ = 1 Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Const REG_DWORD = 4 Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _ Alias "RegOpenKeyExA" (ByVal hKey As Long, _ ByVal lpSubKey As String, ByVal ulOptions As Long, _ ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" _ Alias "RegQueryValueExA" (ByVal hKey As Long, _ ByVal lpValueName As String, ByVal lpReserved As Long, _ lpType As Long, lpData As Any, lpcbData As Long) As Long 'Note that If you declare the lpData parameter as String, you must pass it By Value. Private Declare Function RegCreateKey Lib "advapi32.dll" _ Alias "RegCreateKeyA" (ByVal hKey As Long, _ ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegSetValueExString Lib _ "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, _ ByVal lpValueName As String, ByVal Reserved As Long, _ ByVal dwType As Long, ByVal lpValue As String, _ ByVal cbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As Long Private Declare Function RegSetValueExLong Lib "advapi32.dll" _ Alias "RegSetValueExA" (ByVal hKey As Long, _ ByVal lpValueName As String, ByVal Reserved As Long, _ ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long Public Function isSZKeyExist(szKeyPath As String, _ szKeyName As String, _ ByRef szKeyValue As String) As Boolean Dim bRes As Boolean Dim lRes As Long Dim hKey As Long lRes = RegOpenKeyEx(HKEY_LOCAL_MACHINE, _ szKeyPath, _ 0&, _ KEY_QUERY_VALUE, _ hKey) If lRes <> ERROR_SUCCESS Then isSZKeyExist = False Exit Function End If lRes = RegQueryValueEx(hKey, _ szKeyName, _ 0&, _ REG_SZ, _ ByVal szKeyValue, _ Len(szKeyValue)) RegCloseKey (hKey) If lRes <> ERROR_SUCCESS Then isSZKeyExist = False Exit Function End If isSZKeyExist = True End Function Public Function checkAccessDriver(ByRef szDriverName As String) As Boolean Dim szKeyPath As String Dim szKeyName As String Dim szKeyValue As String Dim bRes As Boolean bRes = False szKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\Microsoft Access Driver (*.mdb)" szKeyName = "Driver" szKeyValue = String(255, Chr(32)) If isSZKeyExist(szKeyPath, szKeyName, szKeyValue) Then szDriverName = szKeyValue bRes = True Else bRes = False End If checkAccessDriver = bRes End Function Public Function checkWantedAccessDSN(szWantedDSN As String) As Boolean Dim szKeyPath As String Dim szKeyName As String Dim szKeyValue As String Dim bRes As Boolean szKeyPath = "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources" szKeyName = szWantedDSN szKeyValue = String(255, Chr(32)) If isSZKeyExist(szKeyPath, szKeyName, szKeyValue) Then bRes = True Else bRes = False End If checkWantedAccessDSN = bRes End Function Public Function createAccessDSN(szDriverName As String, _ szWantedDSN As String) As Boolean Dim hKey As Long Dim szKeyPath As String Dim szKeyName As String Dim szKeyValue As String Dim lKeyValue As Long Dim lRes As Long Dim lSize As Long Dim szEmpty As String szEmpty = Chr(0) lSize = 4 lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _ "SOFTWARE\ODBC\ODBC.INI\" & _ szWantedDSN, _ hKey) If lRes <> ERROR_SUCCESS Then createAccessDSN = False Exit Function End If lRes = RegSetValueExString(hKey, "UID", 0&, REG_SZ, _ szEmpty, Len(szEmpty)) szKeyValue = App.Path & "\DB\ssmdb.mdb" lRes = RegSetValueExString(hKey, "DBQ", 0&, REG_SZ, _ szKeyValue, Len(szKeyValue)) szKeyValue = szDriverName lRes = RegSetValueExString(hKey, "Driver", 0&, REG_SZ, _ szKeyValue, Len(szKeyValue)) szKeyValue = "MS Access;" lRes = RegSetValueExString(hKey, "FIL", 0&, REG_SZ, _ szKeyValue, Len(szKeyValue)) lKeyValue = 25 lRes = RegSetValueExLong(hKey, "DriverId", 0&, REG_DWORD, _ lKeyValue, 4) lKeyValue = 0 lRes = RegSetValueExLong(hKey, "SafeTransactions", 0&, REG_DWORD, _ lKeyValue, 4) lRes = RegCloseKey(hKey) szKeyPath = "SOFTWARE\ODBC\ODBC.INI\" & szWantedDSN & "\Engines\Jet" lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _ szKeyPath, _ hKey) If lRes <> ERROR_SUCCESS Then createAccessDSN = False Exit Function End If lRes = RegSetValueExString(hKey, "ImplicitCommitSync", 0&, REG_SZ, _ szEmpty, Len(szEmpty)) szKeyValue = "Yes" lRes = RegSetValueExString(hKey, "UserCommitSync", 0&, REG_SZ, _ szKeyValue, Len(szKeyValue)) lKeyValue = 2048 lRes = RegSetValueExLong(hKey, "MaxBufferSize", 0&, REG_DWORD, _ lKeyValue, 4) lKeyValue = 5 lRes = RegSetValueExLong(hKey, "PageTimeout", 0&, REG_DWORD, _ lKeyValue, 4) lKeyValue = 3 lRes = RegSetValueExLong(hKey, "Threads", 0&, REG_DWORD, _ lKeyValue, 4) lRes = RegCloseKey(hKey) lRes = RegCreateKey(HKEY_LOCAL_MACHINE, _ "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", _ hKey) If lRes <> ERROR_SUCCESS Then createAccessDSN = False Exit Function End If szKeyValue = "Microsoft Access Driver (*.mdb)" lRes = RegSetValueExString(hKey, szWantedDSN, 0&, REG_SZ, _ szKeyValue, Len(szKeyValue)) lRes = RegCloseKey(hKey) createAccessDSN = True End Function 'anywhere in application Dim szDriverName As String Dim szWantedDSN As String szDriverName = String(255, Chr(32)) szWantedDSN = "MyAccess_ODBC" 'is access drivers installed? If Not checkAccessDriver(szDriverName) Then MsgBox "You must Install Access ODBC Drivers before use this program.", vbOK + vbCritical End If 'is our dsn exist? If Not (checkWantedAccessDSN(szWantedDSN)) Then If szDriverName = "" Then MsgBox "Can't find access ODBC driver.", vbOK + vbCritical Else If Not createAccessDSN(szDriverName, szWantedDSN) Then MsgBox "Can't create database ODBC.", vbOK + vbCritical End If End If End If <% Set objShell = CreateObject("WScript.Shell") Response.Write "Valore: " & objShell.RegRead (Percorso) %> 'dove percorso e` il percorso di ricerca del valore. 'Deve iniziare con uno dei seguenti valori: - HKCU - HKEY_CURRENT_USER - HKLM - HKEY_LOCAL_MACHINE - HKCR - HKEY_CLASSES_ROOT 'Per maggior informazioni su WSH, si veda 'http://www.aspitalia.com/articoli/wsh/introduzione.aspi |