Seite 1 von 1

Datei Kopieren mit Fortschrittsanzeige und Abbrechen

Verfasst: 06.08.2009 14:12
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