• Home
 · 
• Windows System Services
 · 
• To create and config the System Dsn Through the Program.

To create and config the System Dsn Through the Program.

To create and config the System Dsn Through the Program.

Rate To create and config the System Dsn Through the Program.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'as commandline argument



Attribute VB_Name = "modDsn"
Option Explicit
'---------------------------------------------------------------------------------
'Module     :   ModDsn
'WrittenBy  :   Amzad Ali Khan
'Written on :	June 1st 01
'---------------------------------------------------------------------------------
'Constants For fileSearch Function
Private Const INVALID_HANDLE_VALUE = -1
Private Const MAX_PATH = 260

'constants for SqlConfigDsn Function

Private Const ODBC_ADD_SYS_DSN = 4          ' Add data source
Private Const ODBC_CONFIG_DSN = 2           ' Configure (edit) data source
Private Const ODBC_REMOVE_SYS_DSN = 6       ' Remove data source
Private Const vbAPINull As Long = 0         ' NULL Pointer

'Type decleration for FileTime
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

'type decleration for win32data

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Integer, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
    (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

'main Function must be called by external Application
Sub Main()
'------------------------------------------------------------------------
Dim cmd As String
Dim filename As String
Dim dsnflag As String
Dim pos As String
Dim retval As Long
'------------------------------------------------------------------------
            cmd = Command() 'command line arguments (filename(without extention,type(add or remove))
            'MsgBox cmd
            'cmd = "c:\amz\work\ch17031ao ,add"
            
            If cmd = "" Then
                MsgBox "!!Sorry You Can't Config The Dsn Without Arguments " + vbCrLf + "First Arg : DataBase Name (fullpath without extension)" + vbCrLf + "Second Arg : Method (add or remove)" + vbCrLf + "Seperated by comma", vbOKOnly, "Config Dsn"
                Exit Sub
            End If
            
            pos = InStr(1, cmd, ",", vbTextCompare)
            filename = Trim(Mid(cmd, 1, pos - 1))
            
            If (filename = "") Then
                MsgBox "with out Filename How Can I create A Dsn !? "
                Exit Sub
            End If
            
            If Not FileExists(filename) Then
                MsgBox "File " & filename & "Not Found "
                Exit Sub
            End If
            
                                  
            dsnflag = UCase(Trim(Right(cmd, Len(cmd) - pos)))
            
            If (dsnflag = "") Then
                MsgBox "you Must Specify Weather To Remove Or Add A Dsn !"
                Exit Sub
            End If
            
            If dsnflag = "ADD" Then
                retval = dsnAdd(filename)
                
                If Not retval Then
                    MsgBox "Unable to Create Dsn"
                End If
            Else
                If (dsnflag = "REMOVE") Then
                    retval = dsnRemove(filename)
                    If Not retval Then
                        MsgBox "Unable to Remove Dsn probably there is no Dsn Exists"
                    End If
                End If
            End If
                                                  
End Sub

'-----------------------------------------------------------------------------------------------------
'function       :   fileExists
'purpose        :   checks the file is exists . this is to check weather mdb exists or not
'-----------------------------------------------------------------------------------------------------
Private Function FileExists(ByVal source As String) As Boolean
'this is  to test if a file exists
   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
            source = source + ".mdb"
            hFile = FindFirstFile(source, WFD)
            FileExists = hFile <> INVALID_HANDLE_VALUE
            Call FindClose(hFile)
End Function

Private Function initDrv(ByRef strattributes As String, ByRef strdriver As String, ByVal dbName As String)
Dim rootfile As String
        
      rootfile = dbName
      PathStripPath (rootfile)
      dbName = dbName + ".mdb"
      strdriver = "microsoft Access driver (*.mdb)"
      strattributes = strattributes & "DESCRIPTION= " & rootfile & Chr$(0)
      'MsgBox strAttributes
      strattributes = strattributes & "DSN=" & rootfile & Chr$(0)
      'MsgBox strAttributes
      strattributes = strattributes & "UID=" & Chr$(0)
      strattributes = strattributes & "PWD=" & Chr$(0)
      strattributes = strattributes & "DBQ=" & dbName & Chr$(0)
End Function

Private Function dsnAdd(ByVal filename As String) As Boolean
Dim intret As Long
Dim strdriver As String
Dim strattributes As String
Dim mdb As String
     
        'mdb = "c:\amz\sample"
    

        Call initDrv(strattributes, strdriver, filename)
        'To show dialog, use Form1.Hwnd instead of vbAPINull.
        intret = SQLConfigDataSource(vbAPINull, ODBC_ADD_SYS_DSN, _
        strdriver, strattributes)
        dsnAdd = intret
End Function
Private Function dsnRemove(ByVal filename As String) As Boolean
Dim intret As Long
Dim strdriver As String
Dim strattributes As String
Dim mdb As String
     
        'mdb = "c:\amz\sample"
    

        Call initDrv(strattributes, strdriver, filename)
        'To show dialog, use Form1.Hwnd instead of vbAPINull.
        intret = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_SYS_DSN, _
        strdriver, strattributes)
        dsnRemove = intret
End Function