zoukankan      html  css  js  c++  java
  • 通用数据链接文件 (*.UDL) 的创建

    '引用 Microsoft OLE DB Service Component 1.0 Type Library
    Option Explicit
    Private Sub Command1_Click()
     Dim x As New MSDASC.DataLinks
     x.hWnd = Me.hWnd
     Dim s As String
     On Error GoTo ErrorHandler
     s = x.PromptNew
     On Error GoTo 0
     If VBA.Len(VBA.Trim(s & "")) > 0 Then
      Dim CommonDialog1 As New MSComDlg.CommonDialog
      CommonDialog1.DefaultExt = ".udl"
      CommonDialog1.Filter = "通用数据链接文件 (*.UDL)|*.udl"
      CommonDialog1.DialogTitle = "保存为通用数据链接文件"
      CommonDialog1.Flags = cdlOFNOverwritePrompt
      CommonDialog1.CancelError = True
      On Error GoTo ErrorHandler
      CommonDialog1.ShowSave
      On Error GoTo 0
      s = "[oledb]" & vbCrLf _
       & "; Everything after this line is an OLE DB initstring" & vbCrLf _
       & s & vbCrLf
      Dim BytesBuffer() As Byte
      BytesBuffer = VBA.StrConv(VBA.StrConv(s, vbUnicode), vbFromUnicode)
      Dim i As Long
      ReDim BytesBuffer0(1) As Byte
      BytesBuffer0(0) = 255 '&HFF
      BytesBuffer0(1) = 254 '&HFE
      If VBA.Len(VBA.Trim(VBA.Dir(CommonDialog1.FileName))) > 0 Then
       VBA.Kill CommonDialog1.FileName
      End If
      On Error GoTo ErrorHandler
      i = VBA.FreeFile
      Open CommonDialog1.FileName For Binary Access Write As #i
      Put #i, , BytesBuffer0
      Put #i, , BytesBuffer
      Close #i
      On Error GoTo 0
      If VBA.MsgBox("Test?", vbYesNo) = vbYes Then
       Dim adoConnection As New ADODB.Connection
       adoConnection.Open "File Name=" & CommonDialog1.FileName
       VBA.MsgBox "OK!"
      End If
     End If
     Exit Sub
    ErrorHandler:
     If Err.Number <> 91 And Err.Number <> 32755 Then
      VBA.MsgBox Err.Number & ":" & vbCrLf & Err.Description
     End If
    End Sub

    Private Sub Command2_Click()
     Dim CommonDialog1 As New MSComDlg.CommonDialog
     CommonDialog1.DefaultExt = ".udl"
     CommonDialog1.Filter = "通用数据链接文件 (*.UDL)|*.udl"
     CommonDialog1.DialogTitle = "打开通用数据链接文件"
     'CommonDialog1.Flags = cdlOFNOverwritePrompt
     CommonDialog1.CancelError = True
     On Error GoTo ErrorHandler
     CommonDialog1.ShowOpen
     On Error GoTo 0
     If VBA.Len(VBA.Trim(VBA.Dir(CommonDialog1.FileName))) > 0 Then
      VBA.MsgBox GetConnectionStringFromUDL(CommonDialog1.FileName)
     End If
     Exit Sub
    ErrorHandler:
     If Err.Number <> 91 And Err.Number <> 32755 Then
      VBA.MsgBox Err.Number & ":" & vbCrLf & Err.Description
     End If
    End Sub

    Public Function GetConnectionStringFromUDL(UDLFileName As String) As String
     If VBA.Len(VBA.Trim(VBA.Dir(UDLFileName & ""))) > 0 Then
      Dim BytesBuffer() As Byte
      ReDim BytesBuffer(VBA.FileLen(UDLFileName) - 133) As Byte
      Dim i As Long
      i = VBA.FreeFile
      Open UDLFileName For Binary Access Read As #i
      Get #i, 129, BytesBuffer
      Close #i
      GetConnectionStringFromUDL = VBA.Trim(VBA.StrConv(VBA.StrConv(BytesBuffer, vbFromUnicode), vbUnicode))
     End If
    End Function

  • 相关阅读:
    2020-03-12推荐阅读链接
    一问带你区分清楚Authentication,Authorization以及Cookie、Session、Token
    Alibaba-技术专区-开源项目之Nacos源码分析
    Alibaba-技术专区-开源项目之Nacos功能特性
    Alibaba-技术专区-开源项目之Nacos环境准备
    Java-技术专区-javaAgent(插桩,attach)
    SkyWalking 6.x 源码分析 —— 调试环境搭建 (非原创)
    SkyWalking 6.2-Docker-Compose搭建单体
    Zookeeper-技术专区-配置以及学习
    Java-技术专区-设计模式-reactor模式
  • 原文地址:https://www.cnblogs.com/Microshaoft/p/2485794.html
Copyright © 2011-2022 走看看