terminal.pas

一个delphi使用的传送短信(SMS)到GSM手机的单元及示范.

{ Copyright (c) 1999, 2000 by Mandys Tomas - Mandy Soft }
{ email: [e-mail] }
{ URL: http://www.2p.cz }

unit Terminal;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, SyncObjs;

const
  CR = #13;
  LF = #10;

type
  TTerminal = class;

  TTerminalThread = class(TThread)
  private
    FTerminal: TTerminal;
    FLogBuffer: TStrings;
    FLogTermBuffer: string;
    FEvent: TSimpleEvent;
    FCriticalSection: TCriticalSection;
  protected
    procedure Execute; override;
    procedure Terminate;
    procedure DoOnSignal;
  public
    constructor Create(aTerminal: TTerminal);
    destructor Destroy; override;
  end;

  TTerminal = class(TMemo)
  private
    FTermXPos: Integer;
    FMaxLines: Integer;
    FTermThread: TTerminalThread;
  protected
    procedure LogTermChar(C: Char); virtual;
    procedure CheckLines;
  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure Log(const S: string);
    procedure LogErr(const S1, S2: string);
    procedure LogTerm(const S: string);
  published
    property MaxLines: Integer read FMaxLines write FMaxLines;
  end;

procedure Register;

implementation
uses
  AuxStr;

constructor TTerminalThread.Create;
begin
  FTerminal:= aTerminal;
  Priority := tpHigher;
  FreeOnTerminate := True;
  FEvent := TSimpleEvent.Create;
  FCriticalSection:= TCriticalSection.Create;
  FLogBuffer:= TStringList.Create;
  inherited Create(False);
end;

destructor TTerminalThread.Destroy;
begin
  FEvent.Free;
  FCriticalSection.Free;
  FLogBuffer.Free;
  Inherited Destroy;
end;

procedure TTerminalThread.Execute;
begin
  while not Terminated do
  begin
    FEvent.WaitFor(INFINITE);
    if not Terminated then
    begin
      FEvent.ResetEvent;
      Synchronize(DoOnSignal);
    end;
  end;
end;

procedure TTerminalThread.Terminate;
begin
  inherited;
  FEvent.SetEvent;
end;

procedure TTerminalThread.DoOnSignal;
  procedure Log(const S: string);
  begin
    FTerminal.CheckLines;
    FTerminal.Lines.Add(S);
    FTerminal.FTermXPos:= 0;
  end;

  procedure LogTerm(const S: string);
  var
    I: Integer;
  begin
    for I:= 1 to Length(S) do
      FTerminal.LogTermChar(S[I]);
  end;
var
  S: string;
begin
  while FLogBuffer.Count <> 0 do
  begin
    FCriticalSection.Enter;
    try
      S:= FLogBuffer[0];
      FLogBuffer.Delete(0);
    finally
      FCriticalSection.Leave;
    end;
    Log(S);
  end;
  FCriticalSection.Enter;
  try
    S:= FLogTermBuffer;
    FLogTermBuffer:= '';
  finally
    FCriticalSection.Leave;
  end;
  LogTerm(S);
end;

constructor TTerminal.Create;
begin
  inherited;
  FMaxLines:= 100;
  ReadOnly:= True;
  FTermThread:= TTerminalThread.Create(Self);
end;

destructor TTerminal.Destroy;
begin
  FTermThread.Terminate;
  inherited;
end;

procedure TTerminal.Log;
begin
  FTermThread.FCriticalSection.Enter;
  try
    FTermThread.FLogBuffer.Add(S);
  finally
    FTermThread.FCriticalSection.Leave;
  end;
  FTermThread.FEvent.SetEvent;
end;

procedure TTerminal.LogErr;
begin
  Log(Format('%s: %s', [S1, S2]));
end;

procedure TTerminal.LogTerm;
begin
  FTermThread.FCriticalSection.Enter;
  try
    FTermThread.FLogTermBuffer:= FTermThread.FLogTermBuffer + S;
  finally
    FTermThread.FCriticalSection.Leave;
  end;
  FTermThread.FEvent.SetEvent;
end;

procedure TTerminal.CheckLines;
begin
  while Lines.Count > FMaxLines do
    Lines.Delete(0);
end;

procedure TTerminal.LogTermChar;
var
  S: string;
  I, N: Integer;
begin
  CheckLines;
  if Lines.Count = 0 then
    Lines.Add('');
  case C of
    LF: begin
          Lines.Add(ReplSpace(FTermXPos));
        end;
    CR: FTermXPos:= 0;
    #8{BS}: if FTermXPos > 0 then
            begin
              Dec(FTermXPos);
            end;
    else
      S:= Lines[Lines.Count-1];

      I:= FTermXPos+1-Length(S);
      if I > 0 then
        S:= S+ReplSpace(I);
      S[FTermXPos+1]:= C;
      Lines[Lines.Count-1]:= S;
      Inc(FTermXPos);
  end;
  N:= FTermXPos;
  for I:= 0 to Lines.Count-2 do
    Inc(N, Length(Lines[I])+2);
  SelStart:= N;
  SelLength:= 0;
end;

procedure Register;
begin
  RegisterComponents('Communication', [TTerminal]);
end;

end.