This version shows speed improvement over v3 for calling applications.
if you run the simple rapid-fire test procedure, you can see the speed improvement from v3 to v4+
Code: Select all
EnableExplicit
; v7a - 6.03 compatible. Changed some internal functions & structure
; v6f - had to make a small change to the ipc_stuffs file; so I trimmed it down to just what we need;
; fixed memory leak for c backend (code issue, not compiler issue); new processfrompid; added mutex around cache()
; v5f - converted to module; tidied code; added user-parameter to callback;
; added example error code; error if no thread-safe; theoretical speed improvements (TSI);
; more TSI (added some manual c code using registers) but only if using the C backend;
; cache PID/process-name, as process can close will still processing its output.
; v4 - example of queueing data for improved for speed for calling application
; v3 - updated to optionally include process name rather than just PID
; note; the more time you spend 'doing stuff' with the data, the more it will slow down the app calling OutputDebugString()
; v2 - updated to better handle if another dbgview is already running.
CompilerIf #PB_Compiler_Version < 600
CompilerError( "Need at least PB v6 to run" )
; you'll need to edit out anything referencing 'backend' in the source.
CompilerElseIf Not #PB_Compiler_Thread
CompilerError( "You need to enable threadsafe!" )
CompilerEndIf
CompilerIf #PB_Compiler_Backend = #PB_Backend_Asm
CompilerWarning( "You should use the C backend for better performance." )
CompilerEndIf
CompilerIf #PB_Compiler_Debugger
CompilerWarning( "Please run w/o debugger to improve speed for application calling outputdebugstring()." )
CompilerEndIf
DeclareModule systemWide ; this is a stripped down/modified version of https://www.purebasic.fr/german/viewtopic.php?f=8&t=29238
Prototype memCreate( name.p-unicode, size.i) : Global memCreate.memCreate ;Declare memCreate( *Name, Size.i )
Declare memFree( *Mem )
Prototype mutexCreate( name.p-unicode ) : Global mutexCreate.mutexCreate ;Declare mutexCreate( *Name )
Declare mutexFree( hMutex )
EndDeclareModule
Module systemWide
Procedure _mutexCreate( *Name.Unicode )
Protected hMutex = CreateMutex_( #NUL, #False, *Name )
If Not hMutex
hMutex = OpenMutex_( #SYNCHRONIZE, #False, *Name )
EndIf
ProcedureReturn hMutex
EndProcedure
Procedure mutexFree( hMutex )
ReleaseMutex_( hMutex ) ; try to unlock
CloseHandle_( hMutex )
EndProcedure
Global NewMap Mem()
Procedure _memCreate( *Name.unicode, Size.i )
Protected *Mem, ClearMem,
handle = OpenFileMapping_( #FILE_MAP_ALL_ACCESS, 0, *Name )
If handle = #Null
handle = CreateFileMapping_( #INVALID_HANDLE_VALUE, #NUL, #PAGE_READWRITE | #SEC_COMMIT | #SEC_NOCACHE, 0, Size, *Name )
ClearMem = ClearCreate
EndIf
If handle
*Mem = MapViewOfFile_( handle, #FILE_MAP_ALL_ACCESS, 0, 0, 0 )
If *Mem
Mem( Str(*Mem) ) = handle
EndIf
EndIf
ProcedureReturn *Mem
EndProcedure
Procedure memFree( *Mem )
Protected result
UnmapViewOfFile_( *Mem )
result = CloseHandle_( Mem( Str(*Mem) ) )
DeleteMapElement( Mem(), Str(*Mem) )
ProcedureReturn result
EndProcedure
memCreate = @_memCreate()
mutexCreate = @_mutexCreate()
EndModule
DeclareModule processFromPID
Declare.s get( pid = -1 )
EndDeclareModule
Module processFromPID
Structure cacheInfo
name.s
time.i
EndStructure
Prototype protoGetProcessImageFileName(hProcess, lpImageFileName, nSize)
Prototype protoQueryFullProcessImageName(hProcess, dwFlags, lpExeName, lpdwSize)
Global GetProcessImageFileName.protoGetProcessImageFileName
Global QueryFullProcessImageName.protoQueryFullProcessImageName
Global NewMap cache.cacheInfo()
Global listLock
Procedure clearCacheThread(nul)
Repeat
Delay(100)
LockMutex( listLock )
ForEach cache()
If cache()\time + 500 > ElapsedMilliseconds()
DeleteMapElement( cache() )
EndIf
Next
UnlockMutex( listLock )
ForEver
EndProcedure
Procedure init()
Protected hLib
listLock = CreateMutex()
ThreadPriority( CreateThread( @clearCacheThread(), #NUL ), #THREAD_PRIORITY_IDLE )
Select OSVersion()
Case #PB_OS_Windows_XP
hLib = OpenLibrary( #PB_Any, "psapi.dll" )
If IsLibrary( hLib )
GetProcessImageFileName = GetFunction( hLib, "GetProcessImageFileNameW" )
EndIf
Default
hLib = OpenLibrary( #PB_Any, "kernel32.dll" )
If IsLibrary( hLib )
QueryFullProcessImageName = GetFunction( hLib, "QueryFullProcessImageNameW" )
EndIf
EndSelect
EndProcedure
Procedure.s GetProcessPath( hProcess )
Protected.s lpImageFileName, lpDeviceName, lpTargetPath, lpExeName, Result
If hProcess
Select OSVersion()
Case #PB_OS_Windows_XP
If GetProcessImageFileName
nSize = #MAX_PATH
Dim lpBuffer.c( nSize )
lpImageFileName = Space( nSize )
GetProcessImageFileName( hProcess, @lpImageFileName, nSize )
BufferLength = GetLogicalDriveStrings_( nSize, @lpBuffer(0) )
Repeat
lpDeviceName = #Null$
While lpBuffer( rtnCount )
lpDeviceName + Chr( lpBuffer(rtnCount) )
rtnCount + 1
Wend
lpDeviceName = Left( lpDeviceName, Len(lpDeviceName) - 1 )
lpTargetPath = Space( nSize )
QueryDosDevice_( lpDeviceName, @lpTargetPath, nSize )
If Left( lpImageFileName, Len(lpTargetPath) ) = lpTargetPath
Result = Trim( ReplaceString( lpImageFileName, lpTargetPath, lpDeviceName ) )
Break
EndIf
rtnCount + 1
Until rtnCount >= BufferLength
EndIf
Default
If QueryFullProcessImageName
lpdwSize = #MAX_PATH
lpExeName = Space( lpdwSize )
QueryFullProcessImageName( hProcess, 0, @lpExeName, @lpdwSize )
Result = Trim( lpExeName )
EndIf
EndSelect
CloseHandle_( hProcess )
EndIf
ProcedureReturn Result
EndProcedure
Procedure.s Get( pid = -1 )
Protected procName.s, hProcess
If pid = -1 : pid = GetCurrentProcessId_() : EndIf
LockMutex( listLock )
If FindMapElement( cache(), Str(pid) )
procName = cache()\name : cache()\time = ElapsedMilliseconds()
Else
hProcess = OpenProcess_( #PROCESS_QUERY_INFORMATION | #PROCESS_VM_READ, #False, pid )
If hProcess
procname = GetProcessPath( hProcess )
CloseHandle_( hProcess )
LockMutex( listLock )
With cache( Str(pid) )
\name = procName
\time = ElapsedMilliseconds()
EndWith
UnlockMutex( listLock )
EndIf
EndIf
UnlockMutex( listLock )
ProcedureReturn procName
EndProcedure
init()
EndModule
DeclareModule MonitorDebugOutput
EnableExplicit
Declare.l start()
Declare.l stop()
Declare setcallback( *func, *user=#NUL ) ; Function needs to accept(pid.l, *AsciiString)
Declare.l lastStatus()
Declare.s lastStatusString( lastStatus=-1 )
Declare.l isRunning()
Enumeration ; threadControl
#okRun
#Stop
#ErrorNoBufferSignal
#ErrorNoDataSignal
#ErrorCallback
#ErrorNoCallback
#ErrorNoBuffer
#ErrorNoMutex
EndEnumeration
EndDeclareModule
Module MonitorDebugOutput
#delayTime = 5
#cachePIDtime = 5000
Structure dbwin_buffer
dwProcessID.l
dbgString.b[4096-SizeOf(long)]
EndStructure
Global NewList dbgdata()
Global listLock, threadControl, listSignal, mdo,
*callback, *user
Declare receiveThread(nul)
Macro _isRunning() : Bool(threadControl = #okRun And IsThread(mdo)) : EndMacro
;- support functions
Prototype OpenOrCreateEvent( name.p-unicode )
Global OpenOrCreateEvent.OpenOrCreateEvent
Procedure.l _openOrCreateEvent( *pName.unicode )
Protected handle = OpenEvent_( #EVENT_ALL_ACCESS, #False, *pName )
If handle = 0 : handle = CreateEvent_( #NUL, #False, #True, *pName ) : EndIf
ProcedureReturn handle
EndProcedure
Procedure.l isRunning()
ProcedureReturn _isRunning()
EndProcedure
OpenOrCreateEvent = @_openOrCreateEvent()
;- control functions
Procedure.l start()
Protected bStarted = #False
If *callback And Not _isRunning()
threadControl = #okRun
mdo = CreateThread( @receiveThread(), @threadControl )
ThreadPriority( mdo, #THREAD_PRIORITY_TIME_CRITICAL )
Delay(1)
bStarted = _isRunning()
EndIf
ProcedureReturn bStarted
EndProcedure
Procedure.l stop()
threadControl = #stop
WaitThread( mdo )
ProcedureReturn Bool( Not _isRunning() )
EndProcedure
Procedure setCallback( *func, *param=#NUL )
*callback = *func
*user = *param
If *callback = #NUL
stop()
threadControl = #ErrorNoCallback
EndIf
EndProcedure
Procedure.l lastStatus()
ProcedureReturn threadControl
EndProcedure
Procedure.s lastStatusString( lastStatus=-1 )
Protected lss.s
If lastStatus = -1 : lastStatus = threadControl : EndIf
Select lastStatus
Case #okRun : lss = "Thread is running"
Case #Stop : lss = "Thread has been stopped"
Case #ErrorNoBufferSignal : lss = "No buffer-ready signal"
Case #ErrorNoDataSignal : lss = "No data-ready signal"
Case #ErrorCallback : lss = "Callback requested stop"
Case #ErrorNoCallback : lss = "No callback"
Case #ErrorNoBuffer : lss = "No memory buffer"
Case #ErrorNoMutex : lss = "No mutex"
Default : lss = "Unknown: "+Str(lastStatus())
EndSelect
ProcedureReturn lss
EndProcedure
Procedure initialize()
listLock = CreateMutex()
listSignal = CreateSemaphore()
EndProcedure
;- main guts of the process
Procedure processThread( nul )
Protected *p.dbwin_buffer
NewList workdata()
While threadControl = #okRun
If ListSize( dbgdata() )
LockMutex( listLock )
CopyList( dbgdata(), workdata() )
ClearList( dbgdata() )
UnlockMutex( listLock )
SignalSemaphore( listSignal )
ForEach workdata()
*p = workdata()
;If *p\dwProcessID
If Not CallFunctionFast( *callback, *p\dwProcessID, @*p\dbgString, *user )
stop() : threadControl = #ErrorCallback
Break
EndIf
;EndIf
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
! free( p_p );
CompilerElse
FreeMemory( *p )
CompilerEndIf
workdata()=0
Next
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
; if the callback requested 'stop', we still need to clear the memory
; Since we bypassed PB memory management, PB won't 'auto-free' the memory on exit.
ForEach workdata()
*p = workdata()
If *p
! free( p_p );
EndIf
Next
CompilerEndIf
If threadControl = #okRun
ClearList( workdata() )
Delay(#delayTime)
EndIf
Else
SignalSemaphore( listSignal )
Delay(#delayTime)
EndIf ; empty list
Wend
SignalSemaphore( listSignal )
EndProcedure
Procedure receiveThread( nul )
Protected *hDBMonBuffer.dbwin_buffer, *p,
hDBWinMutex, hEventBufferReady,
hEventDataReady,outThread
*hDBMonBuffer = systemWide::memCreate( "DBWIN_BUFFER", SizeOf(dbwin_buffer) )
If Not *hDBMonBuffer
threadControl = #ErrorNoBuffer
Debug "No buffer ";+FormatMessage
Else
hDBWinMutex = systemWide::mutexCreate( "DBWinMutex" )
If Not hDBWinMutex
threadControl = #ErrorNoMutex
Debug "No mutex ";+FormatMessage()
Else
hEventBufferReady = openOrCreateEvent( "DBWIN_BUFFER_READY" )
If Not hEventBufferReady
Debug "No buffer ready signal ";+FormatMessage()
threadControl = #ErrorNoBufferSignal
Else
hEventDataReady = openOrCreateEvent( "DBWIN_DATA_READY" )
If Not hEventDataReady
Debug "No data ready signal ";+FormatMessage()
threadControl = #ErrorNoDataSignal
Else
Debug "Monitor thread ready"
outThread = CreateThread( @processThread(), #NUL ) : ;ThreadPriority(outThread,#THREAD_PRIORITY_BELOW_NORMAL)
; there seems to be an initial signal. So we grab & discard the 1st empty packet.
WaitForSingleObject_( hEventDataReady, 0 )
LockMutex( listLock )
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
; TSI
! register int size;
! int findNull( char p[], int s ) {
! register int i;
! for(i=sizeof(long); p[i] && i<s; ++i);
! return( i );
! }
CompilerEndIf
While threadControl = #okRun
If WaitForSingleObject_( hEventDataReady, #delayTime ) = #WAIT_OBJECT_0
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
; TSI
CompilerIf #PB_Compiler_Version <= 602
! size = findNull( p_hdbmonbuffer, sizeof(monitordebugoutputXdbwin_buffer) );
CompilerElse
! size = findNull( p_hdbmonbuffer, sizeof(monitordebugoutputXs_dbwin_buffer) );
CompilerEndIf
! p_p = malloc( size+1 );
! memcpy( p_p, p_hdbmonbuffer, size );
! memset( p_p+size, 0, 1 );
CompilerElse
*p = AllocateMemory( SizeOf(dbwin_buffer), #PB_Memory_NoClear );
CopyMemory( *hDBMonBuffer, *p, SizeOf(dbwin_buffer) )
CompilerEndIf
AddElement( dbgdata() ) : dbgdata() = *p
SetEvent_( hEventBufferReady )
Else
UnlockMutex( listLock )
WaitSemaphore( listSignal )
LockMutex( listLock )
EndIf
Wend
CompilerIf #PB_Compiler_Backend = #PB_Backend_C
; if the callback requested 'stop', we still need to clear the memory
; Since we bypassed PB memory management, PB won't 'auto-free' the memory on exit.
ForEach dbgdata()
*p = dbgdata()
! free( p_p );
Next
CompilerEndIf
If IsThread( outThread ) : WaitThread( outThread ) : EndIf
CloseHandle_( hEventDataReady )
EndIf
CloseHandle_( hEventBufferReady )
EndIf
systemWide::mutexFree( hDBWinMutex )
EndIf
systemWide::memFree( *hDBMonBuffer )
EndIf
EndProcedure
initialize()
EndModule
CompilerIf #PB_Compiler_IsMainFile
CompilerIf #True ; Rapid fire test, if you want to run a rapid fire test.
#loop = 10000
#length = 500
Procedure RapidFire()
; if you run this w/o a dbgviewer (exe or pb) it is very fast
; if you run it with a viewer, you'll see that it is slower, showing that
; the handler of the output has an affect on the caller.
Protected x,s,f
OpenConsole()
f = ElapsedMilliseconds()
For x = 1 To #loop
If x%5=0
OutputDebugString_( Str(x) + ": chunky monkey")
Else
OutputDebugString_( LSet( Str(x), #length, "*" ) )
EndIf
Next
f = ElapsedMilliseconds() - f
Delay( 600 )
s = ElapsedMilliseconds()
For x = 1 To #loop
OutputDebugString_( LSet( Str(x), #length, "*" ) )
Next
s = ElapsedMilliseconds() - s
PrintN( "First run " + Str( f ) )
PrintN( "Second run " + Str( s ) )
;PrintN("Press 'enter' to close")
;Input()
; results on my old laptop... (averages, rounded up on old laptop)
; 410 / 420 ms for v5 (using a list())
; 280 / 10,000 ms for dbgview
; 300 / 300 ms for dbgview++
; 50 / 50 ms for no handler
;
; 8 seconds for v3 (single run)
; for v3, if run a 2nd time, while the app is still processing received info, time is almost 3x as much
; I think this is an extreme issue, but still interesting.
EndProcedure
CompilerEndIf
;- Example of callback
Procedure dbgCallBack( pid.l, *asciiString, *user ) ; even if you don't use a 'user parameter' your callback
Protected str.s, prog.s ; still needs To accept it.
str = PeekS( *asciiString, -1, #PB_Ascii )
prog = GetFilePart( processFromPID::get(pid) )
; filter only messages that contain "pure" and "monkey"; or "self-test"
If (FindString( prog, "pure", 1, #PB_String_NoCase ) And
FindString( str, "monkey", 1, #PB_String_CaseSensitive )) Or
FindString( str, "self-test", 1, #PB_String_CaseSensitive )
PrintN( RSet( StrF(ElapsedMilliseconds()/1000,4), 10, " " ) +
" [" + RSet( Str(pid), 4, "0" ) + "] " +
prog + ": " +
PeekS( *asciiString, -1, #PB_Ascii ) )
EndIf
PokeL( *user, PeekL(*user)+1 ) ; an example of what you can do with the user parameter
ProcedureReturn #True ; if you reurn #false, processing will stop.
EndProcedure
;- Example of how to run/use
Define mdoItems=0
OpenConsole() : ConsoleTitle( "pb-DBGVIEW" ) ; NOTE: closing the conosole will not stop the program, unless you compile as a console app.
MonitorDebugOutput::setcallback( @dbgCallBack(), @mdoItems ) ; must set a callback 1st! The 2nd parameter is optional
If MonitorDebugOutput::start() ; maybe antoher program is monitoring for outputdebugstring()
Delay(10) ; give the thread some time to start.
OutputDebugString_( "self-test" ) ; but this could be sent from any application.
Delay( 1000 ) ; for testing only: delay so processing can happen
; Increase if you want to send test Data from another app
CompilerIf Defined(RapidFire,#PB_Procedure)
RapidFire()
CompilerEndIf
MonitorDebugOutput::stop()
Else
OutputDebugString_( "Sent to another dbgviewer" )
PrintN( "error: "+MonitorDebugOutput::lastStatusString() )
PrintN( "Maybe another dbgview is running?" )
Delay( 5000 ) ; so you can see the output on the console before it closes.
EndIf
If mdoItems > 0
PrintN( "Total items processed: " + Str(mdoItems) )
PrintN( "Press 'enter' to close" )
Input()
EndIf
CompilerEndIf