进度条

wllx

FileCopy("Z:\Twist\IP地址修改器.exe", "C:\Program Files", 1)    将复制文件在窗体 内写一个进度条

haijie1223

论坛应该有相关的代码，楼主搜索一下

wllx

haijie1223 发表于 2023-8-7 12:56
论坛应该有相关的代码，楼主搜索一下

找到 一个，但是那个进度条复制文件速度太慢，不正常。

tubaba

纯AU3函数复制文件

Func _CopyWithProgress($inSource, $inDest, $ChunkSize = 2048)
        Local $SourceFile = FileOpen($inSource, 16)
        If $SourceFile = -1 Then
                MsgBox(16, "Error", "无法打开源文件: '" & $inSource & "'")
                Return False
        EndIf
        Local $DestFile = FileOpen($inDest, 26)
        If $SourceFile = -1 Then
                MsgBox(16, "Error", "无法打开目标文件: '" & $inDest & "'")
                Return False
        EndIf
        Local $SourceSize = FileGetSize($inSource)
        Local $Chunks = $SourceSize / $ChunkSize
        ProgressOn("文件复制", "正在复制...", "从: " & $inSource & @LF & "到: " & $inDest)
        FileSetPos($SourceFile, 0, 0)
        For $i = 0 To $Chunks
                Local $data = FileRead($SourceFile, $ChunkSize)
                FileSetPos($SourceFile,$ChunkSize * ($i+1),0)
                FileWrite($DestFile, $data)
                ProgressSet((($i + 1) / $Chunks) * 100)
        Next
        ProgressOff()
        FileClose($SourceFile)
        FileClose($DestFile)
        Local $DestSize = FileGetSize($inDest)
        If $SourceSize = $DestSize Then
                Return 0
        Else
                Return 1
        EndIf
EndFunc   ;==>_CopyWithProgress

OLE对象实现复制

Func _DirCopy($SourceDir,$Destdir) 
;说明：利用Shell对象来实现复制文件对话框
;作者：Sanhen
    Local $Shell
    Local $FOF_SIMPLEPROGRESS = 16
    If Not FileExists($Destdir) Then DirCreate($Destdir)
    $Shell = ObjCreate("shell.application")
    $Shell.namespace($Destdir).CopyHere($SourceDir,$FOF_SIMPLEPROGRESS)
EndFunc
 
 
Func _DirMove($SourceDir,$Destdir)
;说明：利用Shell对象来实现移动文件对话框
;作者：Sanhen
     Local $Shell
     Local $FOF_CREATEPROGRESSDLG = 16
     If Not FileExists($Destdir) Then DirCreate($Destdir)
     $Shell = ObjCreate("Shell.Application")
 $Shell.NameSpace($Destdir).MoveHere($SourceDir, $FOF_CREATEPROGRESSDLG)
EndFunc

tubaba

再来个API复制的 ,参数请参考https://learn.microsoft.com/zh-c ... api-shfileopstructa

Func _ExplorerCopy($source, $dest)
        Local Const $FO_COPY = 0x0002
        Local Const $FOF_ALLOWUNDO = 0x0040
        Local Const $FOF_NOCONFIRMATION = 0x0010
        Local Const $FOF_NOCONFIRMMKDIR = 0x0200
    Local $SHFILEOPSTRUCT, $source_struct, $dest_struct

    $SHFILEOPSTRUCT = DllStructCreate("hwnd hWnd;uint wFunc;ptr pFrom;ptr pTo;int fFlags;" & _
                                      "BOOL fAnyOperationsAborted;ptr hNameMappings;ptr lpszProgressTitle")

        Local $bsource=StringToBinary($source, 2)
        Local $bdest=StringToBinary($dest, 2)

    $source_struct = DllStructCreate("byte[" & BinaryLen($bsource) + 4 & "]")
    DllStructSetData($source_struct, 1, $bsource)
        Local $s = DllStructGetData($source_struct,1)

    $dest_struct = DllStructCreate("byte[" & BinaryLen($bdest) + 4 & "]")
    DllStructSetData($dest_struct, 1, $bdest)

    DllStructSetData($SHFILEOPSTRUCT, "hWnd", 0)
    DllStructSetData($SHFILEOPSTRUCT, "wFunc", $FO_COPY)
    DllStructSetData($SHFILEOPSTRUCT, "pFrom", DllStructGetPtr($source_struct))
    DllStructSetData($SHFILEOPSTRUCT, "pTo", DllStructGetPtr($dest_struct))
    DllStructSetData($SHFILEOPSTRUCT, "fFlags", BitOR($FOF_ALLOWUNDO,$FOF_NOCONFIRMATION))
;~     DllStructSetData($SHFILEOPSTRUCT, "fFlags", BitOR($FOF_ALLOWUNDO,$FOF_NOCONFIRMMKDIR))

    DllCall("shell32.dll", "int", "SHFileOperationW", "ptr", DllStructGetPtr($SHFILEOPSTRUCT))
EndFunc   ;==>_ExplorerCopy

wllx

tubaba 发表于 2023-8-8 10:01
再来个API复制的 ,参数请参考https://learn.microsoft.com/zh-cn/windows/win32/api/shellapi/ns-shellapi- ...

太高深 了，我只是想一个简单的复制文件进度在窗体 内的进度条上显示 其进度而已

wllx

tubaba 发表于 2023-8-8 09:06
纯AU3函数复制文件

太高深 了，请问窗体内的进度条呢？复制 什么文件到 什么地方？

wllx

这一个到不错，但是只能复制文件夹，不能单独复制文件，能否修改下，让它支持文件 复制。
Func _COPY()
          ProgressCopy("E:\MHT_YS_IPXE\wim\soft", "C:\Windows\TEMP",1)
EndFunc
Func ProgressCopy($current, $destination, $UseMultiColour=0, $attrib = "-R", $overwrite = 1 ,$Run1 = 0 )
If $Run1 = 0 Then
Global $OverallQty, $Overall, $source, $overallpercent, $Pro0Text, $Pro, $ProText, $Pro2, $Pro1Text, $LocalPercent
DllCall("uxtheme.dll", "none", "SetThemeAppProperties", "int", 0)
If not FileExists ($Destination) then DirCreate ($Destination); This is why it was failing, the dir did not exist
$source = $current
If StringRight($current, 1) = '\' Then $current = StringTrimRight($current, 1)
If StringRight($destination, 1) <> '\' Then $destination = $destination & "\"
$tosearch = $current
$Overall = DirGetSize($tosearch, 1)
$OverallQty = $Overall[1]
$Run1 = 1
EndIf
$Size = DirGetSize($current, 3)
$Qty = $Size[1]
Local $search = FileFindFirstFile($current & "\*.*")
While 1
Dim $file = FileFindNextFile($search)
If @error Or StringLen($file) < 1 Then ExitLoop
If Not StringInStr(FileGetAttrib($current & "\" & $file), "D") And ($file <> "." Or $file <> "..") Then
$Qty -= 1
$LocalPercent = 100 - (($Qty / $Size[1]) * 100)
$OverallQty -= 1
$overallpercent = 100 - (($OverallQty / $Overall[1]) * 100)
GUICtrlSetData($Pro0Text, "已完成："& Int($overallpercent) & "%")
GUICtrlSetData($Pro, $overallpercent)
GUICtrlSetData($Pro2, $LocalPercent)
GUICtrlSetData($Pro1Text, "正在拷贝： " & $file &"文件" )

If $useMultiColour then
GUICtrlSetColor($Pro2, _ChangeColour($LocalPercent))
GUICtrlSetColor($Pro, _ChangeColour($OverallPercent))
EndIf
FileCopy($current & "\" & $file, $destination & StringTrimLeft($current, StringLen($source)) & "\" & $file,$overwrite)
FileSetAttrib($destination & StringTrimLeft($current, StringLen($source)) & "\" & $file, $attrib)
EndIf
If StringInStr(FileGetAttrib($current & "\" & $file), "D") And ($file <> "." Or $file <> "..") Then
DirCreate($destination & StringTrimLeft($current, StringLen($source)) & "\" & $file)
FileSetAttrib($destination & StringTrimLeft($current, StringLen($source)) & "\" & $file, $attrib)
GUICtrlSetData($ProText, "拷贝路径：" & $current & "\" & $file)
ProgressCopy($current & "\" & $file, $destination, $UseMultiColour, $attrib, $overwrite,1)
EndIf
WEnd
FileClose($search)
If $overallpercent = 100 Then
GUICtrlSetData($Pro1Text, "已完成： 100% ")
GUICtrlSetData($Pro , 100)
GUICtrlSetData($Pro2, 100)
Sleep(100)
GUICtrlSetData($Pro1Text, 32)
GUICtrlSetState ( $Pro, 32)
GUICtrlSetState ( $Pro2, 32)
;~ GUICtrlSetState ( $kb, 16)
$Run1 = 0
EndIf
EndFunc ;==>ProgressCopy
Func _ChangeColour($start)
$Redness = Int(255 - ($start / 100 * 512))
If $Redness < 0 Then $Redness = 0
$Greeness = Int(($start / 100 * 512) - 257)
If $Greeness < 0 Then $Greeness = 0
$Blueness = Int(255 - ($Redness + $Greeness))
Return ($Redness * 256 * 256) + ($Greeness * 256) + $Blueness
EndFunc

tubaba

wllx 发表于 2023-8-8 16:16
这一个到不错，但是只能复制文件夹，不能单独复制文件，能否修改下，让它支持文件 复制。
Func _COPY()
         ...

咱们来探讨下这个问题.
1.看到你发出的代码,有点迷糊,没错,这个代码片段是用来复制文件夹,先计算文件夹的大小,然后根据大小设置进度条的值.每复制一个文件,注意,是每复制完成一个文件,进度条会被设置成新的值,那么问题来了,在复制单一文件的这个过程中,进度条大小是不会改变的.所以.你这个代码无法修改成你想要的结果.

2.第二.除非你要复制的文件足够大,才能肉眼可见进度条的改变,否则将是一闪而过.因为windows复制文件的速度并不慢.几十MB一秒,小的文件几乎是瞬间完成.
3.要实现在自定义窗体中嵌入进度条显示文件复制进度.我目前知道的方法只有一个


16进制方式打开源文件,读取文件大小,根据文件大小设置进度条的值,这里举个例子,比如文件1MB,设置每次读取文件大小的10分之1,也就是100K,然后写入目标文件,设置进度条前进10分之1.然后再读取源文件.如此循环,直到结束.


但这种方法肯定不如直接复制粘贴来得快,因为他需要额外的系统开销来设置进度条.


复杂一点的办法,就是API复制,利用回调函数设置进度条.我没有试验过.

如果公开并注册了复制回调处理程序，则 SHFileOperation 会调用它，除非在 lpFileOp 指向的结构的 fFlags 成员中设置一个标志，例如FOF_NOCONFIRMATION。 有关实现复制回调处理程序的详细信息，请参阅 ICopyHook：：CopyCallback 。
https://learn.microsoft.com/zh-c ... top/legacy/bb776048(v=vs.85)

wllx

tubaba 发表于 2023-8-9 10:23
咱们来探讨下这个问题.
1.看到你发出的代码,有点迷糊,没错,这个代码片段是用来复制文件夹,先计算文件夹 ...

高手正解。。。。。。。。。。。。。