Seite 1 von 2

Kopieren von Dateien !

Verfasst: 14.03.2018 12:15
von silbersurfer
Hallo Leute,

habe mal wieder eine Frage, zu meinen derzeitigen Projekt.
Ich habe eine Kopierprocedure geschrieben die auch funzt nur sind ein paar Dinge die mich noch stören !
  • 1. das event handling
  • 2. im eigenen Thread aber wie ?
  • 3. der Progressbar funzt nicht richtig warum?
habe einiges über copyfiles gefunden, aber irgendwie blick ich da nicht ganz durch,
zumal ich mit Threads noch nie was gemacht habe, und mir im moment der richtige Ansatz dazu fehlt.

Ich hoffe das ihr mir da auch wieder weiterhelfen könnt

Code: Alles auswählen

Procedure DatenKopieren(Dummy_copy.s,Move=#False)
	If Dummy_copy
		result=  MessageRequester("Kopieren von Dateien!", "Sollen die Datein Kopiert werden ? "+Chr(10)+"von:"+Quellenfolder+" nach "+Destanationfolder ,#PB_MessageRequester_YesNo)
	Else 
		MessageRequester("Achtung !","Keine Dateien zum kopieren ausgwählt !" ,#PB_MessageRequester_Ok)
	EndIf 	
	If result=#PB_MessageRequester_Yes
		OpenFortschritt_Anzeige()
		DisableWindow(Pure_Commander,1)
		SetGadgetAttribute(#Fortschritt,1,#PB_ProgressBar_Minimum)
		SetGadgetAttribute(#Fortschritt,Get_listanzahl(Dummy_copy),#PB_ProgressBar_Maximum )
		For i=1 To Get_listanzahl(Dummy_copy)
			event=WindowEvent()
			Fortschritt_Anzeige_Events(event)
			Debug Quellenfolder+Get_listeintrag(Dummy_copy,i)+ "  "+Destanationfolder+Get_listeintrag(Dummy_copy,i)
			;überprüfen ob der Selektierte Eintrag eine File oder Verzeichnis ist 
			If FileSize(Quellenfolder+Get_listeintrag(Dummy_copy,i))>0 ; wenn eine File dann
				If CopyFile(Quellenfolder+Get_listeintrag(Dummy_copy,i) ,Destanationfolder+Get_listeintrag(Dummy_copy,i)) ; wenn Copiervorgang erfolgreich dann
					SetGadgetState (#Fortschritt,i)
					SetGadgetText (#Kopiertext,Get_listeintrag(Dummy_copy,i))
					If Move=1 ;Prüfen ob ausschneiden ausgewählt wurde
						DeleteFile(Quellenfolder+Get_listeintrag(Dummy_copy,i))
					EndIf   
				EndIf   
			ElseIf FileSize(Quellenfolder+Get_listeintrag(Dummy_copy,i))=-2 ; wenn ein Verzeichnis dann
				If CopyDirectory(Quellenfolder+Get_listeintrag(Dummy_copy,i),Destanationfolder+Get_listeintrag(Dummy_copy,i),"",#PB_FileSystem_Recursive) ; wenn Copiervorgang erfolgreich dann
					SetGadgetState (#Fortschritt,i)
					SetGadgetText (#Kopiertext,Get_listeintrag(Dummy_copy,i))					
					If Move=1 ;Prüfen ob ausschneiden ausgewählt wurde
						DeleteDirectory(Quellenfolder+Get_listeintrag(Dummy_copy,i),"",#PB_FileSystem_Recursive)
					EndIf              
				EndIf   
			EndIf
		Next 
		CloseWindow(Fortschritt_Anzeige)
		DisableWindow(Pure_Commander,0)
	EndIf 
EndProcedure
Gruß Silbersurfer

Re: Kopieren von Dateien !

Verfasst: 14.03.2018 13:17
von ts-soft
Nimm einfach meine Routine oder guck dir was ab: http://www.purebasic.fr/english/viewtop ... 81#p439881

Ist von 2014, sollte aber noch laufen.

Re: Kopieren von Dateien !

Verfasst: 14.03.2018 13:42
von silbersurfer
@ts-soft
Nimm einfach meine Routine oder guck dir was
die hatte ich mir schon angeschaut, aber so wie das aussieht kopiert diese nur Folder, oder habe ich was übersehen ?
wie kann ich deiner Routine eine liste an dateien übergeben?

Re: Kopieren von Dateien !

Verfasst: 14.03.2018 14:05
von ts-soft
Dann nehm den: http://www.purebasic.fr/german/viewtopi ... 03#p320903
Progress ist aber ungenauer.

Re: Kopieren von Dateien !

Verfasst: 14.03.2018 17:54
von mk-soft
Es sollte im Programm immer nur ein Event-Loop geben. Und dieser sollte nie in einem Thread sein.
Das führt sonst mit Garantie zu Problemen. Um aus Threads Gadget zu bearbeiten oder Ereignisse im Event-Loop auszulösen wurde PostEvent eingeführt. Mit diesen man aus einen oder mehreren Thread mit den Event-Loop im Hauptprogramm kommunizieren.

Da ich viel mit Threads arbeite, habe ich mir eine Modul geschrieben womit ich aus Threads Gadgets ändern und Requester verwenden kann...

Somit kannst du alles in einem Thread auslagern. Ausser das Erstellen von Fenstern. Diese müssen immer im Hauptprogramm erstellt werden.
Musst nur noch darauf achten das der Thread nicht zwei mal gestartet werden kann.

Link: ThreadToGUI

Beispiel

Code: Alles auswählen

;-TOP

; Example ThreadToGUI Requester

IncludeFile "Modul_ThreadToGUI.pb"

Enumeration
  #Window
EndEnumeration

Enumeration
  #List
EndEnumeration

;- Constants
Enumeration #PB_Event_FirstCustomValue
  #My_DoEvent
EndEnumeration

Procedure Test(Null)
  
  Protected result, path.s, message$
  
  UseModule ThreadToGUI
  
  DoAddGadgetItem(#List, -1, "Start Thread")
  Delay(500)
  path = DoOpenFileRequester("OpenFileRequester", "/", "", 0, #PB_Requester_MultiSelection)
  DoAddGadgetItem(#List, -1, "OpenFile: " + path)
  While path
    path = DoNextSelectedFileName()
    If path
      DoAddGadgetItem(#List, -1, "OpenFile: " + path)
    EndIf
  Wend
  result = DoFontRequester("Arial", 12, 0, #Red, #PB_Font_Bold)
  If Result
    Message$ = "Selected Font:"
    DoAddGadgetItem(#List, -1, message$)
    Message$ = "Name:  " + DoSelectedFontName()
    DoAddGadgetItem(#List, -1, message$)
    Message$ = "Size: " + Str(DoSelectedFontSize())
    DoAddGadgetItem(#List, -1, message$)
    Message$ = "Color: " + Str(DoSelectedFontColor())
    DoAddGadgetItem(#List, -1, message$)
    message$ = "Style "
    If DoSelectedFontStyle() & #PB_Font_Italic
      Message$ + "/ Italic"
    EndIf
    If DoSelectedFontStyle() & #PB_Font_Bold
      Message$ + " / Bold"
    EndIf
    If DoSelectedFontStyle() & #PB_Font_StrikeOut
      Message$ + " / StrikeOut"
    EndIf
    If DoSelectedFontStyle() & #PB_Font_Underline
      Message$ + " / Underline"
    EndIf
    DoAddGadgetItem(#List, -1, message$)
  Else 
    Message$ = "Cancel."
    DoAddGadgetItem(#List, -1, message$)
  EndIf
  DoAddGadgetItem(#List, -1, "Exit Thread")
  
EndProcedure

If OpenWindow(#Window, 0, 0, 600, 400, "Example Requester", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
  ListViewGadget(#List, 0, 0, 600, 400)
  
  UseModule ThreadToGUI
  
  BindEventGUI(#My_DoEvent)
  hThread = CreateThread(@Test(), #Null)
  
  Repeat
    
    Select WaitWindowEvent()
        
      Case #PB_Event_CloseWindow
        exit = 1
        
    EndSelect
    
  Until exit
  If IsThread(hThread)
    Debug "Thread läuft"
    KillThread(hThread)
  EndIf
  
EndIf

Re: Kopieren von Dateien !

Verfasst: 14.03.2018 18:17
von mk-soft
Zu Threads...

Um mehrere Parameter in einen Thread zu übergeben kann man dies über einen Zeiger auf die Parameter lösen.

Code: Alles auswählen

;-TOP
; Parameter an Thread übergeben

Structure sMyThread
  ; Header
  *ThreadID
  ; Parameter
  iVal.i
  sVal.s
EndStructure

Procedure thMyThread(*This.sMyThread) ; Ein Thread hat immer ein Parameter
  
  Debug "MyThread ID: " + *This\ThreadID
  Debug "iVal: " + *This\iVal
  Debug "sVal: " + *This\sVal
  Delay(100)
  
EndProcedure

Global MyTheadData.sMyThread

With MyTheadData
  \iVal = 100
  \sVal = "Hallo Welt!"
  \ThreadID = CreateThread(@thMyThread(), @MyTheadData) ; Thread starten mit den Zeiger auf die Parameter
EndWith

Delay(1000)

Re: Kopieren von Dateien !

Verfasst: 15.03.2018 13:44
von silbersurfer
Danke ts-soft,
da muß ich mich jetzt erst einmal durcharbeiten, ist viel Code und viel neues für mich

@mk-soft
Um mehrere Parameter in einen Thread zu übergeben kann man dies über einen Zeiger auf die Parameter lösen.
Danke mk-soft,
ich sehe schon, dass ich mich mit Threads mehr auseinandersetzen muß.

Hier mein erster versuch, von einen Asynchronen Extrahieren der Icons/Info mit ListIconGadget und Thread
schaut mal drüber ob das so überhaupt so richtig ist ?
der Code macht es wie ich es mir gedacht habe, die frage ist dieser so auch sicher (wegen Threads)

Code: Alles auswählen

EnableExplicit

Structure Datei
   Datei.s
   Adatum.s
   Dsize.i
   Typ.s
   ImageID.i
   Icon.i
EndStructure

Structure sGadget
	Gadget.i
	Pfad.s
EndStructure	

NewList Dateien.Datei()
NewList Verzeichnis.Datei()
Define ListIconGadget.i
Define FolderIcon
Define Draw
;Folder Icon Extractieren
ExtractIconEx_("shell32.dll",3,0,@FolderIcon, 1)
CreateImage(1,32,32)
Draw = StartDrawing(ImageOutput(1))
Box(0,0,32,32,RGB(255,255,255))
DrawIcon_(Draw,0,0,FolderIcon)
StopDrawing()

;Thread Procedure für Icon / Info Extract der Dateien
Procedure IconsUndInfoerfassen		(*this.sGadget)
	Shared Verzeichnis(),Dateien()
	Protected info.SHFILEINFO, Icon.SHFILEINFO,zeiger.i
	With *this
		ForEach Verzeichnis()
			SHGetFileInfo_(\Pfad+Verzeichnis()\Datei, #Null, @info.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_TYPENAME)
			SetGadgetItemImage(\Gadget, zeiger,Verzeichnis()\ImageID)
			SetGadgetItemText(\Gadget, zeiger, PeekS(@info\szTypeName,80) ,2)
			zeiger+1
		Next
		ForEach Dateien()
			SHGetFileInfo_(\Pfad+Dateien()\Datei, #Null, @info.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_TYPENAME)
			SHGetFileInfo_(Dateien()\Datei, #Null, @Icon, SizeOf(SHFILEINFO), #SHGFI_ICON|#SHGFI_SMALLICON|#SHGFI_USEFILEATTRIBUTES)
			SetGadgetItemImage(\Gadget,zeiger,Icon\hIcon)
			SetGadgetItemText(\Gadget, zeiger, PeekS(@info\szTypeName,80) ,2)
			; wichtig verhindert ein Handle overflow (gibt wieder alles frei)
			DestroyIcon_(Icon\hIcon)
			zeiger+1
		Next
	EndWith	
EndProcedure
     
Procedure Im_VerzeichnisEinlesen	(Gadget,Paht.s)
      Shared Verzeichnis(),Dateien()
      Protected  FileName.s
       If ExamineDirectory(0,paht, "*.*")
         ;einträge in Gadgetlist sowie Structlisten löschen
         ClearGadgetItems(gadget)
         ClearList(Verzeichnis())   :   ClearList(Dateien())
         ;Verzeichnis öffnen und einlesen
            While NextDirectoryEntry(0)
               FileName = DirectoryEntryName(0)
               ;Ordner in liste eintragen
               If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory And FileName<>"."
                  AddElement(Verzeichnis())
                  Verzeichnis()\Datei      =FileName
                  Verzeichnis()\Adatum   =FormatDate("%dd.%mm.%yyyy",DirectoryEntryDate(0,#PB_Date_Modified))
                  ;Verzeichnis()\Typ      =PeekS(@info\szTypeName,80)
                  Verzeichnis()\ImageID=ImageID(1)
               ;dateien im liste eintragen   
               ElseIf FileName<>"."
                  AddElement(Dateien())
                  Dateien()\Datei         =FileName
                  Dateien()\Adatum      =FormatDate("%dd.%mm.%yyyy",DirectoryEntryDate(0,#PB_Date_Modified))
                  ;Dateien()\Typ              =PeekS(@info\szTypeName,80)
                  Dateien()\Dsize         =DirectoryEntrySize(0)/1024+1
                  ;Dateien()\ImageID      =Icon\hIcon
               EndIf
            Wend
         ;Ordner und Dateienliste sortieren
         SortStructuredList(Verzeichnis()   , #PB_Sort_Ascending, OffsetOf(Datei\Datei), TypeOf(Datei\Datei))
         SortStructuredList(Dateien()         , #PB_Sort_Ascending, OffsetOf(Datei\Datei), TypeOf(Datei\Datei))
         ;listen übergeben an das ListGadget
         SendMessage_(GadgetID(Gadget), #WM_SETREDRAW, #False, 0)
         ForEach Verzeichnis()
            AddGadgetItem(gadget, -1,Verzeichnis()\Datei+Chr(10)+Verzeichnis()\Adatum+Chr(10)+Verzeichnis()\Typ,Verzeichnis()\ImageID)
         Next
         ForEach Dateien()  
            AddGadgetItem(gadget, -1,  Dateien()\Datei+Chr(10)+Dateien()\Adatum+Chr(10)+Dateien()\Typ+Chr(10)+Str(Dateien()\Dsize)+" kb")
         Next
         SendMessage_(GadgetID(Gadget), #WM_SETREDRAW, #True, 0)
      Else
         ;falls das verzeichnis gelesen werden kann
         MessageRequester("Error","Kann das angebene Verzeichnis nicht öffnen: "+paht,0)
       EndIf         
EndProcedure
   
If OpenWindow(0, 100, 200, 500, 400, "PureBasic - FileSystem Example mit Iconextract / Filetypenextract",#PB_Window_ScreenCentered | #PB_Window_SystemMenu)   
   StringGadget  (0,  5, 10, 425, 24, "C:\Windows\System32\")
   ButtonGadget  (1, 435, 10, 60 , 24, "List")
     ListIconGadget=ListIconGadget(#PB_Any, 5, 40, 490, 350, "Name", 200, #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection)
   AddGadgetColumn(ListIconGadget, 1, "Änderungsdatum", 100)
   AddGadgetColumn(ListIconGadget, 2, "Typ", 90)
   AddGadgetColumn(ListIconGadget, 3, "Größe", 80)   
   Repeat
      Define Event = WaitWindowEvent()
      Define *this.SGadget   
      If Event = #PB_Event_Gadget
      	If EventGadget() = 1
      		Im_VerzeichnisEinlesen(ListIconGadget,GetGadgetText(0))
      		;Thread aufruf 
      		*this.sGadget = AllocateMemory(SizeOf(sGadget))
      		*this\Gadget=ListIconGadget
      		*this\Pfad=GetGadgetText(0)
      		Define icons=CreateThread(@IconsUndInfoerfassen(),*this)
         EndIf
      EndIf
   Until Event = #PB_Event_CloseWindow
EndIf
End 
Gruß Silbersurfer

Re: Kopieren von Dateien !

Verfasst: 15.03.2018 13:58
von NicTheQuick
Ich kann es zwar unter Linux nicht testen, aber auch ohne es getestet zu haben kann ich sagen, dass du keine Gadgets innerhalb eines Threads ändern solltest. Nutze dafür PostEvent(). Ein Beispiel dafür gibt es in der Hilfe.

Re: Kopieren von Dateien !

Verfasst: 15.03.2018 15:21
von mk-soft
Gadget, Menu, Statusbar, etc über Threads ändern geht unter Linux und Mac überhaupt nicht (Crash). Unter Windows Teilweise.

Arbeite daher immer mit PostEvent, damit es auf allen OS funktioniert. (Modul_ThreadToGUI)

Re: Kopieren von Dateien !

Verfasst: 15.03.2018 15:57
von mk-soft
P.S. Habe ich zwar schon fertig. Könnte aber mit PostEvent auch so aussehen...

Update v0.02

Code: Alles auswählen

;-TOP

; -----------------------------------------------------------------------------

CompilerIf #PB_Compiler_Thread = 0
  CompilerError "Option Threadsafe aktivieren"
CompilerEndIf

Enumeration #PB_Event_FirstCustomValue ; + 1000
  #MyEvent_SetGadgetItemImage
  #MyEvent_SetGadgetItemText
EndEnumeration

Structure udtSetGadgetItemImage
  Gadget.i
  Item.i
  ImageID.i
EndStructure

Structure udtSetGadgetItemText
  Gadget.i
  Item.i
  Text.s
  Column.i
EndStructure

Procedure thSetGadgetItemImage(Gadget, Item, ImageID)
  Protected *data.udtSetGadgetItemImage
  With *data
    *data = AllocateStructure(udtSetGadgetItemImage)
    If *data
      \Gadget = Gadget
      \Item = Item
      \ImageID = ImageID
      PostEvent(#MyEvent_SetGadgetItemImage, 0, 0, 0, *data)
    EndIf
  EndWith
EndProcedure

Procedure DispatchSetGadgetItemImage()
  Protected *data.udtSetGadgetItemImage
  With *data
    *data = EventData()
    If *data
      If IsGadget(\Gadget)
        SetGadgetItemImage(\Gadget, \Item, \ImageID)
      EndIf
      FreeStructure(*data)
    EndIf
  EndWith
EndProcedure

Procedure thSetGadgetItemText(Gadget, Item, Text.s, Column=-1)
  Protected *data.udtSetGadgetItemText
  With *data
    *data = AllocateStructure(udtSetGadgetItemText)
    If *data
      \Gadget = Gadget
      \Item = Item
      \Text = Text
      \Column = Column
      PostEvent(#MyEvent_SetGadgetItemText, 0, 0, 0, *data)
    EndIf
  EndWith
EndProcedure

Procedure DispatchSetGadgetItemText()
  Protected *data.udtSetGadgetItemText
  With *data
    *data = EventData()
    If *data
      If IsGadget(\Gadget)
        If \Column >= 0
          SetGadgetItemText(\Gadget, \Item, \Text, \Column)
        Else
          SetGadgetItemText(\Gadget, \Item, \Text)
        EndIf
      EndIf
      FreeStructure(*data)
    EndIf
  EndWith
EndProcedure

BindEvent(#MyEvent_SetGadgetItemImage, @DispatchSetGadgetItemImage())
BindEvent(#MyEvent_SetGadgetItemText, @DispatchSetGadgetItemText())

; -----------------------------------------------------------------------------
Jetzt einfach "th" vor SetGadget... schreiben und fertig