connect.frm

大量优秀的vb编程

VERSION 5.00
Begin VB.Form frmODBC 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "代码连接到ODBC"
   ClientHeight    =   4380
   ClientLeft      =   1080
   ClientTop       =   1500
   ClientWidth     =   4590
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4380
   ScaleWidth      =   4590
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdGetConnect 
      Caption         =   "获得连接字符串："
      Enabled         =   0   'False
      Height          =   495
      Left            =   2430
      TabIndex        =   3
      Top             =   990
      Width           =   2055
   End
   Begin VB.CommandButton cmdQuit 
      Caption         =   "退出程序"
      Height          =   495
      Left            =   1320
      TabIndex        =   4
      Top             =   3840
      Width           =   1095
   End
   Begin VB.TextBox txtConnect 
      BackColor       =   &H00C0C0C0&
      Height          =   1215
      Left            =   90
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   2430
      Width           =   4395
   End
   Begin VB.CommandButton cmdConnect 
      Caption         =   "连接到数据源："
      Height          =   495
      Left            =   2460
      TabIndex        =   2
      Top             =   360
      Width           =   2055
   End
   Begin VB.ListBox lstTables 
      Height          =   1500
      Left            =   90
      Sorted          =   -1  'True
      TabIndex        =   1
      Top             =   330
      Width           =   2175
   End
   Begin VB.Label lblConnect 
      BackColor       =   &H00C0C0C0&
      Caption         =   "连接字符串："
      Height          =   252
      Index           =   1
      Left            =   96
      TabIndex        =   5
      Top             =   2196
      Width           =   2172
   End
   Begin VB.Label lblConnect 
      BackColor       =   &H00C0C0C0&
      Caption         =   "表和查询等:"
      Height          =   252
      Index           =   0
      Left            =   96
      TabIndex        =   0
      Top             =   120
      Width           =   2172
   End
End
Attribute VB_Name = "frmODBC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'Module level globals to hold connection info
Dim dbfTemp As Database, recTemp As Recordset

Private Sub cmdConnect_Click()
    'Connect to a data source and populate lstTables
    Dim I As Integer
    Dim strConnect As String
    Dim tbfTemp As TableDef
    
    Screen.MousePointer = vbHourglass
    lstTables.Clear
    
        Set dbfTemp = OpenDatabase("", False, False, "ODBC;")
    
    For Each tbfTemp In dbfTemp.TableDefs
        lstTables.AddItem tbfTemp.Name
    Next
       
    Screen.MousePointer = vbDefault
    
    If lstTables.ListCount Then
        cmdGetConnect.Enabled = True
    Else
        MsgBox "No are tables available. Please connect to another data source."
    End If
        
Exit Sub
    
End Sub

Private Sub cmdCopyConnect_Click()
    'Select the text in txtConnect
    With txtConnect
        .SetFocus: .SelStart = 0: .SelLength = Len(txtConnect.Text)
    End With
        
    ' Copy selected text to Clipboard.
    Clipboard.SetText Screen.ActiveControl.SelText
End Sub

Private Sub cmdGetConnect_Click()
    Screen.MousePointer = vbHourglass
    txtConnect.Text = ""
    
    If Len(lstTables.Text) Then
        Set recTemp = dbfTemp.OpenRecordset(lstTables.Text)
        txtConnect.Text = AddSpaces(dbfTemp.Connect)
    Else
        MsgBox "Please select a table first."
    End If
    
   
    Screen.MousePointer = vbDefault
End Sub

Private Sub Form_Load()
    'Log on to an ODBC data source
    'First, allocate ODBC memory and get handles
    Dim intResult As Integer
    
    'Allocate the ODBC environment handle
'    If SQLAllocEnv(glng_hEnv) <> SQL_SUCCESS Then End
    
'    intResult = SQLAllocConnect(glng_hEnv, glng_hDbc)
    'If intResult <> SQL_SUCCESS Then
'        intResult = frmODBCErrors.ODBCError("Dbc", glng_hEnv, glng_hDbc, 0, intResult, "Error allocating connection handle.")
        'End
    'End If

    frmODBC.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim intResult As Integer
  
End Sub

Private Sub cmdQuit_Click()
    End
End Sub

Private Sub lstTables_DblClick()
    cmdGetConnect_Click
End Sub


Function AddSpaces(strC As String)
    Dim I As Integer
    Dim strNewStr As String, strNextChar As String
    
    For I = 1 To Len(strC)
        strNextChar = Mid$(strC, I, 1)
        If strNextChar = ";" Then
            strNewStr = strNewStr & strNextChar & " "
        Else
            strNewStr = strNewStr & strNextChar
        End If
    Next
    AddSpaces = strNewStr
End Function