📄 frmodbclogon.frm
字号:
VERSION 5.00
Begin VB.Form frmODBCLogon
BackColor = &H80000005&
BorderStyle = 3 'Fixed Dialog
Caption = "连接数据库"
ClientHeight = 3525
ClientLeft = 2850
ClientTop = 1755
ClientWidth = 5070
ControlBox = 0 'False
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3525
ScaleWidth = 5070
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin VB.Frame fraStep3
BackColor = &H80000005&
Caption = "连接值:"
Height = 2535
Index = 0
Left = 360
TabIndex = 12
Top = 120
Width = 4335
Begin VB.TextBox txtUID
Height = 300
Left = 1125
TabIndex = 3
Text = "lovesql"
Top = 600
Width = 3015
End
Begin VB.TextBox txtPWD
Height = 300
IMEMode = 3 'DISABLE
Left = 1125
PasswordChar = "*"
TabIndex = 5
Text = "lovesql"
Top = 930
Width = 3015
End
Begin VB.TextBox txtDatabase
Height = 300
Left = 1125
TabIndex = 7
Text = "test"
Top = 1260
Width = 3015
End
Begin VB.ComboBox cboDSNList
Height = 315
Left = 1125
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 1
Top = 240
Width = 3000
End
Begin VB.TextBox txtServer
Enabled = 0 'False
Height = 330
Left = 1125
TabIndex = 11
Text = "localhost"
Top = 1935
Width = 3015
End
Begin VB.ComboBox cboDrivers
Enabled = 0 'False
Height = 315
Left = 1125
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 9
Top = 1590
Width = 3015
End
Begin VB.Label lblStep3
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "数据源(&D):"
Height = 180
Index = 1
Left = 135
TabIndex = 0
Top = 285
Width = 900
End
Begin VB.Label lblStep3
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "用户名(&U):"
Height = 180
Index = 2
Left = 135
TabIndex = 2
Top = 630
Width = 900
End
Begin VB.Label lblStep3
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "密码(&P):"
Height = 195
Index = 3
Left = 135
TabIndex = 4
Top = 975
Width = 735
End
Begin VB.Label lblStep3
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "数据库(&B):"
Height = 195
Index = 4
Left = 135
TabIndex = 6
Top = 1320
Width = 735
End
Begin VB.Label lblStep3
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "驱动(&V):"
Height = 195
Index = 5
Left = 135
TabIndex = 8
Top = 1665
Width = 465
End
Begin VB.Label lblStep3
AutoSize = -1 'True
BackColor = &H80000005&
Caption = "服务器(&S):"
Height = 195
Index = 6
Left = 135
TabIndex = 10
Top = 2010
Width = 510
End
End
Begin VB.Image cmdCancel
Height = 420
Left = 2760
Picture = "frmODBCLogon.frx":0000
Top = 2880
Width = 1320
End
Begin VB.Image cmdOk
Height = 420
Left = 960
Picture = "frmODBCLogon.frx":0A36
Top = 2880
Width = 1320
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 cmdCancel_Click()
Unload Me
End
End Sub
Private Sub cmdOk_Click()
Dim sConnect As String
Dim sADOConnect As String
Dim sDAOConnect As String
Dim sDSN As String
If cboDSNList.ListIndex > 0 Then
sDSN = "DSN=" & cboDSNList.Text & ";"
Else
sConnect = sConnect & "Driver=" & cboDrivers.Text & ";"
sConnect = sConnect & "Server=" & txtServer.Text & ";"
End If
sConnect = sConnect & "UID=" & txtUID.Text & ";"
sConnect = sConnect & "PWD=" & txtPWD.Text & ";"
If Len(txtDatabase.Text) > 0 Then
sConnect = sConnect & "Database=" & txtDatabase.Text & ";"
End If
sADOConnect = "PROVIDER=MSDASQL;" & sDSN & sConnect
sDAOConnect = "ODBC;" & sDSN & sConnect
'设置数据库连接字符串
cnn.ConnectionString = sADOConnect
'连接字符串复制给全局变量
connStr = sADOConnect
'打开数据库
On Error Resume Next
cnn.Open
MsgBox cnn.ConnectionString
If cnn.State <> 0 Then
frmODBCLogon.Hide
Unload Me
mdiFrm.Show '显示主窗体
Else
Call showMsg("无法连接数据库，请确认数据库服务器已经启动并且所用到的数据库可用。" & vbCrLf & "同时，请检查您的用户名和密码是否正确。", 0)
cboDSNList.SetFocus
End If
End Sub
Private Sub Form_Load()
GetDSNsAndDrivers
End Sub
Private Sub cboDSNList_Click()
On Error Resume Next
If cboDSNList.Text = "(None)" Then
txtServer.Enabled = True
cboDrivers.Enabled = True
Else
txtServer.Enabled = False
cboDrivers.Enabled = False
End If
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 '环境句柄
On Error Resume Next
cboDSNList.AddItem "(None)"
'获得 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
'删除重复项
If cboDSNList.ListCount > 0 Then
With cboDrivers
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -