zoukankan      html  css  js  c++  java
  • 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.

     

  • 相关阅读:
    SQL Server 存储过程语法及实例
    22个开源的PHP框架
    WAYOS路由WEB认证写入工具,有保存密码、提示日期时间星期及提醒的功能
    WAYOS使用定时开关来重启的,悲哀了吧
    WAYOS BCM扩展多WAN口继续研究,已实现扩展至N个WAN口,并成功在线了
    WAYOS免拉黑服务器版已开发成功,可在远程同时控制多台WAYOS,全新处理内核
    WAYOS 免拉黑工具全面测试成功,确定在ISP、PC甚至在BCM都获得成功,支持官方版本,真正的未动WAYOS的破解
    海蜘蛛V8想转WAYOS的用户有福了,用户数据转换工具出来了
    安网SECNET的机器解密——wayos的ODM产品,帮大家解除相关的疑惑
    WAYOS BCM版扩展WAN口研究
  • 原文地址:https://www.cnblogs.com/jimeper/p/309888.html
Copyright © 2011-2022 走看看