by Scott Woods (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 17th June 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This enables the programmer to display the Universal Data Link (UDL) Property Dialog box to the user. This also enables the user to open ,
VBcoders
' 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
No comments have been posted about This enables the programmer to display the Universal Data Link (UDL) Property Dialog box to the use. Why not be the first to post a comment about This enables the programmer to display the Universal Data Link (UDL) Property Dialog box to the use.
