1、在modulel模块的全局说明区定义公共变量，代码如下：Option ExplicitPublic gConnStr As String在modulel模块中，定义Main子程序，当第一次进入应用程序时，Main子程序将激活，代码如下：Public Sub Main（） gConnStr=Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=Goods frmLogin.ShowEnd Sub在modulel模块中，定义函数ExecSQL，用于处理数据库的连接和访问操作，
2、代码如下。Public Function ExecSQL（ByVal sql As String） As ADODB.Recordset On Error GoTo ErrHandler: Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim strArray（） As String Set cn=New ADODB.Connection Set rs=New ADODB.Recordset strArray=Split（sql） cn.Open gConnStr 与数据库Goods建立连接 If StrComp（UCase$（str
3、Array（0）,select,vbTextCompare）=0 Then rs.Open Trim$（sql）,cn,adOpenKeyset,adLockOptimistic Set ExecSQL=rs 返回查询结果集 Else cn.Execute sql End IfExecSQl_Exit: Set rs = Nothing Set cn = Nothing Exit FunctionErrHandler: 显示错误信息 MsgBox 错误号: & Err.Number & 错误信息: Err.Description,vbExclamation Resume ExecSQl_Exi
4、tEnd Function在modulel模块中，定义过程ChangeFormPos，确定调用窗体在主窗体frmMain中的显示位置。Public Sub ChangeFormPos（frmMain As MDIForm, frm As Form） Dim Top As Integer Top=（frmMain.ScaleHeight - frm.Height）/2-600 If Top0 Then frm.Top=Top frm.Top=0 frm.Left=（frmMain.ScaleWidth - frm.Width）/23）创建主窗体以下代码是对“数据录入”模块的权限验证及调用。Pri
5、vate Sub mnuInsert_Click（）判断权限 If frmLogin.intAuthority5 Then对本起，你没有该权限！,vbExclamation Exit Sub frmInsert.Show3实现用户登录功能“登录”窗体的用户验证在“确认”按钮中执行，其代码如下： 定义全局变量strUserName、intAuthority，用于进入系统后的模块权限验证Public strUserName As StringPublic intAuthority As Integer 当单击“取消”按钮时，执行cmdCancel_Click（）事件Private Sub cmdC
6、ancel_Click（） Unload Me 当单击“确认”按钮时，执行cmdOk_Click（）事件Private Sub cmdOk_Click（） Dim sql As String Dim intUserKey As Integer Dim intJobId As Integer If Trim（txtUserName.Text = ） Then请输入用户名称！, vbExclamation txtUserName.SetFocus sql=select * from Users where 用户名= txtUserName.Text & Set rs=ExecSQL（sql） 从U
7、sers表中提取输入的用户名信息 If rs.EOF=True Then没有此用户，请重新输入用户名！ If Trim（rs!密码）=Trim（txtUserKey.Text） Then intAuthority=rs!权限等级 strUserName=txtUserName.Text rs.Close Me.Hide frmMain.Show密码不正确，请重新输入密码！ txtUserKey.SetFocus txtUserKey.Text=错误号：错误描述： Err.Description4实现用户管理功能1）添加用户要在系统中添加新用户，必须在frmUser窗体的“添加”按钮中添加以下代
8、码：Private Sub cmdAdd_Click（） Dim intAuth As Integer If txtUserName.Text= Then 判断用户名是否为空，为空则重新输入用户名请输入用户名！ If txtPassword1.Text=判断密码是否为空，为空则重新输入用户名请输入密码！ txtPassword1.SetFocus If txtPassword2.Text= Then请输入确认密码！ txtPassword2.SetFocus If txtPassword1.TexttxtPassword1.Text Then确认密码不正确！判断是否选择权限 If cboAut
9、hority.Text=请选择权限！ cboAuthority.SetFocus Select Case cboAuthority.Text Case 系统管理员 intAuth = 10管理人员 intAuth = 9数据录入者 intAuth = 5数据修改者 intAuth = 6一般人员 intAuth = 0 End Select sql = insert Users（用户名,密码,权限,权限等级） values（ sql = sql &, txtPassword1.Text & cboAuthority.Text & intAuth &） ExeSQL （sql） Adodc1.R
10、efresh以下代码将数据更新到Users表中。sql=update Users set 密码= where 用户名= _ExeSQL（sql）Adodc1.Refresh2）窗体初始化窗体frmUser载入时，应先初始化，以确定frmUser在屏幕的位置，以及该用户是否有权限添加新用户及修改其他用户的权限，代码如下：Private Sub Form_Load（） ChangeFormPos frmMain, frmUser判断用户的权限，如果是系统管理员则可以添加用户8 Then cmdAdd.Enabled=False 禁用“添加”用户按钮 cmdDelete.Enabled=False
11、禁用“删除”用户按钮 cboAuthority.Enabled=False 禁用权限 txtUserName.Text=frmLogin.strUserName txtUserName.Enabled=False 禁止输入用户名称5实现数据录入功能为frmInsert窗体的“确认”按钮添加以下代码： Dim i As Integer判断是否有未填项 For i = 0 To 4 If txtProductInfo（i）.Text = 请填完此项！ txtProductInfo（i）.SetFocus Next iinsert Products（编码,名称,单位,数量,供应商,备注,价格,进货时
12、间） values（ sql=sql & txtProductInfo（i）.Text & If txtProductInfo（5）.Text = Null &, txtProductInfo（6）.Text & cboDate.Value &数据录入成功！ Init 初始化过程InitPrivate Sub Init（） For i = 0 To 6 txtProductInfo（i）.Text= cboDate.Value=Now txtProductInfo（0）.SetFocus当窗体第一次被打开时，需要确定窗体的位置和进货时间的值设置为当前日期。代码如下： ChangeFormPos
13、 frmMain, frmInsert初始化进货日期时间 cboDate.Value = Now当窗体单击“取消”按钮时，应去掉当前窗体上的数据，让用户重填，只要调用Init过程即可，代码如下：6实现数据查询功能表3-8中，数据控件Adodc1的属性CommandType 为1-adCmdText，属性RecordSource为“select * from Products”；属性ConnectionString为：“Provider=SQLOLEDB.1;Persist Security Info =False;Initial Catalog=Goods”这样可以通过SQL语句设置不同的查询
14、条件。下面是窗体frmQuery的功能实现代码。（1）在代码编辑器的全局说明区为窗体frmQuery定义变量，代码如下：Dim cn As ADODB.Connection（2）当第一次打开frmQuery时，要求连接数据并在frmQuery中显示Products表的所有记录，其代码如下： Dim rs As New ADODB.Recordset ChangeFormPos frmMain, frmQuery 设置frmQuery在frmMain中的显示位置 初始化进货时间，缺省值为当天日期。 cboStartDate.Value = Now cboEndDate.Value = Now 初
15、始化组合框cboProductNo的项为Products表的编码， 初始化组合框cboSupplier的项为Products表的供应商。 Set rs = ExeSQL（select distinct 编码 from Products Do Until rs.EOF cboProductNo.AddItem rs!编码 rs.MoveNext Loopselect distinct 供应商 from Products cboSupplier.AddItem rs!供应商当用户选择用“编号”为条件查询时，单击cboProductNo的下拉按钮，可以从下拉列表中选择一个编号值，去查询Product
16、s表中该编号值的商品信息，这样不仅准确而且方便，不必用户输入编号。同样，在cboSupplier中可以选择供应商，以查询该供应商的商品信息。（3）当设置了查询条件后，单击“查询”按钮时，程序将执行以下代码：Private Sub cmdQuery_Click（） 按商品编号查询 If chkProductNo Then If cboProductNo.Text = 请选择商品编号！ cboProductNo.SetFocus 按chkTime若为已选择，则按时间段查询 If chkTime = vbChecked Then sql =select * from Products where 编
17、码= sql =sql & cboProductNo.Text & and 进货时间 between cboStartDate.Value & and cboEndDate.Value order by 进货时间 Adodc1.RecordSource = sql 数据网格控件dbgrdProducts刷新，显示查询结果 dbgrdProducts.Refresh select * from Products where 编码 = dbgrdProducts.Refresh 按供应商查询 If chkSupplier Then If cboSupplier.Text = 请选择供应商品！ cb
18、oSupplier.SetFocusselect * from Products where 供应商 = cboSupplier.Text & cboEndDate.Value & 查询全部记录 If chkAll Then Adodc1.RecordSource = select * from Products7实现数据修改功能表3-9中，数据控件Adodc1的属性CommandType 为2-adCmdTable ，属性RecordSource为Products；这样可以使显示字段的文本框与表中字段绑定。（1）第一次打开frmUpdate窗体时，设置窗体的显示位置，并使商品编码文本框为不可
19、编辑状态，以禁止用户修改商品的编码。其代码如下： ChangeFormPos frmMain, frmUpdate 初始化商品编码文本框状态 txtProductInfo（0）.Locked = True（2）单击“向前”或“向后”按钮时，将使数据表Products向前或向后移动一条商品记录，以下为代码： 向前移动一条记录Private Sub cmdForward_Click（） If Adodc1.Recordset.BOF=True Then Adodc1.Recordset.MoveFirst Adodc1.Recordset.MovePrevious If Adodc1.Recordset.BOF = True Then已经到了最前一条记录！ 向后移动一条记录Private Sub cmdBackward_Click（） If Adodc1.Recordset.EOF=True Then Adodc1.Recordset.MoveLast Adodc1.Recordset.MoveNext If Adodc1.Recordset.EOF Then已经到了最后一条记录！（3）单击“添加”按钮时，程序将执行以下代码： 如果单
