addguesttype.frm

银行定储模拟程序

Private Sub CancelRecord_Click()
   
   BakPath.Text = ""
   AddPicture.Visible = False
  ' picDraw.Visible = True
   Frame1.Visible = True
   DeleteB.Enabled = True
   ExitB.Enabled = True
   AddB.Enabled = True
   cmdModify.Enabled = True
   AddB.SetFocus
   'subPurView  '安装权限
   
End Sub

Private Sub CancelRecord_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

GetStatus "放弃保存档案新类型"

End Sub

Private Sub cmdModify_Click()
Dim ModifyName As String
Dim db As Database, rs As Recordset, SqlStr As String
If GTN = "" Then
   MsgBox "请先选择一个备份，然后按修改按钮。     ", vbInformation, "提示："
   Exit Sub
End If
   '进行修改目录动作
Set db = OpenDatabase(ConData, False, False, ConStr)
Set rs = db.OpenRecordset("备份记录", dbOpenDynaset)
BEGIN:
ModifyName = InputBox("原备份名是""" & GTN & """" & vbCrLf & "请输入新的备份名", "提示：")
If ModifyName = "" Then Exit Sub
SqlStr = "名称='" & ModifyName & "'"
rs.FindFirst SqlStr
    If Not rs.NoMatch Then
       MsgBox "备份名在备份集中有重名，请改更备份名!", vbExclamation, "提示："
       GoTo BEGIN
    End If
db.Close
Set db = OpenDatabase(ConData, False, False, ConStr)
Set rs = db.OpenRecordset("备份记录", dbOpenDynaset)
SqlStr = "名称='" & GTN & "'"
rs.FindFirst SqlStr
If Not rs.NoMatch Then
    rs.Edit
    rs!名称 = ModifyName
    rs.Update
    Else
    MsgBox "在数据库中没有找到要修改的备份名", vbCritical, "出错："
End If
db.Close
ListView1.ListItems.Clear
Dim EF As Recordset
  Set db = OpenDatabase(ConData, False, False, ConStr)
    Set EF = db.OpenRecordset("备份记录", dbOpenDynaset)
        Do Until EF.EOF
           Set ListIT = ListView1.ListItems.Add()
               ListIT.Text = EF!名称
               ListIT.Icon = "Top"
               ListIT.Key = EF!路径
               ListIT.Tag = EF!时间
           EF.MoveNext
        Loop
    db.Close
    ListView1.Visible = True
    GTN = ""
End Sub

Private Sub cmdModify_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 GetStatus "修改左边选定的档案类型"

End Sub

Private Sub DeleteB_Click()
Dim DelFileName As String
If GTN = "" Then
   MsgBox "请先选择要删除的备份，然后按删除按钮。     ", vbExclamation, "备份提示："
   Exit Sub
End If
   '进行删除目录动作
   Dim OK As Integer
   OK = MsgBox("真的要删除名称是[" & GTN & "]的备份及文件吗？（Y/N）    ", vbYesNo + 16 + vbDefaultButton2, "确认")
   If OK = 7 Then
      Exit Sub
      Else
  '删除代码
  ListView1.Visible = False
  ListView1.ListItems.Clear
  Dim db As Database, tempStr As String
  DelFileName = txtBakPath
    DBEngine.BeginTrans
    Set db = OpenDatabase(ConData, False, False, ConStr)
        tempStr = "Delete * From 备份记录 Where 名称='" & GTN & "'"
        db.Execute tempStr
        db.Close
    DBEngine.CommitTrans
  If Dir(DelFileName) <> "" Then Kill DelFileName
  Dim EF As Recordset
  Set db = OpenDatabase(ConData, False, False, ConStr)
    Set EF = db.OpenRecordset("备份记录", dbOpenDynaset)
        Do Until EF.EOF
           Set ListIT = ListView1.ListItems.Add()
               ListIT.Text = EF!名称
               ListIT.Icon = "Top"
               ListIT.Key = EF!路径
               ListIT.Tag = EF!时间
           EF.MoveNext
        Loop
    db.Close
    ListView1.Visible = True
    GTN = ""
   End If
   NoChange = True
    
End Sub

Private Sub DeleteB_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 GetStatus "删除左边选定的档案类型"
 
End Sub

Private Sub ExitB_Click()
  
  If IT = True And NoChange = True Then
     Call frmManager.cmdLoad_Click
  End If
  
  Unload Me
  
End Sub

Private Sub ExitB_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

  GetStatus "关闭"
  
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

 Select Case KeyCode
 
  
  Case 27
       Call CancelRecord_Click
    
 End Select
  
 
End Sub

Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2, Me.Width, Me.Height
AniShowFrm Me.hwnd

'subPurView  '安装权限

ImageList1.ListImages.Add 1, "Top", Picture1.Picture
ListView1.View = lvwIcon  '图标形式浏览
Dim ListIT As ListItem
Dim db As Database, EF As Recordset

    Set db = OpenDatabase(ConData, False, False, ConStr)
    Set EF = db.OpenRecordset("备份记录", dbOpenDynaset)
        Do Until EF.EOF
           Set ListIT = ListView1.ListItems.Add()
               ListIT.Text = EF!名称
               ListIT.Icon = "Top"
               ListIT.Key = EF!路径
               ListIT.Tag = EF!时间
           EF.MoveNext
        Loop
    db.Close
    GTN = ""
 NoChange = False
 
End Sub



Private Sub Form_Unload(Cancel As Integer)
AniUnloadFrm Me.hwnd
End Sub

Private Sub ListView1_ItemClick(ByVal Item As ComctlLib.ListItem)
GTN = Item.Text
txtName = "名称:" & Item.Text
lblBakDate = "日期:" & Item.Tag
txtBakPath = Item.Key
If Dir(Item.Key) <> "" Then
ListView1.ToolTipText = "检查路径结果：备份存在" & vbCrLf & "文件大小：" & FileLen(Item.Key) & "字节"
Else
ListView1.ToolTipText = "检查路径结果：目前无法找到!"

End If
End Sub


Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetStatus "将鼠标停在备份上可以显示文件情况。"
End Sub

Private Sub bakpath_Change()

If Trim(BakPath.Text) = "" Then
   SaveRecord.Enabled = False
   Else
   SaveRecord.Enabled = True
End If

End Sub

Private Sub BakPath_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
GetStatus "请输入备份文件路径"
End Sub

Private Sub SaveRecord_Click()
  Dim db As Database, tempStr As String, EF As Recordset
    DBEngine.BeginTrans
    Set db = OpenDatabase(ConData, False, False, ConStr)
        tempStr = "Delete * From 备份记录 Where 名称='" & GTN & "'"
        db.Execute tempStr
        db.Close
    DBEngine.CommitTrans
ListView1.ListItems.Clear
  Set db = OpenDatabase(ConData, False, False, ConStr)
    Set EF = db.OpenRecordset("备份记录", dbOpenDynaset)
        Do Until EF.EOF
           Set ListIT = ListView1.ListItems.Add()
               ListIT.Text = EF!名称
               ListIT.Icon = "Top"
               ListIT.Key = EF!路径
               ListIT.Tag = EF!时间
           EF.MoveNext
        Loop
    db.Close
    ListView1.Visible = True
     GTN = ""
     BakPath.Text = ""
     AddPicture.Visible = False
     cmdModify.Enabled = True
     DeleteB.Enabled = True
     ExitB.Enabled = True
     AddB.Enabled = True
     Frame1.Visible = True
If Dir(txtBakPath) = "" Then
MsgBox "还原数据库操作失败，原因：指定的备份文件丢失。", vbCritical, "错误："
Exit Sub
Else
On Error Resume Next
SetAttr App.Path & "\bank.mdb", vbNormal
Kill App.Path & "\bank.mdb"
FileCopy txtBakPath, App.Path & "\bank.mdb"
Kill txtBakPath
End If
MsgBox "您选择的备份已成功还原到 " & App.Path & "\bank.mdb", vbInformation, "恭喜："
   ' subPurView  '安装权限
    
End Sub

Private Sub SaveRecord_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
 GetStatus "保存新类型并返回"
 
End Sub

Private Sub subPurView()

 '权限控制
Select Case PurView
   Case "营业员"
     cmdModify.Enabled = False
     DeleteB.Enabled = False
   Case "备份人员"
     cmdModify.Enabled = False
     DeleteB.Enabled = False
   Case "储蓄科长"
     '没有
   Case "企业主管"
     '没有权限限制
End Select

End Sub