📄 frmregister.frm
字号:
Height = 180
Left = 240
TabIndex = 6
Top = 2040
Width = 3240
End
End
Attribute VB_Name = "frmRegister"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************说明*************************************
'*此部分主要完成系统的初始化和和窗口基本信息的初始化 *
'*系统初始化主要记录数据库服务器和登录用户名,登录密码为了生成数据库连 *
'*接字符串,因为在以后操作数据库中将不在使用数据源而直接使用连接字符串 *
'*2003-08-01 dww pm16:39 *
'***********************************************************************
'===============================特别提示2003-09-11======================
'先要对这部分程序做以下修改:
'1.修改注册信息界面,原注册界面包括两部分一部分是服务器信息注册,另一部分
' 是窗口信息注册。服务器信息注册保留,以防服务器信息的修改后和程序没有接
' 口,去掉窗口信息注册窗口。也就是登陆时不再筛选登陆信息,所有人员都可登
' 陆.
'2.修改部分的信息将加特殊标记,不删除
'================================特别提示2003-09-11=====================
'定义单位代码和电话变量
Dim departmentCode As String
Dim departmentTel As String
'定义数据库服务器名称,数据库登录用户名称以及登录密码变量
Dim ServerName As String
Dim DBUserName As String
Dim DBPassWord As String
'定义数据库名和连接字符串变量
Dim DBName As String
Dim DBConnectString As String
'定义ADO对象变量
Dim rs As ADODB.Recordset
Dim db As ADODB.Connection
'定义窗体换扶对象2003-05-28
Private m_cn As cNeoCaption
Private Sub Form_Load()
'------------------------------
'此处代码将制作一个漂亮窗体用
Set m_cn = New cNeoCaption
Skin Me, m_cn
'------------------------------
Frame2.BackColor = RGB(207, 203, 207)
'初始化变量
ServerName = "Server"
DBUserName = "sa"
DBPassWord = ""
DBName = "ShenPi1"
'------------------------------
'初始化文本框显示
Text1.Text = ServerName
Text2.Text = DBPassWord
Text3.Text = DBUserName
'-------------------------------
End Sub
Private Sub xpcmdbutton1_Click()
'处理确定按钮所执行的操作
'初始化数据库服务器后进行窗口基本信息的注册
'2003-08-01 dww pm10:31
'----------------------------------------------------------------------------------------
'给出提示信息
result = MsgBox("确认你的用户名和密码都正确吗?", vbQuestion + vbYesNo, "系统提示")
If result = vbNo Then
Exit Sub
Else
'将初始化信息记录到文本文件中去
Open txtiniFileDirectory + "\zhuce.txt" For Append As #1
Write #1, "[初始化信息]"
Write #1, "数据库服务器名称:" + ServerName
Write #1, "数据库登录用户名:" + DBUserName
Write #1, "数据库登录密码:" + DBPassWord
Write #1, "数据库名:" + DBName
Close #1
'------------------------------------------------------------------------------------
'显示登录框和斜载注册窗体
frmLogOn.Show
Unload Me
'-------------------------------------------------------------------------------------
End If
End Sub
Private Sub xpcmdbutton2_Click()
'处理取消按钮所执行的操作
'卸载窗体对象
'2003-08-01 dww am10:27
'---------------------------
Unload Me
'---------------------------
End Sub
Private Sub Command1_Click()
'处理注册按钮所执行的操作
'注册以后将一些基本信息记录到了文本文件中去,这些数据包括:单位简称,窗口名称,单位代码
'窗口电话,数据库服务器名称,数据库登录用户名以及数据库登录密码等等
'--------------------------------------------------------------------------------------
Set db = New ADODB.Connection
Set rs = New ADODB.Recordset
'---------------------------------------------------------------------------------------
'在没有选择单位名称时提示错误信息
If Combo2.Text = "" Then
MsgBox "你必须选择一个窗口单位简称!", 48, "系统提示"
Exit Sub
Else
'----------------------------------------------------------------------------------------
db.ConnectionString = DBConnectString
db.Open
rs.Open "select * from " & gsDepartmentStorageName & " where departmentabname='" & LTrim(Combo2.Text) & " '", db, adOpenStatic, adLockReadOnly
'-----------------------------------------------------------------------------------------
'在查询数据非空的情况将单位代码和电话取出来
If Not rs.EOF Then
departmentCode = rs.Fields("departmentcode").Value
'数据为空的情况赋值时容易发生错误,要注意这种情况,一定保证该字段不能为空
departmentTel = rs.Fields("Telephone").Value
End If
End If
'------------------------------------------------------------------------------------------
'如果窗口名称为空则提示错误信息
If Combo3.Text = "" Then
MsgBox "你必须选择一个窗口名称!", 48, "系统提示"
Exit Sub
End If
'-----------------------------------------------------------------------------------------
'将初始化信息记录到文本文件中去
Open txtiniFileDirectory + "\zhuce.txt" For Append As #1
Write #1, "[初始化信息]"
Write #1, "单位简称:" + Combo2.Text
Write #1, "窗口名称:" + Combo3.Text
Write #1, "单位代码:" + departmentCode
Write #1, "窗口电话:" + departmentTel
Write #1, "数据库服务器名称:" + ServerName
Write #1, "数据库登录用户名:" + DBUserName
Write #1, "数据库登录密码:" + DBPassWord
Write #1, "数据库名:" + DBName
Close #1
'------------------------------------------------------------------------------------------
'显示登录框和斜载注册窗体
logon.Show
Unload Me
'-----------------------------------------------------------------------------------------
End Sub
Private Sub Command3_Click()
End Sub
Private Sub Text1_Change()
'处理服务器名称输入框的变化
'将变化结果放入变量ServerName
'2003-08-01 dww am11:01
'-----------------------------
ServerName = LTrim(Text1.Text)
'------------------------------
End Sub
Private Sub Text2_Change()
'处理数据登录密码输入框的的变化
'将变化结果放入变量DBPassWord
'2003-08-01 dww am11:02
'--------------------------------
DBPassWord = LTrim(Text2.Text)
'--------------------------------
End Sub
Private Sub Text3_Change()
'处理数据登录用户名输入框的变化
'将变化结果放入变量DBUserName
'2003-08-01 dww am11:03
'--------------------------------
DBUserName = LTrim(Text3.Text)
'--------------------------------
End Sub
Public Sub iniCombo()
'自定义过程初始化注册界面中单位组合框的数据
'2003-08-01 dww am12:41
'---------------------------------------------------------------------------
'定义SQL查询字符串,保证列出单位名称没有过期,这样做的好处是随时限制注册的单位
'2003-08-08 dww pm11:10
Dim SQL As String
Dim mydate As String
mydate = Date
SQL = " where ValidStart<='" & CDate(mydate) & "' and ValidEnd>='" & CDate(mydate) & "'"
'---------------------------------------------------------------------------
'以下代码将单位简称分别导入组合框2
Set db = New ADODB.Connection
Set rs = New ADODB.Recordset
db.ConnectionString = DBConnectString
db.Open
'---------------------------------------------------------------------------
'为了规范单位表存在常量gsDepartmentStorageName中而该变量有在初始化模块中定义
rs.Open "select departmentname,departmentabname from " & gsDepartmentStorageName & SQL, db, adOpenStatic, adLockReadOnly
Dim tempStr As String
Dim t As Integer
'--------------------------------------------------------------------------
'在记录非空的情况下执行下操作
If Not rs.EOF Then
For t = 0 To Val(rs.RecordCount) - 1
'------------------------------------------------------------------
tempStr = Trim(rs.Fields("departmentabname").Value)
'-------------------------------------------------------------------
'导入单位简称
Combo2.AddItem tempStr
'-------------------------------------------------------------------
rs.MoveNext
Next t
End If
'---------------------------------------------------------------------------
'关闭对象
rs.Close
'---------------------------------------------------------------------------
'释放对象
Set rs = Nothing
Set db = Nothing
'---------------------------------------------------------------------------
End Sub
Private Sub Form_Unload(Cancel As Integer)
'处理窗体退出的事件
'释放对象
'2003-08-01 dww am10:25
'------------------------
Set rs = Nothing
Set db = Nothing
Set m_cn = Nothing
'-----------------------
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -