串口通訊(Delphi)

原创 2011年07月26日 17:19:45


unit   Comm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BaseChildForm, Menus, DBActns, StdActns, ActnList, ImgList, DB,
  ExtCtrls, StdCtrls, ComCtrls, Grids, Wwdbigrd, Wwdbgrid, ADODB,
  DBCtrls;

type

  TComInfo = record
    cCommNum: string;       { com1..com4 }
    cBaudRate: Integer;     { 1200..19200 }
    cDataLen: Integer;      { 6..8 }
    cStopLen: Integer;      { 1..2 }
    cParity: Integer;       { non, odd, even }
    cHandle: THandle;       // 串口打開後用來保存句柄
    Connectioned: Boolean;
  end;

  TComm= class(TfrmBaseChildForm)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure CloseCom(iCom: Integer);
    procedure OpenCom(iCom:Integer);
    function ReadComStr(iCom: Integer): string;
    function GetComStr(cHandle:THandle):string;
  end;

var
  ComInfo: array[1..4] of TComInfo;
  COMIsOpen : Boolean;
  ReadOs : TOverlapped;
  CanisterCode:string;
  CanisterWeight:Double;
implementation

{$R *.dfm}

procedure TComm.CloseCom(iCom: Integer);
begin
   if ComInfo[iCom].cHandle <> INVALID_HANDLE_VALUE then
   begin
      CloseHandle(ComInfo[iCom].cHandle );
      ComInfo[iCom].cHandle:= INVALID_HANDLE_VALUE;
      ComInfo[iCom].Connectioned := False;
      COMIsOpen := False;
   end;
end;

procedure TComm.OpenCom(iCom:Integer);
var ComDCB: TDCB;
   ComTimeOuts: TCOMMTIMEOUTS;
begin
  ComInfo[iCom].cHandle:= CreateFile( PChar(ComInfo[iCom].cCommNum),
                    GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0,0);

  if ComInfo[iCom].cHandle=INVALID_HANDLE_VALUE then
  begin
    ERROR_BOX(Self.Handle,PChar('打開串口錯誤!'));      // 提交異常退出
    COMIsOpen := False;
    Exit;
  end;
 
  if not SetupComm(ComInfo[iCom].cHandle,1024,1024) then
  begin
    ERROR_BOX(Self.Handle,PChar('不能設置串口!'));
    CloseHandle(ComInfo[iCom].cHandle);
    COMIsOpen := False;
    Exit;
  end;

  try
    GetCommState(ComInfo[iCom].cHandle, ComDCB);
    ComDCB.BaudRate:= ComInfo[iCom].cBaudRate;
    ComDCB.ByteSize:= ComInfo[iCom].cDataLen;
    ComDCB.Parity:= NoParity;
    ComDCB.StopBits:= OneStopBit;

    if SetCommState(ComInfo[iCom].cHandle, ComDCB) = False then ERROR_BOX(Self.Handle,PChar('設置串口錯誤!'));   // 提交異常退出

    ComTimeOuts.ReadIntervalTimeout:= 0;                // 讀區間超時
    ComTimeOuts.ReadTotalTimeoutConstant:= 0;           // 讀超時常數
    ComTimeOuts.ReadTotalTimeoutMultiplier:= 50;        // 讀總超時
    ComTimeOuts.WriteTotalTimeoutConstant:= 0;          // 寫超時常數
    ComTimeOuts.WriteTotalTimeoutMultiplier:= 50;       // 寫總超時
    if SetCommTimeouts(ComInfo[iCom].cHandle,ComTimeOuts ) = False then
       ERROR_BOX(Self.Handle,PChar('設置串口超時錯誤!'));   // 提交異常退出
  except
    CloseHandle(ComInfo[iCom].cHandle);

  end;
  ComInfo[iCom].Connectioned := True;
  COMIsOpen := True;
end;

function TComm.GetComStr(cHandle:THandle):string;
var
  CommState : COMSTAT;
  dwNumberOfBytesRead : DWORD;
  ErrorFlag : DWORD;
  InputBuffer : array [0..1024] of Char;
  i:Integer;
begin
  if not ClearCommError(cHandle,ErrorFlag,@CommState) then
  begin
    ERROR_BOX(Self.Handle,PChar('清除串口錯誤!'));
    PurgeComm(cHandle,Purge_Rxabort or Purge_Rxclear);
    Exit;
  end;

  if CommState.cbInQue > 0 then
  begin
    FillChar(InputBuffer,CommState.cbInQue,#0); // 接收通訊數據
    if (not ReadFile(cHandle,InputBuffer,CommState.cbInQue,dwNumberOfBytesRead,@ReadOs )) then
    begin
      ErrorFlag := GetLastError();
      if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then
      begin
        ERROR_BOX(Self.Handle,PChar('讀取串錯誤!'));
        CloseHandle(cHandle);
        Exit;
      end;
    end;

    for i:=0 to dwNumberOfBytesRead -1 do
    begin
        if InputBuffer[i]= #13 then Break
        else Result := Result + InputBuffer[i];
    end;
  end;
end;

function TComm.ReadComStr(iCom: Integer): string;
var sWeight:string;
begin
  sWeight := GetComStr(ComInfo[iCom].cHandle);
  if Pos('N/W',sWeight)>0 then Result := Trim(Copy(sWeight,4,8));
end;

procedure TComm.FormCreate(Sender: TObject);
var i:Integer;
begin
  inherited;
  for i:= 1 to 4 do
  begin
    ComInfo[i].cCommNum := 'COM'+IntToStr(i);
    ComInfo[i].cBaudRate := 9600;
    ComInfo[i].cDataLen := 8;
    ComInfo[i].cStopLen := 1;
    ComInfo[i].cParity := NoParity;
  end;
  Self.OpenCom(1);
  if COMIsOpen then Timer1.Enabled := True;

  if  not qryEmployee.Active then  qryEmployee.Open;
  if  not qryCanisterData.Active then  qryCanisterData.Open;
  if  not qryLoomGoods.Active then  qryLoomGoods.Open;
end;

procedure TComm.FormDestroy(Sender: TObject);
begin
  inherited;
  Self.CloseCom(1);
  frmLoomFinish:=nil;
end;

end.

收藏助手
不良信息举报
您举报文章:串口通訊(Delphi)
举报原因:
原因补充:

(最多只允许输入30个字)