Email服务器

开发平台：
Delphi

XPWinBase.pas：源码内容
							unit XPWinBase;
{
 $Source: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/Common/XPWinBase.pas,v $
 $Revision: 1.1 $
 $Date: 2004/05/03 15:07:15 $
 Last amended by $Author: pvspain $
 $State: Exp $
 XPWinBase:
 Interfaces and implementing classes which provide a base
 for Win32 Kernel objects.
 Copyright (c) 2001 by The Excellent Programming Company Pty Ltd
 (Australia) (ABN 27 005 394 918).
 Contact Paul Spain via email: paul@xpro.com.au
 This unit is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
 License as published by the Free Software Foundation; either
 version 2.1 of the License, or (at your option) any later version.
 This unit is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 Lesser General Public License for more details.
 You should have received a copy of the GNU Lesser General Public
 License along with this unit; if not, the license can be viewed at:
 http://www.gnu.org/copyleft/lesser.html
 or write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 Boston, MA  02111-1307  USA
 }
interface
uses
  Windows,    // THandle,  CreateXXX(), OpenXXX
  SysUtils;   // Exception, Trim(), FmtStr(), AnsiPos(),
              // AnsiLowerCase()
{$IFDEF XPW32E}
type
  EXPWin32 = class (Exception) end;
    EXPWin32Handle = class (EXPWin32) end;
{$ENDIF}
//////////////////////////////////////////////////////////////////////////////
///   IXPWinError
//////////////////////////////////////////////////////////////////////////////
type
  IXPWinError = interface
    ['{B53D5BE1-3BC8-11D5-A2BB-00608CF441D9}']
    function HasErred: boolean;
    function GetLastError: cardinal;
    function GetLastErrorText: string;
    function GetLastContext: string;
    procedure Reset;
    end;
{$IFDEF XPW32E}
  TTEXPWin32 = class of EXPWin32;
{$ENDIF}
  TXPWinError = class(TInterfacedObject, IXPWinError)
    private
    FLastError: cardinal;
    FLastContext: string;
{$IFDEF XPW32E}
    FException: TTEXPWin32;
{$ENDIF}
    protected
{$IFDEF XPW32E}
    procedure SetException(const AException: TTEXPWin32);
{$ENDIF}
    procedure Error(const Context: string);
    procedure SetLastError(const Value: cardinal = 0);
    procedure SetLastContext(const Context: string);
    //
    // IXPWinError implementation
    //
    function HasErred: boolean;
    procedure Reset;
    function GetLastError: cardinal;
    function GetLastErrorText: string;
    function GetLastContext: string;
    public
{$IFDEF XPW32E}
    constructor Create(AException: TTEXPWin32);
{$ELSE}
    constructor Create;
{$ENDIF}
    end;
//////////////////////////////////////////////////////////////////////////////
///   IXPWinHandle
//////////////////////////////////////////////////////////////////////////////
type
  { Reference to a Windows handle which looks after its own closure.
    Used by kernel objects which can return multiple handles. }
  IXPWinHandle = interface(IXPWinError)
    ['{EC93EF02-1092-11D5-A266-00608CF441D9}']
    function IsSignaled: boolean;
    function GetHandle: THandle;
    function Wait: boolean;
    function WaitFor(const Millisecs: cardinal): boolean;
    property Handle: THandle read GetHandle;
    end;
  TXPWinHandle = class(TXPWinError, IXPWinHandle)
    private
    FHandle: THandle;
    //
    // IXPWinHandle implementation
    //
    function GetHandle: THandle;
    protected
    function IsSignaled: boolean; virtual;
    function Wait: boolean; virtual;
    function WaitFor(const Millisecs: cardinal): boolean; virtual;
    public
    constructor Create(AHandle: THandle);
    destructor Destroy; override;
    end;
//////////////////////////////////////////////////////////////////////////////
///   IXPWinNamedKernelObject
//////////////////////////////////////////////////////////////////////////////
type
  TXPKOInstance = (koUnknown, koCreated, koOpened);
  IXPWinNamedKernelObject = interface(IXPWinHandle)
    ['{0BCC42D3-1528-11D5-A26D-00608CF441D9}']
    function GetName: string;
    function GetInstance: TXPKOInstance;
    property Name: string read GetName;
    property Instance: TXPKOInstance read GetInstance;
    end;
  TXPWinKernelObject = class(TXPWinError)
    protected
    FSecurityAttributes: TSecurityAttributes;
    public
    constructor Create(const Inheritable: boolean;
      const SecurityDescriptor: Pointer);
    end;
  TXPWinNamedKernelObject = class(TXPWinKernelObject, IXPWinHandle,
    IXPWinNamedKernelObject)
    private
    function CustomWait(const Timeout: cardinal): boolean;
    protected
    FName: string;
    FHandle: THandle;
    FInstance: TXPKOInstance;
    //
    // IXPWinHandle implementation
    //
    function IsSignaled: boolean; virtual;
    function GetHandle: THandle;
    function Wait: boolean; virtual;
    function WaitFor(const Millisecs: cardinal): boolean; virtual;
    //
    // IXPWinNamedKernelObject implementation
    //
    function GetName: string;
    function GetInstance: TXPKOInstance;
    public
    constructor Create(const AName: string; const Inheritable: boolean;
      const SecurityDescriptor: Pointer);
    destructor Destroy; override;
    class function UniqueName: string;
    end;
//////////////////////////////////////////////////////////////////////////////
///   Creator functions: unit entry points
//////////////////////////////////////////////////////////////////////////////
function CreateHandle(const AHandle: THandle): IXPWinHandle;
//////////////////////////////////////////////////////////////////////////////
///   Global utility functions 
//////////////////////////////////////////////////////////////////////////////
function CreateGUIDAsString: string;
function Win32ErrorText(const ErrorCode: cardinal): string;
implementation
uses
  ActiveX;    // CoCreateGUID
const CVSID: string = '$Header: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/Common/XPWinBase.pas,v 1.1 2004/05/03 15:07:15 pvspain Exp $';
//////////////////////////////////////////////////////////////////////////////
///   IXPWinError implementation
//////////////////////////////////////////////////////////////////////////////
const
  XPWinNoError = ERROR_SUCCESS;
{$IFDEF XPW32E}
constructor TXPWinError.Create(AException: TTEXPWin32);
  begin
  inherited Create;
  FLastError := XPWinNoError;
  SetException(AException);
  end;
procedure TXPWinError.SetException(const AException: TTEXPWin32);
  begin
  FException := AException;
  end;
{$ELSE}
constructor TXPWinError.Create;
  begin
  inherited Create;
  FLastError := XPWinNoError;
  end;
{$ENDIF}
procedure TXPWinError.Error(const Context: string);
  begin
  SetLastError;
  SetLastContext(Context);
{$IFDEF XPW32E}
  raise FException.CreateFmt(GetLastContext + ': Win32 Error %d: %s',
    [GetLastError, GetLastErrorText]);
{$ENDIF}
  end;
function TXPWinError.GetLastError: cardinal;
  begin
  Result := FLastError;
  end;
function TXPWinError.GetLastErrorText: string;
  begin
  Result := Win32ErrorText(FLastError);
  end;
function TXPWinError.GetLastContext: string;
  begin
  Result := FLastContext;
  end;
function TXPWinError.HasErred: boolean;
  begin
  Result := FLastError <> XPWinNoError;
  end;
procedure TXPWinError.Reset;
  begin
  FLastError := XPWinNoError;
  System.SetLength(FLastContext, 0);
  end;
procedure TXPWinError.SetLastError(const Value: cardinal);
  begin
  if Value = 0 then
    FLastError := Windows.GetLastError
  else
    FLastError := Value;
  end;
procedure TXPWinError.SetLastContext(const Context: string);
  begin
  FLastContext := Context;
  end;
///////////////////////////////////////////////////////////////////////////////
///     IXPWinHandle implementation
///////////////////////////////////////////////////////////////////////////////
constructor TXPWinHandle.Create(AHandle: THandle);
  begin
{$IFDEF XPW32E}
  inherited Create(EXPWin32Handle);
{$ELSE}
  inherited Create;
{$ENDIF}
  FHandle := AHandle;
  end;
destructor TXPWinHandle.Destroy;
  begin
  Windows.CloseHandle(FHandle);
  inherited Destroy;
  end;
function TXPWinHandle.IsSignaled: boolean;
  begin
  Result := false;
  end;
function TXPWinHandle.Wait: boolean;
  begin
  Result := true;
  end;
function TXPWinHandle.WaitFor(const Millisecs: cardinal): boolean;
  begin
  Result := true;
  end;
function TXPWinHandle.GetHandle: THandle;
  begin
  Result := FHandle;
  end;
///////////////////////////////////////////////////////////////////////////////
///     TXPWinKernelObject implementation
///////////////////////////////////////////////////////////////////////////////
constructor TXPWinKernelObject.Create(const Inheritable: boolean;
  const SecurityDescriptor: Pointer);
  begin
{$IFDEF XPW32E}
  inherited Create(EXPWin32);
{$ELSE}
  inherited Create;
{$ENDIF}
  with FSecurityAttributes do
    begin
    nLength := SizeOf(FSecurityAttributes);
    lpSecurityDescriptor := SecurityDescriptor;
    bInheritHandle := Inheritable;
    end;
  end;
///////////////////////////////////////////////////////////////////////////////
///     TXPWinNamedKernelObject implementation
///////////////////////////////////////////////////////////////////////////////
constructor TXPWinNamedKernelObject.Create(const AName: string;
  const Inheritable: boolean; const SecurityDescriptor: Pointer);
  begin
  inherited Create(Inheritable, SecurityDescriptor);
  { Create a "unique"  name if none is passed. }
  if System.Length(SysUtils.Trim(AName)) = 0 then
    FName := UniqueName
  else
    FName := AName;
  FHandle := INVALID_HANDLE_VALUE;
  FInstance := koUnknown;
  end;
function TXPWinNamedKernelObject.GetInstance: TXPKOInstance;
  begin
  Result := FInstance;
  end;
destructor TXPWinNamedKernelObject.Destroy;
  begin
  if FHandle <> INVALID_HANDLE_VALUE then
    Windows.CloseHandle(FHandle);
  inherited Destroy;
  end;
class function TXPWinNamedKernelObject.UniqueName: string;
  var
  Count: int64;
  begin
  if Windows.QueryPerformanceCounter(Count) then
    // Create a number which (hopefully) uniquely identifies the calling context
    // in machine-space (current thread ID) and time (high res counter value).
    SysUtils.FmtStr(Result, '%d.%d', [Windows.GetCurrentThreadID, Count])
  else
    // High-res counter not available, create a GUID
    Result := CreateGUIDAsString;
  end;
function TXPWinNamedKernelObject.GetHandle: THandle;
  begin
  Result  := FHandle;
  end;
function TXPWinNamedKernelObject.GetName: string;
  begin
  Result := FName;
  end;
function TXPWinNamedKernelObject.CustomWait(const Timeout: cardinal): boolean;
  var
  WaitResult: cardinal;
  begin
  WaitResult := Windows.WaitForSingleObject(FHandle, Timeout);
  case WaitResult of
    WAIT_FAILED:
      begin
      Error('TXPWinNamedKernelObject: Windows.WaitForSingleObject failure');
      Result := false;
      end;
    WAIT_TIMEOUT:
      Result := false;
    WAIT_OBJECT_0, WAIT_ABANDONED:
      Result := true;
    else
      Result := false;
    end;
  end;
function TXPWinNamedKernelObject.IsSignaled: boolean;
  begin
  Result := CustomWait(0);
  end;
function TXPWinNamedKernelObject.Wait: boolean;
  begin
  Result := CustomWait(INFINITE);
  end;
function TXPWinNamedKernelObject.WaitFor(const Millisecs: cardinal): boolean;
  begin
  Result := CustomWait(Millisecs);
  end;
///////////////////////////////////////////////////////////////////////////////
///    Global functions
///////////////////////////////////////////////////////////////////////////////
function CreateHandle(const AHandle: THandle): IXPWinHandle;
  begin
  Result := TXPWinHandle.Create(AHandle);
  end;
function CreateGUIDAsString: string;
  var
  AGUID: TGUID;
  AGUIDString: widestring;
  begin
  ActiveX.CoCreateGUID(AGUID);
  System.SetLength(AGUIDString, 39);
  ActiveX.StringFromGUID2(AGUID, PWideChar(AGUIDString), 39);
  Result := string(PWideChar(AGUIDString));
  end;
function Win32ErrorText(const ErrorCode: cardinal): string;
  const
  LangID = 0;
  MessageSource = nil;
  Inserts = nil;
  begin
  System.SetLength(Result, 255);
  Windows.FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, MessageSource, ErrorCode,
    LangID, PAnsiChar(Result), 255, Inserts);
  Result := string(PAnsiChar(Result));
  end;
end.

						