ucom.pas

用串口发送手机短信 需要GSM Mode设备

unit uCom;

interface

uses
  Windows, SysUtils;

type
  TclsCom=Class(TObject)
    private
      hComm:THandle;
      waitTime:Word;
      iBaud :Word;
    public
      function bolComInit(CommPort,intTime:byte;tmpBaud:Word) :boolean;  //规格化浮点数转为(本有四位，因精度不高故取三位)单精度
      function bolComClose() :boolean;
      function bytSendB(var snd:array of byte) :boolean;
      function bytRecB() :TBytes;
  end;

implementation

function TclsCom.bolComInit(CommPort,intTime:byte;tmpBaud:Word) :boolean;
{初始化串口
当没有串口或已打开时，返回为false
CommPort  串口号
intTime   命令间等待时间
}
var
  cc:TCOMMCONFIG;   //Windows引用
  tmp:string;
begin
  //设置端口
  if(CommPort=2) then tmp := 'com2'
  else if(CommPort=3) then tmp := 'com3'
  else if(CommPort=4) then tmp := 'com4'
  else tmp := 'com1';

  waitTime := intTime;  //命令间等待时间
  if tmpBaud=1200 then iBaud :=CBR_1200
  else if tmpBaud=2400 then iBaud :=CBR_2400
  else if tmpBaud=4800 then iBaud :=CBR_4800
  else  iBaud :=CBR_9600;

  hComm := CreateFile(PChar(tmp),Generic_Read or Generic_Write, 0, nil, Open_Existing, 0, 0);//打开串行口
  if(hComm=Invalid_Handle_Value)then begin
    Result := false;
    exit;
  end;

  GetCommState(hComm,cc.dcb);    //获取默认通信参数

  cc.dcb.BaudRate:=iBaud;
  cc.dcb.ByteSize:=8;
  cc.dcb.Parity:= 0;  //NOPARITY = 0; MARKPARITY = 3; SPACEPARITY = 4;
  cc.dcb.StopBits:=ONESTOPBIT;  //ONESTOPBIT = 0;

  if not SetCommState(hComm,cc.dcb) then begin  //设置通信参数
    CloseHandle(hComm);         //关闭串行口
    Result := false;
    exit;
  end;

  Result := true;
end;//bolComInit完

function TclsCom.bolComClose() :boolean;
{关闭串口
}
begin
  CloseHandle(hComm);
  Result := true;
end;//bolComClose完

function TclsCom.bytSendB(var snd:array of byte) :boolean;
var
  lrc:LongWord;
  cc:TCOMMCONFIG;
begin
  try
    if(hComm=0)then begin Result:=false; exit; end;
    //*****08-06-19为添加监控而加*****>>
    GetCommState(hComm,cc.dcb);     //获取默认通信参数
    cc.dcb.BaudRate := iBaud;
    cc.dcb.ByteSize :=8;
    cc.dcb.Parity   :=0;     //SPACEPARITY   MARKPARITY
    cc.dcb.StopBits := ONESTOPBIT;
    if not SetCommState(hComm,cc.dcb) then   //设置通信参数
    begin
      CloseHandle(hComm);  //关闭串行口 //没有串口时错在此  (正确加载串口，中途拔掉)
      Result := false;
      exit;                //当打开后又关闭就出错，而没有打开直接执行不出错  ???曾多次出错定位于此
    end;

    WriteFile(hComm,snd,length(snd),lrc,nil);//写串口操作
    Result := true;
  except
    Result := false;
  end;

end;//

function TclsCom.bytRecB() :TBytes;
var
  nBytesRead,dwError:LongWord;
  byteData:array[0..8000] of byte;
  cs:TCOMSTAT;
  i:integer;
  rtn: TBytes;  //（因为后期问题,实际取数据时从1开始，第0位存长度）
begin
try        
  ClearCommError(hComm,dwError,@cs);

  ReadFile(hComm,byteData,cs.cbInQue,nBytesRead,nil);//读串口操作

  ClearCommError(hComm,dwError,@cs);//清除串口错误并获取当前状态

  rtn :=nil;
  if nBytesRead>0 then begin
      setLength(rtn,nBytesRead);//第0位存实际长度  setLength(rtn,20);长为20;从0,1...18,19
      if nBytesRead>=255 then  rtn[0] :=255
      else rtn[0] := nBytesRead-1;
      for i:=1 to high(rtn) do begin
        rtn[i] := byteData[i];  //rtn[0]=长  byteData[0]=FF
      end;
  end else begin
    rtn :=nil;setLength(rtn,1);rtn[0]:=0;
  end;

except
  rtn :=nil;setLength(rtn,1);rtn[0]:=0;
end;
  Result :=rtn;
end;//bytRecB完

end.