Das deutsche PureBasic-Forum
http://forums.purebasic.com/german/
Code: Alles auswählen
...
Procedure Clone(*this.sUser)
Protected *clone.sUser
CloneObject(*this, *clone, sUser)
ProcedureReturn *clone
EndProcedure : AsMethode(Clone)
...
Code: Alles auswählen
;-TOP
; Example 9
CompilerIf #PB_Compiler_Thread = 0
CompilerError "Use compiler option theadsafe"
CompilerEndIf
IncludeFile "Modul_BaseClassSmall.pb"
DeclareModule Work
UseModule BaseClass
Structure sWork Extends sBaseClass
Value.i
EndStructure
Interface iWork Extends iBaseClass
Add(Value)
Sub(Value)
EndInterface
Declare New()
EndDeclareModule
Module Work
UseModule BaseClass
NewClass(iWork)
; ---------------------------------------------------------------------------
Procedure Init(*this.sWork)
Debug "Initialize Work"
EndProcedure : AsInitializeObject(Init)
; ---------------------------------------------------------------------------
Procedure Destroy(*this.sWork)
Debug "Dispose Work"
Debug "Result: " + *this\Value
EndProcedure : AsDisposeObject(Destroy)
; ---------------------------------------------------------------------------
Procedure Add(*this.sWork, Value)
Protected result
LockObject(*this)
*this\Value + Value
result = *this\Value
UnlockObject(*this)
ProcedureReturn result
EndProcedure : AsMethode(Add)
; ---------------------------------------------------------------------------
Procedure Sub(*this.sWork, Value = 0)
Protected result
LockObject(*this)
*this\Value - Value
result = *this\Value
UnlockObject(*this)
ProcedureReturn result
EndProcedure : AsMethode(Sub)
; ---------------------------------------------------------------------------
Procedure New()
InitObject(sWork) ; Mehr kommt hier nicht rein!
EndProcedure
; ---------------------------------------------------------------------------
CheckInterface()
EndModule
; ***************************************************************************************
;-Test AddRef
Procedure thAdd(*Object.Work::iWork)
Protected time
*Object\AddRef()
Delay(1000)
;Debug "Start"
For i = 1 To 10
time = Random(200)
*Object\Add(1)
Delay(time)
Next
;Debug "Ready."
*Object\Release()
EndProcedure
Debug "Mainscope Create Object"
Define *Object.Work::iWork
*Object = Work::New()
mutex = CreateMutex()
Debug "Start Threads"
For i = 1 To 1000
th = CreateThread(@thAdd(), *Object)
Delay(5)
If th = 0
Debug "No Thread " + i
EndIf
Next
Debug "Mainscope Wait..."
Repeat
Delay(200)
ref = *Object\AddRef()
ref = *Object\Release()
Debug ref
If ref = 0
Break
EndIf
ForEver
Debug "Mainscope Release Object"
*Object\Release()
Debug "Ready."
Code: Alles auswählen
[14:37:44] Warte auf den Start des Executable...
[14:37:44] Executable-Typ: Windows - x64 (64bit, Unicode)
[14:37:44] Executable gestartet.
[14:37:44] [Debug] Mainscope Create Object
[14:37:44] [Debug] Initialize Work
[14:37:44] [Debug] Start Threads
[14:37:47] Das mit dem Debugger getestete Executable endete unerwartet.
Code: Alles auswählen
Procedure.s CreateUuid()
Protected Uuid.iid, result.s, i
UuidCreate_(Uuid.iid)
result = " DataSection" + #LF$
result + " Uuid:" + #LF$
result + " Data.l $" + RSet(Hex(Uuid\Data1), 8, "0") + #LF$
result + " Data.w $" + RSet(Hex(Uuid\Data2), 4, "0") + ", $" + RSet(Hex(Uuid\Data3), 4, "0") + #LF$
result + " Data.b $" + RSet(Hex(Uuid\Data4[0]), 2, "0")
For i = 1 To 7
result + ", $" + RSet(Hex(Uuid\Data4[i]), 2, "0")
Next
result + #LF$
result + " EndDataSection" + #LF$
ProcedureReturn result
EndProcedure
; ***************************************************************************************
Uuid.s = CreateUuid()
SetClipboardText(Uuid)
Debug Uuid
Debug "Copied into clipboard"