?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -