📄 odbclogn.frm
字号:
VERSION 5.00
Begin VB.Form frmODBCLogon
BorderStyle = 3 'Fixed Dialog
Caption = "数据库登录"
ClientHeight = 2835
ClientLeft = 2850
ClientTop = 1755
ClientWidth = 4680
ControlBox = 0 'False
BeginProperty Font
Name = "Arial"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HelpContextID = 2016138
Icon = "ODBCLogn.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2835
ScaleWidth = 4680
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "取消"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Left = 2520
MaskColor = &H00000000&
TabIndex = 5
Top = 2280
Width = 1620
End
Begin VB.CommandButton cmdOK
Caption = "确定(&O)"
Default = -1 'True
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 450
Left = 480
MaskColor = &H00000000&
TabIndex = 4
Top = 2280
Width = 1740
End
Begin VB.Frame fraConnection
Caption = "连接值"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2055
Left = 120
TabIndex = 8
Top = 120
Width = 4455
Begin VB.TextBox txtUID
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 1200
TabIndex = 2
Top = 960
Width = 3135
End
Begin VB.TextBox txtPWD
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
IMEMode = 3 'DISABLE
Left = 1200
PasswordChar = "*"
TabIndex = 3
Top = 1560
Width = 3135
End
Begin VB.TextBox txtServer
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 1200
TabIndex = 1
Top = 360
Width = 3135
End
Begin VB.Label lblLabels
AutoSize = -1 'True
Caption = "用户名(&U):"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Index = 1
Left = 135
TabIndex = 0
Top = 960
Width = 900
End
Begin VB.Label lblLabels
AutoSize = -1 'True
Caption = "密码(&P):"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Index = 2
Left = 135
TabIndex = 6
Top = 1560
Width = 720
End
Begin VB.Label lblLabels
AutoSize = -1 'True
Caption = "服务器(&S):"
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 180
Index = 5
Left = 135
TabIndex = 7
Top = 480
Width = 900
End
End
End
Attribute VB_Name = "frmODBCLogon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'>>>>>>>>>>>>>>>>>>>>>>>>
Const MSG1 = "输入 连接参数"
Const MSG2 = "打开 数据库"
Const MSG3 = "输入驱动程序名称："
Const MSG4 = "驱动程序名称"
Const MSG5 = "这个数据源还没有注册，现在将试图注册！"
Const MSG7 = "无效的参数，请再试一次！"
Const MSG8 = "不能设置查询超时，将使用缺省值！"
Const MSG9 = "数据源注册成功，执行打开。"
Const MSG10 = "请输入 DSN！"
Const MSG11 = "请选择一个驱动程序！"
Const MSG12 = "必须先关闭！"
'>>>>>>>>>>>>>>>>>>>>>>>>
Dim mbBeenLoaded As Integer
Public DBOpened As Boolean
Const SQL_SUCCESS As Long = 0
Const SQL_FETCH_NEXT As Long = 1
Private Sub cmdCancel_Click()
gbDBOpenFlag = False
gsDBName = vbNullString
DBOpened = False
Me.Hide
End Sub
Private Sub cmdOK_Click()
On Error GoTo cmdOK_ClickErr
Dim sConnect As String
Dim dbTemp As New ADODB.Connection
MsgBar "打开数据库", True
Screen.MousePointer = vbHourglass
sConnect = "Provider=SQLOLEDB.1;" '连接语句
sConnect = sConnect & "Password=" & txtPWD.Text & ";Persist Security Info=True;" '得到密码
sConnect = sConnect & "User ID=" & txtUID.Text & ";" '得到用户名
sConnect = sConnect & "Data Source=" & txtServer.Text & ";Initial Catalog=master;" '得到服务名
dbTemp.ConnectionString = sConnect '打开连接
dbTemp.ConnectionTimeout = glQueryTimeout
dbTemp.Open
'已经连接则重新连接
If gbDBOpenFlag Then
CloseCurrentDB
If gbDBOpenFlag Then
Beep
MsgBox MSG12, 48
Me.Hide
Exit Sub
End If
End If
'成功
DBOpened = True
'保存此值
gsDBName = gsODBCDatasource
gsODBCUserName = txtUID.Text
gsODBCPassword = txtPWD.Text
gsODBCServer = txtServer.Text
gdbConString = sConnect
txtUID.Text = gsODBCUserName
txtPWD.Text = gsODBCPassword
gbDBOpenFlag = True
AddMRU
Screen.MousePointer = vbDefault
Me.Hide
dbTemp.Close
Exit Sub
cmdOK_ClickErr:
Screen.MousePointer = vbDefault
gbDBOpenFlag = False
Dim errloop As ADODB.Error
Dim strerror As String
For Each errloop In dbTemp.Errors
strerror = errloop.Description & vbCr
MsgBox strerror
Next
End Sub
Private Sub Form_Load()
Dim i As Integer
MsgBar MSG1, False
txtUID.Text = gsODBCUserName
txtPWD.Text = gsODBCPassword
txtServer.Text = gsODBCServer
mbBeenLoaded = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
MsgBar vbNullString, False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -