hcomport.pas

啊看见电脑哦啊师父破案对方；啊老大你发；dfadsdsfadfd发

unit HComPort;

interface

uses
  Windows, Classes, SysUtils, Forms;

type
  TBaudRate = (br110, br300, br600, br1200, br2400, br4800, br9600,
               br14400, br19200, br38400, br56000, br57600, br115200);
  TPortType = (COM1, COM2, COM3, COM4, COM5, COM6, COM7, COM8, COM9,COM10);
  TStopBits = (sbOneStopBit, sbOne5StopBits, sbTwoStopBits);
  TParity = (prNone, prOdd, prEven, prMark, prSpace);
  TFlowControl = (fcNone, fcRtsCts, fcXonXoff, fcBoth);
  TEvent = (evRxChar, evTxEmpty, evRxFlag, evRing, evBreak, evCTS,
            evDSR, evError, evRLSD);
  TEvents = set of TEvent;

  TComRxCharEvent = procedure(Sender: TObject; ResvSize: Integer) of object;
  TComErrorEvent = procedure(Sender: TObject; Msg : string;var Error : integer) of object;

  THSerialPort = class;

  TComThread = class(TThread)
  private
    Owner: THSerialPort;
    Mask: DWORD;
    StopEvent: THandle;
  protected
    procedure Execute; override;
    procedure DoEvents;
    procedure Stop;
  public
    constructor Create(AOwner: THSerialPort);
    destructor Destroy; override;
  end;

  THSerialPort = class(TComponent)
  private
    ComHandle: THandle;
    EventThread: TComThread;
    FConnected: Boolean;
    FBaudRate: TBaudRate;
    FPortType: TPortType;
    FParity: TParity;
    FStopBits: TStopBits;
    FFlowControl: TFlowControl;
    FDataBits: Byte;
    FEvents: TEvents;
    FEnableDTR: Boolean;
    FWriteBufSize: Integer;
    FReadBufSize: Integer;
    FActiveDCD : Boolean;
    FOnRxChar: TComRxCharEvent;
    FOnTxEmpty: TNotifyEvent;
    FOnBreak: TNotifyEvent;
    FOnRing: TNotifyEvent;
    FOnCTS: TNotifyEvent;
    FOnDSR: TNotifyEvent;
    FOnDCD: TNotifyEvent;
    FOnError: TComErrorEvent;
    FOnRxFlag: TNotifyEvent;
    FOnOpen: TNotifyEvent;
    FOnClose: TNotifyEvent;
    procedure SetDataBits(Value: Byte);
    function  ComString: String;
    procedure DoOnRxChar;
    procedure DoOnTxEmpty;
    procedure DoOnBreak;
    procedure DoOnRing;
    procedure DoOnRxFlag;
    procedure DoOnCTS;
    procedure DoOnDSR;
    procedure DoOnError(Msg : string;Error : integer);
    procedure DoOnDCD;
    function  CheckActiveDCD: Boolean;
    procedure CreateHandle;
    procedure DestroyHandle;
    procedure SetupState;
    function  ValidHandle: Boolean;
    procedure InitSerialPort;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    function  InQue: Integer;
    function  OutQue: Integer;
    function  ActiveCTS: Boolean;
    function  ActiveDSR: Boolean;
    function  ActiveDCD: Boolean;
    function  ActiveRing: Boolean;
    function  Write(var Buffer; Count: Integer): Integer;
    function  WriteString(Str: String): Integer;
    function  Read(var Buffer; Count: Integer): Integer;
    function  ReadString(var Str: String; Count: Integer): Integer;
    procedure PurgeIn;
    procedure PurgeOut;
    function  GetComHandle: THandle;
    property  Connected: Boolean read FConnected;
  published
    property BaudRate: TBaudRate read FBaudRate write FBaudRate;
    property Port: TPortType read FPortType write FPortType;
    property Parity: TParity read FParity write FParity;
    property StopBits: TStopBits read FStopBits write FStopBits;
    property FlowControl: TFlowControl read FFlowControl write FFlowControl;
    property DataBits: Byte read FDataBits write SetDataBits;
    property Events: TEvents read FEvents write FEvents;
    property EnableDTR: Boolean read FEnableDTR write FEnableDTR;
    property WriteBufSize: Integer read FWriteBufSize write FWriteBufSize;
    property ReadBufSize: Integer read FReadBufSize write FReadBufSize;
    property OnRxChar: TComRxCharEvent read FOnRxChar write FOnRxChar;
    property OnTxEmpty: TNotifyEvent read FOnTxEmpty write FOnTxEmpty;
    property OnBreak: TNotifyEvent read FOnBreak write FOnBreak;
    property OnRing: TNotifyEvent read FOnRing write FOnRing;
    property OnCTS: TNotifyEvent read FOnCTS write FOnCTS;
    property OnDSR: TNotifyEvent read FOnDSR write FOnDSR;
    property OnDCD: TNotifyEvent read FOnDCD write FOnDCD;
    property OnRxFlag: TNotifyEvent read FOnRxFlag write FOnRxFlag;
    property OnError: TComErrorEvent read FOnError write FOnError;
    property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
  end;

  EComError = class(Exception);


implementation


const
  dcb_Binary           = $00000001;
  dcb_Parity           = $00000002;
  dcb_OutxCtsFlow      = $00000004;
  dcb_OutxDsrFlow      = $00000008;
  dcb_DtrControl       = $00000030;
  dcb_DsrSensivity     = $00000040;
  dcb_TXContinueOnXOff = $00000080;
  dcb_OutX             = $00000100;
  dcb_InX              = $00000200;
  dcb_ErrorChar        = $00000400;
  dcb_Null             = $00000800;
  dcb_RtsControl       = $00003000;
  dcb_AbortOnError     = $00004000;


// Component code

constructor TComThread.Create(AOwner: THSerialPort);
var
  AMask: Integer;
begin
 inherited Create(True);
 StopEvent:=CreateEvent(nil,True,False,nil);
 Owner:=AOwner;
 AMask:=0;
 if evRxChar in Owner.FEvents then AMask:=AMask or EV_RXCHAR;
 if evRxFlag in Owner.FEvents then AMask:=AMask or EV_RXFLAG;
 if evTxEmpty in Owner.FEvents then AMask:=AMask or EV_TXEMPTY;
 if evRing in Owner.FEvents then AMask:=AMask or EV_RING;
 if evCTS in Owner.FEvents then AMask:=AMask or EV_CTS;
 if evDSR in Owner.FEvents then AMask:=AMask or EV_DSR;
 if evRLSD in Owner.FEvents then AMask:=AMask or EV_RLSD;
 if evError in Owner.FEvents then AMask:=AMask or EV_ERR;
 if evBreak in Owner.FEvents then AMask:=AMask or EV_BREAK;
 SetCommMask(Owner.ComHandle,AMask);
 Resume;
end;

procedure TComThread.Execute;
var
 EventHandles: Array[0..1] of THandle;
 Overlapped: TOverlapped;
 dwSignaled, BytesTrans: DWORD;
begin
 FillChar(Overlapped,SizeOf(Overlapped),0);
 Overlapped.hEvent:=CreateEvent(nil,True,True,nil);
 EventHandles[0]:=StopEvent;
 EventHandles[1]:=Overlapped.hEvent;
 repeat
   WaitCommEvent(Owner.ComHandle,Mask,@Overlapped);
   dwSignaled:=WaitForMultipleObjects(2,@EventHandles,False,INFINITE);
   case dwSignaled of
     WAIT_OBJECT_0:Break;
     WAIT_OBJECT_0+1: if GetOverlappedResult(Owner.ComHandle,Overlapped,BytesTrans,False) then Synchronize(DoEvents);
     else Break;
   end;
 until False;
 Owner.PurgeIn;
 Owner.PurgeOut;
 CloseHandle(Overlapped.hEvent);
 CloseHandle(StopEvent);
end;

procedure TComThread.Stop;
begin
 SetEvent(StopEvent);
end;

destructor TComThread.Destroy;
begin
 Stop;
 inherited Destroy;
end;

procedure TComThread.DoEvents;
begin
 if (EV_RXCHAR and Mask)>0 then Owner.DoOnRxChar;
 if (EV_TXEMPTY and Mask)>0 then Owner.DoOnTxEmpty;
 if (EV_BREAK and Mask)>0 then Owner.DoOnBreak;
 if (EV_RING and Mask)>0 then Owner.DoOnRing;
 if (EV_CTS and Mask)>0 then Owner.DoOnCTS;
 if (EV_DSR and Mask)>0 then Owner.DoOnDSR;
 if (EV_RXFLAG and Mask)>0 then Owner.DoOnRxFlag;
 if (EV_RLSD and Mask)>0 then Owner.DoOnDCD;
 if (EV_ERR and Mask) > 0 then Owner.DoOnError('Communication Error',GetLastError);
end;

constructor THSerialPort.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FConnected:=False;
 FBaudRate:=br9600;
 FParity:=prNone;
 FPortType:=COM1;
 FStopBits:=sbOneStopBit;
 FDataBits:=8;
 FEvents:=[evRxChar,evTxEmpty,evRxFlag,evRing,evBreak,evCTS,evDSR,evError,evRLSD];
 FEnableDTR:=True;
 FWriteBufSize:=20480;
 FReadBufSize:=20480;
 ComHandle:=INVALID_HANDLE_VALUE;
 FActiveDCD:=False;
end;

destructor THSerialPort.Destroy;
begin
 Close;
 inherited Destroy;
end;

procedure THSerialPort.CreateHandle;
begin
 ComHandle:=CreateFile(PChar(ComString),GENERIC_READ or GENERIC_WRITE,
   0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,0);
 if ComHandle<>INVALID_HANDLE_VALUE then InitSerialPort;
 if not ValidHandle then DoOnError('Unable to open com port ',GetLastError);
end;

procedure THSerialPort.DestroyHandle;
begin
 if ValidHandle then begin
   PurgeComm(ComHandle,PURGE_TXABORT+PURGE_RXABORT);
   CloseHandle(ComHandle);
 end;
 if FActiveDCD then begin
   FActiveDCD:=False;
   if Assigned(FOnDCD) then FOnDCD(Self);
 end;
 ComHandle:=INVALID_HANDLE_VALUE;
end;

function THSerialPort.ValidHandle: Boolean;
begin
 if ComHandle=INVALID_HANDLE_VALUE then Result:=False
 else Result:=True;
end;

procedure THSerialPort.Open;
begin
 Close;
 CreateHandle;
end;

procedure THSerialPort.Close;
begin
 if FConnected then begin
   EventThread.Free;
   DestroyHandle;
   FConnected:=False;
   if Assigned(FOnClose) then FOnClose(Self);
 end;
end;