form10.frm

一、 设计构想： 为减轻财政局非税收入管理处票据准购薄管理工作量

VERSION 5.00
Object = "{E95A2510-F3D1-416D-823B-4F840FE98091}#3.0#0"; "Command.ocx"
Begin VB.Form Form10 
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "数据备份"
   ClientHeight    =   2265
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5490
   Icon            =   "Form10.frx":0000
   LinkTopic       =   "Form10"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   2265
   ScaleWidth      =   5490
   Begin VB.TextBox Text1 
      Height          =   270
      Left            =   1320
      TabIndex        =   0
      Top             =   1005
      Width           =   3855
   End
   Begin CSCommand.Command Command1 
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   960
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   661
      IconAlign       =   0
      Icon            =   "Form10.frx":84CA
      Caption         =   "选择路径"
      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 CSCommand.Command Command2 
      Default         =   -1  'True
      Height          =   375
      Left            =   2880
      TabIndex        =   2
      Top             =   1680
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   661
      IconAlign       =   0
      Icon            =   "Form10.frx":84E6
      Caption         =   "备份数据"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin CSCommand.Command Command3 
      Height          =   375
      Left            =   4200
      TabIndex        =   3
      Top             =   1680
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   661
      IconAlign       =   0
      Icon            =   "Form10.frx":8502
      Caption         =   "关闭窗口"
      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.Image Image1 
      Height          =   645
      Left            =   840
      Picture         =   "Form10.frx":851E
      Top             =   120
      Width           =   3585
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      ForeColor       =   &H000000FF&
      Height          =   375
      Left            =   120
      TabIndex        =   4
      Top             =   1680
      Width           =   2655
   End
End
Attribute VB_Name = "Form10"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) 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 Type SHITEMID
  cb      As Long
  abID    As Byte
End Type
Private Type ITEMIDLIST
  mkid    As SHITEMID
End Type
Public SQL As String

Private Sub Command1_Click()
On Error Resume Next
    Dim bi As BROWSEINFO
    Dim IDL As ITEMIDLIST
    
    Dim r As Long
    Dim pidl As Long
    Dim tmpPath As String
    Dim pos As Integer
    
    bi.hOwner = Form10.hWnd
    bi.pidlRoot = 0
    bi.lpszTitle = "请选择路径： "
    bi.ulFlags = 1
    
   'get the folder
    pidl = SHBrowseForFolder(bi)
    
    tmpPath = Space$(512)
    r = SHGetPathFromIDList(ByVal pidl, ByVal tmpPath)
      
    If r Then
          pos = InStr(tmpPath, Chr$(0))
          tmpPath = Left(tmpPath, pos - 1)
          If Right$(tmpPath, 1) <> "\" Then tmpPath = tmpPath & "\"
          vbGetBrowseDirectory = tmpPath
    Else
    vbGetBrowseDirectory = ""
    End If
Text1.Text = vbGetBrowseDirectory
End Sub

Private Sub Command2_Click()
On Error Resume Next
Dim i As Integer
Label4.Caption = ""
If Text1.Text <> "" Then
i = Len(Dir$(Text1.Text))
If Err Or i = 0 Then FileExists = False Else FileExists = True
Err.Clear
If FileExists Then

bakfile = "Backup_" & Year(Now()) & "-" & Month(Now()) & "-" & Day(Now()) & ".do"
Set fso = CreateObject("Scripting.FileSystemObject")
    Set fil1 = fso.GetFile(App.Path & "\GLNHHY.DLL")
    fil1.Copy (Text1.Text & "\" & bakfile)
    Set fil1 = Nothing

If Err.Number = 0 Then
Label4.Caption = "备份成功，备份文件名" & bakfile & "！"
Else
Label4.Caption = "备份时出现错误！"
End If
    ProgressBar1.Visible = False
    Set fso = Nothing
Else
Label4.Caption = "存放路径不存在"
End If
Else
Label4.Caption = "请选择存放路径"
End If
End Sub

Private Sub Command3_Click()
Me.Hide
End Sub