Hier mal ein etwas angepasster Code mit Mini Thread Control ...
Code: Alles auswählen
;-TOP
;- Begin Mini Thread Control
; by mk-soft, Version 1.08, 20.10.2019 - 29.04.2023
; Link: https://www.purebasic.fr/english/viewtopic.php?t=73231
; Example Update - 03.11.2024
CompilerIf Not #PB_Compiler_Thread
CompilerError "Use Compiler-Option ThreadSafe!"
CompilerEndIf
Structure udtThreadControl
ThreadID.i
UserID.i
Signal.i
Pause.i
Exit.i
EndStructure
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
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
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
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
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
;--- MacOS NapStop
CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
; Author : Danilo
; Date : 25.03.2014
; Link : https://www.purebasic.fr/english/viewtopic.php?f=19&t=58828
; Info : NSActivityOptions is a 64bit typedef - use it with quads (.q) !!!
#NSActivityIdleDisplaySleepDisabled = 1 << 40
#NSActivityIdleSystemSleepDisabled = 1 << 20
#NSActivitySuddenTerminationDisabled = (1 << 14)
#NSActivityAutomaticTerminationDisabled = (1 << 15)
#NSActivityUserInitiated = ($00FFFFFF | #NSActivityIdleSystemSleepDisabled)
#NSActivityUserInitiatedAllowingIdleSystemSleep = (#NSActivityUserInitiated & ~#NSActivityIdleSystemSleepDisabled)
#NSActivityBackground = $000000FF
#NSActivityLatencyCritical = $FF00000000
Procedure BeginWork(Option.q, Reason.s= "MyReason")
Protected NSProcessInfo = CocoaMessage(0,0,"NSProcessInfo processInfo")
If NSProcessInfo
ProcedureReturn CocoaMessage(0, NSProcessInfo, "beginActivityWithOptions:@", @Option, "reason:$", @Reason)
EndIf
EndProcedure
Procedure EndWork(Activity)
Protected NSProcessInfo = CocoaMessage(0, 0, "NSProcessInfo processInfo")
If NSProcessInfo
CocoaMessage(0, NSProcessInfo, "endActivity:", Activity)
EndIf
EndProcedure
CompilerEndIf
; ****
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
; ---- 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 CustomEvent #PB_Event_FirstCustomValue
#MyEvent_ThreadGetFilesString
#MyEvent_ThreadGetFilesDone
#MyEvent_ThreadGetFilesCancel
EndEnumeration
Enumeration Windows
#Main
EndEnumeration
Enumeration Menus
#MainMenu
EndEnumeration
Enumeration MenuItems
#MainExit
EndEnumeration
Enumeration StatusBar
#MainStatusBar
EndEnumeration
Enumeration Gadget
#List
#ButtonStart
#ButtonPauseResume
#ButtonStop
EndEnumeration
; Extends always own data structure with structure from thread control
Structure udtThreadFileData Extends udtThreadControl
; Data
cntRecursive.i
FirstPath.s
Path.s
Extension.s
List Files.s()
EndStructure
Procedure MyTheadGetFiles(*Data.udtThreadFileData)
Protected id, path.s, filename.s, stringdata.s
With *Data
If \cntRecursive > 0
path = \Path
Else
path = \FirstPath
EndIf
\cntRecursive + 1
PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString("Process: " + path))
id = ExamineDirectory(#PB_Any, path, "*.*")
If id
While NextDirectoryEntry(id)
; 1. Query on thread pause
If \Pause
stringdata = "Process: Pause Thread " + \UserID
PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString(stringdata))
WaitSemaphore(\Signal)
stringdata = "Process: Resume Thread " + \UserID
PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString(stringdata))
EndIf
; 2. Query on thread cancel
If \Exit
Break
EndIf
; 3. Cyle process one step
filename = DirectoryEntryName(id)
If filename <> "." And filename <> ".."
If DirectoryEntryType(id) = #PB_DirectoryEntry_File
If \Extension
If FindString(\Extension, GetExtensionPart(filename), -1, #PB_String_NoCase)
AddElement(\Files())
\Files() = path + filename
EndIf
Else
AddElement(\Files())
\Files() = path + filename
EndIf
Else
; Call recursive
Delay(5) ; Save Processor
\Path = path + filename + #PS$
MyTheadGetFiles(*Data)
EndIf
EndIf
Wend
FinishDirectory(id)
EndIf
\cntRecursive - 1
If \cntRecursive = 0
If \Exit
PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString("Process: Cancel."))
PostEvent(#MyEvent_ThreadGetFilesCancel, 0, 0, 0, *Data)
Else
PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString("Process: Sort Files."))
SortList(\Files(), #PB_Sort_Ascending | #PB_Sort_NoCase)
PostEvent(#MyEvent_ThreadGetFilesString, 0, 0, 0, AllocateString("Process: Done."))
PostEvent(#MyEvent_ThreadGetFilesDone, 0, 0, 0, *Data)
EndIf
\ThreadID = 0
EndIf
EndWith
EndProcedure
Procedure StartGetFiles(*Data.udtThreadFileData, Path.s, Extension.s = "")
If Not IsThread(*Data\ThreadID)
With *Data
If Right(path, 1) <> #PS$
path + #PS$
EndIf
\cntRecursive = 0
\FirstPath = Path
\Extension = LCase(Extension)
ClearList(\Files())
StartThread(*Data, @MyTheadGetFiles())
EndWith
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure UpdateWindow()
Protected dx, dy
dx = WindowWidth(#Main)
dy = WindowHeight(#Main) - MenuHeight() - StatusBarHeight(#MainStatusBar)
ResizeGadget(#List, 5, 5, dx - 10, dy - 45)
ResizeGadget(#ButtonStart, 5, dy - 35, 120, 30)
ResizeGadget(#ButtonPauseResume, 130, dy - 35, 120, 30)
ResizeGadget(#ButtonStop, 255, dy - 35, 120, 30)
EndProcedure
; Create Data always with AllocateStructure
Global *MyFileData.udtThreadFileData = AllocateStructure(udtThreadFileData)
Global path.s
Procedure Main()
Protected dx, dy
#WinStyle = #PB_Window_SystemMenu | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget
If OpenWindow(#Main, 50, 50, 600, 400, "Mini Thread Control", #WinStyle)
CreateMenu(#MainMenu, WindowID(0))
MenuTitle("&File")
MenuItem(#MainExit, "E&xit")
CreateStatusBar(#MainStatusBar, WindowID(#Main))
AddStatusBarField(#PB_Ignore)
dx = WindowWidth(#Main)
dy = WindowHeight(#Main) - MenuHeight() - StatusBarHeight(#MainStatusBar)
ListViewGadget(#List, 5, 5, dx - 10, dy - 45)
ButtonGadget(#ButtonStart, 5, dy - 35, 120, 30, "Start")
ButtonGadget(#ButtonPauseResume, 130, dy - 35, 120, 30, "Pause")
ButtonGadget(#ButtonStop, 255, dy - 35, 120, 30, "Stop")
BindEvent(#PB_Event_SizeWindow, @UpdateWindow(), 0)
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
FreeThread(*MyFileData)
Break
Case #PB_Event_Menu
Select EventMenu()
Case #MainExit
PostEvent(#PB_Event_CloseWindow, #Main, #Null)
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case #ButtonStart
If Not IsThread(*MyFileData\ThreadID)
path = PathRequester("Select Path", GetHomeDirectory())
If path
StartGetFiles(*MyFileData, path, "pdf;xml")
EndIf
EndIf
Case #ButtonPauseResume
If IsThread(*MyFileData\ThreadID)
If Not *MyFileData\Pause
ThreadPause(*MyFileData)
SetGadgetText(#ButtonPauseResume, "Resume")
Else
ThreadResume(*MyFileData)
SetGadgetText(#ButtonPauseResume, "Pause")
EndIf
EndIf
Case #ButtonStop
StopThread(*MyFileData)
SetGadgetText(#ButtonPauseResume, "Pause")
EndSelect
Case #MyEvent_ThreadGetFilesString
; Receive string over event data
StatusBarText(#MainStatusBar, 0, FreeString(EventData()))
Case #MyEvent_ThreadGetFilesDone
ForEach *MyFileData\Files()
AddGadgetItem(#List, -1, *MyFileData\Files())
; Small trick to move last item
SetGadgetState(#List, CountGadgetItems(#List) - 1)
SetGadgetState(#List, -1)
Next
Case #MyEvent_ThreadGetFilesCancel
;
EndSelect
ForEver
EndIf
EndProcedure : Main()
CompilerEndIf