一个同步对象工具单元：
unit USync;
interface
uses
SysUtils, Classes, Windows;
type
TSync = class(TObject)
protected
FHandle: THandle;
public
destructor Destroy;
override;
property Handle: THandle read FHandle;
end;
TMutex = class(TSync)
public
constructor Create(const Name: string);
function Get(TimeOut: Integer): Boolean;
function Release: Boolean;
end;
TEvent = class(TSync)
public
constructor Create(const Name: string;
Manual: Boolean);
function Wait(TimeOut: Integer): Boolean;
procedure Signal;
procedure Reset;
end;
TSemaphore = class(TSync)
public
constructor Create(const Name: string;
Initial, Maxinum: Integer);
function Release(Count: Integer;
var PreviousCount: Integer): Boolean;
overload;
function Release(Count: Integer): Boolean;
overload;
function Get(TimeOut: Integer): Boolean;
end;
TFileMap = class(TSync)
private
FCreated: Boolean;
FSize: Integer;
FFileView: Pointer;
FName: string;
public
constructor Create(const Name: string;
Size: Integer);
constructor Open(const Name: string);
destructor Destroy;
override;
property Name: string read FName;
property Size: Integer read FSize;
property Buffer: Pointer read FFileView;
property Created: Boolean read FCreated;
end;
TMemStream = class(TCustomMemoryStream)
private
Owned: Boolean;
public
destructor Destroy;
override;
procedure Clear;
procedure Attach(PBuff: Pointer;
BuffSize: Integer);
procedure AttachOwnFree(PBuff: Pointer;
BuffSize: Integer);
procedure LoadFromStream(Stream: TStream);
function Write(const Buffer;
Count: Longint): Longint;
override;
function WriteString(const S: String): Longint;
function ReadString(const Count: Integer): String;
end;
implementation
procedure Error(const Msg: string);
begin
raise Exception.Create(Msg);
end;
{ TSync }
destructor TSync.Destroy;
begin
if FHandle <> 0 then
CloseHandle(FHandle);
end;
{ TMutex }
constructor TMutex.Create(const Name: string);
begin
FHandle := CreateMutex(nil, False, PChar(Name));
if FHandle = 0 then
abort;
end;
function TMutex.Get(TimeOut: Integer): Boolean;
begin
Result := WaitForSingleObject(FHandle, TimeOut) = WAIT_OBJECT_0;
end;
function TMutex.Release: Boolean;
begin
Result := ReleaseMutex(FHandle);
end;
{ TEvent }
constructor TEvent.Create(const Name: string;
Manual: Boolean);
begin
FHandle := CreateEvent(nil, Manual, False, PChar(Name));
if FHandle = 0 then
abort;
end;
function TEvent.Wait(TimeOut: Integer): Boolean;
begin
Result := WaitForSingleObject(FHandle, TimeOut) = WAIT_OBJECT_0;
end;
procedure TEvent.Signal;
begin
SetEvent(FHandle);
end;
procedure TEvent.Reset;
begin
ResetEvent(FHandle);
end;
{ TSemaphore }
constructor TSemaphore.Create(const Name: string;
Initial,
Maxinum: Integer);
begin
FHandle := CreateSemaphore(nil, Initial, Maxinum, PChar(Name));
if FHandle = 0 then
abort;
end;
function TSemaphore.Get(TimeOut: Integer): Boolean;
begin
Result := WaitForSingleObject(FHandle, TimeOut) = WAIT_OBJECT_0;
end;
function TSemaphore.Release(Count: Integer): Boolean;
begin
Result := ReleaseSemaphore(Handle, Count, nil);
end;
function TSemaphore.Release(Count: Integer;
var PreviousCount: Integer): Boolean;
begin
Result := ReleaseSemaphore(Handle, Count, @PreviousCount);
end;
{ TFileMap }
constructor TFileMap.Create(const Name: string;
Size: Integer);
begin
try
FName := Name;
FSize := Size;
{ CreateFileMapping, when called with $FFFFFFFF for the hanlde value,
creates a region of shared memory }
FHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
Size, PChar(Name));
if FHandle = 0 then
abort;
FCreated := GetLastError = 0;
{ We still need to map a pointer to the handle of the shared memory region }
FFileView := MapViewOfFile(FHandle, FILE_MAP_WRITE, 0, 0, Size);
if FFileView = nil then
