• Delphi串口通讯的监听


     

    Delphi串口通讯的监听

     

    2001-06-25· ·aizb··天极论坛


      串口程序我后来研究了好久,写了下面的代码,后台生成一个线程监听串口,不影响前台工作。效果很好,一直用于GPS仪器的数据接收。

    unit frmComm;
    interface
    uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    StdCtrls, ComCtrls,GeoUtils,GeoGPS;
    const MAXBLOCK = 160;
    type
    TComm = record
    idComDev : THandle;
    fConnected : Boolean;
    end;
    TCommForm = class(TForm)
    ComboBox1: TComboBox;
    Button1: TButton;
    StatusBar1: TStatusBar;
    Button2: TButton;
    ComboBox2: TComboBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    private
    { Private declarations }
    public
    { Public declarations }
    end;
    TCommThread = Class(TThread)
    protected
    procedure Execute;override;
    public
    constructor Create;
    end;
    var
    CommForm: TCommForm;
    CommHandle : THandle;
    Connected : Boolean;
    CommThread : TCommThread;
    implementation
    {$R *.DFM}
    uses
    frmMain,frmMdiMapView;
    procedure TCommThread.Execute;
    var
    dwErrorFlags,dwLength : DWORD;
    ComStat : PComStat;
    fReadStat : Boolean;
    InChar : Char;
    AbIn : String;
    XX,YY : double; file://
    经度、纬度
    VID : string; file://
    车号
    begin
    while Connected do begin
    GetMem(ComStat,SizeOf(TComStat));
    ClearCommError(CommHandle, dwErrorFlags, ComStat);
    if (dwErrorFlags > 0) then begin
    PurgeComm(CommHandle,(PURGE_RXABORT and PURGE_RXCLEAR));
    // return 0;
    end;
    dwLength := ComStat.cbInQue;
    if (dwLength>0) then begin
    fReadStat := ReadFile(CommHandle, InChar, 1,dwLength, nil);
    if (fReadStat) then begin
    if (InChar <> Chr(13)) and (Length(abIn) < MAXBLOCK+5 ) then AbIn := AbIn + InChar
    else begin
    ...
    {
    接收完毕,}
    end;//if (fReadStat>0){
    end; file://if (dwLength>0){
    FreeMem(ComStat);
    end;{while}
    end;
    constructor TCommThread.Create;
    begin
    FreeOnTerminate := TRUE;
    inherited Create(FALSE); file://Createsuspended = false
    end;
    //
    procedure TCommForm.Button1Click(Sender: TObject);
    var
    CommTimeOut : TCOMMTIMEOUTS;
    DCB : TDCB;
    fRetVal : Boolean;
    begin
    StatusBar1.SimpleText := '
    连接中...';
    CommHandle := CreateFile(PChar(ComboBox1.Text),GENERIC_READ,0,nil,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL
    , 0);
    if CommHandle = INVALID_HANDLE_VALUE then begin
    StatusBar1.SimpleText := '
    连接失败';
    Exit;
    end;
    StatusBar1.SimpleText := '
    已同端口 '+ ComboBox1.Text + ' 连接!';
    CommTimeOut.ReadIntervalTimeout := MAXDWORD;
    CommTimeOut.ReadTotalTimeoutMultiplier := 0;
    CommTimeOut.ReadTotalTimeoutConstant := 0;
    SetCommTimeouts(CommHandle, CommTimeOut);
    GetCommState(CommHandle,DCB);
    DCB.BaudRate := 9600;
    DCB.ByteSize := 8;
    DCB.Parity := NOPARITY;
    DCB.StopBits := ONESTOPBIT;
    fRetVal := SetCommState(CommHandle, DCB);
    if (fRetVal) then begin
    Connected := TRUE;
    try
    CommThread := TCommThread.Create;
    except
    Connected := FALSE;
    CloseHandle(CommHandle);
    fRetVal := FALSE;
    StatusBar1.SimpleText := '
    线程建立失败';
    Exit;
    end;
    end
    else begin
    Connected := FALSE;
    CloseHandle(CommHandle);
    end;
    end;
    procedure TCommForm.Button2Click(Sender: TObject);
    begin
    Connected := FALSE;
    CloseHandle(CommHandle);
    {
    终止线程}
    CommThread.Terminate;
    StatusBar1.SimpleText := '
    关闭端口'+ComboBox1.Text;
    end;
    procedure TCommForm.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
    Connected := FALSE;
    CloseHandle(CommHandle);
    StatusBar1.SimpleText := '
    关闭端口'+ComboBox1.Text;
    end;
    end.

     

  • 相关阅读:
    二维数组展示到DataGridView(c#)
    发送请求获取响应内容(c#)
    重建freescale 4.6.2 multilib toolchain
    [raspberry pi3] raspberry 充当time machine
    sublime ctags
    lua遍历文件
    pthread中如何追踪stack over flow
    Core Dump
    2 plan team 服务器搭建
    mac上编译 arm linux gnueabi交叉编译工具链toolchain
  • 原文地址:https://www.cnblogs.com/jimeper/p/309888.html
Copyright © 2020-2023  润新知