Hier aber mit möglichst wendig Code.
Link EN: Mini Thread Control
Update v1.08
- Code bereinigt
- Kommentare in DE
Code: Alles auswählen
;-TOP
;- Begin Mini Thread Control
; by mk-soft, Version 1.08, 20.10.2019, Update examples 21.07.2020
CompilerIf Not #PB_Compiler_Thread
CompilerError "Use Compiler-Option ThreadSafe!"
CompilerEndIf
; Struktur über dem der Thread gesteuert wird.
; Diese Struktur wird immer mit Extends an die eigene Daten Stuktur erweitern.
; Die muss immer mit Extends als letzte Stuktur hingefügt werden,
; damit diese immer ganz oben steht.
Structure udtThreadControl
ThreadID.i
UserID.i
Signal.i
Pause.i
Exit.i
EndStructure
; Erstellt einen neuen Thread.
; Das Ergebnis ist umgleich null wenn der Thread erfolgreich angelegt wurde
Procedure StartThread(*Data.udtThreadControl, *Procedure) ; ThreadID
If Not IsThread(*Data\ThreadID)
*Data\Exit = #False
*Data\Pause = #False
*Data\ThreadID = CreateThread(*Procedure, *Data)
EndIf
ProcedureReturn *Data\ThreadID
EndProcedure
; Stop einen existierenden Thread. Sollte der Thread in Pause sein, wird vorher
; mit einen Signal die Pause beendet
Procedure StopThread(*Data.udtThreadControl, Wait = 1000) ; Void
If IsThread(*Data\ThreadID)
*Data\Exit = #True
If *Data\Pause
*Data\Pause = #False
SignalSemaphore(*Data\Signal)
EndIf
If Wait
If WaitThread(*Data\ThreadID, Wait) = 0
KillThread(*Data\ThreadID)
EndIf
*Data\ThreadID = 0
*Data\Pause = #False
*Data\Exit = #False
If *Data\Signal
FreeSemaphore(*Data\Signal)
*Data\Signal = 0
EndIf
EndIf
EndIf
EndProcedure
; Gibt den Speicher für den Thread frei. Sollte dieser noch laufen, wird dieser erst gestoppt.
Procedure FreeThread(*Data.udtThreadControl, Stop = #True, Wait = 1000) ; True or False
If IsThread(*Data\ThreadID)
If Stop
StopThread(*Data, Wait)
FreeStructure(*Data)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
Else
If *Data\Signal
FreeSemaphore(*Data\Signal)
EndIf
FreeStructure(*Data)
ProcedureReturn #True
EndIf
EndProcedure
; Hält den Thread an. Dafür wird ein Semaphore erstellt auf dem der Thread warten kann.
Procedure ThreadPause(*Data.udtThreadControl) ; Void
If IsThread(*Data\ThreadID)
If Not *Data\Signal
*Data\Signal = CreateSemaphore()
EndIf
If Not *Data\Pause
*Data\Pause = #True
EndIf
EndIf
EndProcedure
; Setzt den Thread fort, wenn dieser angehalten wurde. Dazu wird über Semaphore ein Signal ausgelöst.
Procedure ThreadResume(*Data.udtThreadControl) ; Void
If IsThread(*Data\ThreadID)
If *Data\Pause
*Data\Pause = #False
SignalSemaphore(*Data\Signal)
EndIf
EndIf
EndProcedure
;- End Mini Thread Control
; ****
; Example 1: Multi Threads
; Example 2: RunProgram
; Example 3: Send string from thread to GUI
#Example = 3
;- Example 1
CompilerIf #Example = 1
Enumeration #PB_Event_FirstCustomValue
#MyEvent_ThreadFinished
EndEnumeration
Enumeration Gadget
#ButtonStart1
#ButtonStart2
#ButtonPauseResume1
#ButtonPauseResume2
#ButtonStop1
#ButtonStop2
EndEnumeration
Structure udtFileData
Name.s
Result.s
EndStructure
; Hier die Struktur für alle erforderlich zu bearbeiteten Daten definieren
; Mit Extends die eigene Stuktur mit der Struktur von Thread Control erweitern
; Extends setzt immer die zu erweiterten Stuktur an den Anfang der Struktur
Structure udtThreadData Extends udtThreadControl
; Data
Window.i
Event.i
List Files.udtFileData()
EndStructure
; ----------
Procedure MyThread(*Data.udtThreadData)
Protected c
With *Data
Debug "Init Thread " + \UserID
; TODO
; Daten vorbereiten
Delay(500)
Debug "Start Thread " + \UserID
; TODO
; Hier beginnt die zyklische Schleife (For .. next, Repeat .. forever, etc)
ForEach \Files()
; 1. Abfragen ob der Thread in Pause gehen soll
If \Pause
Debug "Pause Thread " + \UserID
; TODO
; Hier die Bearbeitung bevor der Thread in Pause gehen kann
; Hier wartet der Thread auf ein Signal zum fortsetzen
WaitSemaphore(\Signal)
; Abfragen ob der Thread nach der Pause sofort beendet werde soll
If \Exit
Break ; Hier wird beim beenden die Schleife verlassen
EndIf
Debug "Resume Thread " + \UserID
; TODO
; Hier die Bearbeitung bevor der Threads forgesetzt werden kann
EndIf
; 2. Abfragen ob der Thread beendet werden soll
If \Exit
Break ; Hier wird beim vorzeitigen beenden die Schleife verlassen
EndIf
; TODO
; Hier die Daten bearbeiten.
; Aber immer nur ein Datensatz und keine Endlos Schleifen. Sonst reagiert der Thread nicht mehr.
Debug "Busy Thread " + \UserID + ": File " + \Files()\Name
Delay(500)
\Files()\Result = "Ready."
Next
; Hier endet die zyklische Schleife
If \Exit
; TODO
; Hier die Berbeitung bei vorzeitigen beenden des Threads
Debug "Cancel Thread " + \UserID
Else
; TODO
; Hier die Bearbeitung bei normalen beenden des Threads
Debug "Shutdown Thread " + \UserID
PostEvent(\Event, \Window, 0, 0, *Data) ; <- EventData = Pointer to ThreadData
EndIf
Debug "Exit Thread " + \UserID
; Hier die globale Bearbeitung beim beenden des Threads
; 3. Die eigene ThreadID löschen. Letzte Aufgabe des Threads
\ThreadID = 0
EndWith
EndProcedure
; ----------
; Die Daten für den Thread immer mit AllocateStructure anlegen,
; damit FreeThread die Daten auch wieder löschen kann.
Global *th1.udtThreadData = AllocateStructure(udtThreadData)
*th1\UserID = 1
*th1\Window = 1
*th1\Event = #MyEvent_ThreadFinished
For i = 10 To 30
AddElement(*th1\Files())
*th1\Files()\Name = "Data_" + i
Next
Global *th2.udtThreadData = AllocateStructure(udtThreadData)
*th2\UserID = 2
*th2\Window = 1
*th2\Event = #MyEvent_ThreadFinished
For i = 31 To 60
AddElement(*th2\Files())
*th2\Files()\Name = "Data_" + i
Next
; Output Data
Procedure Output(*Data.udtThreadData)
Debug "Thread Finished UserID " + *Data\UserID
MessageRequester("Thread Message", "Thread Finished UserID " + *Data\UserID)
ForEach *Data\Files()
Debug *Data\Files()\Name + " - Result " + *Data\Files()\Result
Next
EndProcedure
If OpenWindow(1, 0, 0, 222, 250, "Mini Thread Control", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(#ButtonStart1, 10, 10, 200, 30, "Start 1")
ButtonGadget(#ButtonStart2, 10, 50, 200, 30, "Start 2")
ButtonGadget(#ButtonPauseResume1, 10, 90, 200, 30, "Pause 1")
ButtonGadget(#ButtonPauseResume2, 10, 130, 200, 30, "Pause 2")
ButtonGadget(#ButtonStop1, 10, 170, 200, 30, "Stop 1")
ButtonGadget(#ButtonStop2, 10, 210, 200, 30, "Stop 2")
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
FreeThread(*th1)
FreeThread(*th2)
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #ButtonStart1
StartThread(*th1, @MyThread())
Case #ButtonStart2
StartThread(*th2, @MyThread())
Case #ButtonPauseResume1
If IsThread(*th1\ThreadID)
If Not *th1\Pause
ThreadPause(*th1)
SetGadgetText(#ButtonPauseResume1, "Resume 1")
Else
ThreadResume(*th1)
SetGadgetText(#ButtonPauseResume1, "Pause 1")
EndIf
EndIf
Case #ButtonPauseResume2
If IsThread(*th2\ThreadID)
If Not *th2\Pause
ThreadPause(*th2)
SetGadgetText(#ButtonPauseResume2, "Resume 2")
Else
ThreadResume(*th2)
SetGadgetText(#ButtonPauseResume2, "Pause 2")
EndIf
EndIf
Case #ButtonStop1
StopThread(*th1)
SetGadgetText(#ButtonPauseResume1, "Pause 1")
Case #ButtonStop2
StopThread(*th2)
SetGadgetText(#ButtonPauseResume2, "Pause 2")
EndSelect
Case #MyEvent_ThreadFinished
Output(EventData())
EndSelect
ForEver
EndIf
CompilerEndIf
;- Example 2
CompilerIf #Example = 2
Enumeration #PB_Event_FirstCustomValue
#MyEvent_ThreadFinished
EndEnumeration
Enumeration Gadget
#ButtonStart1
#ButtonPauseResume1
#ButtonStop1
EndEnumeration
; Extends always own data structure with structure from thread control
Structure udtThreadData Extends udtThreadControl
; Data
Window.i
Event.i
Output.s
EndStructure
Procedure MyThread(*Data.udtThreadData)
Protected Compiler, Output.s
With *Data
Debug "Init Thread " + \UserID
;- Begin Thread init
url.s = "Item1"+#LF$+"Item2"+#LF$
;Compiler = RunProgram(#PB_Compiler_Home+"./php", "-r 'echo rawurlencode(" + url + ").PHP_EOL;'", "", #PB_Program_Open | #PB_Program_Read)
Compiler = RunProgram(#PB_Compiler_Home+"/Compilers/pbcompiler", "-h", "", #PB_Program_Open | #PB_Program_Read)
Output = ""
;- End Thread init
Debug "Start Thread " + \UserID
;- Begin Thread loop
If Compiler
While ProgramRunning(Compiler)
; 1. Query on thread pause
If \Pause
Debug "Pause Thread " + \UserID
WaitSemaphore(\Signal)
; Query on thread cancel
If \Exit
Break ; Exit Thread loop
EndIf
Debug "Resume Thread " + \UserID
EndIf
; 2. Query on thread cancel
If \Exit
Break ; Exit Thread loop
EndIf
; Input
If AvailableProgramOutput(Compiler)
Output + ReadProgramString(Compiler) + Chr(13)
Else
Delay(10)
EndIf
Wend
Output + Chr(13) + Chr(13)
Output + "Exitcode: " + Str(ProgramExitCode(Compiler))
CloseProgram(Compiler) ; Close the connection to the program
Else
Output = "Error - Programm konnte nicht gestartet werden!"
EndIf
;- End Thread lopp
If \Exit
;- TODO Thread Cancel
Debug "Cancel Thread " + \UserID
\Output = "Error - Thread vom user abgebrochen!"
Else
;- TODO Thread Finished
Debug "Shutdown Thread " + \UserID
\Output = Output
PostEvent(\Event, \Window, 0, 0, *Data) ; <- EventData = Pointer to ThreadData
EndIf
Debug "Exit Thread " + \UserID
; 3. Clear ThreadID
\ThreadID = 0
EndWith
EndProcedure
; Create Data always with AllocateStructure
Global *th1.udtThreadData = AllocateStructure(udtThreadData)
*th1\UserID = 1
*th1\Window = 1
*th1\Event = #MyEvent_ThreadFinished
; Output Data
Procedure Output(*Data.udtThreadData)
Debug "Thread Finished UserID " + *Data\UserID
MessageRequester("Thread Message", "Thread Finished " + #LF$ + #LF$ + *Data\Output)
EndProcedure
If OpenWindow(1, 0, 0, 222, 250, "Mini Thread Control", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(#ButtonStart1, 10, 10, 200, 30, "Start 1")
ButtonGadget(#ButtonPauseResume1, 10, 90, 200, 30, "Pause 1")
ButtonGadget(#ButtonStop1, 10, 170, 200, 30, "Stop 1")
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
FreeThread(*th1)
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #ButtonStart1
StartThread(*th1, @MyThread())
Case #ButtonPauseResume1
If IsThread(*th1\ThreadID)
If Not *th1\Pause
ThreadPause(*th1)
SetGadgetText(#ButtonPauseResume1, "Resume 1")
Else
ThreadResume(*th1)
SetGadgetText(#ButtonPauseResume1, "Pause 1")
EndIf
EndIf
Case #ButtonStop1
StopThread(*th1)
SetGadgetText(#ButtonPauseResume1, "Pause 1")
EndSelect
Case #MyEvent_ThreadFinished
Output(EventData())
EndSelect
ForEver
EndIf
CompilerEndIf
;- Example 3
CompilerIf #Example = 3
; ---- String Helper ----
Procedure AllocateString(String.s) ; Result = Pointer
Protected *mem.string = AllocateStructure(String)
If *mem
*mem\s = String
EndIf
ProcedureReturn *mem
EndProcedure
Procedure.s FreeString(*mem.string) ; Result String
Protected r1.s
If *mem
r1 = *mem\s
FreeStructure(*mem)
EndIf
ProcedureReturn r1
EndProcedure
; ----
Enumeration #PB_Event_FirstCustomValue
#MyEvent_ThreadSendString
#MyEvent_ThreadFinished
EndEnumeration
Enumeration Gadget
#List
#ButtonStart1
#ButtonPauseResume1
#ButtonStop1
EndEnumeration
; Extends always own data structure with structure from thread control
Structure udtThreadData Extends udtThreadControl
; Data
Window.i
Event.i
EndStructure
Procedure MyThread(*Data.udtThreadData)
Protected cnt, stringdata.s
; Send string over PostEvent and parameter EventData
With *Data
stringdata = "Init Thread " + \UserID
PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
;TODO
Delay(500)
stringdata = "Start Thread " + \UserID
PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
;TODO
Repeat
; 1. Query on thread pause
If \Pause
stringdata = "Pause Thread " + \UserID
PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
WaitSemaphore(\Signal)
; Query on thread cancel
If \Exit
Break ; Exit Thread loop
EndIf
stringdata = "Resume Thread " + \UserID
PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
EndIf
; 2. Query on thread cancel
If \Exit
Break ; Exit Thread loop
EndIf
;TODO Cyle Process
cnt + 1
stringdata = "Busy Thread " + \UserID + ": Count " + cnt
PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
Delay(500)
ForEver
If \Exit
;TODO Thread Cancel
stringdata = "Cancel Thread " + \UserID
PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
Else
;TODO Thread Finished
stringdata = "Finished Thread " + \UserID
PostEvent(#MyEvent_ThreadSendString, \Window, 0, 0, AllocateString(stringdata))
EndIf
; 3. Clear ThreadID
\ThreadID = 0
EndWith
EndProcedure
; Create Data always with AllocateStructure
Global *th1.udtThreadData = AllocateStructure(udtThreadData)
*th1\UserID = 1
*th1\Window = 1
If OpenWindow(1, 50, 50, 600, 400, "Mini Thread Control", #PB_Window_SystemMenu)
ListViewGadget(#List, 5, 5, 590, 360)
ButtonGadget(#ButtonStart1, 5, 365, 120, 30, "Start")
ButtonGadget(#ButtonPauseResume1, 130, 365, 120, 30, "Pause")
ButtonGadget(#ButtonStop1, 255, 365, 120, 30, "Stop")
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
FreeThread(*th1)
Break
Case #PB_Event_Gadget
Select EventGadget()
Case #ButtonStart1
StartThread(*th1, @MyThread())
Case #ButtonPauseResume1
If IsThread(*th1\ThreadID)
If Not *th1\Pause
ThreadPause(*th1)
SetGadgetText(#ButtonPauseResume1, "Resume")
Else
ThreadResume(*th1)
SetGadgetText(#ButtonPauseResume1, "Pause")
EndIf
EndIf
Case #ButtonStop1
StopThread(*th1)
SetGadgetText(#ButtonPauseResume1, "Pause")
EndSelect
Case #MyEvent_ThreadSendString
; Receive string over event data
AddGadgetItem(#List, -1, FreeString(EventData()))
; Small trick to move last item
SetGadgetState(#List, CountGadgetItems(#List) - 1)
SetGadgetState(#List, -1)
EndSelect
ForEver
EndIf
CompilerEndIf