spc.pas

SPComm.v2005.8.2.Full.Source.Delphi.513802.rar,相当于mscomm

unit SPC;

{
SPC --- Serial Port Communication Component
   powered by LYSoft Liu Yang 2005.8.2

SPC is compatible with MSCOMM an ActiveX control, use it to replace MSCOMM
all interface is coded by API, no other DLL or OCX is needed 
}

interface

uses
  SysUtils, Classes, Controls, Messages, Windows, SPComm;

const
  // please do not remove this line!
  CopyRight = 'SPC powered by LYSoft Liu Yang';
  WM_MCM = WM_User + 1234;

  comEvSend = 1;  // 发送事件
  comEvReceive = 2;  // 接收事件
  comEvCTS = 3;  // clear-to-send 线变化
  comEvDSR = 4;  // data-set ready 线变化
  comEvCD = 5;  // carrier detect 线变化
  comEvRing = 6;  // 振铃检测
  comEvEOF = 7;  // 文件结束

type
  TSPC = class(TComponent)
    private
      FComm: TComm;
      FRThreshold, FSThreshold, FInputLen, FInputMode: Integer;
      FReceiveData: string;
      FIsPortOpen, FEOFEnable: Boolean;
      FHandle, FModemStatus: Cardinal;
      FOnComm: TNotifyEvent;
      FCommEvent: Byte;
      procedure DoModemStateChange(Sender: TObject;
        ModemEvent: Cardinal);
      procedure DoReceiveData(Sender: TObject; Buffer: Pointer;
        BufferLength: Word);
      procedure DoReceiveError(Sender: TObject;
        EventMask: Cardinal);
      procedure DoRequestHangup(Sender: TObject);
      procedure DoSendDataEmpty(Sender: TObject);
      procedure SetSPComm(Comm: TComm);
      function GetParityCheck: Boolean;
      procedure SetParityCheck(Value: Boolean);
      procedure SetPortOpen(Value: Boolean);
      function GetReceiveData: string;
      procedure SendData(Data: string);
      function GetCommPort: byte;
      procedure SetCommPort(PortNumber: byte);
      function GetSettings: string;
      procedure SetSettings(Value: string);
      function GetDTREnable: Boolean;
      procedure SetDTREnable(Value: Boolean);
      function GetRTSEnable: Boolean;
      procedure SetRTSEnable(Value: Boolean);
      procedure WndProc(var Msg: TMessage); message WM_MCM;
    protected
      property SPCommControl: TComm read FComm write SetSPComm;
    public
      constructor Create( AOwner: TComponent ); override;
      destructor Destroy; override;
      function CTSHolding: Boolean;
    published
      property CommPort: byte read GetCommPort write SetCommPort;
      property Settings: string read GetSettings write SetSettings;
      property DTREnable: Boolean read GetDTREnable write SetDTREnable;
      property RTSEnable: Boolean read GetRTSEnable write SetRTSEnable;
      property RThreshold: Integer read FRThreshold write FRThreshold;
      property SThreshold: Integer read FSThreshold write FSThreshold;
      property Input: string read GetReceiveData;
      property Output: string write SendData;
      property InputLen: Integer read FInputLen write FInputLen;
      property ParityCheck: Boolean read GetParityCheck write SetParityCheck;
      property PortOpen: Boolean read FIsPortOpen write SetPortOpen;
      property OnComm: TNotifyEvent read FOnComm write FOnComm;
      property CommEvent: Byte read FCommEvent;
      property EOFEnable: Boolean read FEOFEnable write FEOFEnable;
      property InputMode: Integer read FInputMode write FInputMode;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('System', [TSPC])
end;

{ TSPC }

constructor TSPC.Create(AOwner: TComponent);
begin
  inherited;
  FComm := nil;
  FRThreshold := 0;
  FSThreshold := 0;
  FInputLen := 0;
  FInputMode := 0;
  FReceiveData := '';
  FEOFEnable := False;
  if not (csDesigning in ComponentState) then
     FHandle := AllocateHWnd(WndProc);
  SPCommControl := TComm.Create(Self);
end;

procedure TSPC.DoModemStateChange(Sender: TObject; ModemEvent: Cardinal);
begin
  FModemStatus := ModemEvent;
  case ModemEvent of
    ME_CTS: FCommEvent := comEvCTS;
    ME_DSR: FCommEvent := comEvDSR;
    ME_RING:FCommEvent := comEvRing;
    ME_RLSD:FCommEvent := comEvCD;
  end;
  if Assigned(FOnComm) then PostMessage(FHandle, WM_MCM, 0, 0);
end;

procedure TSPC.DoReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
  Buf: PChar;
  i: Integer;
begin
  Buf := Buffer;
  FReceiveData := FReceiveData + Buf;
  if RThreshold < 1 then Exit else
     if RThreshold <= Length(FReceiveData) then
        if Assigned(FOnComm) then
           begin
             FCommEvent := comEvReceive;
             PostMessage(FHandle, WM_MCM, 0, 0);
           end;
end;

procedure TSPC.DoReceiveError(Sender: TObject; EventMask: Cardinal);
begin
  if Assigned(FOnComm) then FOnComm(Sender);
end;

procedure TSPC.DoRequestHangup(Sender: TObject);
begin

end;

procedure TSPC.DoSendDataEmpty(Sender: TObject);
begin
  if SThreshold < 1 then Exit;
  if SThreshold = 1 then if Assigned(FOnComm) then
     begin
       FCommEvent := comEvSend;
       PostMessage(FHandle, WM_MCM, 0, 0);
     end;
end;

function TSPC.GetCommPort: byte;
var s: string;
begin
  Result := 0;
  if FComm = nil then Exit;
  s := LowerCase(FComm.CommName);
  if Pos('com', s) = 1 then Delete(s, 1, 3) else Exit;
  Result := StrToIntDef(s, 0);
end;

function TSPC.CTSHolding: Boolean;
begin
  Result := False;
  if FComm = nil then Exit;
  Result := True;  // FModemStatus = ME_CTS;
end;

function TSPC.GetDTREnable: Boolean;
begin
  if FComm = nil then Exit;
  Result := FComm.DtrControl = SPComm.DTREnable;
end;

function TSPC.GetRTSEnable: Boolean;
begin
  if FComm = nil then Exit;
  Result := FComm.RtsControl = SPComm.RtsEnable;
end;

function TSPC.GetSettings: string;
var s: string; i: Integer;
begin
  // BR,P,D,S
  Result := IntToStr(FComm.BaudRate) + ',';
  case FComm.Parity of
    None : Result := Result + 'n,';
    Odd  : Result := Result + 'o,';
    Even : Result := Result + 'e,';
    Mark : Result := Result + 'm,';
    Space: Result := Result + 's,';
  end;
  case FComm.ByteSize of
    _5: Result := Result + '5,';
    _6: Result := Result + '6,';
    _7: Result := Result + '7,';
    _8: Result := Result + '8,';
  end;
  case FComm.StopBits of
    _1: Result := Result + '1';
    _1_5: Result := Result + '1.5';
    _2: Result := Result + '2';
  end;
end;

function TSPC.GetReceiveData: string;
begin
  if FComm = nil then Exit;
  if InputLen < 1 then
     begin
       Result := FReceiveData;
       FReceiveData := '';
     end else
     begin
       Result := Copy(FReceiveData, 1, InputLen);
       Delete(FReceiveData, 1, InputLen);
     end;
end;

procedure TSPC.SendData(Data: string);
var i: Integer;
begin
  if FComm = nil then Exit;
  if FEOFEnable then
     begin
       i := Pos(#13#10, Data);
       if i > 0 then
          begin
            Data := Copy(Data, 1, 1);
            FCommEvent := comEvEOF;
            PostMessage(FHandle, WM_MCM, 0, 0);
          end;
     end;
  FComm.WriteCommData(PChar(Data), Length(Data));
end;

procedure TSPC.SetCommPort(PortNumber: byte);
begin
  if FComm = nil then Exit;
  FComm.CommName := Format('COM%d', [PortNumber]);
end;

procedure TSPC.SetDTREnable(Value: Boolean);
begin
  if FComm = nil then Exit;
  if Value then FComm.DtrControl := SPComm.DtrEnable else FComm.DtrControl := SPComm.DtrDisable;
end;

procedure TSPC.SetPortOpen(Value: Boolean);
begin
  if FComm = nil then Exit;
  if Value then
     begin
       FIsPortOpen := True;
       FComm.StartComm;
     end else
     begin
       FIsPortOpen := False;
       FComm.StopComm;
     end;
end;

procedure TSPC.SetRTSEnable(Value: Boolean);
begin
  if FComm = nil then Exit;
  if Value then FComm.RtsControl := SPComm.RtsEnable else FComm.RtsControl := SPComm.RtsDisable;
end;

procedure TSPC.SetSettings(Value: string);
var s: string; i: Integer;
begin
  if FComm = nil then Exit;
  // BR,P,D,S
  i := Pos(',', Value);
  s := Copy(Value, 1, i-1);
  Delete(Value, 1, i);
  FComm.BaudRate := StrToIntDef(s, 115200);
  i := Pos(',', Value);
  s := LowerCase(Copy(Value, 1, i-1));
  Delete(Value, 1, i);
  // E Even; M Mark; N (Default) None; O Odd; S Space
  if s = 'e' then FComm.Parity := Even else
  if s = 'm' then FComm.Parity := Mark else
  if s = 'o' then FComm.Parity := Odd else
  if s = 's' then FComm.Parity := Space else
     FComm.Parity := None;
  i := Pos(',', Value);
  s := Copy(Value, 1, i-1);
  Delete(Value, 1, i);
  case StrToIntDef(s, 8) of
    5: FComm.ByteSize := _5;
    6: FComm.ByteSize := _6;
    7: FComm.ByteSize := _7;
    8: FComm.ByteSize := _8;
  end;
  i := Pos(',', Value);
  s := Copy(Value, 1, i-1);
  if s = '1.5' then FComm.StopBits := _1_5 else
  case StrToIntDef(s, 1) of
    1: FComm.StopBits := _1;
    2: FComm.StopBits := _2;
  end;
end;

procedure TSPC.SetSPComm(Comm: TComm);
begin
  if Comm = nil then Exit;
  if not Assigned(Comm) then Exit;
  FComm := Comm;
  FComm.OnModemStateChange := DoModemStateChange;
  FComm.OnReceiveData := DoReceiveData;
  FComm.OnReceiveError := DoReceiveError;
  FComm.OnRequestHangup := DoRequestHangup;
  FComm.OnSendDataEmpty := DoSendDataEmpty;
  CommPort := 1;
  DTREnable := True;
  RTSEnable := True;
  Settings := '115200,n,8,1';
end;

procedure TSPC.WndProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_MCM then FOnComm(Self);
end;

destructor TSPC.Destroy;
begin
  if not (csDesigning in ComponentState) then
     DeallocateHWnd(FHandle);
  if FComm <> nil then FComm.Free;
  inherited;
end;

function TSPC.GetParityCheck: Boolean;
begin
  if FComm = nil then Exit;
  Result := FComm.ParityCheck;
end;

procedure TSPC.SetParityCheck(Value: Boolean);
begin
  if FComm = nil then Exit;
  FComm.ParityCheck := Value;
end;

end.