Universal Data link files are handy for select data sources but there isn’t a way to create/edit this files. This little class shows how to read/write a UDL file.
'-----------------------' The cUDL Class'-----------------------'please visit www.shoutsoft.com for Tools building VB database application.Private Const CON_UDL_LINE1 = "[oledb]"Private Const CON_UDL_LINE2 = "; Everything after this line is an OLE DB " _ & "initstring"Private mvarADOConnectString As StringPublic Property Let ADOConnectString(ByVal vData As String) mvarADOConnectString = vDataEnd PropertyPublic Property Get ADOConnectString() As String ADOConnectString = mvarADOConnectStringEnd PropertyPublic Function CreateUDL() As Boolean On Error GoTo Err_CreateUDL Dim pDataLink As New DataLinks, pConn As Connection Set pConn = pDataLink.PromptNew pConn.Open mvarADOConnectString = pConn.ConnectionString pConn.Close CreateUDL = True Exit FunctionErr_CreateUDL: CreateUDL = FalseEnd FunctionPublic Function OpenUDL(Optional ByVal strConnectString As String) As Boolean On Error GoTo Err_OpenUDL Dim pDataLink As New DataLinks, pConn As New Connection If mvarADOConnectString = vbNullString Then OpenUDL = CreateUDL Exit Function Else pConn.ConnectionString = mvarADOConnectString If pDataLink.PromptEdit(pConn) Then pConn.Open mvarADOConnectString = pConn.ConnectionString pConn.Close End If End If OpenUDL = True Exit FunctionErr_OpenUDL: OpenUDL = FalseEnd FunctionPublic Sub SaveToFile(ByVal strUDLFile As String) Dim strBuf As String, intFileNum As Integer strBuf = CON_UDL_LINE1 & vbCrLf & CON_UDL_LINE2 & vbCrLf & _ mvarADOConnectString strBuf = StrConv(strBuf, vbUnicode) intFileNum = FreeFile If Dir(strUDLFile) <> vbNullString Then Kill strUDLFile Open strUDLFile For Binary As #intFileNum Put #intFileNum, , strBuf Close #intFileNumEnd SubPublic Function LoadFromFile(ByVal strUDLFile As String) As Boolean Dim intFileNum As Integer, strBuf As String, i As Integer intFileNum = FreeFile Open strUDLFile For Binary As #intFileNum strBuf = Input(LOF(intFileNum), #intFileNum) Close #intFileNum strBuf = StrConv(strBuf, vbFromUnicode) i = InStr(strBuf, "Provider=") If i > 0 Then mvarADOConnectString = Mid(strBuf, i) LoadFromFile = True Else LoadFromFile = False End IfEnd Function
To test the cUDL class, create a form and add three buttons on it (named cmdLoad, cmdSave, and cmdCreate) and a CommonDialog control (named dlgCommonDialog), then add this code:
Private Sub cmdLoad_Click() Dim m_udl As New cUDL, m_FileName As String With dlgCommonDialog .DialogTitle = "Open" .CancelError = False .Flags = cdlOFNHideReadOnly .FileName = vbNullString 'ToDo: set the flags and attributes of the common dialog control .Filter = "Microsoft data link files (*.udl)|*.udl" .ShowOpen m_FileName = .FileName If m_FileName = vbNullString Then Exit Sub End With With m_udl .LoadFromFile m_FileName .OpenUDL End WithEnd SubPrivate Sub cmdNew_Click() Dim m_udl As New cUDL, m_FileName As String With dlgCommonDialog .DialogTitle = "Save" .CancelError = False .Flags = cdlOFNOverwritePrompt 'ToDo: set the flags and attributes of the common dialog control .Filter = "Microsoft data link files (*.udl)|*.udl" .FileName = vbNullString .ShowSave m_FileName = .FileName If m_FileName = vbNullString Then Exit Sub End With With m_udl If .CreateUDL Then .SaveToFile m_FileName End WithEnd SubPrivate Sub cmdSave_Click() Dim m_udl As New cUDL, m_FileName As String With dlgCommonDialog .DialogTitle = "Save" .CancelError = False .Flags = cdlOFNOverwritePrompt 'ToDo: set the flags and attributes of the common dialog control .Filter = "Microsoft data link files (*.udl)|*.udl" .FileName = vbNullString .ShowSave m_FileName = .FileName If m_FileName = vbNullString Then Exit Sub End With With m_udl If .OpenUDL Then .SaveToFile m_FileName End WithEnd Sub
##########################################################################
This tip has been brought to you by Shoutsoft, Inc, the creators of COM Express, a tool which generates serious N(3)-tier VB application(withGUI, COM+ and Unlimited Hierarchical support) in minutes. Learn more at http://www.shoutsoft.com ##########################################################################