frmodbclogon.frm

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

VERSION 5.00
Begin VB.Form frmODBCLogon 
   Appearance      =   0  'Flat
   BorderStyle     =   1  'Fixed Single
   Caption         =   "ODBC>DSN"
   ClientHeight    =   1635
   ClientLeft      =   3705
   ClientTop       =   4830
   ClientWidth     =   5520
   Icon            =   "frmODBCLogon.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1635
   ScaleWidth      =   5520
   Begin VB.ComboBox cboDrivers 
      Height          =   300
      Left            =   1755
      TabIndex        =   2
      Text            =   "cboDrivers"
      Top             =   360
      Width           =   3615
   End
   Begin VB.CommandButton cmdFh 
      Caption         =   "退出"
      Height          =   375
      Left            =   3870
      TabIndex        =   1
      Top             =   1020
      Width           =   1320
   End
   Begin VB.ComboBox cboDSNList 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00000000&
      Height          =   300
      ItemData        =   "frmODBCLogon.frx":0ECA
      Left            =   75
      List            =   "frmODBCLogon.frx":0ECC
      Sorted          =   -1  'True
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   360
      Width           =   1665
   End
   Begin VB.Label Label2 
      Caption         =   "驱动程序："
      Height          =   210
      Left            =   1740
      TabIndex        =   4
      Top             =   165
      Width           =   990
   End
   Begin VB.Label Label1 
      Caption         =   "DSN名称："
      Height          =   195
      Left            =   75
      TabIndex        =   3
      Top             =   165
      Width           =   840
   End
End
Attribute VB_Name = "frmODBCLogon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function SQLDataSources Lib "ODBC32.DLL" (ByVal henv&, ByVal fDirection%, ByVal szDSN$, ByVal cbDSNMax%, pcbDSN%, ByVal szDescription$, ByVal cbDescriptionMax%, pcbDescription%) As Integer
Private Declare Function SQLAllocEnv% Lib "ODBC32.DLL" (env&)
Const SQL_SUCCESS As Long = 0
Const SQL_FETCH_NEXT As Long = 1


Private Sub cmdFh_Click()
Unload Me
FrmDsn.Show
End Sub

Private Sub Form_Load()
    GetDSNsAndDrivers
End Sub
Sub GetDSNsAndDrivers()
    Dim i As Integer
    Dim sDSNItem As String * 1024
    Dim sDRVItem As String * 1024
    Dim sDSN As String
    Dim sDRV As String
    Dim iDSNLen As Integer
    Dim iDRVLen As Integer
    Dim lHenv As Long         'handle to the environment

    On Error Resume Next
    cboDSNList.AddItem "(None)"

    'get the DSNs
    If SQLAllocEnv(lHenv) <> -1 Then
        Do Until i <> SQL_SUCCESS
            sDSNItem = Space$(1024)
            sDRVItem = Space$(1024)
            i = SQLDataSources(lHenv, SQL_FETCH_NEXT, sDSNItem, 1024, iDSNLen, sDRVItem, 1024, iDRVLen)
            sDSN = Left$(sDSNItem, iDSNLen)
            sDRV = Left$(sDRVItem, iDRVLen)
                
            If sDSN <> Space(iDSNLen) Then
                cboDSNList.AddItem sDSN
                cboDrivers.AddItem sDRV
            End If
        Loop
    End If
    'remove the dupes
    If cboDSNList.ListCount > 0 Then
        With cboDSNList
            If .ListCount > 1 Then
                i = 0
                While i < .ListCount
                    If .List(i) = .List(i + 1) Then
                        .RemoveItem (i)
                    Else
                        i = i + 1
                    End If
                Wend
            End If
        End With
    End If
    cboDSNList.ListIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unload Me
End Sub