> On Fri, 27 Jun 2003 14:46:34 +0200, "Jonathan" <a...@b.com> wrote:
> >hey thanks for your input,
> >although I don't think I know as much about it as do you, I noticed it
was a
> >weird (and maybe imcomplete) source code; I tried the Mutex thing but it
> >didn't work, so I'm gonna now try to find the problem myself, if that
> >doesn't work, I'd really like your code...!
> Maybe this will give you some ideas :-
> unit BroadCast;
> interface
> (* 10/3/01 JF
> Usage:
> BroadCast.Install( Self.Handle,
> 'UNIQUE_ID',
> @Notify )
> RecipientCount := BroadCast.SendString( 'Hullo' )
> If Notify is Called :-
> StringReceived := Broadcast.ReceiveString
> *)
> Uses Windows, Messages, Classes;
> Type
> TNotify = Procedure;StdCall;
> TAppWinHook = Function( Var WindowHandle:hWnd;
> Var TheMessage,
> ParamW,
> ParamL:Integer ):Integer;StdCall;
> // Exposed Procedures
> Procedure Install( Const App_HandleIn:Integer;
> Const AppID_StringIn:String;
> Const Address:TNotify );
> Procedure SetAppWinHook( Const Address:TAppWinHook );
> Function SendString( Const SendString:String ):Integer ;
> Procedure UnInstall ;
> // Exposed Variables
> Var
> ReceiveString : String ; // Public - The String from Another App
> implementation
> Const DEMAND_REPLY = 1 ;
> Const NOTIFY_STRING_READY = 2 ;
> Const REQUEST_DATA = 4 ;
> Const STRING_FLAG = 140956 ; // A rather unique number
> var
> WM_ID : Integer = 0 ; // Unique Windows Message ID
> App_Handle : Integer ; // Form.hWnd or
> Application.Handle
> AppID_String : String ; // Application.ExeName is Ok
> FNotify : TNotify = Nil ; // The Callback Notification
> Address
> AppWinHook : TAppWinHook = Nil; // Users Hook Callback
> HookedFlag : Boolean = False ;
> OldWindowProc : Pointer;
> Prev_HandleCount : Integer ;
> LocalSendString : String ;
> DebugFlag : Boolean = False ;
> Procedure HookWindows;Forward;
> Procedure UnHookWindows;Forward;
> Procedure LS_ErrorMsg( Msg:String );Forward;
> {
> ########################################################################
> }
> Procedure Install( Const App_HandleIn:Integer;
> Const AppID_StringIn:String;
> Const Address:TNotify );
> Begin
> If HookedFlag Then
> Begin
> LS_ErrorMsg( 'BroadCast.Install Error - Already Installed' ) ;
> End;
> AppID_String := AppID_StringIn ;
> App_Handle := App_HandleIn ;
> FNotify := @Address ;
> HookWindows ;
> End;
> {
> ########################################################################
> }
> Procedure SetAppWinHook( Const Address:TAppWinHook );
> Begin
> AppWinHook := @Address ;
> End; {SetAppWinHook}
> {
> ########################################################################
> Public Routine for Despatch
> }
> Function SendString( Const SendString:String ):Integer ;
> Begin
> LocalSendString := SendString ; // We MUST make a Local Copy
> Prev_HandleCount := 0 ;
> SendMessage( HWND_BROADCAST, WM_ID, App_Handle, DEMAND_REPLY ) ;
> Result := Prev_HandleCount
> End; {SendString}
> {
> ########################################################################
> }
> Procedure UnInstall;
> Begin
> If HookedFlag = False Then
> Begin
> LS_ErrorMsg( 'BroadCast.InInstall Error - Not Installed' ) ;
> Exit;
> End;
> UnHookWindows ;
> End; {UnInstall}
> {
> ########################################################################
> Despatch Data to a Target App - in response to a REQUEST_DATA
> }
> Procedure LS_DespatchData( Const ParamW:Integer );
> Var
> P : Integer ;
> Packet : COPYDATASTRUCT ;
> Begin
> Packet.dwData := STRING_FLAG ;
> Packet.cbData := Length( LocalSendString ) ;
> Packet.lpData := @LocalSendString[1] ;
> P := Integer( ( @Packet ) ) ;
> {Send the Data - this blocks our thread}
> SendMessage( ParamW, WM_COPYDATA, App_Handle, P ) ;
> {Now notify the recipient - this is non-blocking}
> PostMessage( ParamW, WM_ID, App_Handle, NOTIFY_STRING_READY )
> End; {LS_DespatchData}
> {
> ########################################################################
> Read Data from another App in response to a WM_COPYDATA message
> }
> Procedure LS_ReceiveData( Const ParamL:Integer );
> Type Packet = COPYDATASTRUCT ;
> Var
> P : ^Packet ;
> L9 : Integer ;
> Begin
> P := Pointer( ParamL ) ;
> // Sanity Checks
> If P^.dwData <> STRING_FLAG Then
> Begin
> LS_ErrorMsg( 'WM_COPYDATA - Bad Packet Type' ) ;
> Exit;
> End;
> If Integer( P^.cbData ) < 0 Then
> Begin
> LS_ErrorMsg( 'WM_COPYDATA - Bad Packet String Length' ) ;
> Exit;
> End;
> // So we are able to Get the Data
> SetLength( ReceiveString, P^.cbData ) ;
> For L9 := 1 To P^.cbData Do
> ReceiveString[L9] := PChar( P^.lpData )[L9-1] ;
> End; {LS_ReceiveData}
> {
> ########################################################################
> }
> Procedure LS_ErrorMsg( Msg:String );
> Begin
> MessageBox( App_Handle,
> PChar( ParamStr(0) + #13
> + Msg ) ,
> 'Unit SendStrA', 0 ) ;
> End; {LS_ErrorMsg}
> {
> ########################################################################
> Windows Hook
> }
> function NewWindowProc(WindowHandle : hWnd;
> TheMessage : Integer;
> ParamW : Integer;
> ParamL : Integer ) : Integer ; StdCall;
> Export;
> begin
> { Message Handler - WindowHandle is Target ID - Us or Broadcast
> WM_ID is Unique to this App
> ParamW is Possibly Callers ID / Maybe Our
> Own
> ParamL our User Message
> }
> If Assigned( AppWinHook ) Then
> Begin
> If AppWinHook( WindowHandle, TheMessage, ParamW, ParamL ) <> 0
> Then
> Begin
> Result := 0 ; // The Caller decided to handle it
> Exit;
> End;
> End;
> If TheMessage = WM_ID then
> Begin
> {Message 1 - a Broadcast message - get out if it is from us }
> If ParamW = Integer( App_Handle ) Then // It is Ourselves
> Begin
> Result := 0 ;
> Exit;
> End;
> {Message 2 - a Broadcast Message - from new instance OR Demanding
> a reply}
> If ( ParamL = DEMAND_REPLY ) Then // A new Notifier
> Begin
> SendMessage( ParamW, WM_ID, App_Handle, REQUEST_DATA ) ;
> Result := 0 ;
> Exit;
> End;
> {Message 3 - we have already got a string - notify our App}
> If ParamL = NOTIFY_STRING_READY Then // the sender has sent
> us a string
> Begin
> If Assigned( FNotify ) Then
> FNotify ;
> Result := 0 ;
> Exit;
> End;
> {Message 4 - Another Instance Requests the Data }
> If ( ParamL = REQUEST_DATA ) Then
> Begin
> Prev_HandleCount := Prev_HandleCount + 1 ; // Remember
> and reply
> LS_DespatchData( ParamW );
> Result := 0 ;
> Exit;
> End;
> End;
> { Copy Data Handler - Receive the Data }
> If TheMessage = WM_COPYDATA then
> Begin
> LS_ReceiveData( ParamL );
> Result := 0 ;
> Exit;
> End;
> { Exit here and return zero if you want }
> { to stop further processing of the message }
> { Call the old Window procedure to }
> { allow processing of the message. }
> NewWindowProc := CallWindowProc(OldWindowProc,
> WindowHandle,
> TheMessage,
> ParamW,
> ParamL);
> End; {NewWindowProc}
> {
> ########################################################################
> }
> Procedure HookWindows;
> Begin
> If HookedFlag Then
> Exit;
> If App_Handle = 0 Then
> Exit;
> WM_ID := RegisterWindowMessage( PChar( AppID_String ) );
> SetLastError( 0 ) ; // Clear Last Error
> OldWindowProc := Pointer(SetWindowLong( App_Handle,
> GWL_WNDPROC,
> Integer(@NewWindowProc)));
> If Integer( OldWindowProc ) = 0 Then // Maybe no prior hook or
> Error
> Begin
> If GetLastError <> 0 Then // Was it really an Error
> Begin
> LS_ErrorMsg( 'SetWindowLong Failed' ) ;
> Exit;
> End;
> End;
> HookedFlag := True ;
> End; {HookWindows}
> {
> ########################################################################
> }
> Procedure UnHookWindows;
> Begin
> If HookedFlag Then
> Begin
> SetWindowLong( App_Handle,
> GWL_WNDPROC,
> LongInt(OldWindowProc));
> App_Handle := 0 ;
> HookedFlag := False ;
> End;
> End; {UnHookWindows}
> {
> ########################################################################
> }
> Initialization
> If DebugFlag Then
> LS_ErrorMsg( 'DLL Initialization' ) ;
> HookWindows ; // This will do nothing
> Finalization
> UnHookWindows ;
> If DebugFlag Then
> LS_ErrorMsg( 'DLL Finalization' ) ;
> end.
