r232comm.pas

delphi编程

unit R232Comm;

interface
uses
  Windows,SysUtils;
const
  INITR12COMM_SUCCESS=0;
  INITR12COMM_FAILURE=-1;
var
  bSendFinish:boolean=True;//发送完标志
  iRecvLen:DWORD=0;
  RecvBuff,TempBuff:PChar;
  SendCommand,RecvCommand:String;//发送和接收到的命令
  RecvFinish:BOOL=False;
  RecvBuffInit:BOOL=False;
  SendCommandSuccess:BOOL; //切换台命令被成功发送标志

procedure initialCOM(comNo:PChar);  //初始化串口
procedure sendPchar(WriteBuffer:PChar);//串口发送字符串
procedure SwitchR12Byte(WriteBuffer:Byte);
procedure CommSendNotify;//串口接收到字符事件响应过程
procedure CommRecvNotify; //串口发送缓冲区空事件响应过程
procedure CommWatchThread(var lpdwParam:DWORD);//通信口监视线程
function  ConInfo :String;

implementation
var
  dcb:_DCB; //DCB结构用于配置串口，程序中涉及各域含义如下：
            //DWORD DCBlength :DCB结构大小
            //DWORD BaudRate :  波特率
            //DWORD fBinary  : 1 二进制模式
            //DWORD fParity  : 1 进行奇偶校验
            //BYTE  ByteSize: 字符位数 4~8
            //BYTE  Parity:   奇偶校验位 0-4分别表示无、奇、偶、传号、空号校验
            //BYTE  StopBits: 停止位数 0-2分别表示 1、1.5、2个停止位
            //WORD  XonLim ：XON 阈值
            //WORD  XoffLim  XOFF 阈值
            //char  XonChar： XON 字符
            //char  XoffChar: XOFF 字符
            //char  EvtChar:  事件字符
  comStat:_COMSTAT;
  dwErrorFlag:LongWord;
  hCommDev,comThreadHwnd:Thandle;//通信串口句柄和通信监视线程句柄
  comMask,comBuf,comState:BOOL;
  read_os,write_os:_OVERLAPPED;
  postRecvEvent,postSendEvent:Thandle;//发送缓冲区空和接收到字符事件句柄
  dwThreadID1:DWORD; //通信监视线程ID号


procedure initialCOM(comNo:PChar);
begin
   ///打开串口
   hCommDev:=CreateFile(comNo,   //串口号
                       GENERIC_READ or GENERIC_WRITE,//对串口以读写方式打开
                       0,
                       nil,
                       OPEN_EXISTING,
                       FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,//允许重叠操作
                       0
                       );
   comMask:=SetCommMask(hCommDev,EV_RXFLAG);//设置事件掩码
   //comBuf:=SetupComm(hCommDev,4096,4096);//设置接收和发送缓冲区大小皆为4096字节
   comBuf:=SetupComm(hCommDev,1,1);//设置接收和发送缓冲区大小皆为4096字节
         //清空缓冲区
         PurgeComm(hCommDev,PURGE_TXABORT or PURGE_RXABORT or
                                      PURGE_TXCLEAR or PURGE_RXCLEAR ) ;

   //以下对串口进行配置
   dcb.DCBlength:=sizeof(_DCB);
   comState:=GetCommState(hCOmmDev,dcb);  //得到缺省设置
   dcb.BaudRate:=9600;  //波特率 9600
   dcb.ByteSize:=8;//7;  //数据长度7位
   dcb.Parity:=NOPARITY;//ODDPARITY; //校验方式 奇校验
   dcb.StopBits:=ONESTOPBIT; //停止位 1 位

   dcb.Flags := 0;         // Enable fBinary
   dcb.Flags := dcb.Flags or 2;          // Enable parity check
   dcb.XonChar:= chr($00) ;
   dcb.XoffChar:= chr($00) ;
   dcb.XonLim:= 100 ;
   dcb.XoffLim:= 100 ;
   dcb.EvtChar := Char($ff);

   comState:=SetCommState(hCommDev,dcb);  //设置串口
     //设置通信接收到字符事件句柄
   postRecvEvent:=CreateEvent(NIL,
                              TRUE,//手工重置事件
                              TRUE, //初始化为有信号状态
                              NIL
                              );
   //设置读异步I/O操作事件句柄
   read_os.hEvent:=CreateEvent(NIL,
                              TRUE,//手工重置事件
                              FALSE, //初始化为无信号状态
                              NIL
                              );
   //设置发送缓冲区空事件句柄
   postSendEvent:=CreateEvent(NIL,
                              TRUE,//手工重置事件
                              TRUE, //初始化为有信号状态
                              NIL);
   //设置写异步I/O操作事件句柄
   write_os.hEvent:=CreateEvent(NIL,
                              TRUE,//手工重置事件
                              FALSE,//初始化为无信号状态
                              NIL);
   //创建通信监视线程
   comThreadHwnd:=CreateThread(NIL,
                         0,
                         @CommWatchThread, //通信线程函数的地址
                         nil,
                         0,   //创建后立即运行
                         dwThreadID1);//通信线程ID号
end;

///切换台切换控制函数
///输入参数；切换命令字符串
procedure sendPchar(WriteBuffer:PChar);
var
 dwWriteByte,TxCount:DWORD;
 bl:BOOL;
 dwError:DWORD;

begin
     TxCount:=StrLen(WriteBuffer);
     if bSendFinish=True then  //发送缓冲区空发送
     begin
         dwWriteByte:=0;
         bSendFinish:=False;
         bl:=WriteFile(hCommDev,Byte(WriteBuffer^),TxCount,dwWriteByte,@write_os);
         if bl=True then
         begin
          bSendFinish:=True;
          PurgeComm(hCommDev,PURGE_TXCLEAR );//如果发送完成，置缓冲区空标志，并清空缓冲区
         end;
         if bl=False then
         begin
           dwError:=GetLastError();
           if (dwError=ERROR_IO_PENDING) or (dwError=ERROR_IO_INCOMPLETE) then
           begin
             bl:=GetOverLappedResult(hCommDev,
                             write_os,dwWriteByte,TRUE);//如果未发送完命令字符
                                                    //等待发送完成
             if bl=True then
             begin
                bSendFinish:=True;
                PurgeComm(hCommDev,PURGE_TXCLEAR ); //发送完成 置缓冲区空标志，并清空缓冲区
             end;
           end;
         end;
     end;
end;

procedure SwitchR12Byte(WriteBuffer:Byte);
var
 dwWriteByte,TxCount:DWORD;
 bl:BOOL;
 dwError:DWORD;

begin
     TxCount:= 1 ;
     if bSendFinish=True then  //发送缓冲区空发送
     begin
         dwWriteByte:=0;
         bSendFinish:=False;
         bl:=WriteFile(hCommDev,WriteBuffer,TxCount,dwWriteByte,@write_os);
         if bl=True then
         begin
          bSendFinish:=True;
          PurgeComm(hCommDev,PURGE_TXCLEAR );//如果发送完成，置缓冲区空标志，并清空缓冲区
         end;
         if bl=False then
         begin
           dwError:=GetLastError();
           if (dwError=ERROR_IO_PENDING) or (dwError=ERROR_IO_INCOMPLETE) then
           begin
             bl:=GetOverLappedResult(hCommDev,
                             write_os,dwWriteByte,TRUE);//如果未发送完命令字符
                                                    //等待发送完成
             if bl=True then
             begin
                bSendFinish:=True;
                PurgeComm(hCommDev,PURGE_TXCLEAR ); //发送完成 置缓冲区空标志，并清空缓冲区
             end;
           end;
         end;
     end;
end;

////通信监视线程
procedure CommWatchThread(var lpdwParam:DWORD);
var
    dwTransfer,dwEvtMask,dwError:DWORD;
    os:_OVERLAPPED;
    bl:boolean;
begin
    os.hEvent:=CreateEvent(nil,
                          TRUE,
                          FALSE,
                          NIL);
    comMask:=SetCommMask(hCommDev,EV_RXCHAR or EV_TXEMPTY);//设置监视的事件为接
                                                        //收到字符或发送缓冲区空
    if comMask=True then
    begin
        while True do
        begin
           dwEvtMask:=0;
           bl:=WaitCommEvent(hCommDev,dwEvtMask,@os); //查询所监视的通信事件是否
                                                       //已经发生
           if bl=False then
           begin
             dwError:=GetLastError();
             if dwError=ERROR_IO_PENDING then
                GetOverlappedResult(hCOmmDev,os,dwTransfer,TRUE);//若未监测到通信事件
                                           //则在此等待事件发生
           end;
           //有事件，进行如下处理
           if (dwEvtMask and EV_RXCHAR)=EV_RXCHAR then //判断是否为接收到 字符事件
           begin
              WaitForSingleObject(postRecvEvent,$FFFFFFFF);//等待接收事件句柄为有
                                                      //信号状态
              ResetEvent(postRecvEvent); //置接收事件句柄为无信号状态，以免接收
                                        //缓冲区被覆盖
              CommRecvNotify; //调用接收到字符处理函数
              continue; //处理完接收字符，继续监测通信事件
           end;
           if (dwEvtMask and EV_TXEMPTY)=EV_TXEMPTY then //判断是否为发送缓冲区空事件
           begin
              WaitForSingleObject(postSendEvent,$FFFFFFFF);//等待发送事件句柄为有
                                                           //信号状态
              ResetEvent(postSendEvent); //置发送事件句柄为无信号状态，，以免发送
                                        //缓冲区被覆盖
              CommSendNotify; //调用发送缓冲区空处理函数
              continue;//处理完，继续监测通信事件
           end;
        end;
    end;
    CloseHandle(os.hEvent);
end;

       //发送缓冲区空处理过程
procedure CommSendNotify;
begin
    SetEvent(postSendEvent);//置发送事件未有信号状态，以便进行下一次发送
end;

       //接收到字符处理函数
procedure CommRecvNotify;
var
     RxCount,dwReadByte:DWORD;
     inData :Byte;
begin
     ClearCommError(hCommDev,dwErrorFlag,@ComStat);
     RxCount:=ComStat.cbInQue; //获取接收缓冲区的字符个数
     if RxCount>0 then
     begin
       if not RecvBuffInit then
       begin
          StrCopy(RecvBuff,'');
          RecvBuffInit:=True;
       end;
       StrCopy(TempBuff,'');
       ReadFile(hCommDev,Byte(TempBuff^),RxCount,dwReadByte,@read_os);//读字符存入
                                                                      //临时缓冲区中
       iRecvLen:=iRecvLen+dwReadByte; //接收到字符个数统计

       if iRecvLen >=1 then
       begin
            inData := Byte(TempBuff^);
            if inData = $D9 then
            begin
                 SendCommandSuccess:=True;  //如果状态一致，则置该标志为真，标志切换成功
            end
            else
            begin
                 SendCommandSuccess:=False;//否则，置该标志为假，表示切换失败
            end;

            iRecvLen:=0;
            StrCopy(RecvBuff,'');
            RecvBuffInit:=False;
            PurgeComm(hCommDev,PURGE_RXCLEAR ); //清空接收缓冲区
       end
    end;

    SetEvent(postRecvEvent); //置接收事件句柄为有信号状态，以便接收新字符
end;

function ConInfo :String;
begin
     if  SendCommandSuccess =True then
     begin
          Result := '切换器联机监测成功！';
     end
     else
     begin
          Result := '切换器联机监测失败！';
     end;
end;

initialization
    RecvBuff:=StrAlloc(50*sizeof(Char));
    TempBuff:=StrAlloc(50*sizeof(Char));
Finalization
    StrDispose(RecvBuff);
    StrDispose(TempBuff);
    CloseHandle(PostRecvEvent);
    CloseHandle(read_os.hEvent);
    CloseHandle(PostSendEvent);
    CloseHandle(write_os.hEvent);
end.