⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 239.htm

📁 水木清华的BBS文章
💻 HTM
字号:
🔍 
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>CTerm非常精华下载</title>
</head>
<body bgcolor="#FFFFFF">
<table border="0" width="100%" cellspacing="0" cellpadding="0" height="577">
<tr><td width="32%" rowspan="3" height="123"><img src="DDl_back.jpg" width="300" height="129" alt="DDl_back.jpg"></td><td width="30%" background="DDl_back2.jpg" height="35"><p align="center"><a href="http://bbs.tsinghua.edu.cn"><font face="黑体"><big><big>水木清华★</big></big></font></a></td></tr>
<tr>
<td width="68%" background="DDl_back2.jpg" height="44"><big><big><font face="黑体"><p align="center">         Delphi编程                            (BM: strayli FlyingBoy)          </font></big></big></td></tr>
<tr>
<td width="68%" height="44" bgcolor="#000000"><font face="黑体"><big><big><p   align="center"></big></big><a href="http://cterm.163.net"><img src="banner.gif" width="400" height="60" alt="banner.gif"border="0"></a></font></td>
</tr>
<tr><td width="100%" colspan="2" height="454">　<p align="center">[<a href="index.htm">回到开始</a>][<a href="183.htm">上一层</a>][<a href="240.htm">下一篇</a>]
<hr><p align="left"><small>发信人: fuse (保险丝), 信区: Visual <br>

标  题: Delphi中读写COM口 <br>

发信站: BBS 水木清华站 (Sat Nov  1 02:54:35 1997) <br>

  <br>

  <br>

{下面的代码是一个COM控件，适合于发出命令后等待一些回应的应用。 <br>

 (嘿嘿，我是搞仪器的，这种应用比较多点)，贴在这里主要是想说明 <br>

 Delphi中如何使用COM口的这些函数。 <br>

 真正实用的COM控件呢，也有：ftp://ftp.lib.pku.edu.cn/incoming/fuse/ <br>

 里面已经有一些东东了，看到有comm字样的，asyn字样的就是了 } <br>

  <br>

unit Comm; <br>

  <br>

interface <br>

  <br>

uses <br>

  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, <br>

  Forms, Dialogs, ExtCtrls; <br>

  <br>

type <br>

  TCmdMode = (cmStr, cmBytes); <br>

  <br>

  TComm = class(TGraphicControl) <br>



  private <br>

    { Private declarations } <br>

    FPort : string; <br>

    FBaudRate: Word;        { Baudrate at which runing       } <br>

    FByteSize: Byte;        { Number of bits/byte, 4-8       } <br>

    FParity: Byte;          { 0-4=None,Odd,Even,Mark,Space   } <br>

    FStopBits: Byte;        { 0,1,2 = 1, 1.5, 2              } <br>

    FWaitByteNum : word; <br>

    FTimeOut : word; <br>

    FMode : TCmdMode; <br>

    ColorSet : array [0..3] of TColor; <br>

    FCmdStr : string; <br>

    { Communicate-relate varibles } <br>

    State : integer; <br>

    dcb : TDCB; <br>

    CommBeginTime : TDateTime; <br>

    Timer1 : TTimer; <br>

    { NotifyEvents } <br>

    FOnDataLoad : TNotifyEvent; <br>

    FOnTimeOut : TNotifyEvent; <br>

    procedure CommQuery(Sender : TObject); <br>

    procedure LoadData; <br>

    procedure LoadData; <br>

    procedure SendCmd; <br>

    procedure SendStrCmd; <br>

    procedure SendBytesCmd; <br>

    procedure SetByteNum(val : word); <br>

    procedure DecodeCmd(str1 : string; var char1 : array of char); <br>

  protected <br>

    { Protected declarations } <br>

    procedure Paint; override; <br>

  public <br>

    { Public declarations } <br>

    hCommDev : integer; <br>

    { Memory Pool } <br>

    connected, WaitOn : boolean; <br>

    stat : TComStat; <br>

    CmdChar : array[0..64] of Char; <br>

    SendLen : word; <br>

    pool : array [0..2048] of char; <br>

    ms : TMemoryStream; <br>

    constructor Create(AOwner : TComponent); override; <br>

    procedure Connect; <br>

    procedure Excute; <br>

    function GetData(Offset : word) : Char; <br>



    procedure ClearSigns; <br>

    procedure Free; <br>

    procedure HardWait; <br>

    procedure Query; <br>

  published <br>

    { Published declarations } <br>

    property BaudRate : word read FBaudRate write FBaudRate; <br>

    property Parity : byte read FParity write FParity; <br>

    property ByteSize : byte read FByteSize write FByteSize; <br>

    property StopBits : byte read FStopBits write FStopBits; <br>

    property CmdStr : string read FCmdStr write FCmdStr; <br>

    property WaitByteNum : word read FWaitByteNum write SetByteNum; <br>

    property Port : string read FPort write FPort; <br>

    property TimeOut : word read FTimeOut write FTimeOut; <br>

    property OnTimeOut : TNotifyEvent read FOnTimeOut write FOnTimeOut; <br>

    property OnDataLoad : TNotifyEvent read FOnDataLoad write FOnDataLoad; <br>

    property OnClick; <br>

    property ShowHint; <br>

    property OnMouseDown; <br>

    property Mode : TCmdMode read FMode write FMode; <br>

  end; <br>

  <br>

  <br>

procedure Register; <br>

  <br>

implementation <br>

  <br>

procedure Register; <br>

begin <br>

  RegisterComponents('Samples', [TComm]); <br>

end; <br>

  <br>

constructor TComm.Create(AOwner : TComponent); <br>

begin <br>

  inherited Create(AOwner); <br>

  ControlStyle := ControlStyle + [csFramed]; <br>

  FPort := 'COM1'; <br>

  FBaudRate := 9600; <br>

  FByteSize := 8; <br>

  FStopBits := 0; <br>

  FParity := 0; <br>

  FTimeOut := 7; <br>

  Width := 20; <br>

  Height := 20; <br>

  <br>

  <br>

  WaitOn := False; <br>

  Connected := False; <br>

  <br>

  State := 0; Hint := '空闲'; <br>

  ShowHint := True; <br>

  ColorSet[0] := clBlue; <br>

  ColorSet[1] := clYellow; <br>

  ColorSet[2] := clOlive; <br>

  ColorSet[3] := clMaroon; <br>

  <br>

  { Create  Memory Stream } <br>

  ms := TMemoryStream.Create; <br>

  ms.SetSize(1); <br>

  FWaitByteNum := 1; <br>

  <br>

  { Create a Timer } <br>

  Timer1 := TTimer.Create(self); <br>

  Timer1.Interval := 100; <br>

  Timer1.OnTimer := CommQuery; <br>

end; <br>

  <br>

procedure TComm.Paint; <br>



var <br>

  rGraph : TRect; <br>

begin <br>

  with Canvas do begin <br>

    rGraph := Rect(1, 1, Width - 1, Height - 1); <br>

    Pen.Color := clBlack; <br>

    MoveTo(rGraph.Right, rGraph.Top); <br>

    LineTo(rGraph.Left, rGraph.Top); <br>

    LineTo(rGraph.Left, rGraph.Bottom); <br>

    Pen.Color := clWhite; <br>

    LineTo(rGraph.Right, rGraph.Bottom); <br>

    LineTo(rGraph.Right, rGraph.Top); <br>

  <br>

    Brush.Color := ColorSet[State]; Pen.Color := clSilver; <br>

    InflateRect(rGraph, -3, -3); <br>

    Ellipse(rGraph.Left, rGraph.Top, rGraph.Right, rGraph.Bottom); <br>

  end; <br>

end; <br>

  <br>

procedure TComm.SetByteNum(val : word); <br>

begin <br>

  FWaitByteNum := val; <br>

  FWaitByteNum := val; <br>

  ms.Clear; <br>

  ms.SetSize(val); <br>

end; <br>

  <br>

procedure TComm.Connect; <br>

var <br>

  PortChar : array[0..12] of Char; <br>

Label ret1; <br>

begin <br>

  Connected := False; <br>

  { Initialize the Communication Port } <br>

  StrPCopy(PortChar, FPort); <br>

  hCommDev := OpenComm(PortChar, 8192, 2048); <br>

  if hCommDev < 0 then goto ret1; <br>

  <br>

  GetCommState(hCommDev, dcb); <br>

  dcb.BaudRate := FBaudRate; <br>

  dcb.ByteSize := FByteSize; <br>

  dcb.Parity := FParity; <br>

  dcb.StopBits := FStopBits; <br>

  <br>

  if SetCommState( dcb ) < 0 then begin <br>



    CloseComm(hCommDev); <br>

    goto ret1; <br>

  end; <br>

  <br>

  EscapeCommFunction( hCommDev, SETDTR ); <br>

  <br>

  Connected := True; <br>

  <br>

ret1: <br>

end; <br>

  <br>

procedure TComm.DecodeCmd( str1 : string; var char1 : array of char); <br>

var <br>

  i, j : integer; <br>

  btstr : string; <br>

  bytebegin : boolean; <br>

begin <br>

  if str1[1] = '$' then begin <br>

    i := 1; j := 0; <br>

    btstr := ''; <br>

    bytebegin := false; <br>

    while (i<=Length(str1)) do begin <br>

    while (i<=Length(str1)) do begin <br>

      case str1[i] of <br>

      '0'..'9', 'a'..'f', 'A'..'F' : begin <br>

        if not bytebegin then bytebegin := true; <br>

        btstr := btstr + str1[i]; <br>

      end; <br>

      ' ' : begin <br>

        if bytebegin then begin <br>

          btstr := '$'+btstr; <br>

          char1[j] := Chr(StrToInt(btstr)); <br>

          j := j + 1; <br>

          bytebegin := false; <br>

          btstr := ''; <br>

        end; <br>

      end; <br>

      end; <br>

      i := i + 1; <br>

    end; <br>

    if bytebegin then begin <br>

      btstr := '$'+btstr; <br>

      char1[j] := Chr(StrToInt(btstr)); <br>

      j := j + 1; <br>

      bytebegin := false; <br>



      btstr := ''; <br>

    end; <br>

    char1[j] := Chr(0); <br>

    SendLen := j; <br>

  end <br>

  else begin <br>

    StrPCopy(Addr(char1), str1); <br>

    SendLen := Length(str1); <br>

  end; <br>

end; <br>

  <br>

procedure TComm.SendCmd; <br>

begin <br>

  case FMode of <br>

  cmStr : SendStrCmd; <br>

  cmBytes : SendBytesCmd; <br>

  end; <br>

end; <br>

  <br>

procedure TComm.SendBytesCmd; <br>

begin <br>

  State := 1; Hint := FPort+'-等待'; <br>

  State := 1; Hint := FPort+'-等待'; <br>

  Refresh; <br>

  WaitOn := False; <br>

  if not Connected then Connect; <br>

  if Connected then begin <br>

    FlushComm(hCommDev, 0); <br>

    FlushComm(hCommDev, 1); <br>

    FillChar(pool, 32, 0); <br>

    WriteComm(hCommDev, CmdChar, SendLen); <br>

    CmdStr := ''; <br>

    FillChar(CmdChar, 32, 0); <br>

    WaitOn := True; <br>

    CommBeginTime := Now; <br>

  end <br>

  else begin <br>

    State := 3; Hint := FPort+'-错误'; <br>

    Invalidate; <br>

  end; <br>

end; <br>

  <br>

procedure TComm.SendStrCmd; <br>

begin <br>

  DecodeCmd(CmdStr, CmdChar); <br>



  State := 1; Hint := FPort+'-等待'; <br>

  Refresh; <br>

  WaitOn := False; <br>

  if not Connected then Connect; <br>

  if Connected then begin <br>

    FlushComm(hCommDev, 0); <br>

    FlushComm(hCommDev, 1); <br>

    FillChar(pool, 32, 0); <br>

    WriteComm(hCommDev, CmdChar, SendLen); <br>

    CmdStr := ''; <br>

    FillChar(CmdChar, 32, 0); <br>

    WaitOn := True; <br>

    CommBeginTime := Now; <br>

  end <br>

  else begin <br>

    State := 3; Hint := FPort+'-错误'; <br>

    Invalidate; <br>

  end; <br>

end; <br>

  <br>

procedure TComm.ClearSigns; <br>

begin <br>

begin <br>

  ReadComm(hCommDev, pool, stat.cbInQue); <br>

  pool[stat.cbInQue] := #0; <br>

  if WaitOn then begin <br>

    State := 2; Hint := FPort+'-超时'; <br>

    Refresh; <br>

    WaitOn := False; <br>

  end; <br>

  CommBeginTime := Now; <br>

  FlushComm(hCommDev, 0); <br>

  FlushComm(hCommDev, 1); <br>

end; <br>

  <br>

procedure TComm.LoadData; <br>

begin <br>

  ReadComm(hCommDev, pool, stat.cbInQue); <br>

  <br>

  pool[stat.cbInQue] := #0; <br>

  <br>

  ms.Seek(0,0); <br>

  ms.Write(pool, FWaitByteNum); <br>

  <br>

  State := 0; Hint := FPort+'-空闲'; <br>



  Refresh; <br>

  WaitOn := False; <br>

end; <br>

  <br>

procedure TComm.HardWait; <br>

begin <br>

  while Connected and WaitOn do begin <br>

    Query; <br>

  end; <br>

end; <br>

  <br>

procedure TComm.CommQuery(Sender : TObject); <br>

begin <br>

  Query; <br>

end; <br>

  <br>

procedure TComm.Query; <br>

var <br>

  Hour, Min, Sec, MSec : Word; <br>

begin <br>

  if Connected and WaitOn and (FWaitByteNum > 0) then <br>

  begin <br>

  begin <br>

    GetCommError(hCommDev, stat); <br>

    if stat.cbInQue >= FWaitByteNum then begin <br>

      LoadData; <br>

      if Assigned(FOnDataLoad) then FOnDataLoad(self); <br>

    end <br>

    else begin <br>

      DecodeTime(Now-CommBeginTime, Hour, Min, Sec, MSec); <br>

      { Communication Timeout Falure } <br>

      if (Sec > FTimeOut) or <br>

         ((FTimeOut = 0) and (MSec > 500)) then begin <br>

        ClearSigns; <br>

        if Assigned(FOnTimeOut) then FOnTimeOut(self); <br>

      end; <br>

    end; <br>

  end; <br>

end; <br>

  <br>

procedure TComm.Excute; <br>

begin <br>

  if not WaitOn then SendCmd; <br>

end; <br>

  <br>



procedure TComm.Free; <br>

begin <br>

  if Connected then begin <br>

    Connected := False; <br>

    ClearSigns; <br>

    CloseComm(hCommDev); <br>

  end; <br>

end; <br>

  <br>

function TComm.GetData(Offset : word) : Char; <br>

begin <br>

  if Offset <= FWaitByteNum then begin <br>

    Result := pool[Offset]; <br>

  end; <br>

end; <br>

  <br>

end. <br>

  <br>

-- <br>

※ 来源:·BBS 水木清华站 bbs.net.tsinghua.edu.cn·[FROM: 210.32.151.168] <br>

</small><hr>
<p align="center">[<a href="index.htm">回到开始</a>][<a href="183.htm">上一层</a>][<a href="240.htm">下一篇</a>]
<p align="center"><a href="http://cterm.163.net">欢迎访问Cterm主页</a></p>
</body>
</html>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -