databackup.frm

适合乡镇供电所使用电费处理系统v3 软件

VERSION 5.00
Begin VB.Form DataBackUp 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "数据备份"
   ClientHeight    =   3870
   ClientLeft      =   2715
   ClientTop       =   2160
   ClientWidth     =   5985
   Icon            =   "DataBackUp.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3870
   ScaleWidth      =   5985
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton Command2 
      Caption         =   "退出(&E)"
      Height          =   375
      Left            =   4740
      TabIndex        =   4
      Top             =   3435
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确定(&O)"
      Height          =   375
      Left            =   3285
      TabIndex        =   3
      Top             =   3435
      Width           =   1215
   End
   Begin VB.Frame Frame2 
      Caption         =   "方式"
      Height          =   3240
      Left            =   30
      TabIndex        =   0
      Top             =   105
      Width           =   5910
      Begin VB.Frame Frame1 
         Caption         =   "提示"
         Height          =   1740
         Left            =   2925
         TabIndex        =   9
         Top             =   1365
         Width           =   2835
         Begin VB.Label Label4 
            Caption         =   $"DataBackUp.frx":030A
            Height          =   1290
            Left            =   255
            TabIndex        =   10
            Top             =   315
            Width           =   2355
         End
      End
      Begin VB.TextBox Text1 
         BackColor       =   &H00FFFFFF&
         Height          =   270
         Left            =   3225
         TabIndex        =   5
         Top             =   690
         Width           =   2430
      End
      Begin VB.DirListBox Dir1 
         Height          =   1560
         Left            =   375
         TabIndex        =   2
         Top             =   1530
         Width           =   2295
      End
      Begin VB.DriveListBox Drive1 
         Height          =   300
         Left            =   360
         TabIndex        =   1
         Top             =   645
         Width           =   2295
      End
      Begin VB.Label Label3 
         Caption         =   "请输入备份数据的文件名称->"
         ForeColor       =   &H00000000&
         Height          =   195
         Left            =   3195
         TabIndex        =   8
         Top             =   315
         Width           =   2445
      End
      Begin VB.Label Label2 
         Caption         =   "请选择备份数据的目录->"
         ForeColor       =   &H00000000&
         Height          =   255
         Left            =   180
         TabIndex        =   7
         Top             =   1170
         Width           =   2430
      End
      Begin VB.Label Label1 
         Caption         =   "请选择备份数据的位置->"
         ForeColor       =   &H00000000&
         Height          =   210
         Left            =   150
         TabIndex        =   6
         Top             =   300
         Width           =   2610
      End
   End
End
Attribute VB_Name = "DataBackUp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    Command1.Enabled = False
    Drive1.Drive = App.Path
    Dir1.Path = App.Path
End Sub

Private Sub Command1_Click()   '开始
    Dim DirString As String
    Dim result As Long, fileop As SHFILEOPSTRUCT
    On Error Resume Next
    DirString = Trim(Text1)
    If Text1.Text = "" Then
       DirString = Dir1.Path & "\" & Year(Date) & Format(Month(Date), "0#") & ".Mdb"
    End If
    With fileop
            .hWnd = Me.hWnd
            .wFunc = FO_COPY
            .pFrom = App.Path & "\Data\Eletricity.Mdb" & vbNullChar & vbNullChar
            .pTo = Trim(DirString) & vbNullChar & vbNullChar
            .fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY
    End With
    result = SHFileOperation(fileop)
    If result <> 0 Then
    Else
            If fileop.fAnyOperationsAborted <> 0 Then
               MsgBox "备份文件失败！"
            Else
               MsgBox "数据备份成功，备份数据存放在" & Text1 & "下!", vbInformation
               Exit Sub
            End If
    End If
End Sub

Private Sub Command2_Click()
   Unload Me
End Sub


Private Sub Drive1_Change()
  On Error GoTo eh
  Dir1.Path = Drive1.Drive
  Exit Sub

eh:
    Select Case Err.Number
           Case 68
               MsgBox "请把软盘插到软驱！", vbCritical
               Drive1.Drive = "E:"
               Exit Sub
    End Select
End Sub

Private Sub Dir1_Change()
  On Error Resume Next
  If Right(Dir1.Path, 1) <> "\" Then
     Text1 = Dir1.Path & "\" & Year(Date) & Format(Month(Date), "0#") & ".Mdb"
  Else
     Text1 = Dir1.Path & Year(Date) & Format(Month(Date), "0#") & ".Mdb"
  End If
  Text1.SelStart = 0
  Text1.SelLength = Len(Text1)
End Sub

Private Sub Text1_Change()
  On Error Resume Next
  If Len(Text1) <> 0 Then
     If Mid(Right(Text1, 4), 1, 1) <> "." Then
        MsgBox "文件名称不正确,格式为:xxxx.mdb", vbCritical
        Exit Sub
     Else
        Command1.Enabled = True
     End If
  Else
     Command1.Enabled = False
  End If
End Sub