用Delphi3寫一個串口程式 - Delphi K.Top 討論區

發表時間：2004-05-22 21:04:20
IP:61.64.xxx.xxx 未訂閱
 http://www.cetinet.com/t_article/list.asp?indexid=1483
一個串口程式     〖文章轉載或出處〗≡中國電子技術資訊網≡ 網址：www.CETINet.com 
一個串口程式
用Delphi3寫    unit whuart;    interface
uses
  Windows,SysUtils;
type
  EUart = Class(Exception);
  TUart = class(TObject)
   constructor Create;
   destructor  Destroy; override;
   //打開串口，例：Open('COM1',CBR_9600,'n',8,1)
   procedure Open(com:string;bps:longint;par:char;dbit,sbit:byte);
   //關閉串口
   procedure Close;
   //返回輸入緩衝區中的字元數
   function InbufChars:longint;
   //返回輸出緩衝區中的字元數
   function OutBufChars:Longint;
   //寫串口 buf:存放要寫的資料，len:要寫的長度
   procedure Send(var buf;len:integer);
   //讀串口 buf:存放讀到的資料，len:要讀的長度，tmout:超時值(ms)
   //返回: 實際讀到的字元數
   function Receive(var buf;len:integer;tmout:integer):integer;
   //向串口發一個字元
   procedure PutChar(ch:char);
   //向串口發一個字串
   procedure Puts(s:string);
   //從串口讀一個字元，未收到字元則返回#0
   function GetChar:char;
  //從串口取一個字串，忽略不可見字元,收到#13或255個字元結束，tmout:超時值(ms)
   //返回:true表示收到完整字串，false表示超時退出
   function Gets(var s:string;tmout:integer):boolean;
   //清接收緩衝區
   procedure ClearInBuf;
   //等待一個字串,tmout:超時值(ms),返回false表示超時
   function Wait(s:String;tmout:integer):boolean;
   //執行一個AT命令，返回true表示成功
   function ExecAtComm(s:string):boolean;
   //掛機，返回true表示成功
   function Hangup:boolean;
   //應答，返回true表示成功
   function Answer:boolean;      private
    OpenFlag: boolean;      //打開標誌
    handle  : THandle;      //串口控制碼
  end;        implementation    {$H }    const
  CommInQueSize  = 4096;    //輸入緩衝區大小
  CommOutQueSize = 4096;    //輸出緩衝區大小    {**********************
*      計時器        *
**********************}
type
  Timers=Class
  private
    StartTime: TTimeStamp;
  public
    constructor Create;
    Procedure Start;            {開始計時}
    Function  Get:LongInt;      {返回計時值(單位:ms)}
  end;    //構造函數
constructor Timers.Create;
begin
  inherited Create;
  Start;
end;    //開始計時
Procedure Timers.Start;
begin
  StartTime:=DateTimeToTimeStamp(Now);
end;    //返回計時值(單位:ms)
Function Timers.Get:LongInt;
var
  CurTime: TTimeStamp;
begin
  CurTime:=DateTimeToTimeStamp(Now);
  result:=(CurTime.Date-StartTime.Date)*24*3600000 (CurTime.Time-StartTime.Time);
end;    {******************
*      TUart     *
******************}    //構造函數
constructor TUart.Create;
begin
  inherited Create;
  OpenFlag:=False;
end;    //析構函數
Destructor TUart.Destroy;
begin
  Close;
  inherited Destroy;
end;    {*****
打開串口，例：Open('COM1',CBR_9600,'n',8,1)
串列傳輸速率：
  CBR_110       CBR_19200
  CBR_300     CBR_38400
  CBR_600     CBR_56000
  CBR_1200    CBR_57600
  CBR_2400    CBR_115200
  CBR_4800    CBR_128000
  CBR_9600    CBR_256000
  CBR_14400
校驗位:
  'n'=no,'o'=odd,'e'=even,'m'=mark,'s'=space
數據位元： 4-8 (other=8)
停止位： 1-2 (other=1.5)
****}
procedure TUart.Open(com:string;bps:longint;par:char;dbit,sbit:byte);
var
  dcb   : TDCB;
begin
  OpenFlag:=false;
  //初始化串口
  handle:=CreateFile(PChar(com),
             GENERIC_READ GENERIC_WRITE,
             0,
             nil,
             OPEN_EXISTING,
             0,
             0 );
  if handle = INVALID_HANDLE_VALUE then
    begin
      raise EUart.Create('無法打開串口:' com);
      exit;
    end;
  GetCommState(handle,dcb);
  with dcb do
  begin
    BaudRate:=bps;                // 串列傳輸速率
    if dbit in [4,5,6,7,8] then   // 數據位元
      ByteSize:=dbit
    else
      ByteSize:=8;
    case sbit of                  // 停止位
      1: StopBits:=0;             // 1
      2: StopBits:=2;             // 2
      else StopBits:=0;           //1
      //else StopBits:=1;           // 1.5
    end;
    case par of                   //校驗
      'n','N': Parity:=0;         //no
      'o','O': Parity:=1;         //odd
      'e','E': Parity:=2;         //even
      'm','M': Parity:=3;         //mark
      's','S': Parity:=4;         //space
      else     Parity:=0;         //no
    end;
  end;
  SetCommState(handle,dcb);
  SetupComm(handle,CommOutQueSize,CommInQueSize);
  OpenFlag:=true;
end;    //關閉串口
procedure TUart.Close;
begin
   if OpenFlag then
     CloseHandle(handle);
   OpenFlag:=false;
end;    //檢測輸入緩衝區中的字元數
function TUart.InbufChars:longint;
var
  ErrCode : Integer;
  Stat    : TCOMSTAT;
begin
  result:=0;
  if not OpenFlag then exit;
  ClearCommError(handle,ErrCode,@Stat);
  result:=stat.cbInQue;
end;    //檢測輸出緩衝區中的字元數
function TUart.OutBufChars:Longint;
var
  ErrCode : Integer;
  Stat    : TCOMSTAT;
begin
  result:=0;
  if not OpenFlag then exit;
  ClearCommError(handle,ErrCode,@Stat);
  result:=stat.cbOutQue;
end;    //寫串口 buf:存放要寫的資料，len:要寫的長度
procedure TUart.Send(var buf;len:integer);
var
  i : integer;
begin
  WriteFile(handle,Buf,len,i,nil);  //寫串口
end;    //讀串口 buf:存放讀到的資料，len:要讀的長度，tmout:超時值(ms)
//返回: 實際讀到的字元數
function TUart.Receive(var buf;len:integer;tmout:integer):integer;
var
  Timer   : Timers;
  i       : Integer;
  BufChs  : Integer;
begin
  Timer:=Timers.Create;
  Timer.Start;
  repeat until (InBufChars>=len) or (Timer.Get>tmout); //收到指定長度資料或超時
  BufChs:=InBufChars;
  if len>BufChs then len:=BufChs;
  ReadFile(handle,Buf,len,i,nil);  //讀串口
  result:=i;
  Timer.free;
end;    //向串口發一個字元
procedure TUart.PutChar(ch:char);
var
  i : integer;
begin
  WriteFile(handle,ch,1,i,nil);  //寫串口
end;    //向串口發一個字串
procedure TUart.Puts(s:string);
var
  i : integer;
begin
  for i:=1 to length(s) do Putchar(s[i]);
end;    //從串口讀一個字元，未收到字元則返回#0
function TUart.GetChar:char;
var
  i: integer;
begin
  result:=#0;
  if InBufChars>0 then
    ReadFile(handle,result,1,i,nil);  //讀串口
end;    //從串口取一個字串，忽略不可見字元,收到#13或255個字元結束，tmout:超時值(ms)
//返回:true表示收到完整字串，false表示超時退出
function TUart.Gets(var s:string;tmout:integer):boolean;
var
  Timer   : Timers;
  ch      : char;
begin
  Timer:=Timers.Create;
  Timer.Start;
  s:='';
  result:=false;
  repeat
    ch:=GetChar;
    if ch<>#0 then Timer.Start;   //如收到字元則清計時器
    if ch>=#32 then s:=s ch;
    if (ch=#13) or (length(s)>=255) then
    begin
     result:=true;
     break;
    end;
  until Timer.Get>tmout; //超時
  Timer.free;
end;    //清接收緩衝區
procedure TUart.ClearInBuf;
begin
  if not OpenFlag then exit;
  PurgeComm(handle,PURGE_RXCLEAR);
end;    //等待一個字串,tmout:超時值(ms),返回false表示超時
function TUart.Wait(s:String;tmout:integer):boolean;
var
  s1    : string;
  timer : Timers;
begin
  timer:=Timers.Create;
  timer.Start;
  result:=false;
  repeat
    Gets(s1,tmout);
    if pos(s,s1)>0 then
    begin
      result:=true;
      break
    end;
  until timer.Get>tmout;
  timer.Free;
end;    //執行一個AT命令，返回true表示成功
function TUart.ExecAtComm(s:string):boolean;
begin
  ClearInBuf;
  Puts(s);
  result:=false;
  if Wait('OK',3000) then
    result:=true;
end;    //掛機，返回true表示成功
function TUart.Hangup:boolean;
begin
  result:=false;
  ExecAtComm('   ');
  if not ExecAtComm('ATH'#13) then exit;
  result:=true;
end;    //應答，返回true表示成功
function TUart.Answer:boolean;
begin
  ClearInBuf;
  Puts('ATA'#13);
  result:=false;
  if Wait('CONNECT',30000) then
    result:=true;
end;    end. 
 
鄭重聲明
   近年來我站數百篇“原創文章”被一些媒體肆意轉載，不但不標明出自“中
國電子技術資訊網”，而且把相關字眼刪除！這是無視技術價值的盜竊行為，是
對技術人員辛勤勞動的蔑視，我對此種行為表示強烈的譴責。       “本是同根生，相煎何太急”，考慮到我們做技術的都是同門兄弟，對以前
的盜竊行為不再追究，今後再有此類事件，最低處理限度是“明示於天下”。
在這裏向轉載過又標注了出處的兄弟媒體表示崇高的敬意！
   兄弟網站如果引用本站“原創文章”，請首先經本人許可，並標注
“www.cetinet.com”或“中國電子技術資訊網”字樣。
   歡迎個人下載使用！
發表人 - conundrum 於 2004/05/22 21:06:22