form3.frm

可以与称重仪表连接

           MsgBox "无此用户名！", vbOKOnly, "错误："
           cnnUser.Close
           Form3.txtyuan.Text = ""
           Form3.txtch.Text = ""
           Form3.txtxin.Text = ""
           Exit Sub
     End If
           ![Password] = cipher(Form3.txtxin.Text)
           .Update
           .Close
           MsgBox "修改成功", vbOKOnly, "提示："
           Form3.txtch.Text = ""
           Form3.txtxin.Text = ""
           Form3.txtyuan.Text = ""
     End With
    cnnUser.Close
End Sub

Private Sub Command3_Click()
Dim a As Integer
If Check1.Value = 1 Then
  a = 1
  Else
  a = 0
End If
If Form3.txtxin.Text = Form3.txtch.Text Then
     Dim xname As String
     xname = Form3.txtname.Text
     cnnUser.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & App.Path & "\db.mpp;" & _
     "Mode= ReadWrite | Share Deny None"
     cnnUser.Open
     With rstUser
     Set .ActiveConnection = cnnUser
    .CursorType = adOpenKeyset  'adOpenKeyset,adOpenStatic可使用Recordset的RecordCount,其他两个属性不行
     End With
     With rstUser
     If .State = adOpenKeyset Then .Close
     .Open "select * from [admin] where [name]='" & xname & "'"
     If Not .EOF Then
        MsgBox "已存数据！", vbOKOnly, "错误："
        Form3.txtch.Text = ""
        Form3.txtxin.Text = ""
        cnnUser.Close
        Exit Sub
     End If
     .Close
     End With
     With rstUser
     If .State = adOpenKeyset Then .Close
     .Open "select * from [admin] where [name]='" & xname & "'", cnnUser, adOpenKeyset, adLockOptimistic
     .AddNew
     ![Name] = Form3.txtname.Text
     ![Password] = cipher(Form3.txtxin.Text)
     ![adm] = a
     .Update
     .Close
     End With
     cnnUser.Close
     Form3.txtch.Text = ""
     Form3.txtxin.Text = ""
     List1.Clear
     List2.Clear
     data
Else
     MsgBox "两次密码输入不正确！", vbOKOnly, "错误："
End If
End Sub

Private Sub Command6_Click()
Dim pkey As String
pkey = txtfahuo.List(txtfahuo.ListIndex)
If pkey <> "" Then
  cnnUser.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
   "Data Source=" & App.Path & "\db.mpp"
  cnnUser.Open
  With rstUser
    Set .ActiveConnection = cnnUser
    .CursorType = adOpenKeyset  'adOpenKeyset,adOpenStatic可使用Recordset的RecordCount,其他两个属性不行
  End With
  With rstUser
     If .State = adStateOpen Then .Close
     .Open "Select * from [fahuo] where fahuo = '" + pkey + "'", cnnUser, adOpenKeyset, adLockOptimistic
     .Delete
     .Update
     .Close
  End With
  cnnUser.Close
  Call ddt
Else
  MsgBox "请选择删除项！", vbOKOnly, "提示："
End If

End Sub

Private Sub Command7_Click()
Dim pkey As String
pkey = txtjingying.List(txtjingying.ListIndex)
If pkey <> "" Then
  cnnUser.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
   "Data Source=" & App.Path & "\db.mpp"
  cnnUser.Open
  With rstUser
    Set .ActiveConnection = cnnUser
    .CursorType = adOpenKeyset  'adOpenKeyset,adOpenStatic可使用Recordset的RecordCount,其他两个属性不行
  End With
  With rstUser
     If .State = adStateOpen Then .Close
     .Open "Select * from [jingyinghu] where jingying = '" + pkey + "'", cnnUser, adOpenKeyset, adLockOptimistic
     .Delete
     .Update
     .Close
  End With
  cnnUser.Close
  Call ddt
Else
  MsgBox "请选择删除项！", vbOKOnly, "提示："
End If


End Sub

Private Sub Command8_Click()
Dim pkey As String
pkey = txthuo.List(txthuo.ListIndex)
If pkey <> "" Then
  cnnUser.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
   "Data Source=" & App.Path & "\db.mpp"
  cnnUser.Open
  With rstUser
    Set .ActiveConnection = cnnUser
    .CursorType = adOpenKeyset  'adOpenKeyset,adOpenStatic可使用Recordset的RecordCount,其他两个属性不行
  End With
  With rstUser
     If .State = adStateOpen Then .Close
     .Open "Select * from [food] where mz = '" + pkey + "'", cnnUser, adOpenKeyset, adLockOptimistic
     .Delete
     .Update
     .Close
  End With
  cnnUser.Close
  Call ddt
Else
  MsgBox "请选择删除项！", vbOKOnly, "提示："
End If

End Sub

Private Sub Command9_Click()
If tt1.Text <> "" Then
  cnnUser.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
   "Data Source=" & App.Path & "\db.mpp"
  cnnUser.Open
  With rstUser
    Set .ActiveConnection = cnnUser
    .CursorType = adOpenKeyset  'adOpenKeyset,adOpenStatic可使用Recordset的RecordCount,其他两个属性不行
  End With
   With rstUser
     If .State = adStateOpen Then .Close
     .Open "Select * from [food] where mz = '" & tt1.Text & "'"
     If Not .EOF Then
     MsgBox "数据已存在！", vbOKOnly, "提示："
     tt1.Text = ""
     .Close
     cnnUser.Close
     Exit Sub
     End If
     .Close
  End With
  
  
  
  
  
  With rstUser
     If .State = adStateOpen Then .Close
     .Open "Select * from [food]", cnnUser, adOpenKeyset, adLockOptimistic
     .AddNew
     ![mz] = tt1.Text
     .Update
     .Close
  End With
  cnnUser.Close
  Call ddt

 Else
  MsgBox "请填写内容！", vbOKOnly, "提示："
End If
tt1.Text = ""
 
End Sub

Private Sub Form_Load()
data
Me.Frame1.Visible = False
Me.Frame2.Visible = False
Me.Frame7.Visible = True
Call ddt
End Sub
Private Sub ddt()

txthuo.Clear
txtjingying.Clear
txtfahuo.Clear
  cnnUser.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
   "Data Source=" & App.Path & "\db.mpp"
  cnnUser.Open
  With rstUser
    Set .ActiveConnection = cnnUser
    .CursorType = adOpenKeyset  'adOpenKeyset,adOpenStatic可使用Recordset的RecordCount,其他两个属性不行
  End With
  With rstUser
     If .State = adStateOpen Then .Close
     .Open ("Select * from [food]")
      Do While Not .EOF
      txthuo.AddItem rstUser.Fields("mz").Value
      
     .MoveNext
      Loop
     .Close
  End With
    With rstUser
     If .State = adStateOpen Then .Close
     .Open ("Select * from [jingyinghu]")
      Do While Not .EOF
      txtjingying.AddItem rstUser.Fields("jingying").Value
      
     .MoveNext
      Loop
     .Close
  End With
    With rstUser
     If .State = adStateOpen Then .Close
     .Open ("Select * from [fahuo]")
      Do While Not .EOF
      txtfahuo.AddItem rstUser.Fields("fahuo").Value
      
     .MoveNext
      Loop
     .Close
  End With
   cnnUser.Close


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

Private Sub genggai_Click(Index As Integer)
  Me.Hide
  Form1.Show
End Sub

Private Sub guanyu_Click(Index As Integer)
frmAbout.Show
End Sub

Private Sub jbzl_Click(Index As Integer)
Me.Frame1.Visible = False
Me.Frame2.Visible = False
Me.Frame7.Visible = True
End Sub

Private Sub List1_Click()
 Form3.txtname.Text = Trim(List1.List(List1.ListIndex))
 If Trim(List2.List(List1.ListIndex)) = "是" Then
  Form3.Check1.Value = 1
  Else
  Form3.Check1.Value = 0
 End If
  Form3.txtch.Text = ""
  Form3.txtxin.Text = ""
End Sub

Private Sub shj_Click(Index As Integer)
Me.Frame1.Visible = True
Me.Frame2.Visible = True
Me.Frame7.Visible = False

End Sub

Private Sub tt1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command9_Click
End If
End Sub

Private Sub tt2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command10_Click
End If
End Sub

Private Sub tt3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command11_Click
End If
End Sub

Private Sub tuichu_Click(Index As Integer)
Dim tm As Integer
tm = MsgBox("确定退出？", vbOKCancel, "提示：")
If tm = 1 Then

  End
Else
Exit Sub
End If
End Sub

Private Sub txtname_Change()
Check1.Value = 0
End Sub


Function cipher(stext As String)    '加密程序
    Const min_asc = 32
    Const max_asc = 126
    Const num_asc = max_asc - min_asc + 1
    Dim offset As Long
    Dim strlen As Integer
    Dim i As Integer
    Dim ch As Integer
    offset = 123
    Rnd (-1)
    Randomize (offset)
    strlen = Len(stext)
    For i = 1 To strlen
       ch = Asc(Mid(stext, i, 1))
       If ch >= min_asc And ch <= max_asc Then
           ch = ch - min_asc
           offset = Int((num_asc + 1) * Rnd())
           ch = ((ch + offset) Mod num_asc)
           ch = ch + min_asc
           ptext = ptext & Chr(ch)
       End If
    Next i
    cipher = ptext
End Function

Function decipher(stext As String)      '解密程序
    Const min_asc = 32
    Const max_asc = 126
    Const num_asc = max_asc - min_asc + 1
    Dim offset As Long
    Dim strlen As Integer
    Dim i As Integer
    Dim ch As Integer
    offset = 123
    Rnd (-1)
    Randomize (offset)
    strlen = Len(stext)
    For i = 1 To strlen
       ch = Asc(Mid(stext, i, 1))
       If ch >= min_asc And ch <= max_asc Then
           ch = ch - min_asc
           offset = Int((num_asc + 1) * Rnd())
           ch = ((ch - offset) Mod num_asc)
           If ch < 0 Then
               ch = ch + num_asc
           End If
           ch = ch + min_asc
           ptext = ptext & Chr(ch)
       End If
    Next i
    decipher = ptext
End Function