Menampilkan Properti Universal Data Link (UDL) Open, Edit, Save

 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
 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
 On Error GoTo GetUdlInitErr
 Dim objFSO          As Scripting.FileSystemObject
 Dim objFile         As Scripting.TextStream
 Dim strData         As String
 Set objFSO = New Scripting.FileSystemObject
 If Not objFSO.FileExists(GetUdlDir & GetUdlName & ".cfg") Then
     If objFSO.FileExists(UDLFilePath) Then
        Open UDLFilePath For Input As #1
             Input #1, strData
             Input #1, strData
             Input #1, strData
        Close 1
     Else
         Open GetUdlDir & GetUdlName & ".cfg" For Output As #1
         Print #1, strData
         Close 1
     End If
     Open GetUdlDir & GetUdlName & ".cfg" For Output As #1
     Print #1, strData
     Close 1
 Else
     Open GetUdlDir & GetUdlName & ".cfg" For Input As #2
         Input #2, strData
     Close 2
 End If
 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
 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
 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

 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