【delphi开源代码栏目提醒】:本文主要为网学会员提供IPCThrd.pas，希望对需要IPCThrd.pas网友有所帮助，学习一下!

    unit IPCThrd;
    
    { Inter-Process Communication Thread Classes }
    
    {$DEFINE DEBUG}
    
    interface
    
    uses
      SysUtils, Classes, Windows;
    
    {$MINENUMSIZE 4}  { DWORD sized enums to keep TEventInfo DWORD aligned }  
    
    type
    
    { WIN32 Helper Classes }
    
    { THandledObject }
    
    { This is a generic class for all encapsulated WinAPI's which need to call
      CloseHandle when no longer needed.  This code eliminates the need for
      3 identical destructors in the TEvent, TMutex, and TSharedMem classes
      which are descended from this class. }
    
      THandledObject = class(TObject)
      protected
        FHandle: THandle;
      public
        destructor Destroy; override;
        property Handle: THandle read FHandle;
      end;
    
    { TEvent }
    
    { This class encapsulates the concept of a Win32 event (not to be
      confused with Delphi events), see "CreateEvent" in the Win32
      reference for more information }
    
      TEvent = class(THandledObject)
      public
        constructor Create(const Name: string; Manual: Boolean);
        procedure Signal;
        procedure Reset;
        function Wait(TimeOut: Integer): Boolean;
      end;
    
    { TMutex }
    
    { This class encapsulates the concept of a Win32 mutex.  See "CreateMutex"
      in the Win32 reference for more information }
    
      TMutex = class(THandledObject)
      public
        constructor Create(const Name: string);
        function Get(TimeOut: Integer): Boolean;
        function Release: Boolean;
      end;
    
    { TSharedMem }
    
    { This class simplifies the process of creating a region of shared memory.
      In Win32, this is accomplished by using the CreateFileMapping and
      MapViewOfFile functions. }
    
      TSharedMem = class(THandledObject)
      private
        FName: string;
        FSize: Integer;
        FCreated: Boolean;
        FFileView: Pointer;
      public
        constructor Create(const Name: string; Size: Integer);
        destructor Destroy; override;
        property Name: string read FName;
        property Size: Integer read FSize;
        property Buffer: Pointer read FFileView;
        property Created: Boolean read FCreated;
      end;
    
    {$IFDEF DEBUG}
    
    { Debug Tracing }
    
    { The IPCTracer class was used to create and debug the IPC classes which
      follow.  When developing a multi-process, multi-threaded application, it
      is difficult to debug effectively using ordinary debuggers.  The trace
      data is displayed in a Window when you click on a speed button in the
      monitor program. }
    
    const
      TRACE_BUF_SIZE = 200 * 1024;
      TRACE_BUFFER   = 'TRACE_BUFFER';
      TRACE_MUTEX    = 'TRACE_MUTEX';
    
    type
    
      PTraceEntry = ^TTraceEntry;
      TTraceEntry = record
        Size: Integer;
        Time: Integer;
        Msg: array[0..0] of Char;
      end;
    
      TIPCTracer = class(TObject)
      private
        FIDName: string[10];
        FSharedMem: TSharedMem;
        FMutex: TMutex;
        function MakePtr(Ofs: Integer): PTraceEntry;
        function FirstEntry: PTraceEntry;
        function NextEntry: PTraceEntry;
      public
        constructor Create(ID: string);
        destructor Destroy; override;
        procedure Add(AMsg: PChar);
        procedure GetList(List: TStrings);
        procedure Clear;
      end;
    
    {$ENDIF}
    
    { IPC Classes }
    
    { These are the classes used by the Monitor and Client to perform the
      inter-process communication }
    
    const
      MAX_CLIENTS        = 6;
      TIMEOUT            = 2000;
      BUFFER_NAME        = 'BUFFER_NAME';
      BUFFER_MUTEX_NAME  = 'BUFFER_MUTEX';
      MONITOR_EVENT_NAME = 'MONITOR_EVENT';
      CLIENT_EVENT_NAME  = 'CLIENT_EVENT';
      CONNECT_EVENT_NAME = 'CONNECT_EVENT';
      CLIENT_DIR_NAME    = 'CLIENT_DIRECTORY';
      CLIENT_DIR_MUTEX   = 'DIRECTORY_MUTEX';
    
    type
    
      EMonitorActive = class(Exception);
    
      TIPCThread = class;
    
    
    { TIPCEvent }
    
    { Win32 events are very basic.  They are either signaled or non-signaled.
      The TIPCEvent class creates a "typed" TEvent, by using a block of shared
      memory to hold an "EventKind" property.  The shared memory is also used
      to hold an ID, which is important when running multiple clients, and
      a Data area for communicating data along with the event }
    
      TEventKind = (
        evMonitorAttach,    // Notify client that monitor is attaching
        evMonitorDetach,    // Notify client that monitor is detaching
        evMonitorSignal,    // Monitor signaling client
        evMonitorExit,      // Monitor is exiting
        evClientStart,      // Notify monitor a client has started
        evClientStop,       // Notify monitor a client has stopped
        evClientAttach,     // Notify monitor a client is attaching
        evClientDetach,     // Notify monitor a client is detaching
        evClientSwitch,     // Notify monitor to switch to a new client
        evClientSignal,     // Client signaling monitor
        evClientExit        // Client is exiting
      );
    
      TClientFlag = (cfError, cfMouseMove, cfMouseDown, cfResize, cfAttach);
      TClientFlags = set of TClientFlag;
    
      PEventData = ^TEventData;
      TEventData = packed record
        X: SmallInt;
        Y: SmallInt;
        Flag: TClientFlag;
        Flags: TClientFlags;
      end;
    
      TConnectEvent = procedure (Sender: TIPCThread; Connecting: Boolean) of Object;
      TDirUpdateEvent = procedure (Sender: TIPCThread) of Object;
      TIPCNotifyEvent = procedure (Sender: TIPCThread; Data: TEventData) of Object;
    
      PIPCEventInfo = ^TIPCEventInfo;
      TIPCEventInfo = record
        FID: Integer;
        FKind: TEventKind;
        FData: TEventData;
      end;
    
      TIPCEvent = class(TEvent)
      private
        FOwner: TIPCThread;
        FOwnerID: Integer;
        FSharedMem: TSharedMem;
        FEventInfo: PIPCEventInfo;
        function GetID: Integer;
        procedure SetID(Value: Integer);
        function GetKind: TEventKind;
        procedure SetKind(Value: TEventKind);
        function GetData: TEventData;
        procedure SetData(Value: TEventData);
      public
        constructor Create(AOwner: TIPCThread; const Name: string; Manual: Boolean);
        destructor Destroy; override;
        procedure Signal(Kind: TEventKind);
        procedure SignalID(Kind: TEventKind; ID: Integer);
        procedure SignalData(Kind: TEventKind; ID: Integer; Data: TEventData);
        function WaitFor(TimeOut, ID: Integer; Kind: TEventKind): Boolean;
        property ID: Integer read GetID write SetID;
        property Kind: TEventKind read GetKind write SetKind;
        property Data: TEventData read GetData write SetData;
        property OwnerID: Integer read FOwnerID write FOwnerID;
      end;
    
    { TClientDirectory }
    
    { The client directory is a block of shared memory where the list of all
      active clients is maintained }
    
      TClientDirEntry = packed record
        ID: Integer;
        Name: Array[0..58] of Char;
      end;
    
      TClientDirRecords = array[1..MAX_CLIENTS] of TClientDirEntry;
      PClientDirRecords = ^TClientDirRecords;
    
      TClientDirectory = class
      private
        FClientCount: PInteger;
        FMonitorID: PInteger;
        FMaxClients: Integer;
        FMutex: TMutex;
        FSharedMem: TSharedMem;
        FDirBuffer: PClientDirRecords;
        function GetCount: Integer;
        function GetClientName(ClientID: Integer): string;
        function GetClientRec(Index: Integer): TClientDirEntry;
        function IndexOf(ClientID: Integer): Integer;
        function GetMonitorID: Integer;
        procedure SetMonitorID(MonitorID: Integer);
      public
        constructor Create(MaxClients: Integer);
        destructor Destroy; override;
        function AddClient(ClientID: Integer; const AName: string): Integer;
        function Last: Integer;
        function RemoveClient(ClientID: Integer): Boolean;
        property Count: Integer read GetCount;
        property ClientRec[Index: Integer]: TClientDirEntry read GetClientRec;
        property MonitorID: Integer rea

上一篇：intrcptu.pas
下一篇：法律专业开题报告范文