`
free_bird816
  • 浏览: 198305 次
  • 性别: Icon_minigender_1
  • 来自: 济南
社区版块
存档分类
最新评论

复制/移动文件,并显示相应的进度条对话框(转载)

 
阅读更多


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

注意Private Declare Function SHFileOperation Lib "shell32.dll"  _ 
        Alias 
" SHFileOperationA "  引号里的空格 ,一定要去掉
分享到:
评论

相关推荐

Global site tag (gtag.js) - Google Analytics