logs.pas

delphi完成端口Socks例子,纯Delphi做的

unit Logs;

interface

type
  TLog = class
  private
    FFileName: string;
    function OpenSyncObject: THandle;
  public
    constructor Create(const AFileName: string);
    procedure Write(const Msg: string); overload;
    procedure Write(const Msg: string; const Args: array of const); overload;
    class procedure SetLog(const AFileName: string);
  end;

var
  Log: TLog;

procedure InitializeLog;
procedure FinalizeLog;

implementation

uses SysUtils, Windows;

{ TLog }

constructor TLog.Create(const AFileName: string);
begin
  FFileName := AFileName;
end;

function TLog.OpenSyncObject: THandle;
var
  P, P1: PChar;
begin
  P := StrAlloc(Length(FFileName) + 1);
  try
    StrPCopy(P, FFileName);
    P1 := P;
    while P1[0] <> #0 do
    begin
      if P1[0] = '\' then
        P1[0] := '_';
      Inc(P1);
    end;
    Result := OpenMutex(MUTEX_ALL_ACCESS or SYNCHRONIZE, False, P);
    if Result = 0 then
      Result := CreateMutex(nil, True, P)
    else
      WaitForSingleObject(Result, INFINITE);
  finally
    StrDispose(P);
  end;
end;

procedure TLog.Write(const Msg: string; const Args: array of const);
begin
  Write(Format(Msg, Args));
end;

procedure TLog.Write(const Msg: string);
var
  Mutex: THandle;
  S: string;
  P: PChar;
  Stream: THandle;
begin
  Mutex := OpenSyncObject;
  if FileExists(FFileName) then
    Stream := FileOpen(FFileName, fmOpenReadWrite)
  else
    Stream := FileCreate(FFileName);
  S := Format('%s:[ProcessID:%d]%s'#13#10,
    [FormatDateTime('yyyy-mm-dd hh:nn:ss zzz', Now),
    GetCurrentProcessId, Msg]);
  P := StrAlloc(Length(S) + 1);
  try
    StrPCopy(P, S);
    FileSeek(Stream, 0, 2);
    FileWrite(Stream, P^, Length(S));
  finally
    StrDispose(P);
    FileClose(Stream);
    ReleaseMutex(Mutex);
    CloseHandle(Mutex);
  end;
end;

class procedure TLog.SetLog(const AFileName: string);
begin
  if (Log <> nil) and (CompareText(Log.FFileName, AFileName) <> 0) then
    Log.Free
  else
    Exit;
  Log := TLog.Create(AFileName);
end;

function GetDefaultLogFileName: string;
begin
  Result := Format('%s.log', [ParamStr(0)]);
end;

procedure InitializeLog;
begin
  Log := TLog.Create(GetDefaultLogFileName);
end;

procedure FinalizeLog;
begin
  if Log <> nil then
    FreeAndNil(Log);
end;

initialization
//  Log := TLog.Create(GetDefaultLogFileName);
finalization
//  if Log <> nil then
//    FreeAndNil(Log);
end.