frmdsn.frm

利用程序建立ODBC数据源连接

         Begin VB.CommandButton Command4 
            Caption         =   "…"
            Height          =   285
            Left            =   5430
            TabIndex        =   6
            Top             =   1065
            Width           =   390
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "驱动程序:"
            Height          =   180
            Index           =   0
            Left            =   645
            TabIndex        =   16
            Top             =   315
            Width           =   810
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "DSN 名称:"
            Height          =   180
            Index           =   1
            Left            =   645
            TabIndex        =   15
            Top             =   705
            Width           =   810
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "数据库:"
            Height          =   180
            Index           =   2
            Left            =   825
            TabIndex        =   14
            Top             =   1095
            Width           =   630
         End
         Begin VB.Label Label1 
            AutoSize        =   -1  'True
            Caption         =   "描述:"
            Height          =   180
            Index           =   3
            Left            =   1005
            TabIndex        =   13
            Top             =   1530
            Width           =   450
         End
      End
   End
   Begin VB.Frame Frame1 
      Height          =   735
      Left            =   75
      TabIndex        =   1
      Top             =   2955
      Width           =   6735
      Begin VB.CommandButton cmdHelp 
         Caption         =   "帮助"
         Height          =   375
         Index           =   0
         Left            =   105
         TabIndex        =   33
         Top             =   225
         Width           =   1185
      End
      Begin VB.CommandButton cmdCreate 
         Caption         =   "创建DSN"
         Height          =   375
         Left            =   5430
         TabIndex        =   32
         Top             =   225
         Width           =   1185
      End
      Begin VB.CommandButton cmdShowOM 
         Caption         =   "数据源管理器"
         Height          =   375
         Left            =   2511
         TabIndex        =   4
         Top             =   225
         Width           =   1695
      End
      Begin VB.CommandButton cmdVerify 
         Caption         =   "测试DSN"
         Height          =   375
         Left            =   1308
         TabIndex        =   3
         Top             =   225
         Width           =   1185
      End
      Begin VB.CommandButton cmdDelete 
         Caption         =   "删除"
         Height          =   375
         Left            =   4224
         TabIndex        =   2
         Top             =   225
         Width           =   1185
      End
   End
End
Attribute VB_Name = "FrmDsn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SQLManageDataSources Lib "ODBCCP32.DLL" (ByVal hwnd As Long) As Long   'Show ODBC Manager
Private Declare Function SQLValidDSN Lib "ODBCCP32.DLL" (ByVal lpszDSN As String) As Long
Dim oDatabase As SQLDMO.Database
Dim oSQLServer As SQLDMO.SQLServer

Private Sub CmdCk_Click()
frmODBCLogon.Show
End Sub

Private Sub cmdCreate_Click()
Dim oOdbc As New clsOdbc
Dim result As String
Dim strAttr As String
Dim m_tab As Integer
m_tab = SSTab1.Tab
If m_tab = 0 Then 'Type Access
    strAttr = strAttr & "DSN=" & Text1(1).Text & Chr$(0)
    strAttr = strAttr & "DBQ=" & Text1(2).Text & Chr$(0)
    strAttr = strAttr & "DESCRIPTION=" & Text1(3).Text & Chr$(0)
    If Option0(0) Then
        'Example for any driver
        oOdbc.ODBC_DRIVER_NAME = Text1(0).Text
        oOdbc.ODBC_ATTRIBUTES = strAttr
        result = oOdbc.ExecuteDSN(CreateUserDSN)
        'Or you can use:
        'result = oOdbc.ExecuteDSN(CreateUserDSN, MSAccess, strAttr)
    ElseIf Option0(1) Then
        result = oOdbc.ExecuteDSN(CreateSystemDSN, MSAccess, strAttr)
    ElseIf Option0(2) Then
        strAttr = "FIL=MS Access|DBQ=" & Text1(2).Text & "|UID=sa|Description=" & Text1(3).Text
        result = oOdbc.ExecuteFileDSN(Text1(1).Text, MSAccess, strAttr)
    End If
ElseIf m_tab = 1 Then 'type SQL Server
    strAttr = strAttr & "DSN=" & Text2(1).Text & Chr$(0)
    strAttr = strAttr & "SERVER=" & Text2(2).Text & Chr$(0)
    strAttr = strAttr & "DATABASE=" & CobDatabase.Text & Chr$(0)
    strAttr = strAttr & "DESCRIPTION=" & Text2(4).Text & Chr$(0)
    If Option1(0) Then
        result = oOdbc.ExecuteDSN(CreateUserDSN, SQLServer, strAttr)
    ElseIf Option1(1) Then
        result = oOdbc.ExecuteDSN(CreateSystemDSN, SQLServer, strAttr)
    ElseIf Option1(2) Then
        strAttr = "SERVER=" & Text2(2).Text & "|DATABASE=" & CobDatabase.Text & "|UID=sa"
        result = oOdbc.ExecuteFileDSN(Text2(1).Text, SQLServer, strAttr)
    End If
End If
If result <> "" Then MsgBox "DSN建立失败!", vbExclamation, "信息提示" Else MsgBox "DSN建立成功!"
Set oOdbc = Nothing
End Sub


Private Sub cmdHelp_Click(Index As Integer)
MsgBox "创建 DSN 连接" & vbCrLf & _
        "灵活运用软件向计算机写入 DSN " & vbCrLf & _
        "删除用户DSN 连接" & vbCrLf & _
        "删除系统DSN连接" & vbCrLf & vbCrLf & _
        "E-mail:[e-mail]", , "帮助信息"
End Sub


Private Sub cmdDelete_Click()
Dim oOdbc As New clsOdbc
Dim result As String
Dim strAttr As String
Dim m_tab As Integer
m_tab = SSTab1.Tab
If m_tab = 0 Then 'Type Access
    strAttr = strAttr & "DSN=" & Text1(1).Text & Chr$(0)
    If Option0(0) Then
        result = oOdbc.ExecuteDSN(DeleteUserDSN, MSAccess, strAttr)
    ElseIf Option0(1) Then
        result = oOdbc.ExecuteDSN(DeleteSystemDSN, MSAccess, strAttr)
    ElseIf Option0(2) Then 'Use regedit for delete
        strAttr = "FIL=MS Access|DBQ=" & Text1(2).Text & "|UID=sa|Description=" & Text1(3).Text
        result = oOdbc.ExecuteFileDSN(Text1(1).Text, MSAccess, strAttr)
    End If
ElseIf m_tab = 1 Then 'type SQL Server
    strAttr = strAttr & "DSN=" & Text2(1).Text & Chr$(0)
    If Option1(0) Then
        result = oOdbc.ExecuteDSN(DeleteUserDSN, SQLServer, strAttr)
    ElseIf Option1(1) Then
        result = oOdbc.ExecuteDSN(DeleteSystemDSN, SQLServer, strAttr)
    ElseIf Option1(2) Then 'User regedit for delete
        strAttr = "SERVER=" & Text2(2).Text & "|DATABASE=" & CobDatabase.Text & "|UID=sa"
        result = oOdbc.ExecuteFileDSN(Text2(1).Text, SQLServer, strAttr)
        Set oOdbc = Nothing
    End If
End If
If result <> "" Then MsgBox "删除失败", vbExclamation, "错误提示" Else MsgBox "删除成功!", , "信息提示"
Set oOdbc = Nothing
End Sub

Private Sub cmdShowOM_Click()
    SQLManageDataSources (Me.hwnd)
End Sub

Private Sub cmdVerify_Click()
    Dim s_dsn As String
    If SSTab1.Tab = 0 Then
        s_dsn = Text1(1).Text
    ElseIf SSTab1.Tab = 1 Then
        s_dsn = Text2(1).Text
    ElseIf SSTab1.Tab = 2 Then
        's_dsn = Text3(1).Text
    End If
    If SQLValidDSN(s_dsn) Then MsgBox "DSN 测试 OK" Else MsgBox "DSN 测试不合格", 16, "测试信息"
End Sub


Private Sub CobDatabase_DropDown()
On Error GoTo ErrHandle:
Dim SQLServer As New SQLDMO.SQLServer
Dim i As Integer
    MousePointer = vbHourglass
    CobDatabase.Clear
        SQLServer.Connect Text2(2).Text, Text2(5).Text

'    SQLServer.AutoReConnect
    '列出所有的数据库
    For i = 1 To SQLServer.Databases.Count
        CobDatabase.AddItem SQLServer.Databases.Item(i).Name
    Next

ErrExit:
    MousePointer = vbDefault
    Exit Sub
ErrHandle:
    MsgBox "SQL Server服务器未启动。", 0 + 48 + 0, "错误提示"
    GoTo ErrExit

End Sub



Private Sub Command1_Click()

End Sub

Private Sub CmdCka_Click()
'frmODBCLogon.Show
End Sub

Private Sub Command4_Click()
    With CommonDialog1
        .Filter = "Access Database (*.mdb)|*.mdb"
        .ShowOpen
        If .FileName = "" Then
'            MsgBox ("You press cancel")
            Exit Sub
        End If
        Text1(2).Text = .FileName
    End With
End Sub
Private Sub fw()
     Set oSQLServer = New SQLDMO.SQLServer
    oSQLServer.Name = Trim(Text2(2))
    oSQLServer.LoginSecure = False
    oSQLServer.Connect Trim(Text2(2).Text), Trim(Text2(5))
End Sub

Private Sub Form_Load()
Text2(2).Text = sGetComputerName
Call fw
End Sub