Function CopyFile(Src As String, Dst As String) As Single
Static Buf As String
Dim needsize, Fizesize As Single
Dim Chunk, i2, i1 As Integer
Const BUFizesize = 1024
If Len(Dir(Dst)) Then
Response = MsgBox(Dst + Chr(10) + Chr(10) + "文件已存在,覆盖吗?", vbYesNo + vbQuestion) 'prompt the user with a message box
If Response = vbNo Then
Exit Function
Else
'如果文件存在,先删除文件
Kill Dst
End If
End If
' On Error GoTo FileCopyError
i1 = FreeFile
Open Src For Binary As i1
i2 = FreeFile
Open Dst For Binary As i2
Fizesize = LOF(i1)
needsize = Fizesize - LOF(i2)
Do
If needsize < BUFizesize Then
Chunk = needsize
Else
Chunk = BUFizesize
End If
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form CopyFile
BorderStyle = 1 'Fixed Single
Caption = "备份数据"
ClientHeight = 3135
ClientLeft = 3330
ClientTop = 3210
ClientWidth = 4830
Icon = "CopyFile.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 3135
ScaleWidth = 4830
Begin VB.CommandButton Copy
Caption = "备份"
Height = 375
Left = 2520
TabIndex = 5
Top = 2400
Width = 975
End
Begin VB.CommandButton Command1
Caption = "退出"
Height = 375
Left = 3600
TabIndex = 4
Top = 2400
Width = 975
End
Begin VB.TextBox Filepath
Height = 285
Left = 240
TabIndex = 3
Top = 480
Width = 3255
End
Begin VB.CommandButton Browsefile
Caption = "from"
Height = 375
Left = 3600
TabIndex = 2
Top = 480
Width = 975
End
Begin VB.TextBox Destinationpath
Enabled = 0 'False
Height = 285
Left = 240
TabIndex = 1
Top = 1080
Width = 3255
End
Begin VB.CommandButton copytopath
Caption = "To"
Enabled = 0 'False
Height = 375
Left = 3600
TabIndex = 0
Top = 1080
Width = 975
End
Begin MSComDlg.CommonDialog Dialog
Left = 360
Top = 2400
_ExtentX = 847
_ExtentY = 847
_Version = 393216
Flags = 6148
End
Begin ComctlLib.ProgressBar copybar
Height = 375
Left = 300
TabIndex = 9
Top = 1830
Width = 4095
_ExtentX = 7223
_ExtentY = 661
_Version = 327682
Appearance = 1
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "Percent complete:"
Height = 195
Left = 360
TabIndex = 6
Top = 1545
Width = 1290
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "要备份的数据路径:"
Height = 180
Left = 240
TabIndex = 8
Top = 240
Width = 1530
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "备份数据的路径:"
Height = 180
Left = 240
TabIndex = 7
Top = 840
Width = 1350
End
End
Attribute VB_Name = "CopyFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Function CopyFile(Src As String, Dst As String) As Single
Static Buf As String
Dim needsize, Fizesize As Single
Dim Chunk, i2, i1 As Integer
Const BUFizesize = 1024
If Len(Dir(Dst)) Then
Response = MsgBox(Dst + Chr(10) + Chr(10) + "文件已存在,覆盖吗?", vbYesNo + vbQuestion) 'prompt the user with a message box
If Response = vbNo Then
Exit Function
Else
'如果文件存在,先删除文件
Kill Dst
End If
End If
' On Error GoTo FileCopyError
i1 = FreeFile
Open Src For Binary As i1
i2 = FreeFile
Open Dst For Binary As i2
Fizesize = LOF(i1)
needsize = Fizesize - LOF(i2)
Do
If needsize < BUFizesize Then
Chunk = needsize
Else
Chunk = BUFizesize
End If
If Right$(inpath, 1) = "\" Then
outpath = inpath
Else
outpath = inpath + "\"
End If
Destinationpath.Text = outpath + getpath(Filepath.Text)
End Sub
Private Sub Browsefile_Click()
Dialog.DialogTitle = "源文件路径"
Dialog.ShowOpen
Filepath.Text = Dialog.Filename
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Copy_Click()
On Error Resume Next
If Filepath.Text = "" Then
MsgBox "你没有选择拷贝文件", vbCritical
Exit Sub
End If
If Destinationpath.Text = "" Then
MsgBox "你没有选择目标路径", vbCritical
Exit Sub
End If
copybar.Value = CopyFile(Filepath.Text, Destinationpath.Text)
End Sub
Private Sub filepath_Change()
Destinationpath.Enabled = True
copytopath.Enabled = True
' Destinationpath.SetFocus
End Sub
Private Sub Form_Load()
Filepath.Text = "c:\ndr20001229\sftcc.mdb"
Destinationpath.Text = "c:\ndr20001229\backup\sftcc.mdb"
End Sub
Public Const FO_MOVE = &H1
Public Const FO_COPY = &H2
Public Const FO_DELETE = &H3
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_NOCONFIRMMKDIR = &H200
Public Const FOF_ALLOWUNDO = &H40
Public Const FOF_SILENT = &H4
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long