fmc.Development

This code has been declared by its author to be Public Domain code.
fmc.Development by Fabian.
2006
Since 2006-11-06 my modules stored in the code archives are out of synchronization. To have the latest version you need to use the bmk/syncmods utility or the MaxIDE.

You need to add "webspace100.we.funpic.de/root/mod" as a new line to "cfg/modservers.cfg" in your BlitzMax installation directory.

You can't synchronize with the default BlitzMax 1.22 IDE. If you don't have another IDE, you need to download a tweaked MaxIDE. You need to specify "fmc" as additional module scope.

Alternative you can synchronize with the bmk tool: bmk syncmods fmc

For a better description see my thread in the programming forum introducing these modules.
Strict
Rem
bbdoc:Development
about:
This module contains some useful features for win32 programmers.
<table><tr><th>Constant</th><th>Value</th><th>Description</th></tr>
<tr><td>EVENT_ENDSESSION</td><td>$40001</td><td>This event is posted when the user logs off or shuts down the computer.</td></tr>
</table>
EndRem
Module fmc.Development
?Win32

ModuleInfo "Version: 0.09"
ModuleInfo "Modserver: Fabian"

Import brl.event

Const EVENT_ENDSESSION = $40001

Rem
bbdoc:Suspend the debugger
EndRem
Function DebugSuspend ( ) NoDebug
  OnDebugSuspend :+ 1
EndFunction

Rem
bbdoc:Resume the debugger
EndRem
Function DebugResume ( ) NoDebug
  OnDebugSuspend :- 1
EndFunction

Rem
bbdoc:Callback in main thread
EndRem
Function CallbackMain ( func ( context ) , context , sync = 0 )
  If sync
    Local Mem Ptr = Int Ptr MemAlloc ( 12 )
    Mem [ 0 ] = Int Byte Ptr func
    Mem [ 1 ] = context
    Mem [ 2 ] = sync
    WaitForSingleObject ( ( Int Ptr sync ) [ 1 ] , -1 )
    ( Int Ptr sync ) [ 0 ] :+ 1
    SetEvent ( ( Int Ptr sync ) [ 1 ] )
    PostMessageW Wnd , $400 , Int Byte Ptr CallbackSyncFunc , Int Mem
  Else
    PostMessageW Wnd , $400 , Int Byte Ptr func , context
  EndIf
EndFunction

Rem
bbdoc:Callback in main thread and wait for result
EndRem
Function CallbackMainWithReturn ( func ( context ) , context )
  Local Mem Ptr = Int Ptr MemAlloc ( 12 )
  Mem [ 0 ] = Int Byte Ptr func
  Mem [ 1 ] = context
  Mem [ 2 ] = CreateEventW ( Null , 0 , 0 , Null )
  PostMessageW Wnd , $400 , Int Byte Ptr CallbackMainFunc , Int Mem
  WaitForSingleObject Mem [ 2 ] , -1
  CloseHandle Mem [ 2 ]
  context = Mem [ 1 ]
  MemFree Mem
  Return context
EndFunction

Rem
bbdoc:Create a callback synchronization object
EndRem
Function CreateCallbackSync ( )
  Local Mem Ptr = Int Ptr MemAlloc ( 12 )
  Mem [ 0 ] = 1
  Mem [ 1 ] = CreateEventW ( Null , 0 , 1 , Null )
  Mem [ 2 ] = True
  Return Int Mem
EndFunction

Rem
bbdoc:Cancel callback operations
EndRem
Function CancelCallback ( sync )
  WaitForSingleObject ( ( Int Ptr sync ) [ 1 ] , -1 )
  ( Int Ptr sync ) [ 2 ] = False
  ( Int Ptr sync ) [ 0 ] :- 1
  If Not ( Int Ptr sync ) [ 0 ]
    CloseHandle ( ( Int Ptr sync ) [ 1 ] )
    MemFree Byte Ptr sync
  Else
    SetEvent ( ( Int Ptr sync ) [ 1 ] )
  EndIf
EndFunction

Rem
bbdoc:Thread type
EndRem
Type TThread
  Field Handle

Rem
bbdoc:Create a new thread
EndRem
  Function Create:TThread ( func ( context ) , context )
    Local Thread:TThread = New TThread
    Thread.Handle = CreateThread ( Null , 0 , func , context , 0 , Null )
    Return Thread
  EndFunction

Rem
bbdoc:Terminate the thread
EndRem
  Method Terminate ( )
    TerminateThread Handle , 0
  EndMethod

  Method Delete ( )
    CloseHandle Handle
  EndMethod
EndType

Rem
bbdoc:Synchronization type
EndRem
Type TSync
  Field Handle

  Method New ( )
    Handle = CreateEventW ( Null , 0 , 1 , Null )
  EndMethod

Rem
bbdoc:Begin the synchronization
EndRem
  Method Sync ( )
    WaitForSingleObject Handle , -1
  EndMethod

Rem
bbdoc:Try to begin the synchronization
returns:#brl.blitz.True if the synchronization began successfully, else #brl.blitz.False
EndRem
  Method TrySync ( )
    Return Not WaitForSingleObject ( Handle , 0 )
  EndMethod

Rem
bbdoc:End the synchronization
EndRem
  Method EndSync ( )
    SetEvent Handle
  EndMethod

  Method Delete ( )
    CloseHandle Handle
  EndMethod
EndType

Rem
bbdoc:Function hook type
EndRem
Type TFunctionHook
  Field HookLeft:TFunctionHook
  Field HookRight:TFunctionHook
  Field Hooked:THooked
  Field Data:Byte []
  Field Active

Rem
bbdoc:Create a new function hook
EndRem
  Function Create:TFunctionHook ( func:Byte Ptr , newfunc:Byte Ptr ) NoDebug
    Local Hooked:THooked = FirstHooked
    While Hooked
      If Hooked.Func = func
        Exit
      EndIf
      Hooked = Hooked.HookedDown
    Wend
    If Not Hooked
      Hooked = New THooked
      If FirstHooked
        FirstHooked.HookedUp = Hooked
        Hooked.HookedDown = FirstHooked
      EndIf
      FirstHooked = Hooked
      Hooked.FirstHook = New TFunctionHook
      Hooked.FirstHook.Hooked = Hooked
      Hooked.FirstHook.Data = New Byte [ 7 ]
      MemCopy Hooked.FirstHook.Data , func , 7
      Hooked.FirstHook.Active = True
      Hooked.Func = func
    EndIf
    Local Hook:TFunctionHook = New TFunctionHook
    Hooked.FirstHook.HookLeft = Hook
    Hook.HookRight = Hooked.FirstHook
    Hooked.FirstHook = Hook
    Hook.Hooked = Hooked
    Hook.Data = New Byte [ 7 ]
    Hook.Data [ 0 ] = 184
    ( Byte Ptr Ptr ( Byte Ptr Hook.Data + 1 ) ) [ 0 ] = newfunc
    Hook.Data [ 5 ] = 255
    Hook.Data [ 6 ] = 224
    Hook.Active = True
    UpdateHooked Hooked
    Return Hook
  EndFunction

Rem
bbdoc:Disable the function hook
EndRem
  Method Disable ( ) NoDebug
    If Hooked
      Active = False
      UpdateHooked Hooked
    EndIf
  EndMethod

Rem
bbdoc:Enable the function hook
EndRem
  Method Enable ( ) NoDebug
    If Hooked
      Active = True
      UpdateHooked Hooked
    EndIf
  EndMethod

Rem
bbdoc:Free the function hook
EndRem
  Method Free ( ) NoDebug
    If Hooked
      If Hooked.FirstHook = Self
        Hooked.FirstHook = HookRight
      Else
        HookLeft.HookRight = HookRight
      EndIf
      HookRight.HookLeft = HookLeft
      UpdateHooked Hooked
      If Not Hooked.FirstHook.HookRight
        Hooked.FirstHook = Null
        If FirstHooked = Hooked
          FirstHooked = Hooked.HookedDown
        Else
          Hooked.HookedUp.HookedDown = Hooked.HookedDown
        EndIf
        If Hooked.HookedDown
          Hooked.HookedDown.HookedUp = Hooked.HookedUp
        EndIf
      EndIf
      Hooked = Null
    EndIf
  EndMethod
EndType

Type THooked
  Field HookedUp:THooked
  Field HookedDown:THooked
  Field FirstHook:TFunctionHook
  Field Func:Byte Ptr
EndType

Private

Global FirstHooked:THooked
Global CurrentProcess = GetCurrentProcess ( )
Global MainThreadID = GetCurrentThreadId ( )
Local Class:TWinClass = New TWinClass
Class.Proc = Proc
Class.ClassName = ( "CLASS#" + Int Byte Ptr Proc ).ToWString ( )
RegisterClassW Class
Global Wnd = CreateWindowExW ( 0 , Class.ClassName , Null , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 )
MemFree Class.ClassName
'Area "Debug"
Global OnDebugSuspend
Extern
Global bbOnDebugStop()
Global bbOnDebugLog(message$)
Global bbOnDebugEnterStm(stm Ptr)
Global bbOnDebugEnterScope(scope Ptr,inst:Byte Ptr)
Global bbOnDebugLeaveScope()
Global bbOnDebugPushExState()
Global bbOnDebugPopExState()
Global bbOnDebugUnhandledEx(ex:Object)
EndExtern
Global _OnDebugStop()                             =bbOnDebugStop
Global _OnDebugLog(message$)                      =bbOnDebugLog
Global _OnDebugEnterStm(stm Ptr)                  =bbOnDebugEnterStm
Global _OnDebugEnterScope(scope Ptr,inst:Byte Ptr)=bbOnDebugEnterScope
Global _OnDebugLeaveScope()                       =bbOnDebugLeaveScope
Global _OnDebugPushExState()                      =bbOnDebugPushExState
Global _OnDebugPopExState()                       =bbOnDebugPopExState
Global _OnDebugUnhandledEx(ex:Object)             =bbOnDebugUnhandledEx
bbOnDebugStop=OnDebugStop
bbOnDebugLog=OnDebugLog
bbOnDebugEnterStm=OnDebugEnterStm
bbOnDebugEnterScope=OnDebugEnterScope
bbOnDebugLeaveScope=OnDebugLeaveScope
bbOnDebugPushExState=OnDebugPushExState
bbOnDebugPopExState=OnDebugPopExState
bbOnDebugUnhandledEx=OnDebugUnhandledEx
Function OnDebugStop()                             NoDebug;If Dbg()Return _OnDebugStop()
EndFunction
Function OnDebugLog(message$)                      NoDebug;If Dbg()Return _OnDebugLog(message)
EndFunction
Function OnDebugEnterStm(stm Ptr)                  NoDebug;If Dbg()Return _OnDebugEnterStm(stm)
EndFunction
Function OnDebugEnterScope(scope Ptr,inst:Byte Ptr)NoDebug;If Dbg()Return _OnDebugEnterScope(scope,Inst)
EndFunction
Function OnDebugLeaveScope()                       NoDebug;If Dbg()Return _OnDebugLeaveScope()
EndFunction
Function OnDebugPushExState()                      NoDebug;If Dbg()Return _OnDebugPushExState()
EndFunction
Function OnDebugPopExState()                       NoDebug;If Dbg()Return _OnDebugPopExState()
EndFunction
Function OnDebugUnhandledEx(ex:Object)             NoDebug;If Dbg()Return _OnDebugUnhandledEx(ex)
EndFunction
Function Dbg ( ) NoDebug
  Return GetCurrentThreadId ( ) = MainThreadID And Not OnDebugSuspend
EndFunction
'EndArea

Function Proc ( Win , Msg , WP ( context ) , LP )
  If Win = Wnd And Msg = $400
    WP LP
    Return
  EndIf
  If Win = Wnd And Msg = 22 And Byte Ptr WP
    TEvent.Create ( EVENT_ENDSESSION ).Emit
  EndIf
  Return DefWindowProcW ( Win , Msg , Int Byte Ptr WP , LP )
EndFunction

Function UpdateHooked ( Hooked:THooked ) NoDebug
  Local Hook:TFunctionHook = Hooked.FirstHook
  While Not Hook.Active
    Hook = Hook.HookRight
  Wend
  WriteProcessMemory CurrentProcess , Hooked.Func , Hook.Data , 7 , Null
EndFunction

Function CallbackMainFunc ( Mem Ptr )
  Local Func ( context ) = Byte Ptr Mem [ 0 ]
  Mem [ 1 ] = Func ( Mem [ 1 ] )
  SetEvent Mem [ 2 ]
EndFunction

Function CallbackSyncFunc ( Mem Ptr )
  Local Func ( context ) = Byte Ptr Mem [ 0 ]
  Local Context = Mem [ 1 ]
  Local Sync Ptr = Int Ptr Mem [ 2 ]
  MemFree Byte Ptr Mem
  WaitForSingleObject ( ( Int Ptr Sync ) [ 1 ] , -1 )
  Local Call = ( Int Ptr Sync ) [ 2 ]
  ( Int Ptr Sync ) [ 0 ] :- 1
  If Not ( Int Ptr Sync ) [ 0 ]
    CloseHandle ( ( Int Ptr Sync ) [ 1 ] )
    MemFree Byte Ptr Sync
  Else
    SetEvent ( ( Int Ptr Sync ) [ 1 ] )
  EndIf
  If Call
    Func Context
  EndIf
EndFunction

Type TWinClass
  Field Style
  Field Proc:Byte Ptr
  Field ClsExtra
  Field WndExtra
  Field Instance
  Field Icon
  Field Cursor
  Field Background
  Field MenuName:Short Ptr
  Field ClassName:Short Ptr
EndType

Extern "Win32"
  Function GetCurrentProcess ( )
  Function GetCurrentThreadId ( )
  Function WriteProcessMemory ( DstProc , Dst:Byte Ptr , Src:Byte Ptr , Size , Written Ptr )
  Function CreateThread ( TA:Byte Ptr , Size , Func:Byte Ptr , P , Flags , ID Ptr )
  Function TerminateThread ( H , E )
  Function RegisterClassW ( Class:Byte Ptr )
  Function CreateWindowExW ( ExS , CN:Short Ptr , WN:Short Ptr , S , X , Y , W , H , P , M , I , LP )
  Function DefWindowProcW ( Win , Msg , WP , LP )
  Function PostMessageW ( Win , Msg , WP , LP )
  Function CreateEventW ( EA:Byte Ptr , MR , IS , Name:Short Ptr )
  Function WaitForSingleObject ( Handle , Millis )
  Function SetEvent ( Handle )
  Function CloseHandle ( Handle )
EndExtern
?
Comments
Fabian.
2006
Edit: too many changes, post not valid
Code Archives Forum