PureBasic Forums - English

Posted: **Thu Jun 08, 2006 4:10 am**

Does this exist or is it even possible?

Basically a way to use CopyFile and track the progress of the bytes downloaded and display in a progress bar?

I have found on the forums a way to do this with an Internet file, but I just need it for a LAN hosted file.

Thanks for any help.

Posted: **Thu Jun 08, 2006 7:49 am**

I have found a working example for PB 3.94 in the German forum:
http://www.robsite.de/php/pureboard/viewtopic.php?t=373

Posted: **Thu Jun 08, 2006 8:16 am**

I made this, see if it is close to what you had in mind. Note that it uses longs so if you're copying files > 2gb in size you'll want to make a few adaptations. I tested it on several large files and followed each test with a Windiff check and they were all identical. So it probably works, but you never know... Here goes:

Code: Select all

; Copy file with progress bar
; 
; By netmaestro, June 8, 2006
;
; For PureBasic version 4.0 Final

Global length,remaining

Procedure callback(a)
  OpenWindow(0,0,0,320,100,"Copy Progress",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  CreateGadgetList(WindowID(0))
  ProgressBarGadget(0,10,70,300,20,0,length)
  TextGadget(1,120,40,100,20,"")
  LoadFont(0,"Arial",12,#PB_Font_Bold)
  SetGadgetFont(1,FontID(0))
  Dim msg.s(4)
  msg(0) = "Copying"
  msg(1) = "Copying."
  msg(2) = "Copying.."
  msg(3) = "Copying..."
  msg(4) = "Copying...."
  counter=0
  Repeat
    SetGadgetState(0, length-remaining)
    SetGadgetText(1,msg(counter))
    counter+1
    If counter > 4
      counter = 0
    EndIf
  Until WaitWindowEvent(300)=#PB_Event_CloseWindow
EndProcedure

BiteSize.l = 10000000 ; There may be a more efficient chunk size, dunno
*buf = AllocateMemory(BiteSize)
file$=OpenFileRequester("Choose a file to copy","","*.*",0)
If ReadFile(0,file$)
  fileout$=GetPathPart(file$)+"Copy of "+GetFilePart(file$)
  If CreateFile(1,fileout$)
    tid = CreateThread(@callback(),0)
    length.l = Lof(0)
    remaining.l = Lof(0)-Loc(0)
    While remaining
      If remaining >= BiteSize
        ReadData(0,*buf,BiteSize)
        WriteData(1,*buf,BiteSize)
      Else
        ReadData(0,*buf,remaining)
        WriteData(1,*buf,remaining)
      EndIf
      remaining.l = Lof(0)-Loc(0)
      Delay(1)
      If Not IsThread(tid) ; This lets the user abort by closing the window
        remaining=0 
      EndIf
    Wend
    CloseFile(1)
  Else
    MessageRequester("Error","Cannot Open Output file")
  EndIf
  CloseFile(0)
EndIf

You can go kinda nuts and have a lot of fun playing with different animations, but I was in a bit of a rush so I left it kind of boring. But the possibilites are endless with all kinds of cool options.

[edit] Looking at the CopyFileEx_() API, it could be made to do what my program does, and it might be faster, dunno. I'm tired of this for now, so I'm probably not going to experiment with it and do speed tests. But somebody could.

Posted: **Thu Jun 08, 2006 8:45 am**

Hi,
I've made a small program which does that, just have a look on the status bar of Copyme.exe...

http://sudokuprogram.googlepages.com/copyme.exe

some important procedures for doing this stuff are...

Procedure UpdateStatus(text.s="")

If AbortCopy
Status=#Aborting
StatusBarText(#statusbar,0," "+text)

ElseIf ThreadCopy
If ThreadCalc
Statustext=StatusText(2)+" / "+StatusText(OptAutoDelete)+"- "+CopyName+" "
Else
Statustext=StatusText(OptAutoDelete)+"- "+CopyName+" "
EndIf
Status=#Working
StatusBarText(#statusbar,0,Statustext)

ElseIf ThreadCalc
Statustext=StatusText(2)+"- "+CalcName+" "
Status=#Working
StatusBarText(#statusbar,0,Statustext)

Else
Status=#Idle
StatusBarText(#statusbar,0," Bereit")
StatusBarText(#statusbar,1,"")
StatusBarText(#statusbar,2,"")
EndIf

Timer=0
EndProcedure

Procedure.l MyCopyFile(von.s,nach.s)

Protected open.q,total.q
Protected soll.l,ist.l

If FileSize(nach)<>-2; Directory
If ReadFile(1,von); <1>; <1>
FileBuffersSize(1,#Blocksize)

If CreateFile(2,nach)

total=Lof(1)
open=total
While open>0

If open>#Blocksize
soll=#Blocksize
Else
soll=open
EndIf
ist=ReadData(1,*MemBlock,soll)

If soll<>ist Or AbortCopy=1
CloseFile(2)
CloseFile(1)
ProcedureReturn #False
EndIf

WriteData(2,*MemBlock,ist)
open-ist
copydone+ist

Wend
CloseFile(2)

Else
CopyError=#True
ProcedureReturn #False
EndIf
CloseFile(1)
ProcedureReturn #True
EndIf
EndIf

ProcedureReturn #False

EndProcedure
Procedure.l MyCopyDir(sourcedir.s,destdir.s,depth)
Protected name.s

CreateDirectory(destdir); auch weitermachen, wenn es das Verzeichnis schon gibt...

If ExamineDirectory(depth,sourcedir,#NULL$) And AbortCopy=0
While NextDirectoryEntry(depth) And AbortCopy=0
name=DirectoryEntryName(depth)
If DirectoryEntryType(depth)=#PB_DirectoryEntry_File
If MyCopyFile(sourcedir+name,destdir+name)=#False : CopyError=#True : EndIf
;Debug "S:"+sourcedir+DirectoryEntryName(depth)
;Debug "D:"+destdir
ElseIf name<>".." And name<>"."
;falls rekursives Kopieren gewünscht ist, aufpassen: nichts VOM Zielpfad kopieren (\Pfad\Ziel\Ziel\Ziel\...)
If OptRecursiveDir And (sourcedir<>actpath) And (sourcedir+name+"\"<>actpath)
MyCopyDir(sourcedir+name+"\",destdir+name+"\",depth+1)
EndIf
EndIf
Wend
FinishDirectory(depth)
EndIf

If AbortCopy Or CopyError
ProcedureReturn #False
Else
ProcedureReturn #True
EndIf

EndProcedure
Procedure.l CopyEntry(nr.l)
Protected ret.l=#True; nicht kopieren ist auch positiv...
Protected ok.l

With filelist(nr)
If \copied=0
ret=#False
If \sourcepath<>\destpath
CopyError=#False
CopyTotal=\size
copydone=0
CopyTime=GetTickCount_()/1000
CopyName=\name
UpdateStatus()

Select \type
Case 2; Datei
;Debug "F:"+\sourcepath+\name+" >> "+\destpath+\name
If OptOwnCopy
ok=MyCopyFile(\sourcepath+\name,\destpath+\name)
Else
ok=CopyFile(\sourcepath+\name,\destpath+\name)
EndIf
If ok
ret=#True
\copied=1
CopyFile-1
CopySize-\size
EndIf
Case 1; Verzeichnis
;Debug "D:"+\sourcepath+\name+" >> "+\destpath+\name
If OptOwnCopy
ok=MyCopyDir(\sourcepath+\name+"\",\destpath+\name+"\",1)
Else
ok=CopyDirectory(\sourcepath+\name,\destpath+\name,"",OptRecursiveDir|#PB_FileSystem_Force)
EndIf
If ok
ret=#True
\copied=1
CopyFile-1
CopySize-\size
EndIf
EndSelect
If \copied
SetGadgetItemText(#listgadget,nr,CopyText(\copied),#copycol)
SetGadgetItemColor(#listgadget,nr,#PB_Gadget_BackColor,CopyColor(\copied),5)
EndIf
EndIf
EndIf
EndWith
ProcedureReturn ret
EndProcedure
Procedure CopyList(Nothing.l)
Protected i.l=-1

CopyFinished=#False
TotalTime=GetTickCount_()/1000

While i<anz
i+1
If CopyEntry(i)
If OptAutoDelete
DeleteSingleFile(i)
EndIf
If OptAutoRemove
RemoveListItem(i)
i-1
EndIf
UpdateSizeDisplay()
Else
If AbortCopy
If OptAutoCopy
UpdateStatus("Vorgang abgebrochen, automatisches Kopieren deaktiviert")
OptAutoCopy=#False
Else
UpdateStatus("Vorgang abgebrochen")
EndIf
Else
Beeps(1)
AbortCopy=33; damit UpdateStatus auch was anzeigt...
If OptAutoCopy
UpdateStatus("Kopierfehler, automatisches Kopieren deaktiviert")
OptAutoCopy=#False
Else
UpdateStatus("Kopierfehler, Vorgang beendet")
EndIf
EndIf
Delay(1600)
Break
EndIf
Wend
;Debug Str(i)+" / "+Str(anz)

AbortCopy=99
ThreadCopy=0
UpdateButtons()
UpdateStatus()
CopyFinished=#True

EndProcedure

Posted: **Thu Jun 08, 2006 9:59 am**

Why don't you use SHFileOperation_() with wFunc set to #FO_COPY? This provides a dialog with a progress bar...

[Edit: Sample code added]

Code: Select all

;-
;- Wrapper for SHFileOperation_()
;- Writte for PB4 by Wayne-C
;- Works with Unicode!
;-

Procedure SHFileOp_CreateMemFileList(*fn.s())
  Protected size.l= 0
  Protected *mem.l= 0
  Protected xpos.l= 0
  ForEach *fn()
    size+ StringByteLength(*fn()) + SizeOf(Character)
  Next
  size+ 2 * SizeOf(Character)
  *mem= AllocateMemory(size)
  If *mem
    ForEach *fn()
      PokeS(*mem + xpos, *fn())
      xpos+ StringByteLength(*fn()) + SizeOf(Character)
    Next
    ProcedureReturn *mem
  EndIf
  ProcedureReturn 0
EndProcedure

Procedure SHFileOp_CopyOrMoveToFolder(hwnd.l, *fnSrc.s(), DestFolder.s, delSource.l)
  ;-
  ;- hwnd: WindowID() of parent window (for the progress dialog)
  ;- delSource: 0=COPY, 1=MOVE
  ;-
  Protected *src.l= 0
  Protected NewList fnDst.s()
  Protected *dst.l= 0
  Protected fos.SHFILEOPSTRUCT
  Protected rv.l= 0
  AddElement(fnDst()): fnDst()= DestFolder
  *src= SHFileOp_CreateMemFileList(*fnSrc())
  *dst= SHFileOp_CreateMemFileList(fnDst())
  If *src And *dst
    fos\hwnd= hwnd
    fos\pFrom= *src
    fos\pTo= *dst
    fos\fFlags= #FOF_ALLOWUNDO
    If delSource
      fos\wFunc= #FO_MOVE
    Else
      fos\wFunc= #FO_COPY
    EndIf
    rv= SHFileOperation_(@fos)
    FreeMemory(*dst)
    FreeMemory(*src)
  EndIf
  ProcedureReturn rv
EndProcedure

Procedure SHFileOp_CopyToFolder(hwnd.l, *fnSrc.s(), DestFolder.s)
  ProcedureReturn SHFileOp_CopyOrMoveToFolder(hwnd, *fnSrc(), DestFolder, 0)
EndProcedure

;- Copy to folder demo
NewList SrcFileNames.s()
AddElement(SrcFileNames()): SrcFileNames()= "C:\test\a.txt"
AddElement(SrcFileNames()): SrcFileNames()= "C:\test\b.txt"
SHFileOp_CopyToFolder(0, SrcFileNames(), "C:\test\backup")

Posted: **Thu Jun 08, 2006 6:02 pm**

Nice - thanks for all the replys. Now to just choose....

Posted: **Thu Jun 08, 2006 6:19 pm**

straker wrote:Nice - thanks for all the replys. Now to just choose....

I pick wayne-c's. The rest seem to have drawbacks imho and mine's a steaming pile of homemade noob-doodie.

Posted: **Thu Jun 08, 2006 9:56 pm**

noob-doodie

:snicker:

I actually used a modified version of Shardik's reference on the German forum, turned out to be real easy (coded in 3.94):

Code: Select all

#PROGRESS_CONTINUE = 0

Procedure.l CopyProgressCallback(TotalFileSize, totalbytetransfertalk, StreamSize, StreamBytesTransferred, dwStreamNumber.l, dwCallbackReason.l, hSourceFile.l)
  TotalFileSize_ = (TotalFileSize>>16) &$FFFFFFFF
  StreamSize_ = 100 * (StreamSize>>16) &$FFFFFFFF
  If TotalFileSize_ > 0 And StreamSize_ > 0
    percent = 100 * (StreamSize>>16) &$FFFFFFFF/(TotalFileSize>>16) &$FFFFFFFF
  Else
    percent = 100
  EndIf
  SetGadgetState(#ProgressBar_0, percent)
  While WindowEvent(): Wend
  ProcedureReturn #PROGRESS_CONTINUE
EndProcedure

Procedure.l CopyFileWithProgress(pSource.s,pTarget.s)
  ProcedureReturn CopyFileEx_ (@pSource.s, @pTarget.s, @CopyProgressCallback(), 0, 0, 0)
EndProcedure

just change the progressbar reference in the callback function to your progressbar gadget name, that should do it.

Thanks again to all who responded and props to isidoro in this thread

Posted: **Sat May 12, 2012 11:16 am**

Procedure SHFileOp_CreateMemFileList(*fn.s()) <|======= Erreur de syntaxe dans les paramètres de la procédure

Aidez-moi !!!

Merci

Posted: **Sat May 12, 2012 11:30 am**

NY152 wrote:Procedure SHFileOp_CreateMemFileList(*fn.s()) <|======= Erreur de syntaxe dans les paramètres de la procédure

Aidez-moi !!!

Merci

Code: Select all

;-
;- Wrapper for SHFileOperation_()
;- Writte for PB4 by Wayne-C
;- Works with Unicode!
;-

Procedure SHFileOp_CreateMemFileList(List *fn.s())
  Protected size.l= 0
  Protected *mem.l= 0
  Protected xpos.l= 0
  ForEach *fn()
    size+ StringByteLength(*fn()) + SizeOf(Character)
  Next
  size+ 2 * SizeOf(Character)
  *mem= AllocateMemory(size)
  If *mem
    ForEach *fn()
      PokeS(*mem + xpos, *fn())
      xpos+ StringByteLength(*fn()) + SizeOf(Character)
    Next
    ProcedureReturn *mem
  EndIf
  ProcedureReturn 0
EndProcedure

Procedure SHFileOp_CopyOrMoveToFolder(hwnd.l, List *fnSrc.s(), DestFolder.s, delSource.l)
  ;-
  ;- hwnd: WindowID() of parent window (for the progress dialog)
  ;- delSource: 0=COPY, 1=MOVE
  ;-
  Protected *src.l= 0
  Protected NewList fnDst.s()
  Protected *dst.l= 0
  Protected fos.SHFILEOPSTRUCT
  Protected rv.l= 0
  AddElement(fnDst()): fnDst()= DestFolder
  *src= SHFileOp_CreateMemFileList(*fnSrc())
  *dst= SHFileOp_CreateMemFileList(fnDst())
  If *src And *dst
    fos\hwnd= hwnd
    fos\pFrom= *src
    fos\pTo= *dst
    fos\fFlags= #FOF_ALLOWUNDO
    If delSource
      fos\wFunc= #FO_MOVE
    Else
      fos\wFunc= #FO_COPY
    EndIf
    rv= SHFileOperation_(@fos)
    FreeMemory(*dst)
    FreeMemory(*src)
  EndIf
  ProcedureReturn rv
EndProcedure

Procedure SHFileOp_CopyToFolder(hwnd.l, List *fnSrc.s(), DestFolder.s)
  ProcedureReturn SHFileOp_CopyOrMoveToFolder(hwnd, *fnSrc(), DestFolder, 0)
EndProcedure

;- Copy to folder demo
NewList SrcFileNames.s()
AddElement(SrcFileNames()): SrcFileNames()= "C:\test\a.txt"
AddElement(SrcFileNames()): SrcFileNames()= "C:\test\b.txt"
SHFileOp_CopyToFolder(0, SrcFileNames(), "C:\test\backup")

PureBasic Forums - English

CopyFile with Progress?

CopyFile with Progress?

Re: CopyFile with Progress?

Re: CopyFile with Progress?