[代码]复制/移动文件，并显示相应的进度条对话框

精华区

当前位置：网易精华区>>讨论区精华>>编程开发>>● VB和Basic>>[代码]复制/移动文件，并显示相应的进度条对话框

主题：[代码]复制/移动文件，并显示相应的进度条对话框

发信人: pkhjc(痞客)
整理人: winsy(2003-08-15 16:16:46), 站内信件

Option Explicit

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 Function SHFileOperation Lib "shell32.dll" _
        Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Private Const FOF_ALLOWUNDO = &H40
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_SIMPLEPROGRESS = &H100

Private Const FO_COPY = &H2
Private Const FO_MOVE = &H1

'--------------------------------------------------------------------------------
' 过程: ShellFileCopy
' 描述: 复制文件，并显示“正在复制...”进度条对话框
' 返回: [Boolean] True为复制成功，False为复制失败
'
' 参数:
'     Src (String)                      要复制的源文件
'     Dest (String)                     要复制到的位置
'     hWnd (Long)                       父窗体的句柄（可选）
'     NoShowText (Boolean = False)      是否不显示复制的文件名
'     NoConfirm (Boolean = False)       是否不显示确认对话框
'
'--------------------------------------------------------------------------------
Public Function ShellFileCopy(Src As String, Dest As String, _
       Optional hWnd As Long, _
       Optional NoShowText As Boolean = False, _
       Optional NoConfirm As Boolean = False) As Boolean

    Dim SFO As SHFILEOPSTRUCT
    Dim lRet As Long
    Dim lflags As Long

    lflags = FOF_ALLOWUNDO

    If NoShowText Then lflags = lflags Or FOF_SIMPLEPROGRESS

    If NoConfirm Then lflags = lflags Or FOF_NOCONFIRMATION

    With SFO

        .wFunc = FO_COPY
        .pFrom = Src
        .pTo = Dest
        .fFlags = lflags

    End With

    lRet = SHFileOperation(SFO)
    ShellFileCopy = (lRet = 0)

End Function

'--------------------------------------------------------------------------------
' 过程: ShellFileMove
' 描述: 移动文件，并显示“正在移动...”进度条对话框
' 返回: [Boolean] True为移动成功，False为移动失败
'
' 参数:
'     Src (String)                      要移动的源文件
'     Dest (String)                     要移动到的位置
'     hWnd (Long)                       父窗体的句柄（可选）
'     NoShowText (Boolean = False)      是否不显示移动的文件名
'     NoConfirm (Boolean = False)       是否不显示确认对话框
'
'--------------------------------------------------------------------------------
Public Function ShellFileMove(Src As String, Dest As String, _
       Optional hWnd As Long, _
       Optional NoShowText As Boolean = False, _
       Optional NoConfirm As Boolean = False) As Boolean

    Dim SFO As SHFILEOPSTRUCT
    Dim lRet As Long
    Dim lflags As Long

    lflags = FOF_ALLOWUNDO

    If NoShowText Then lflags = lflags Or FOF_SIMPLEPROGRESS

    If NoConfirm Then lflags = lflags Or FOF_NOCONFIRMATION

    With SFO

        .wFunc = FO_MOVE
        .pFrom = Src
        .pTo = Dest
        .fFlags = lflags

    End With

    lRet = SHFileOperation(SFO)
    ShellFileMove = (lRet = 0)

End Function

----

★★★★★痞客★★★★★

[关闭][返回]