Option Explicit Private Const REG_SZ = 1 'Constant for a string variable type. Private Const REG_BINARY = 3 'Constant for Binary Private Const REG_DWORD = 4 '32-bit numberPrivate Const HKEY_LOCAL_MACHINE = &H80000002'Creates a Key In Registry Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long 'API FOR STRING Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long 'API FOR DWORD Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long 'API FOR BINARY Private Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long 'API for closing the Registry Key Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongPrivate Sub cmdDSN_Click() Dim DataSourceName As String Dim DatabaseName As String Dim Description As String Dim DriverPath As String Dim DriverName As String Dim LastUser As String Dim Regional As String Dim Server As String Dim lResult As Long Dim hKeyHandle As Long
Dim Engines As String Dim Jet As String
Dim DBQPath As String Dim Driver As String Dim DriverId As Long Dim FIL As String Dim SafeTransaction As Long Dim UID As String
Dim ImplicitCommitSync As String Dim MaxBufferSize As Long Dim PageTimeOut As Long Dim Threads As Long Dim UserCommitSync As String Dim Password As String
Private Const REG_SZ = 1 'Constant for a string variable type.
Private Const REG_BINARY = 3 'Constant for Binary
Private Const REG_DWORD = 4 '32-bit numberPrivate Const HKEY_LOCAL_MACHINE = &H80000002'Creates a Key In Registry
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
'API FOR STRING
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
'API FOR DWORD
Private Declare Function RegSetValueExA Lib "advapi32.dll" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Long, ByVal cbData As Long) As Long
'API FOR BINARY
Private Declare Function RegSetValueExB Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByRef lpData As Byte, ByVal cbData As Long) As Long
'API for closing the Registry Key
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongPrivate Sub cmdDSN_Click() Dim DataSourceName As String
Dim DatabaseName As String
Dim Description As String
Dim DriverPath As String
Dim DriverName As String
Dim LastUser As String
Dim Regional As String
Dim Server As String Dim lResult As Long
Dim hKeyHandle As Long
Dim Engines As String
Dim Jet As String
Dim DBQPath As String
Dim Driver As String
Dim DriverId As Long
Dim FIL As String
Dim SafeTransaction As Long
Dim UID As String
Dim ImplicitCommitSync As String
Dim MaxBufferSize As Long
Dim PageTimeOut As Long
Dim Threads As Long
Dim UserCommitSync As String
Dim Password As String
DataSourceName = Text1.Text
Engines = "Engines"
Jet = "Jet"
DBQPath = Text2.Text
Driver = "C:\WinNT\system32\odbcjt32.dll"
UID = Text3.Text
FIL = "MS Access;"
DriverId = &H19
SafeTransaction = &H0
ImplicitCommitSync = ""
MaxBufferSize = &H800
PageTimeOut = &H5
Threads = &H3
UserCommitSync = ""
Password = Text4.Text 'Specify the DSN parameters.
On Error GoTo ErrorHandler
'If You are using Windows NT use the folllowing Drivers
Driver = "C:\WinNT\system32\odbcjt32.dll"
'If You are using Windows 95,98 uncomment the following line and comment the above line
'Driver = "C:\Windows\system\odbcjt32.dll"
'Create the new DSN key.
lResult = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & _
DataSourceName, hKeyHandle) 'DBQ
lResult = RegSetValueEx(hKeyHandle, "DBQ", 0&, REG_SZ, _
ByVal DBQPath, Len(DBQPath))
'Driver
lResult = RegSetValueEx(hKeyHandle, "Driver", 0&, REG_SZ, _
ByVal Driver, Len(Driver))
lResult = RegSetValueExA(hKeyHandle, "DriverId", 0, REG_DWORD, DriverId, 4) 'write the value
'FIL
lResult = RegSetValueEx(hKeyHandle, "FIL", 0&, REG_SZ, _
ByVal FIL, Len(FIL))
lResult = RegSetValueExA(hKeyHandle, "SafeTransaction", 0, REG_DWORD, SafeTransaction, 4) 'write the value
'Password
lResult = RegSetValueEx(hKeyHandle, "PWD", 0&, REG_SZ, _
ByVal Password, Len(Password))
'UID
lResult = RegSetValueEx(hKeyHandle, "UID", 0&, REG_SZ, _
ByVal UID, Len(UID))
lResult = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & DataSourceName & "\" & _
Engines, hKeyHandle) lResult = RegCreateKey(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & DataSourceName & "\" & Engines & "\" & _
Jet, hKeyHandle)
'ImplicitCommitsync
lResult = RegSetValueEx(hKeyHandle, "ImplicitCommitSync", 0&, REG_SZ, _
ByVal ImplicitCommitSync, Len(ImplicitCommitSync))
'MaxBufferSize
lResult = RegSetValueExA(hKeyHandle, "MaxBufferSize", 0, REG_DWORD, MaxBufferSize, 4) 'write the value
'PageTimeOut
lResult = RegSetValueExA(hKeyHandle, "PageTimeOut", 0, REG_DWORD, PageTimeOut, 4) 'write the value
'Threads
lResult = RegSetValueExA(hKeyHandle, "Threads", 0, REG_DWORD, Threads, 4) 'write the value
'UserCommitSync
lResult = RegSetValueEx(hKeyHandle, "UserCommitSync", 0&, REG_SZ, _
ByVal UserCommitSync, Len(UserCommitSync)) 'Close the new DSN key.
lResult = RegCloseKey(hKeyHandle) 'Open ODBC Data Sources key to list the new DSN in the ODBC Manager.
'Specify the new value.
'Close the key. lResult = RegCreateKey(HKEY_LOCAL_MACHINE, _
"SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", hKeyHandle)
lResult = RegSetValueEx(hKeyHandle, DataSourceName, 0&, REG_SZ, _
ByVal DriverName, Len(DriverName))
lResult = RegCloseKey(hKeyHandle)
MsgBox "DSN Creation Successfull !", vbExclamation
Exit Sub
ErrorHandler:
MsgBox "Error In Creating DSN"
Exit Sub
End Sub