cyscomm.pas

模仿DCS系统主站的仿真软件

unit CysComm;

//这是一个串口操作的模板

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

type
  {TReadThread = class( TThread )
  protected
    procedure Execute; override;
  public
    hCommFile: THandle;
    bReadThread: Boolean;
  end;}

  TComm = class( TComponent )
  private
    hCommFile: THandle;
    //ReadThread: TReadThread;
    //procedure CloseReadThread;
  public
    bOpened: Boolean;
    CommName: string;
    INQUESIZE, OUTQUESIZE: Integer;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function InitComm(ThisCommName: string; BaudRate,DataByte,StopByte,ParityByte: integer): Boolean;
    procedure FreeComm;

    function WriteData(pDataToWrite: PChar; dwSizeofDataToWrite: DWORD): Boolean;
    function ReadData(pBuffer: PChar; BufferSize: DWORD): boolean;
    function BytesInInQue: DWORD;
    function BytesInOutQue: DWORD;
    function WaitForBytes(Bytes: DWORD; TimeLen: DWORD): boolean;
    procedure ClearComm;
  end;

const
// This is the message posted to the WriteThread
// When we have something to write.
  PWM_COMMWRITE = WM_USER+1;

implementation

constructor TComm.Create(AOwner: TComponent);
begin
  inherited Create( AOwner );

  //ReadThread := nil;
  hCommFile := 0;
  bOpened := False;

  // Default size of the Input Buffer used by this code.
  INQUESIZE := 40960;
  OUTQUESIZE := 8192;
end;

destructor TComm.Destroy;
begin
  FreeComm;
  inherited Destroy;
end;

function TComm.InitComm(ThisCommName: string; BaudRate,DataByte,StopByte,ParityByte: integer): Boolean;
var
  dcb: Tdcb;
begin
  //修正微软串口COM10以后Bug
  if (Pos(ThisCommName, 'COM') = 1) and (Length(ThisCommName) > 4) then
    ThisCommName := '\\.\' + ThisCommName;

  //Are we already doing comm?
  if hCommFile <> 0 then
  begin
    InitComm := False;
    Exit;
  end;

  hCommFile := CreateFile( PChar(ThisCommName),
                           GENERIC_READ or GENERIC_WRITE,
                           0, {not shared}
                           nil, {no security ??}
                           OPEN_EXISTING,
                           FILE_ATTRIBUTE_NORMAL,
                           0);

  if hCommFile = INVALID_HANDLE_VALUE then
  begin
    hCommFile := 0;
    InitComm := False;
    Exit;
  end;

  //Is this a valid comm handle?
  if GetFileType(hCommFile)<>FILE_TYPE_CHAR then
  begin
    CloseHandle(hCommFile);
    hCommFile := 0;
    InitComm := False;
    Exit;
  end;

  if not SetupComm(hCommFile, INQUESIZE, OUTQUESIZE) then
  begin
    CloseHandle(hCommFile);
    hCommFile := 0;
    InitComm := False;
    Exit;
  end;

   //purge any information in the buffer
  PurgeComm(hCommFile, PURGE_TXABORT or PURGE_RXABORT or
                       PURGE_TXCLEAR or PURGE_RXCLEAR);

  //Querying then setting the comm port configurations.
  GetCommState(hCommFile, dcb);

  dcb.BaudRate := BaudRate;
  dcb.ByteSize := DataByte;  //number of bits/byte, 4-8
  dcb.Parity := ParityByte;  //0-4=no,odd,even,mark,space
  dcb.StopBits := StopByte;  //0,1,2 = 1,1.5,2

  dcb.Flags := 1;         // Enable fBinary
{
  if FParityCheck then
    dcb.Flags := dcb.Flags or 2;          // Enable parity check

  if FOutx_CtsFlow then
    dcb.Flags := dcb.Flags or 4;

  if FOutx_DsrFlow then
    dcb.Flags := dcb.Flags or 8;

  if FDtrControl = DtrEnable then
    dcb.Flags := dcb.Flags or $10;
  else if FDtrControl = DtrHandshake then
    dcb.Flags := dcb.Flags or $20;

  if FDsrSensitivity then
    dcb.Flags := dcb.Flags or $40;

  if FTxContinueOnXoff then
    dcb.Flags := dcb.Flags or $80;

  if FOutx_XonXoffFlow then
    dcb.Flags := dcb.Flags or $100;

  if FInx_XonXoffFlow then
    dcb.Flags := dcb.Flags or $200;

  if FReplaceWhenParityError then
    dcb.Flags := dcb.Flags or $400;

  if FIgnoreNullChar then
    dcb.Flags := dcb.Flags or $800;

  if FRtsControl = RtsEnable then
    dcb.Flags := dcb.Flags or $1000;
  else if FRtsControl = RtsHandshake then
    dcb.Flags := dcb.Flags or $2000
  else if FRtsControl = RtsTransmissionAvailable then
    dcb.Flags := dcb.Flags or $3000;
}
  if not SetCommState(hCommFile, dcb) then
  begin
    CloseHandle(hCommFile);
    hCommFile := 0;
    InitComm := False;
    Exit;
  end;

     //Create the Read thread.
{ try
    ReadThread := TReadThread.Create(True);  //suspended
  except
    ReadThread := nil;
    CloseHandle(hCommFile);
    hCommFile := 0;
    InitComm := False;
    Exit;
  end;
  ReadThread.hCommFile := hCommFile;
  ReadThread.bReadThread := True;
  ReadThread.Priority := tpHighest;   //most important
  ReadThread.Resume;
}
  InitComm := True;
  bOpened := True;
  CommName := ThisCommName;
end;

procedure TComm.FreeComm;
begin
  if hCommFile = 0 then exit;

  //Close the threads.
  //CloseReadThread;

  //Now close the comm port handle.
  PurgeComm(hCommFile, PURGE_RXABORT + PURGE_RXCLEAR
                     + PURGE_TXABORT + PURGE_TXCLEAR);
  CloseHandle(hCommFile);
  hCommFile := 0;
  bOpened := False;
end;

function TComm.WriteData(pDataToWrite: PChar; dwSizeofDataToWrite: DWORD): Boolean;
var
  nSent: DWORD;
begin
  Result := WriteFile(hCommFile, pDataToWrite^, dwSizeofDataToWrite,
                      nSent, Nil);
end;

function TComm.ReadData(pBuffer: PChar; BufferSize: DWORD): boolean;
var
   nRead: DWORD;
begin
   Result := ReadFile(hCommFile, pBuffer^, BufferSize, nRead, Nil);
end;


//Closes the Read thread by signaling the CloseEvent.
//Purges any outstanding reads on the comm port.
{procedure TComm.CloseReadThread;
begin
  //If it exists...
  if ReadThread <> nil then
  begin
     //Signal the event to close the worker threads.
     ReadThread.bReadThread := False;

     //Purge all outstanding reads
     PurgeComm(hCommFile, PURGE_RXABORT + PURGE_RXCLEAR);

     //Wait 10 seconds for it to exit.  Shouldn't happen.
     if (WaitForSingleObject(ReadThread.Handle, 10000) = WAIT_TIMEOUT) then
        ReadThread.Terminate;
     ReadThread.Free;
     ReadThread := nil;
  end;
end;}

function TComm.BytesInInQue: DWORD;
var
  stat: TCOMSTAT;
  errs: DWORD;
begin
  ClearCommError(hCommFile, errs, @stat);
  Result := stat.cbInQue;
end;

function TComm.BytesInOutQue: DWORD;
var
  stat: TCOMSTAT;
  errs: DWORD;
begin
  ClearCommError(hCommFile, errs, @stat);
  Result := stat.cbOutQue;
end;

function TComm.WaitForBytes(Bytes: DWORD; TimeLen: DWORD): boolean;
var
  time1, time2: DWORD;
begin
  time1 := GetTickCount;
  time2 := time1;
  while (BytesInInQue<Bytes) and (hCommFile<>0) and ((time2-time1)<TimeLen)
  do begin
    Application.ProcessMessages;
    time2 := GetTickCount;
  end;
  if BytesInInQue>=Bytes then Result := True
  else Result := False;
end;

procedure TComm.ClearComm;
begin
  PurgeComm(hCommFile, PURGE_TXABORT or PURGE_RXABORT or
            PURGE_TXCLEAR or PURGE_RXCLEAR);
end;

////////////////////////////////////////////////////////
////////////  Read Thread   ////////////////////////////
////////////////////////////////////////////////////////
{procedure TReadThread.Execute;
var
  TempByte: Byte;
  pTempByte: PChar;
  nRead: DWORD;
begin
   pTempByte := @TempByte;
  //Keep looping until we break out.
  while bReadThread do
  begin
    //read one byte
  if ReadFile(hCommFile, pTempByte^, 1, nRead, Nil) then
    begin
        case TempByte of  //flag byte
        end;
    end;
  end;
end;}

end.