unit pasMyComm;
interface
uses
    Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs;
type
    //分配單獨的線程
    TReadThread=class(TThread)
    protected
      //重載Excute函數
      procedure Execute;override;
    public
      hCommFile:THandle;  //作為一個文件打開的串口
      bReadThread:boolean;  //讀寫線程的標志
    end;
    //繼承TComponent的子類TComm
    TComm=class(TComponent)
    private
      hCommFile:THandle;  //作為一個文件打開的串口
      ReadThread:TReadThread;  //讀線程
      procedure CloseReadThread;
    public
      bOpened:boolean;  //串口是否打開
      CommName:string;  //串口名稱
      INQUESIZE,QUTQUESIZE: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 WriteDelayData(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;           //清除串口數據
      procedure SendStr(str:String);  //發送字符串數據
      function OutputByte(const ByteData:array of Byte):Boolean;
      function GetCheckResult: boolean;
    end;
const
     PWM_COMMWRITE=WM_USER+1;
implementation
//構造函數,初始化變量
constructor TComm.Create(AOWner:TComponent);
begin
  inherited Create(AOwner);
  ReadThread:=nil;
  hCommFile:=0;
  bOpened:=False;
  //缺省隊列長度
  INQUESIZE:=129600;
  QUTQUESIZE:=129600;
end;
//析構函數,釋放串口
destructor TComm.Destroy;
begin
  FreeComm;
  inherited Destroy;  //執行父類的析構函數
end;
//初始化串口
function TComm.InitComm(ThisCommName:string;BaudRate,DataByte,StopByte,ParityByte:integer):boolean;
var
  dcb:Tdcb;  //Data Control Block 控制信息
begin
  //判斷有沒有打開該串口
  if hCommFile<>0 then
  begin
    InitComm:=False;
    exit;
  end;
  //用CreateFile打開串口
  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;
  //如果打開的文件類型不是FILE_TYPE_CHAR也算失敗,則關閉文件
  if GetFileType(hCommFile)<>FILE_TYPE_CHAR then
  begin
    CloseHandle(hCommFile);
    hCommFile:=0;
    InitComm:=False;
    exit;
  end;
  //如果設置失敗,則關閉文件
  if not SetupComm(hCommFile,INQUESIZE,QUTQUESIZE) then
  begin
    CloseHandle(hCommFile);
    hCommFile:=0;
    InitComm:=False;
    exit;
  end;
  //讀入串口信息
  PurgeComm(hCommFile,PURGE_TXABORT or PURGE_RXABORT or PURGE_TXCLEAR or PURGE_RXCLEAR);
  GetCommState(hCommFile,dcb);
  //設置串口參數
  dcb.BaudRate:=BaudRate;  //波特率
  dcb.ByteSize:=DataByte;  //數據位數,如每byte4-8個bit
  dcb.Parity:=ParityByte;  //是否有校驗位0-4=no,odd,even,mark,space
  dcb.StopBits:=StopByte;  //停止位,0,1,2=1,1.5,2
  dcb.Flags:=1;
  //如果設置串口參數失敗,則關閉文件
  if not SetCommState(hCommFile,dcb) then
  begin
    CloseHandle(hCommFile);
    hCommFile:=0;
    InitComm:=False;
    exit;
  end;
  //設置打開文件成功標志
  InitComm:=True;
  bOpened:=True;
  CommName:=ThisCommName;
end;
//釋放串口
procedure Tcomm.FreeComm;
begin
  if hCommFile=0 then exit;  //如果沒有打開的串口,則直接退出
  //關閉讀數據線程
  CloseReadThread;
  //關閉文件
  PurgeComm(hCommFile,PURGE_RXABORT+PURGE_RXCLEAR+PURGE_TXABORT+PURGE_TXCLEAR);
  CloseHandle(hCommFile);
  bOpened:=False;
end;
//調用WriteFile向串口寫數據
function TComm.WriteData(pDataToWrite:PChar;dwSizeofDataToWrite:DWord):boolean;
var
  nSent:DWord;
begin
  Result:=WriteFile(hCommFile,pDataToWrite^,dwSizeofDataToWrite,nSent,Nil);
end;
//調用WriteFile和sleep向串口延遲寫數據
function TComm.WriteDelayData(pDataToWrite:PChar;dwSizeofDataToWrite:DWord):boolean;
var
  nSent:DWord;
  i:integer;
begin
  Result:=False;
  for i:=1 to dwSizeofDataToWrite do
  begin
    Result:=WriteFile(hCommFile,(i-1+pDataToWrite)^,dwSizeofDataToWrite,nSent,Nil);
    Sleep(50);  //延遲一段時間再寫下一段數據
  end;
end;
//發送字符串
procedure TComm.SendStr(str:String);
begin
  str:=str+Chr(13)+Chr(10);  //添加回車,換行
  WriteData(pChar(str),Length(str));
end;
//調用ReadFile讀入數據
function Tcomm.ReadData(pBuffer:pChar;BufferSize:DWord):boolean;
var
  nRead:DWord;
begin
  Result:=ReadFile(hCommFile,pBuffer^,BufferSize,nRead,Nil);
end;
//通過CloseEvent事件關閉讀線程
procedure TComm.CloseReadThread;
begin
  //如果讀線程存在則關閉
  if ReadThread<>nil then
  begin
    ReadThread.bReadThread:=False;
    //清除讀的數據
    PurgeComm(hCommFile,PURGE_RXABORT+PURGE_RXCLEAR);
    //等待一段時間，結束線程
    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;
  //循環等待，直到TimeLen秒或讀入Bytes個數據
  while (BytesInInQue<Bytes) and (hCommFile<>0) and ((time2-time1)<TimeLen) do
  begin
    Application.ProcessMessages;
    time2:=GetTickCount;
  end;
  //返回是否成功讀入Bytes個數據
  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;
//傳送二進制的數據
function TComm.OutputByte(const ByteData: array of Byte ): Boolean;
var
  lrc: LongWord;
    i: Integer;
begin
   for i:=Low(ByteData) to High(ByteData) do
     WriteFile(hCommFile,ByteData[i],1,lrc, nil);
   Result := True;
end;
//讀數據線程
procedure TReadThread.Execute;
begin
  while bReadThread do
  begin
  end;
end;
//設置校驗項目

function TComm.GetCheckResult:boolean;
var
  dwEventMask: DWORD;
  stat:TCOMSTAT;
  errs:DWord;
begin
  Result:=TRUE;
  dwEventMask:=0;
  SetCommMask(hCommFile,EV_ERR);
  ClearCommError(hCommFile,errs,@stat);
  WaitCommEvent(hCommFile,dwEventMask,nil);
  if ((dwEventMask and EV_ERR)=EV_ERR) then
    Result:=FALSE;;
end;

end.