Option Explicit Private Const FO_COPY = &H2& 'Copies the files specified 'in the pFrom member to the 'location specified in the 'pTo member. Private Const FO_DELETE = &H3& 'Deletes the files specified 'in pFrom (pTo is ignored.) Private Const FO_MOVE = &H1& 'Moves the files specified 'in pFrom to the location 'specified in pTo. Private Const FO_RENAME = &H4& 'Renames the files 'specified in pFrom. Private Const FOF_ALLOWUNDO = &H40& 'Preserve Undo information. Private Const FOF_CONFIRMMOUSE = &H2& 'Not currently implemented. Private Const FOF_CREATEPROGRESSDLG = &H0& 'handle to the parent 'window for the 'progress dialog box. Private Const FOF_FILESONLY = &H80& 'Perform the operation 'on files only if a 'wildcard file name '(*.*) is specified. Private Const FOF_MULTIDESTFILES = &H1& 'The pTo member 'specifies multiple 'destination files (one 'for each source file) 'rather than one 'directory where all 'source files are 'to be deposited. Private Const FOF_NOCONFIRMATION = &H10& 'Respond with Yes to 'All for any dialog box 'that is displayed. Private Const FOF_NOCONFIRMMKDIR = &H200& 'Does not confirm the 'creation of a new 'directory if the 'operation requires one 'to be created. Private Const FOF_RENAMEONCOLLISION = &H8& 'Give the file being 'operated on a new name 'in a move, copy, or 'rename operation if a 'file with the target 'name already exists. Private Const FOF_SILENT = &H4& 'Does not display a 'progress dialog box. Private Const FOF_SIMPLEPROGRESS = &H100& 'Displays a progress 'dialog box but does 'not show the 'file names. Private Const FOF_WANTMAPPINGHANDLE = &H20& 'If FOF_RENAMEONCOLLISION is specified, 'the hNameMappings member will be filled 'in if any files were renamed. ' The SHFILOPSTRUCT is not double-word aligned. If no steps are ' taken, the last 3 variables will not be passed correctly. This ' has no impact unless the progress title needs to be changed. Private Type SHFILEOPSTRUCT hwnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Long hNameMappings As Long lpszProgressTitle As String End Type Private Declare Sub CopyMemory Lib "KERNEL32" _ Alias "RtlMoveMemory" _ (hpvDest As Any, _ hpvSource As Any, _ ByVal cbCopy As Long) Private Declare Function SHFileOperation Lib "Shell32.dll" _ Alias "SHFileOperationA" _ (lpFileOp As Any) As Long Private Sub Form_Load() Check1.Caption = "Copy All Files in VB Directory" Check2.Caption = "Display Custom Message" Command1.Caption = "Copy Files" End Sub Private Sub Command1_Click() Dim result As Long Dim lenFileop As Long Dim foBuf() As Byte Dim fileop As SHFILEOPSTRUCT lenFileop = LenB(fileop) ' double word alignment increase ReDim foBuf(1 To lenFileop) ' the size of the structure. With fileop .hwnd = Me.hwnd .wFunc = FO_COPY ' The files to copy separated by Nulls and terminated by two ' nulls If Check1.Value = vbChecked Then .pFrom = Environ("windir") & "\*.exe" .fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY Else .pFrom = Environ("windir") & "\Explorer.exe" _ & vbNullChar _ & Environ("windir") & "\WinHelp.exe" _ & vbNullChar _ & vbNullChar End If .pTo = "C:\testfolder\" & vbNullChar & vbNullChar If Check2.Value = vbChecked Then .fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION Or _ FOF_NOCONFIRMMKDIR .lpszProgressTitle = "Your custom dialog string " & _ "appears here." & vbNullChar _ & vbNullChar End If End With ' Now we need to copy the structure into a byte array Call CopyMemory(foBuf(1), fileop, lenFileop) ' Next we move the last 12 bytes by 2 to byte align the data Call CopyMemory(foBuf(19), foBuf(21), 12) result = SHFileOperation(foBuf(1)) If result <> 0 Then ' Operation failed MsgBox Err.LastDllError 'Show the error returned from 'the API. Else If fileop.fAnyOperationsAborted <> 0 Then MsgBox "Operation Failed" End If End If End Sub
to lxcc: 用不成啊,老是说有错!还有能不能加点注释!
Option ExplicitPrivate Const FO_COPY = &H2&Private Const FO_DELETE = &H3& Private Const FO_MOVE = &H1& Private Const FO_RENAME = &H4& Private Const FOF_ALLOWUNDO = &H40& Private Const FOF_CONFIRMMOUSE = &H2& Private Const FOF_CREATEPROGRESSDLG = &H0& Private Const FOF_FILESONLY = &H80& Private Const FOF_MULTIDESTFILES = &H1& Private Const FOF_NOCONFIRMATION = &H10& Private Const FOF_NOCONFIRMMKDIR = &H200& Private Const FOF_RENAMEONCOLLISION = &H8& Private Const FOF_SILENT = &H4& Private Const FOF_SIMPLEPROGRESS = &H100& Private Const FOF_WANTMAPPINGHANDLE = &H20&Private Type SHFILEOPSTRUCT hwnd As Long wFunc As Long pFrom As String pTo As String fFlags As Integer fAnyOperationsAborted As Long hNameMappings As Long lpszProgressTitle As String End TypePrivate Declare Sub CopyMemory Lib "KERNEL32" _ Alias "RtlMoveMemory" _ (hpvDest As Any, _ hpvSource As Any, _ ByVal cbCopy As Long)Private Declare Function SHFileOperation Lib "Shell32.dll" _ Alias "SHFileOperationA" _ (lpFileOp As Any) As LongPrivate Sub Form_Load() Check1.Caption = "Copy All Files in VB Directory" Check2.Caption = "Display Custom Message" Command1.Caption = "Copy Files" End SubPrivate Sub Command1_Click() Dim result As Long Dim lenFileop As Long Dim foBuf() As Byte Dim fileop As SHFILEOPSTRUCT
lenFileop = LenB(fileop) ' double word alignment increase ReDim foBuf(1 To lenFileop) ' the size of the structure.
With fileop .hwnd = Me.hwnd
.wFunc = FO_COPY If Check1.Value = vbChecked Then '是否拷贝全部系统文件夹下的exe文件 .pFrom = Environ("windir") & "\*.exe" .fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY Else '只拷贝指定文件 .pFrom = Environ("windir") & "\Explorer.exe" _ & vbNullChar _ & Environ("windir") & "\WinHelp.exe" _ & vbNullChar _ & vbNullChar End If
.pTo = "C:\testfolder\" & vbNullChar & vbNullChar
If Check2.Value = vbChecked Then '是否显示拷贝动画 .fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION Or _ FOF_NOCONFIRMMKDIR .lpszProgressTitle = "Your custom dialog string " & _ "appears here." & vbNullChar _ & vbNullChar End If End With
Call CopyMemory(foBuf(1), fileop, lenFileop)
Call CopyMemory(foBuf(19), foBuf(21), 12) result = SHFileOperation(foBuf(1))
If result <> 0 Then MsgBox Err.LastDllError Else If fileop.fAnyOperationsAborted <> 0 Then MsgBox "Operation Failed" End If End If End Sub
'in the pFrom member to the
'location specified in the
'pTo member. Private Const FO_DELETE = &H3& 'Deletes the files specified
'in pFrom (pTo is ignored.) Private Const FO_MOVE = &H1& 'Moves the files specified
'in pFrom to the location
'specified in pTo. Private Const FO_RENAME = &H4& 'Renames the files
'specified in pFrom. Private Const FOF_ALLOWUNDO = &H40& 'Preserve Undo information. Private Const FOF_CONFIRMMOUSE = &H2& 'Not currently implemented. Private Const FOF_CREATEPROGRESSDLG = &H0& 'handle to the parent
'window for the
'progress dialog box. Private Const FOF_FILESONLY = &H80& 'Perform the operation
'on files only if a
'wildcard file name
'(*.*) is specified. Private Const FOF_MULTIDESTFILES = &H1& 'The pTo member
'specifies multiple
'destination files (one
'for each source file)
'rather than one
'directory where all
'source files are
'to be deposited. Private Const FOF_NOCONFIRMATION = &H10& 'Respond with Yes to
'All for any dialog box
'that is displayed. Private Const FOF_NOCONFIRMMKDIR = &H200& 'Does not confirm the
'creation of a new
'directory if the
'operation requires one
'to be created. Private Const FOF_RENAMEONCOLLISION = &H8& 'Give the file being
'operated on a new name
'in a move, copy, or
'rename operation if a
'file with the target
'name already exists. Private Const FOF_SILENT = &H4& 'Does not display a
'progress dialog box. Private Const FOF_SIMPLEPROGRESS = &H100& 'Displays a progress
'dialog box but does
'not show the
'file names. Private Const FOF_WANTMAPPINGHANDLE = &H20&
'If FOF_RENAMEONCOLLISION is specified,
'the hNameMappings member will be filled
'in if any files were renamed. ' The SHFILOPSTRUCT is not double-word aligned. If no steps are
' taken, the last 3 variables will not be passed correctly. This
' has no impact unless the progress title needs to be changed. Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type Private Declare Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long) Private Declare Function SHFileOperation Lib "Shell32.dll" _
Alias "SHFileOperationA" _
(lpFileOp As Any) As Long Private Sub Form_Load()
Check1.Caption = "Copy All Files in VB Directory"
Check2.Caption = "Display Custom Message"
Command1.Caption = "Copy Files"
End Sub Private Sub Command1_Click()
Dim result As Long
Dim lenFileop As Long
Dim foBuf() As Byte
Dim fileop As SHFILEOPSTRUCT lenFileop = LenB(fileop) ' double word alignment increase
ReDim foBuf(1 To lenFileop) ' the size of the structure. With fileop
.hwnd = Me.hwnd .wFunc = FO_COPY ' The files to copy separated by Nulls and terminated by two
' nulls
If Check1.Value = vbChecked Then
.pFrom = Environ("windir") & "\*.exe"
.fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY
Else
.pFrom = Environ("windir") & "\Explorer.exe" _
& vbNullChar _
& Environ("windir") & "\WinHelp.exe" _
& vbNullChar _
& vbNullChar
End If .pTo = "C:\testfolder\" & vbNullChar & vbNullChar If Check2.Value = vbChecked Then
.fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION Or _
FOF_NOCONFIRMMKDIR
.lpszProgressTitle = "Your custom dialog string " & _
"appears here." & vbNullChar _
& vbNullChar
End If
End With ' Now we need to copy the structure into a byte array
Call CopyMemory(foBuf(1), fileop, lenFileop) ' Next we move the last 12 bytes by 2 to byte align the data
Call CopyMemory(foBuf(19), foBuf(21), 12)
result = SHFileOperation(foBuf(1)) If result <> 0 Then ' Operation failed
MsgBox Err.LastDllError 'Show the error returned from
'the API.
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed"
End If
End If
End Sub
用不成啊,老是说有错!还有能不能加点注释!
Private Const FO_MOVE = &H1&
Private Const FO_RENAME = &H4&
Private Const FOF_ALLOWUNDO = &H40&
Private Const FOF_CONFIRMMOUSE = &H2&
Private Const FOF_CREATEPROGRESSDLG = &H0&
Private Const FOF_FILESONLY = &H80&
Private Const FOF_MULTIDESTFILES = &H1&
Private Const FOF_NOCONFIRMATION = &H10&
Private Const FOF_NOCONFIRMMKDIR = &H200&
Private Const FOF_RENAMEONCOLLISION = &H8&
Private Const FOF_SILENT = &H4&
Private Const FOF_SIMPLEPROGRESS = &H100&
Private Const FOF_WANTMAPPINGHANDLE = &H20&Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End TypePrivate Declare Sub CopyMemory Lib "KERNEL32" _
Alias "RtlMoveMemory" _
(hpvDest As Any, _
hpvSource As Any, _
ByVal cbCopy As Long)Private Declare Function SHFileOperation Lib "Shell32.dll" _
Alias "SHFileOperationA" _
(lpFileOp As Any) As LongPrivate Sub Form_Load()
Check1.Caption = "Copy All Files in VB Directory"
Check2.Caption = "Display Custom Message"
Command1.Caption = "Copy Files"
End SubPrivate Sub Command1_Click()
Dim result As Long
Dim lenFileop As Long
Dim foBuf() As Byte
Dim fileop As SHFILEOPSTRUCT
lenFileop = LenB(fileop) ' double word alignment increase
ReDim foBuf(1 To lenFileop) ' the size of the structure.
With fileop
.hwnd = Me.hwnd
.wFunc = FO_COPY If Check1.Value = vbChecked Then '是否拷贝全部系统文件夹下的exe文件
.pFrom = Environ("windir") & "\*.exe"
.fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY
Else '只拷贝指定文件
.pFrom = Environ("windir") & "\Explorer.exe" _
& vbNullChar _
& Environ("windir") & "\WinHelp.exe" _
& vbNullChar _
& vbNullChar
End If
.pTo = "C:\testfolder\" & vbNullChar & vbNullChar
If Check2.Value = vbChecked Then '是否显示拷贝动画
.fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION Or _
FOF_NOCONFIRMMKDIR
.lpszProgressTitle = "Your custom dialog string " & _
"appears here." & vbNullChar _
& vbNullChar
End If
End With
Call CopyMemory(foBuf(1), fileop, lenFileop)
Call CopyMemory(foBuf(19), foBuf(21), 12)
result = SHFileOperation(foBuf(1))
If result <> 0 Then
MsgBox Err.LastDllError
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operation Failed"
End If
End If
End Sub