Datei Kopieren mit Fortschrittsanzeige und Abbrechen

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
Kai
Beiträge: 264
Registriert: 29.09.2005 20:58
Computerausstattung: iMac 2019
Wohnort: Hannover
Kontaktdaten:

Datei Kopieren mit Fortschrittsanzeige und Abbrechen

Beitrag von Kai »

Hier mal ein Beispiel wie man mit dem API Befehl CopyFileEx_() eine Datei mit Fortschrittsanzeige und Abbruchmöglichkeit kopieren kann.
Nachteil: Läuft erst ab Windows NT laut MSDN!

Code: Alles auswählen

EnableExplicit

Enumeration 
  #Win_Main
EndEnumeration

Enumeration 
  #G_TX_Main_SourceFile
  #G_SR_Main_SourceFile
  #G_BN_Main_SourceFile
  #G_TX_Main_DestinationFile
  #G_SR_Main_DestinationFile
  #G_BN_Main_DestinationFile
  #G_TX_Main_Process
  #G_PB_Main_Process
  #G_BN_Main_Copy
EndEnumeration

Global iCancelCopy.i

Declare WinLoop(TimeOut = 0)

If OpenWindow(#Win_Main, 0, 0, 300, 150, "Datei Kopieren", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible)
  TextGadget(#G_TX_Main_SourceFile, 5, 5, WindowWidth(0) - 10, 15, "Quell-Datei:")
  StringGadget(#G_SR_Main_SourceFile, 5, 25, WindowWidth(0) - 40, 20, "", #PB_String_ReadOnly)
  ButtonGadget(#G_BN_Main_SourceFile, WindowWidth(0) - 30, 25, 25, 20, "...")
  TextGadget(#G_TX_Main_DestinationFile, 5, 60, WindowWidth(0) - 10, 15, "Ziel-Datei:")
  StringGadget(#G_SR_Main_DestinationFile, 5, 75, WindowWidth(0) - 40, 20, "", #PB_String_ReadOnly)
  ButtonGadget(#G_BN_Main_DestinationFile, WindowWidth(0) - 30, 75, 25, 20, "...")
  TextGadget(#G_TX_Main_Process, 5, WindowHeight(#Win_Main) - 45, WindowWidth(#Win_Main) - 10, 15, "")
  ProgressBarGadget(#G_PB_Main_Process, 5, WindowHeight(#Win_Main) - 30, WindowWidth(#Win_Main) - 95, 25, 0, 100)
  ButtonGadget(#G_BN_Main_Copy, WindowWidth(0) - 85, WindowHeight(0) - 30, 80, 25, "Kopieren")
EndIf

Procedure.s FormatByteSize(Size.q, RndCnt = 2, Ext = 1)
 If Size >= 0
  Protected sResult.s
  If Size > 1073741824  ;GigaByte
   sResult = StrF(Size / 1073741824, RndCnt)
   If Ext >= 1: sResult + " GB": EndIf
  ElseIf Size > 1048576 ;MegaByte
   sResult = StrF(Size / 1048576, RndCnt)
   If Ext >= 1: sResult + " MB": EndIf
  ElseIf Size > 1024    ;KiloByte
   sResult = StrF(Size / 1044, RndCnt)
   If Ext >= 1: sResult + " KB": EndIf
  Else                  ;Byte
   sResult = Str(Size)
   If Ext >= 1: sResult + " B": EndIf
  EndIf
  ProcedureReturn sResult
 EndIf
EndProcedure

Procedure CopyProgressRoutine(TotalFileSize.q, TotalBytesTransferred.q, StreamSize.q, StreamBytesTransferred.q, dwStreamNumber.i, dwCallbackReason.i, hSourceFile.i, hDestinationFile.i, lpData.i)
  Static qMBPerSecond.q, iTime.i
  
  If TotalBytesTransferred > 0
    SetGadgetState(#G_PB_Main_Process, TotalBytesTransferred * 100 / TotalFileSize)
    
    If timeGetTime_() - iTime >= 1000
      iTime = timeGetTime_()
      qMBPerSecond = TotalBytesTransferred - qMBPerSecond
      If qMBPerSecond > 0
        SetGadgetText(#G_TX_Main_Process, FormatByteSize(qMBPerSecond) + "/Sekunde - " + FormatByteSize(TotalFileSize - TotalBytesTransferred) + " Verbleibend")
      Else
        SetGadgetText(#G_TX_Main_Process, "Berechne Geschwindigkeit..")
      EndIf
      qMBPerSecond = TotalBytesTransferred
    EndIf
  EndIf 
  
  WinLoop(0)
  
  ProcedureReturn iCancelCopy
EndProcedure

Procedure StartCopyFile()
  Protected sSourceFile.s
  Protected sDestinationFile.s
  
  sSourceFile       = Trim(GetGadgetText(#G_SR_Main_SourceFile))
  sDestinationFile  = Trim(GetGadgetText(#G_SR_Main_DestinationFile))
  
  If FileSize(sSourceFile) > 0 And sDestinationFile <> ""
    iCancelCopy = 0
    DisableGadget(#G_BN_Main_SourceFile, 1)
    DisableGadget(#G_BN_Main_DestinationFile, 1)
    SetGadgetText(#G_BN_Main_Copy, "Abbrechen")
    
    CopyFileEx_(@sSourceFile, @sDestinationFile, @CopyProgressRoutine(), #Null, 0, 0)
    
    DisableGadget(#G_BN_Main_SourceFile, 0)
    DisableGadget(#G_BN_Main_DestinationFile, 0)
    SetGadgetText(#G_BN_Main_Copy, "Kopieren")
    If iCancelCopy = 0
      SetGadgetText(#G_SR_Main_SourceFile, "")
      SetGadgetText(#G_SR_Main_DestinationFile, "")
    EndIf
    SetGadgetState(#G_PB_Main_Process, 0)
    SetGadgetText(#G_TX_Main_Process, "")
  EndIf
  
EndProcedure

Procedure SetSourceFile()
  Protected sFile.s
  sFile = OpenFileRequester("Datei Kopieren..", GetCurrentDirectory(), "Alle Dateien|*.*", 0)
  If sFile
    SetGadgetText(#G_SR_Main_SourceFile, sFile)
  EndIf
EndProcedure

Procedure SetDestinationFile()
  Protected sFile.s, sDefaultFile.s
  sFile = SaveFileRequester("Datei Kopieren.. Nach", GetCurrentDirectory() + GetFilePart(GetGadgetText(#G_SR_Main_SourceFile)), "Alle Dateien|*.*", 0)
  If sFile
    SetGadgetText(#G_SR_Main_DestinationFile, sFile)
  EndIf
EndProcedure

HideWindow(#Win_Main, 0)

Procedure WinLoop(TimeOut = 0)
  Repeat
    Protected iWinEvent.i
    Protected iEventWin.i
    Protected iEventGadget.i
    Protected iEventMenu.i
    Protected iEventType.i
    
    iWinEvent     = WaitWindowEvent(TimeOut)
    iEventWin     = EventWindow()
    iEventGadget  = EventGadget()
    iEventMenu    = EventMenu()
    iEventType    = EventType()
    
    Select iWinEvent
      Case #PB_Event_Gadget
        Select iEventGadget
          Case #G_BN_Main_Copy
            If GetGadgetText(#G_BN_Main_Copy) = "Kopieren"
              StartCopyFile()
            Else
              iCancelCopy = 1
            EndIf
          Case #G_BN_Main_SourceFile
            SetSourceFile()
          Case #G_BN_Main_DestinationFile
            SetDestinationFile()
        EndSelect
      Case #PB_Event_CloseWindow
        Select iEventWin
          Case #Win_Main : End
        EndSelect
    EndSelect
  
  Until iWinEvent = 0
EndProcedure

Procedure Main()
  HideWindow(#Win_Main, 0)
  Repeat
    WinLoop(-1)
  ForEver
  End
EndProcedure
Main()
End
Meine Homepage - Aktuelle Projekte - Launcher
Letzte PB-Version - Window 7 x86