frm_backup.frm

打印方面的程序

VERSION 5.00
Begin VB.Form frm_backup 
   Caption         =   "数据备份"
   ClientHeight    =   4635
   ClientLeft      =   2415
   ClientTop       =   2175
   ClientWidth     =   7440
   Icon            =   "frm_backup.frx":0000
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   ScaleHeight     =   4635
   ScaleWidth      =   7440
   Begin VB.Frame Frame2 
      Height          =   15
      Left            =   360
      TabIndex        =   8
      Top             =   3840
      Width           =   6855
   End
   Begin VB.CommandButton Command2 
      Caption         =   "返回"
      Height          =   375
      Left            =   5880
      TabIndex        =   7
      Top             =   4080
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "开始备份"
      Height          =   375
      Left            =   4320
      TabIndex        =   6
      Top             =   4080
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      Caption         =   "备份模式"
      Height          =   1215
      Left            =   360
      TabIndex        =   0
      Top             =   840
      Width           =   6735
      Begin VB.CommandButton Command3 
         Caption         =   "选择目录"
         Height          =   375
         Left            =   5280
         TabIndex        =   9
         Top             =   480
         Visible         =   0   'False
         Width           =   1215
      End
      Begin VB.OptionButton Option2 
         Caption         =   "备份其他目录"
         Height          =   375
         Left            =   3600
         TabIndex        =   3
         Top             =   480
         Width           =   1575
      End
      Begin VB.OptionButton Option1 
         Caption         =   "备份系统默认目录"
         Height          =   375
         Left            =   360
         TabIndex        =   2
         Top             =   480
         Value           =   -1  'True
         Width           =   1935
      End
   End
   Begin VB.Label Label3 
      Caption         =   "数据时间："
      Height          =   375
      Left            =   360
      TabIndex        =   5
      Top             =   3240
      Width           =   2535
   End
   Begin VB.Label Label2 
      Height          =   735
      Left            =   360
      TabIndex        =   4
      Top             =   2280
      Width           =   6615
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Caption         =   "备份文件"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   2160
      TabIndex        =   1
      Top             =   240
      Width           =   3015
   End
End
Attribute VB_Name = "frm_backup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim fso As New FileSystemObject
Dim fld As Folder
Dim fil As File
Dim specout As String   '定义获取路径的公共变量

Private Declare Function SHGetPathFromIDList Lib "Shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "Shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Type BROWSEINFO

     hOwner As Long

     pidlRoot As Long

     pszDisplayName As String

     lpszTitle As String

     ulFlags As Long

     lpfn As Long

     lParam As Long

     iImage As Long

    End Type



Private Sub Command1_Click()

If Option1.Value = True Then
   '*******************************************************
   '如果备份到当前系统目录
   If fso.FolderExists(curpath + "backup") = False Then
      fso.CreateFolder curpath + "backup"
      fso.CopyFile curpath + "wupin.mdb", curpath + "backup\" + CStr(Date) + ".sld", True
      MsgBox " 备份成功！"

   Else
      fso.CopyFile curpath + "wupin.mdb", curpath + "backup\" + CStr(Date) + ".sld", True
      MsgBox " 备份成功！"
   End If
Else
   '********************************************************
   '如果备份到其他目录
   If specout = "" Or specout = "\" Then
      '**************************************
      '如果获取外部位置路径为空的话
      If fso.FolderExists(curpath + "backup") = False Then
         fso.CreateFolder curpath + "backup"
         fso.CopyFile curpath + "wupin.mdb", curpath + "backup\" + CStr(Date) + ".sld", True
         MsgBox " 备份成功！"
      Else
          fso.CopyFile curpath + "wupin.mdb", curpath + "backup\" + CStr(Date) + ".sld", True
          MsgBox " 备份成功！"
      End If
   Else
          fso.CopyFile curpath + "wupin.mdb", specout + "\" + CStr(Date) + ".sld", True
          MsgBox " 备份成功！"
   End If
   
 End If
      
   
End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()

    Dim bi As BROWSEINFO '声明必要的变量

    Dim rtn, pidl, path$, pos%

    bi.hOwner = Me.hwnd

    bi.lpszTitle = "选择目录..." '设置标题文字

    bi.ulFlags = BIF_RETURNONLYFSDIRS '返回文件夹的类型

    pidl = SHBrowseForFolder(bi)   '显示对话框

    path = Space(512) '设置字符数的最大值

    t = SHGetPathFromIDList(ByVal pidl, ByVal path) '获得所选的路径

    pos% = InStr(path$, Chr$(0)) '从字符串中提取路径

    SpecIn = Left(path$, pos - 1)

    If Right$(SpecIn, 1) = "\" Then
       specout = SpecIn
    Else
       specout = SpecIn + "\"
    End If
End Sub

Private Sub Form_Load()
If Right(App.path, 1) = "\" Then ' 若 App.Path 为根目录
curpath = App.path
Else
curpath = App.path + "\"
End If


   Label2.Caption = "当前数据备份目录：" & curpath + "backup"
   Label3.Caption = "当前备份时间：" & CStr(Date)
End Sub

Private Sub Option1_Click()
Command3.Visible = False
End Sub

Private Sub Option2_Click()

Command3.Visible = True
End Sub