frmbackup.frm

< 飞鸿商品>>零售是基于VB+SQL2000开的商品零售管理系统. 开发的很好.可以一看

      TabIndex        =   19
      Top             =   4410
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   873
      Caption         =   "下一步(&N)"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.OptionButton opt2 
      Caption         =   " 创建一个新的数据还原点"
      Height          =   255
      Left            =   1650
      TabIndex        =   18
      Top             =   3570
      Width           =   3525
   End
   Begin VB.OptionButton opt1 
      Caption         =   " 数据还原"
      Height          =   255
      Left            =   1680
      TabIndex        =   17
      Top             =   3090
      Width           =   1335
   End
   Begin VB.Label Label9 
      Caption         =   "请选择您要进行的操作："
      Height          =   180
      Left            =   930
      TabIndex        =   16
      Top             =   2580
      Width           =   1980
   End
   Begin VB.Image Image2 
      Height          =   480
      Left            =   7350
      Picture         =   "frmBackup.frx":171C
      Top             =   240
      Width           =   480
   End
   Begin VB.Label Label8 
      Caption         =   $"frmBackup.frx":1FE6
      Height          =   465
      Left            =   900
      TabIndex        =   15
      Top             =   1680
      Width           =   6225
   End
   Begin VB.Label Label4 
      BackStyle       =   0  'Transparent
      Caption         =   "通过数据的备份\还原以避免数据操作失误而造成的损失。"
      Height          =   285
      Left            =   480
      TabIndex        =   7
      Top             =   510
      Width           =   6585
   End
   Begin VB.Label Label3 
      BackStyle       =   0  'Transparent
      Caption         =   "数据备份\还原"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   450
      TabIndex        =   6
      Top             =   210
      Width           =   1335
   End
   Begin VB.Shape Shape1 
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00BD7717&
      BorderWidth     =   3
      FillColor       =   &H00FF0000&
      Height          =   1035
      Left            =   -60
      Top             =   -30
      Width           =   8745
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00FFFFFF&
      Index           =   1
      X1              =   8430
      X2              =   8430
      Y1              =   1170
      Y2              =   5490
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00FFFFFF&
      Index           =   1
      X1              =   180
      X2              =   8400
      Y1              =   5490
      Y2              =   5490
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00808080&
      Index           =   0
      X1              =   120
      X2              =   120
      Y1              =   1170
      Y2              =   5490
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00808080&
      Index           =   0
      X1              =   120
      X2              =   8400
      Y1              =   1170
      Y2              =   1170
   End
End
Attribute VB_Name = "frmBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdBack_Click()
  fraBack.Visible = False
End Sub

Private Sub cmdCancel_Click()
  fraCreate.Visible = False
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmdCreate_Click()
Dim Cmd As ADODB.Command
Dim SQL As String

If Dir(App.Path & "\backup", vbDirectory) = "" Then
  MkDir App.Path & "\backup"
End If

Open App.Path & "\backuplist" For Append As #1
Write #1, Format(Date$, "yyyy-mm-dd") & " " & Format(Time$, "hh:mm:ss") & _
      "/" & txt.Text & "/" & UserName & ""
Close #1

Set Cmd = New ADODB.Command
Cmd.ActiveConnection = Conn
SQL = "BACKUP DATABASE pos TO DISK='" & App.Path & "\backup\" & Format(Date$, "yyyy-mm-dd") _
    & " " & Format(Time$, "hh#mm#ss") & ".dat" & "'"
Cmd.CommandText = SQL
Cmd.CommandType = adCmdText
Cmd.Execute

MsgBox "还原点创建完毕！", 64

Unload Me

End Sub

Private Sub cmdNext_Click()
If opt1.Value = True Then
  Dim LItem As ListItem
  Dim InputStr As String
  Dim I As Integer
  
  lvw.ListItems.Clear
  Open App.Path & "\backuplist" For Input As #1
  Do While Not EOF(1)
    Line Input #1, InputStr
    InputStr = Mid(InputStr, 2, Len(InputStr) - 2)
    Set LItem = lvw.ListItems.Add
    LItem.Text = Mid(InputStr, 1, InStr(InputStr, "/") - 1)
    InputStr = Mid(InputStr, InStr(InputStr, "/") + 1)
    LItem.ListSubItems.Add , , Mid(InputStr, 1, InStr(InputStr, "/") - 1)
    LItem.ListSubItems.Add , , Mid(InputStr, InStr(InputStr, "/") + 1)
    LItem.SmallIcon = 1
  Loop
  Close #1

  If lvw.ListItems.Count = 0 Then
    MsgBox "您还没有创建还原点，因此不能进行数据还原！", 64
    Exit Sub
  End If
  
  fraBack.Visible = True
ElseIf opt2.Value = True Then
  fraCreate.Visible = True
End If
End Sub

Private Sub cmdRosete_Click()
Dim Cmd As ADODB.Command
Dim BackName As String

If lvw.SelectedItem Is Nothing Then MsgBox "请在列表中选择还原点！", 48: Exit Sub

On Error GoTo ee
Conn.Close
Set Conn = New ADODB.Connection
Conn.ConnectionString = ConnectionStr & "master;Data Source=" & Base
Conn.Open

BackName = lvw.SelectedItem.Text
Mid(BackName, InStr(BackName, ":"), 1) = "#"
Mid(BackName, InStr(BackName, ":"), 1) = "#"
BackName = BackName & ".dat"
If Dir(App.Path & "\backup\" & BackName) = "" Then
  MsgBox "该数据备份文件丢失！", 16
  Exit Sub
End If

Set Cmd = New ADODB.Command
Cmd.ActiveConnection = Conn
Cmd.CommandText = "RESTORE DATABASE pos FROM DISK = '" & App.Path & "\backup\" & BackName & "'"
Cmd.CommandType = adCmdText
Cmd.Execute

Set Cmd = Nothing

Conn.Close
Set Conn = New ADODB.Connection
Conn.ConnectionString = ConnectionStr & "pos;Data Source=" & Base
Conn.Open

MsgBox "数据还原顺利完成！", 64
Unload Me
Exit Sub

ee:
MsgBox "数据还原出现错误！" & vbCrLf & vbCrLf & "原因有可能是应用程序还在访问数据库或者备份的数据文件已损坏！", 16
End Sub

Private Sub Form_Load()
With fraBack
  .Height = 4185
  .Width = 7845
  .Left = 270
  .Top = 1260
  .Visible = False
End With

With fraCreate
  .Height = 4185
  .Width = 7845
  .Left = 270
  .Top = 1260
  .Visible = False
End With

End Sub