pasmycomm.~pas

汽车行驶记录仪的数据初始化组件

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.