• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• This enables the programmer to display the Universal Data Link (UDL) Property Dialog box to the use

This enables the programmer to display the Universal Data Link (UDL) Property Dialog box to the use

This enables the programmer to display the Universal Data Link (UDL) Property Dialog box to the user. This also enables the user to open ,

Rate This enables the programmer to display the Universal Data Link (UDL) Property Dialog box to the use

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

 ' clsEditUdl Class -
 ' (Using the Data Links Property dialog box)
 '
 ' The purpose of this class is to configure custom UDL
 ' information. The class has a number of properties
 ' that return information about the udl connection
 ' string. If the property in this class is not
 ' avaliable, There is an addtional method that
 ' can obtain the property for you. (.Properties)
 '
 ' The class allows you to Open, Edit and Save the
 ' Connection information from within the udl.
 ' Note - When saving the udl information, the
 ' class writes a Connection String cfg file.
 ' (The ConnectionString name is the udl name & ".cfg"
 ' This file holds the new configuration information.
 ' If this file .cfg is deleted, then the saved
 ' information will be lost. The class will then
 ' look for the original UDL file for the information.
 '
 ' To obtain the properties, you must first Set the
 ' UDLFilePath and then use GetInitUdl. These steps
 ' will populate the properties for you.
 '
 ' References Needed
 ' Uses MSDASC.DataLinks             - OLE DB Service Component 1.0 Type Lib
 ' Uses ADODB                        - Microsoft ActiveX Data Objects 2.0 or 
 ' Higher.
 ' Uses Scripting.FileSystemObject   - Mircosoft Scripting Runtime

 ' Written by Scott Woods
 ' 18/5/2000 @ 10:15am  Version 1.0
 

 Private mstrProvider            As String
 Private mstrIntegratedSecurity  As String
 Private mstrUserId              As String
 Private mstrInitialCatalog      As String
 Private mstrDataSource          As String
 Private mstrPersistSecurityInfo As String
 Private mstrMode                As String
 Private mstrConnectTimeout      As String
 Private mstrInitialFileName     As String
 Private mstrUdlFilePath         As String
 Private mstrExtendedProperties  As String
 Private mstrCurrentLanguage     As String
 Private mstrNetworkAddress      As String
 Private mstrNetworkLibrary      As String
 Private mstrApplicationName     As String
 Private mstrInitString          As String
 Private mstrNewConnectionString As String

 ' This handles the Property Types
 Public Enum enumUDLInfo
     udlProvider = 1
     udlIntegratedSecurity = 2
     udlUserId = 3
     udlInitialCatalog = 4
     udlDataSource = 5
     udlPersistSecurityInfo = 6
     udlMode = 7
     udlConnectTimeout = 8
     udlInitialFilename = 9
     udlUDLFilePath = 10
     udlExtendedProperties = 11
     udlCurrentLanguage = 12
     udlNetworkAddress = 13
     udlNetworkLibrary = 14
     udlApplicationName = 15
 End Enum

 Public Function GetUdlInit() As Boolean
 ' ================================================
 ' This code handles the ConnectionString cfg file.
 ' If the file is missing, then the method will
 ' look for the Default UDL which was specified in
 ' the UDLFilePath Property. If the UDLFilePath
 ' Property is not set then a blank udl will
 ' be displayed.
 ' =================================================
 On Error GoTo GetUdlInitErr

 Dim objFSO          As Scripting.FileSystemObject
 Dim objFile         As Scripting.TextStream
 Dim strData         As String

 Set objFSO = New Scripting.FileSystemObject
 ' Look for the ConnectionString.cfg file
 If Not objFSO.FileExists(GetUdlDir & GetUdlName & ".cfg") Then
     ' If the ConnectionString.cfg file is missing then
     ' Look for the Default UDL
     If objFSO.FileExists(UDLFilePath) Then
        Open UDLFilePath For Input As #1
             Input #1, strData
             Input #1, strData
             Input #1, strData
        Close 1
     Else
         ' Write the new Config File
         Open GetUdlDir & GetUdlName & ".cfg" For Output As #1
         Print #1, strData
         Close 1
     End If
     ' Write the new Config File
     Open GetUdlDir & GetUdlName & ".cfg" For Output As #1
     Print #1, strData
     Close 1
 Else
     ' Read the Config File
     Open GetUdlDir & GetUdlName & ".cfg" For Input As #2
         Input #2, strData
     Close 2
 End If

 ' Populate the Properties With the connection string info
 mstrProvider = StripInfo(strData, udlProvider)
 mstrPersistSecurityInfo = StripInfo(strData, udlPersistSecurityInfo)
 mstrDataSource = StripInfo(strData, udlDataSource)
 mstrIntegratedSecurity = StripInfo(strData, udlIntegratedSecurity)
 mstrUserId = StripInfo(strData, udlUserId)
 mstrInitialCatalog = StripInfo(strData, udlInitialCatalog)
 mstrMode = StripInfo(strData, udlMode)
 mstrConnectTimeout = StripInfo(strData, udlConnectTimeout)
 mstrInitialFileName = StripInfo(strData, udlInitialFilename)
 mstrExtendedProperties = StripInfo(strData, udlExtendedProperties)
 mstrCurrentLanguage = StripInfo(strData, udlCurrentLanguage)
 mstrNetworkAddress = StripInfo(strData, udlNetworkAddress)
 mstrNetworkLibrary = StripInfo(strData, udlNetworkLibrary)
 mstrApplicationName = StripInfo(strData, udlApplicationName)
 mstrInitString = strData

 GetUdlInit = True

GetUdlInitExit:
     If Not objFSO Is Nothing Then Set objFSO = Nothing
     If Not objFile Is Nothing Then Set objFile = Nothing
     Close
     Exit Function

GetUdlInitErr:
     GetUdlInit = False
     Resume GetUdlInitExit
 End Function

 Private Function StripInfo(ByVal str_Data As String, _
                            ByVal enum_UdlInfo As enumUDLInfo) As String

 ' Private function that strips info from a PropertyValue

 On Error GoTo StripInfoErr
 

 Dim lngFind     As Long

 Select Case enum_UdlInfo

     Case udlProvider
     If PropertyValue(str_Data, "Provider=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, "Provider="))
     End If

     Case udlPersistSecurityInfo
     If PropertyValue(str_Data, "Persist Security Info=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "Persist Security Info="))
     End If

     Case udlUserId
     If PropertyValue(str_Data, "User ID=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "User ID="))
     End If

     Case udlDataSource
     If PropertyValue(str_Data, "Data Source=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, "Data Source="))
     End If

     Case udlMode
     If PropertyValue(str_Data, "Mode=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, "Mode="))
     End If

     Case udlConnectTimeout
     If PropertyValue(str_Data, "Connect Timeout=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "Connect Timeout="))
     End If

     Case udlInitialCatalog
     If PropertyValue(str_Data, "Initial Catalog=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "Initial Catalog="))
     End If

     Case udlIntegratedSecurity
     If PropertyValue(str_Data, "Integrated Security=") < 0 Then
        StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "Integrated Security="))
     End If

     Case udlInitialFilename
     If PropertyValue(str_Data, "Initial File Name=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "Initial File Name="))
     End If

     Case udlExtendedProperties
     If PropertyValue(str_Data, "Extended Properties=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "Extended Properties="))
     End If

     Case udlCurrentLanguage
     If PropertyValue(str_Data, "Current Language=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "Current Language="))
     End If

     Case udlNetworkAddress
     If PropertyValue(str_Data, "Network Address=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "Network Address="))
     End If

     Case udlNetworkLibrary
     If PropertyValue(str_Data, "Network Library=") < 0 Then
        StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "Network Library="))
     End If

     Case udlApplicationName
      If PropertyValue(str_Data, "Application Name=") < 0 Then
         StripInfo = SplitString(str_Data, _
                     PropertyValue(str_Data, _
                     "Application Name="))
      End If
 End Select

StripInfoExit:
     Exit Function

StripInfoErr:
     Resume StripInfoExit
 End Function
 Private Function PropertyValue(ByVal str_String As String, _
                                ByVal str_PropertyValue As String) As Long

 PropertyValue = InStr(1, str_String, str_PropertyValue, vbTextCompare)
 If PropertyValue < 0 Then
     PropertyValue = PropertyValue + Len(str_PropertyValue)
 End If

 End Function
 Private Function SplitString(ByVal str_Text As String, _
                              ByVal lng_StartAt As Long) As String

 On Error GoTo SplitStringErr

 Dim lngLoop As Long
 Dim strTemp As String

 For lngLoop = lng_StartAt To Len(str_Text)
             strTemp = Mid(str_Text, lngLoop, 1)
             If strTemp < ";" Then
                 If strTemp < "" Then
                     SplitString = SplitString & strTemp
                 Else
                     Exit For
                 End If
             Else
                 Exit For
             End If
 Next lngLoop

SplitStringExit:
     Exit Function

SplitStringErr:
     Resume SplitStringExit
 End Function

 Public Function OpenUdl(ByRef ctl_FormName As Form) As Boolean

 On Error GoTo OpenUdlErr

 Dim objOpenUdl  As MSDASC.DataLinks
 Dim cnnOpenUdl  As ADODB.Connection

 Set objOpenUdl = New MSDASC.DataLinks
 Set cnnOpenUdl = New ADODB.Connection

 ' Get the Init String
 If GetUdlInit Then
     cnnOpenUdl.ConnectionString = mstrInitString
     objOpenUdl.hWnd = ctl_FormName.hWnd
     objOpenUdl.PromptEdit cnnOpenUdl
     mstrInitString = cnnOpenUdl.ConnectionString
     SaveUdl mstrInitString
     GetUdlInit
     OpenUdl = True
 End If
OpenUdlExit:
     If Not objOpenUdl Is Nothing Then Set objOpenUdl = Nothing
     If Not objcnnopenudl Is Nothing Then Set cnnOpenUdl = Nothing
     Exit Function

OpenUdlErr:
     OpenUdl = False
     Resume OpenUdlExit
 End Function
 Public Function SaveUdl(ByVal str_ConnectionString As String) As Boolean

 On Error GoTo SaveUdlErr

 Dim objFSO  As Scripting.FileSystemObject
 Dim objFile As Scripting.TextStream

 Set objFSO = New Scripting.FileSystemObject
 Set objFile = objFSO.CreateTextFile(GetUdlDir & GetUdlName & ".cfg", True)
     objFile.WriteLine str_ConnectionString
     objFile.Close

     SaveUdl = True

SaveUdlExit:
     If Not objFile Is Nothing Then Set objFile = Nothing
     If Not objfsl Is Nothing Then Set objFSO = Nothing
   
     Exit Function

SaveUdlErr:
     SaveUdl = False
     Resume SaveUdlExit
 End Function
 Public Function UdlExists() As Boolean

 On Error GoTo UdlExistsErr

 Dim objFSO  As Scripting.FileSystemObject

 Set objFSO = New FileSystemObject
 If UDLFilePath < "" Then
     UdlExists = objFSO.FileExists(UDLFilePath)
 Else
     UdlExists = False
 End If

UdlExistsExit:
     If Not objFSO Is Nothing Then Set objFSO = Nothing
     Exit Function

UdlExistsErr:
     UdlExists = False
     Resume UdlExistsExit
 End Function
 Public Function Properties(ByVal str_PropertyName As String, _
                            ByVal str_InitString As String) As String
 On Error GoTo PropertiesErr

 If PropertyValue(str_InitString, str_PropertyName & "=") < 0 Then
         Properties = SplitString(str_InitString, _
                     PropertyValue(str_InitString, str_PropertyName & "="))
 End If

PropertiesExit:
     Exit Function

PropertiesErr:
     Resume PropertiesExit
 End Function
 Public Function CreateUdl(ctl_Form As Form) As String

 On Error GoTo CreateUdlErr
 

 Dim objCreateUdl    As MSDASC.DataLinks
 Dim cnnCreateUdl    As ADODB.Connection

 Set objCreateUdl = New MSDASC.DataLinks
 Set cnnCreateUdl = New ADODB.Connection

 objCreateUdl.hWnd = ctl_Form.hWnd
 cnnCreateUdl.Open (objCreateUdl.PromptNew)
 CreateUdl = cnnCreateUdl.ConnectionString
 InitString = cnnCreateUdl.ConnectionString
 cnnCreateUdl.Close

CreateUdlExit:
     If Not objCreateUdl Is Nothing Then Set objCreateUdl = Nothing
     If Not cnnCreateUdl Is Nothing Then Set cnnCreateUdl = Nothing
     Exit Function

CreateUdlErr:
     Resume CreateUdlExit
 End Function
 Public Function GetUdlName() As String

 On Error GoTo GetUdlNameErr
 
 ' This function returns the UDL name only.
 ' Note that this will truncate the .udl of the end

 Dim intloop As Integer

 For intloop = Len(UDLFilePath) To 1 Step -1
 If Mid(UDLFilePath, intloop, 1) = "\" Then
     GetUdlName = Mid(UDLFilePath, intloop + 1)
     GetUdlName = Left(GetUdlName, (Len(GetUdlName) - 4))
     Exit For
 End If
 Next intloop

GetUdlNameExit:
     Exit Function

GetUdlNameErr:
     Resume GetUdlNameExit
 End Function
 Public Function GetUdlDir() As String

 On Error GoTo GetUdlDirErr
 
 Dim intloop As Integer

 For intloop = Len(UDLFilePath) To 1 Step -1
 If Mid(UDLFilePath, intloop, 1) = "\" Then
     GetUdlDir = Mid(UDLFilePath, 1, (intloop))
     Exit For
 End If
 Next intloop


GetUdlDirExit:
      Exit Function

GetUdlDirErr:
     Resume GetUdlDirExit
 End Function


 Public Property Get Provider() As String
 Provider = mstrProvider
 End Property
 Public Property Let Provider(ByVal str_Provider As String)
 mstrProvider = str_Provider
 End Property
 Public Property Get IntegratedSecurity() As String
 IntegratedSecurity = mstrIntegratedSecurity
 End Property
 Public Property Let IntegratedSecurity(ByVal str_IntegratedSecurity As String)
 mstrIntegratedSecurity = str_IntegratedSecurity
 End Property
 Public Property Get PersistSecurityInfo() As String
 PersistSecurityInfo = mstrPersistSecurityInfo
 End Property
 Public Property Let PersistSecurityInfo(ByVal str_PersistSecurityInfo As String)
 mstrPersistSecurityInfo = str_PersistSecurityInfo
 End Property
 Public Property Get UserId() As String
 UserId = mstrUserId
 End Property
 Public Property Let UserId(ByVal str_UserId As String)
 mstrUserId = str_UserId
 End Property
 Public Property Get InitialCatalog() As String
 InitialCatalog = mstrInitialCatalog
 End Property
 Public Property Let InitialCatalog(ByVal str_InitialCatalog As String)
 mstrInitialCatalog = str_InitialCatalog
 End Property
 Public Property Get DataSource() As String
 DataSource = mstrDataSource
 End Property
 Public Property Let DataSource(ByVal str_DataSource As String)
 mstrDataSource = str_DataSource
 End Property
 Public Property Get InitialFileName() As String
 InitialFileName = mstrInitialFileName
 End Property
 Public Property Let InitialFileName(ByVal str_InitialFileName As String)
 mstrInitialFileName = str_InitialFileName
 End Property
 Public Property Get Mode() As String
 Mode = mstrMode
 End Property
 Public Property Let Mode(ByVal str_Mode As String)
 mstrMode = str_Mode
 End Property
 Public Property Get ConnectTimeout() As String
 ConnectTimeout = mstrConnectTimeout
 End Property
 Public Property Let ConnectTimeout(str_ConnectTimeout As String)
 mstrConnectTimeout = str_ConnectTimeout
 End Property
 Public Property Get UDLFilePath() As String
 UDLFilePath = mstrUdlFilePath
 End Property
 Public Property Let UDLFilePath(ByVal str_UDLFilePath As String)
 mstrUdlFilePath = str_UDLFilePath
 End Property
 Public Property Get ExtendedProperties() As String
 ExtendedProperties = mstrExtendedProperties
 End Property
 Public Property Let ExtendedProperties(ByVal str_ExtendedProperties As String)
 mstrExtendedProperties = str_ExtendedProperties
 End Property
 Public Property Get CurrentLanguage() As String
 CurrentLanguage = mstrCurrentLanguage
 End Property
 Public Property Let CurrentLanguage(ByVal str_CurrentLanguage As String)
 mstrCurrentLanguage = str_CurrentLanguage
 End Property
 Public Property Get NetWorkAddress() As String
 NetWorkAddress = mstrNetworkAddress
 End Property
 Public Property Let NetWorkAddress(ByVal str_NetWorkAddress As String)
 mstrNetworkAddress = str_NetWorkAddress
 End Property
 Public Property Get NetworkLibrary() As String
  NetworkLibrary = mstrNetworkLibrary
 End Property
 Public Property Let NetworkLibrary(ByVal str_NetworkLibrary As String)
 mstrNetworkLibrary = str_NetworkLibrary
 End Property
 Public Property Get ApplicationName() As String
 ApplicationName = mstrApplicationName
 End Property
 Public Property Let ApplicationName(ByVal str_ApplicationName As String)
 mstrApplicationName = ApplicationName
 End Property
 Public Property Get InitString() As String
 InitString = mstrInitString
 End Property
 Public Property Let InitString(ByVal str_InitString As String)
 mstrInitString = str_InitString
 End Property