ipcthrd.pas

Clock 桌面时钟 日历 阴历 看到的delphi程序 转发

unit IPCThrd;

{ Inter-Process Communication Thread Classes }

interface

uses
  SysUtils, Classes, Windows;

type

  THandledObject = class(TObject)
  protected
    FHandle: THandle;
  public
    destructor Destroy; override;
    property Handle: THandle read FHandle;
  end;

  TEvent = class(THandledObject)
  public
    constructor Create(const Name: string; Manual: Boolean);
    procedure Signal;
    procedure Reset;
    function Wait(TimeOut: Integer): Boolean;
  end;

  TMutex = class(THandledObject)
  public
    constructor Create(const Name: string);
    function Get(TimeOut: Integer): Boolean;
    function Release: Boolean;
  end;

  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;

  TWindow = class(THandledObject)
  public
    constructor Create(WndMethod: TWndMethod);
    destructor Destroy; override;
  end;

function MutexExist(Const Name : String): Boolean;

implementation

function MutexExist(Const Name : String): Boolean;
var FH : THandle;
begin
  FH := OpenMutex(MUTEX_ALL_ACCESS, false, PChar(Name));
  result := FH <> 0;
  if result then
    CloseHandle(FH);
end;

destructor THandledObject.Destroy;
begin
  if FHandle <> 0 then
    CloseHandle(FHandle);
end;

constructor TEvent.Create(const Name: string; Manual: Boolean);
begin
  FHandle := CreateEvent(nil, Manual, False, PChar(Name));
end;

procedure TEvent.Reset;
begin
  if FHandle <> 0 then
    ResetEvent(FHandle);
end;

procedure TEvent.Signal;
begin
  if FHandle <> 0 then
    SetEvent(FHandle);
end;

function TEvent.Wait(TimeOut: Integer): Boolean;
begin
  result := FHandle <> 0;
  if result then
    Result := WaitForSingleObject(FHandle, TimeOut) = WAIT_OBJECT_0;
end;

constructor TMutex.Create(const Name: string);
begin
  FHandle := CreateMutex(nil, False, PChar(Name));
end;

function TMutex.Get(TimeOut: Integer): Boolean;
begin
  Result := FHandle <> 0;
  if Result then
    Result := WaitForSingleObject(FHandle, TimeOut) = WAIT_OBJECT_0;
end;

function TMutex.Release: Boolean;
begin
  result := FHandle <> 0;
  if result then
    Result := ReleaseMutex(FHandle);
end;

constructor TSharedMem.Create(const Name: string; Size: Integer);
begin
  try
    FName := Name;
    FSize := Size;

    FHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, Size, PChar(Name));

    FCreated := GetLastError = 0;
    if FCreated then
      FFileView := MapViewOfFile(FHandle, FILE_MAP_WRITE, 0, 0, Size);

  except
    raise exception.CreateFmt('Error creating shared memory %s (%d)', [Name, GetLastError]);
  end;
end;

destructor TSharedMem.Destroy;
begin
  if FFileView <> nil then
    UnmapViewOfFile(FFileView);
  inherited Destroy;
end;

constructor TWindow.Create(WndMethod: TWndMethod);
begin
  FHandle := AllocateHWnd(WndMethod);
end;

destructor TWindow.Destroy;
begin
  DeallocateHWnd(FHandle);
  
  FHandle := 0;
  inherited;
end;  
end.