请问什么方法能够得到文件拷贝的速率？（急！！）

TommyXian 2003-08-20 02:17:20

如题。

大虾帮帮忙啊~~~~~

...全文

151 8 打赏收藏转发到动态举报

写回复

用AI写文章

8 条回复

切换为时间正序

请发表友善的回复…

发表回复

道素 2003-08-20

打赏
举报

Private Sub Option2_Click(Index As Integer)

'this was missing from previous
'posts. Thanks to Sylvain Hamel
'for noticing!
FO_FUNC = CLng(Index)

'disable the Method frame
'if the action <> delete
frDeleteMethod.Enabled = Option2(FileDelete).Value = True

End Sub

Private Function GetOptionFlags() As Long

'Iterate through the options,
'and build the flag variable
'according to the user selection.

'can only have one of these, so ..
If Option1(0).Value Then GetOptionFlags= FOF_ALLOWUNDO

'these can be multiple
If Check1.Value Then GetOptionFlags = GetOptionFlags Or FOF_SILENT
If Check2.Value Then GetOptionFlags = GetOptionFlags Or FOF_SIMPLEPROGRESS
If Check3.Value Then GetOptionFlags = GetOptionFlags Or FOF_NOCONFIRMATION

End Function

Private Function GetTempDir() As String

Dim nSize As Long
Dim tmp As String

tmp = Space$(256)
nSize = Len(tmp)
Call GetTempPath(nSize, tmp)

GetTempDir = TrimNull(tmp)

End Function

Private Function TrimNull(item As String)

Dim pos As Long

'double check that there is a
'vbNullChar (Chr$(0)) in the string
pos = InStr(item, vbNullChar)
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If

End Function

Private Sub ShellDelete(sFileArray() As String, sDestination As String)

'Note: sDestination (the pTo member of
'the SHFILEOPSTRUCT) is ignored for deletion.
'
'In addition, a DWORD-alignment problem exists
'in the shf Type. This means you can not
'use the shf hNameMaps or sProgress
'members without significant code changes to
'assure DWORD alignment is corrected. See the
'MS KB for information. If you attempt to use
'these members without following the KB and GPF,
'this alignment issue is probably the cause.

'working variables
Dim cnt As Long
Dim sFiles As String
Dim shf As SHFILEOPSTRUCT

'create a single string of files from the
'passed file array, each separated by nulls
For cnt = LBound(sFileArray) To UBound(sFileArray)
sFiles = sFiles & sFileArray(cnt) & vbNullChar
Next

'add a final null to double-null
'terminate the string
sFiles = sFiles & vbNullChar

'determine the user's options selected
FOF_FLAGS = GetOptionFlags()

'set up the options
With shf
.wFunc = FO_FUNC 'action to take place
.pFrom = sFiles 'the files to act on
.pTo = sDestination 'the destination, if not recycle
.fFlags = FOF_FLAGS 'special flags (FOF_*)
End With

'and perform the chosen operation
Call SHFileOperation(shf)

End Sub
'--end block--'

One command button (Command1)
A FileListBox control (File1). Set the FileListBox MultiSelect property to 1 - Single
A DirListBox control to provide the current path (Dir1)
A label (Label1) above the FileListBox.
Two large frames (Frame1 & Frame2)
Inside Frame1 (titled SHFileOperation Actions) draw a smaller frame (name it frDeleteMethod) and into it draw two option buttons in a control array (Option1(0) and Option1(1)). This corresponds to the two Method buttons in the illustration ("to Recycle Bin" and "permanently").
Still inside Frame1, but outside of frDeleteMethod, draw four more option buttons (Option2(0) - Option2(3)), then delete Option2(0) so that only Option2(1), Option2(2) and Option2(3) remain. This allows the index of the buttons to directly correspond with the constant values for move-1, copy-2 and delete-3). Renaming files is not shown in this demonstration.
Inside Frame2, add three checkboxes (Check1, Check 2, Check 3).

道素 2003-08-20

打赏
举报

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2003 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
sProgress As String
End Type

'File Operations
Private Const FO_MOVE As Long = &H1
Private Const FO_COPY As Long = &H2
Private Const FO_DELETE As Long = &H3
Private Const FO_RENAME As Long = &H4

'File Operation Flags
Private Const FOF_MULTIDESTFILES As Long = &H1
Private Const FOF_CONFIRMMOUSE As Long = &H2
Private Const FOF_SILENT As Long = &H4 'don't create progress/report
Private Const FOF_RENAMEONCOLLISION As Long = &H8
Private Const FOF_NOCONFIRMATION As Long = &H10 'don't prompt the user.
Private Const FOF_WANTMAPPINGHANDLE As Long = &H20 'Fill in SHFILEOPSTRUCT.hNameMappings
'Must be freed using SHFreeNameMappings
Private Const FOF_ALLOWUNDO As Long = &H40
Private Const FOF_FILESONLY As Long = &H80 'on *.*, do only files
Private Const FOF_SIMPLEPROGRESS As Long = &H100 'don't show names of files
Private Const FOF_NOCONFIRMMKDIR As Long = &H200 'don't confirm making any needed dirs
Private Const FOF_NOERRORUI As Long = &H400 'don't put up error UI
Private Const FOF_NORECURSION As Long = &H1000 'don't recurse into directories
Private Const FOF_NOCOPYSECURITYATTRIBS As Long = &H800 'don't copy NT file Security Attributes
Private Const FOF_NO_CONNECTED_ELEMENTS As Long = &H2000 'Shell v5+: don't operate on connected file elements
Private Const FOF_WANTNUKEWARNING As Long = &H4000 'Shell v5+: during delete operation, warn if
'nuking instead of recycling (partially
'overrides FOF_NOCONFIRMATION)
Private Const FOF_NORECURSEREPARSE As Long = &H8000 'Shell v5.1+: treat reparse points as
'objects, not containers

Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" _
(ByVal nSize As Long, _
ByVal lpBuffer As String) As Long

Private Declare Function SHFileOperation Lib "shell32" _
Alias "SHFileOperationA" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'FO_FUNC is determined by the
'type of SHFileOperation action chosen
'(move/delete/rename/copy)
Dim FO_FUNC As Long

'FOF_FLAGS is determined by the
'both the SHFileOperation Actions/Method
'frame and the SHFileOperation Options
'frame choices(delete/recycle/simple
'progress/no confirm etc.)
Dim FOF_FLAGS As Long

'for ease of reading, substitute constants
'for numbers in code SHFileOperationAction
'option button constants
Const FileMove As Long = 1
Const FileCopy As Long = 2
Const FileDelete As Long = 3

Private Sub Form_Load()

Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2

Option1(0).Caption = "to the Recycle Bin"
Option1(0).Value = True
Option1(1).Caption = "permanently"
Option2(FileMove).Caption = "Move files to temp folder"
Option2(FileCopy).Caption = "Copy files to temp folder"
Option2(FileDelete).Caption = "Delete ..."
Option2(FileDelete).Value = True

Check1.Caption = "Don't show operation (silent)"
Check2.Caption = "Don't show filenames for multiple deletes"
Check3.Caption = "Don't prompt for confirmation"

Command1.Caption = "Perform Action"
File1.Pattern = "*.txt"

End Sub

Private Sub Command1_Click()

'set some working variables
Dim cnt As Long
Dim c As Long
Dim fNames() As String
Dim fPath As String
Dim r As Long
Dim target As String

'get the current path from the Dir1 control
fPath = Dir1.Path

'load an array with the file names selected
For cnt = 0 To File1.ListCount - 1

If File1.Selected(cnt) Then

c = c + 1
ReDim Preserve fNames(1 To c)
fNames(c) = fPath & "\" & File1.List(cnt)

End If

Next

'if nothing is yet selected,
'don't go any farther
If c = 0 Then Exit Sub

'if copying or moving to the temp
'folder, get its location
If Option2(1).Value Or _
Option2(2).Value Then target = GetTempDir()

'call ShellDelete
Call ShellDelete(fNames(), target)

'refresh the file list
File1.Refresh

End Sub

Private Sub Dir1_Change()

File1.Path = Dir1.Path

End Sub

道素 2003-08-20