PureBasic Forums - English

Code: Select all

; updated 2023-04-22
;    Use a mutex to update buffer map to make it thread-safe.
;
; If your DLL already has a "DetachThread", "DetachProcess",  or  "AttachProcess" 
;            rename them To "DetachThread2","DetachProcess2", and "AttachProcess2"
;            You must Declare them prior to including the ProcedureDLLReturnString.pbi file.
;            that way, we can clean up memory before releasing the dll & call your functions after that.
;
; Example shows how I handle returning strings from a dll in a threadsafe way.
; the dll reverses the string; so the program reverses that, and we get the original string
; just a simple test to demonstrate...

EnableExplicit
CompilerIf #PB_Compiler_ExecutableFormat=#PB_Compiler_DLL
  Macro ProcedureDLLReturnString( str )
    ProcedureReturn ReturnDLLStringPtr( str )
  EndMacro
  
  #UseTimerToCleanUp = #True 
  #pdrsTimeout = 60000 ; use the return buffer w/in 1 minute otherwise it will be cleared.
  
  CompilerIf #UseTimerToCleanUp
    Import "kernel32.lib"
      CreateTimerQueue()
      CreateTimerQueueTimer(  hTimer, hTimerQueue, timerCallback, param, dueTime, period, flags)
      ChangeTimerQueueTimer(  hTimerQueue, hTimer, dueTime, period)
      DeleteTimerQueueTimer(  hTimerQueue, hTimer, completionEvent)
      DeleteTimerQueueEx(     hTimerQueue, completionEvent)
    EndImport
    Global pdrsTimerQueue
    
    ProcedureDLL pdrsChangeTimer( newInterval )
      ProcedureReturn ChangeTimerQueueTimer(pdrsTimerQueue, 1, newInterval, newInterval)
    EndProcedure 
  CompilerEndIf 
  
  Structure pdspStruct
    *ptr
    time.i
  EndStructure
  
  Global pdrsReturnBufferMutex = CreateMutex()
  Global NewMap pdrsReturnBuffer.pdspStruct()
  
  Procedure ReturnDLLStringPtr( str.s )
    Protected key.s = Str(GetCurrentThreadId_())
    LockMutex(pdrsReturnBufferMutex)
    
    If FindMapElement( pdrsReturnBuffer(), key) 
      pdrsReturnBuffer( key )\ptr = ReAllocateMemory(pdrsReturnBuffer(key)\ptr,StringByteLength(str)+2)
    Else 
      pdrsReturnBuffer( key )\ptr = AllocateMemory(StringByteLength(str)+SizeOf(Character))
    EndIf
    pdrsReturnBuffer( key )\time = ElapsedMilliseconds()
    PokeS(pdrsReturnBuffer( key )\ptr, str, StringByteLength(str))
    
    UnlockMutex(pdrsReturnBufferMutex)
    ProcedureReturn( pdrsReturnBuffer(key)\ptr )
  EndProcedure
  
  Procedure pdrsCleanMap(param.i, timer.i)
    ;  OutputDebugString_("Cleanup timer fired")
    LockMutex(pdrsReturnBufferMutex)
    ForEach pdrsReturnBuffer()
      If pdrsReturnBuffer()\time + #pdrsTimeout > ElapsedMilliseconds()
        DeleteMapElement( pdrsReturnBuffer() )
      EndIf
    Next
    UnlockMutex(pdrsReturnBufferMutex)
  EndProcedure
  
  Procedure pdrsClear(n=0)
    Protected i, id.s = Str(GetCurrentThreadId_())
    LockMutex(pdrsReturnBufferMutex)
    If FindMapElement( pdrsReturnBuffer(), id )
      FreeMemory(pdrsReturnBuffer(id)\ptr)
      DeleteMapElement( pdrsReturnBuffer(), id )
      i=1
    EndIf
    UnlockMutex(pdrsReturnBufferMutex)
    ProcedureReturn i
  EndProcedure
  
  ;- Exported procedures 
  ProcedureDLL AttachProcess( n ) 
    CompilerIf #UseTimerToCleanUp
      Protected timer
      pdrsTimerQueue = CreateTimerQueue()
      CreateTimerQueueTimer(@timer, pdrsTimerQueue, @pdrsCleanMap(), 1, 5000, 5000, 0)
    CompilerEndIf   
    CompilerIf Defined(AttachProcess2,#PB_Procedure)
      AttachProcess2( n ) 
    CompilerEndIf
  EndProcedure
  ProcedureDLL DeteachThread(n) 
    pdrsClear()
    
    CompilerIf Defined( DetachThread2, #PB_Procedure )
      DetachThread2( n )
    CompilerEndIf
  EndProcedure
  ProcedureDLL DetachProcess(n) 
    CompilerIf #UseTimerToCleanUp
      DeleteTimerQueueTimer( pdrsTimerQueue,1,0)
      DeleteTimerQueueEx( pdrsTimerQueue, 0)
    CompilerEndIf 
    LockMutex(pdrsReturnBufferMutex)
    ForEach pdrsReturnBuffer() 
      FreeMemory( pdrsReturnBuffer()\ptr )
    Next
    ClearMap( pdrsReturnBuffer() )
    UnlockMutex(pdrsReturnBufferMutex)
    CompilerIf Defined( DetachProcess2, #PB_Procedure)
      DetachProcess2( n )
    CompilerEndIf
  EndProcedure
  
  ;}
  
  ;XIncludeFile "ProcedureDLLReturnString.pbi"
  
  ;- Sample DLL procedure to return a string, demonstration only...
  ProcedureDLL RevStr_( str.s )
    Protected retstr.s = ReverseString( str )
    ; Using a global with ProcedureReturn is not threadsafe.
    ProcedureDLLReturnString( retstr )
  EndProcedure
  
CompilerElse ;- test program
  Import "DLLStringTest.lib"
    RevStr_( str.s )
  EndImport
  
  Global s = CreateSemaphore(0) ; Use a semaphore to get threads to execute as close to the same time as possible.
  
  Procedure ThreadedTest( *str )
    WaitSemaphore(s)
    Debug "Reverse "+PeekS(RevStr_( PeekS(*str) ))
    Debug "Normal "+ReverseString(PeekS(RevStr_( PeekS(*str) )))
  EndProcedure
  
  Define t1, t2, t3
  Define *p
  
  *p = revstr_("1 I am there") 
  Debug ReverseString(PeekS(*p))
  
  *p = revstr_("2 you are here")
  Debug ReverseString(PeekS(*p))
  
  t1 = CreateThread(@ThreadedTest(),@"3 Here is a test")
  t2 = CreateThread(@ThreadedTest(),@"4 Here is another test")
  t3 = CreateThread(@ThreadedTest(),@"5 Here is the last one test")
  
  Delay(10) 
  SignalSemaphore(s): SignalSemaphore(s) : SignalSemaphore(s)
  
  Repeat ;- Wait for threads to complete.
    Delay(5)
  Until IsThread(t1) = #False And IsThread(t2)=#False And IsThread(t3)=#False
CompilerEndIf 

; IDE Options = PureBasic 6.02 beta 2 LTS (Windows - x64)
; ExecutableFormat = Shared dll
; CursorPosition = 10
; Folding = BaB1-
; Optimizer
; EnableThread
; EnableXP
; Executable = DLLStringTest.dll
; EnablePurifier
; EnableExeConstant

Code: Select all

ProcedureDLL.s RevStr_(str.s)
 ProcedureReturn str
EndProcedure