RS232串口通訊模塊

2019-11-18 17:57:46

字體：大中小

來源：轉載

供稿：網友

應為工作需要自己編寫的RS232通訊模塊，該模塊已經編寫了蠻久，在實際使用中可能有沒有考慮和不完善的地方。

//=================================================================================

//如果使用該模塊請保留該注釋，如果被修改或編輯請將修改后的代碼發送一份給我

//編寫：戴琪英

//E_Mail:[email protected]

//2000-09-01

//=================================================================================

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; //切換臺命令被成功發送標志

function InitR12CommDev(comNo:PChar):String; //初始化切換臺串口，返回狀態字符
PRocedure SwitchR12(WriteBuffer:PChar);//對切換臺進行切換函數
procedure SwitchR12Byte(WriteBuffer:Byte);
procedure CommSendNotify;//串口接收到字符事件響應過程
procedure CommRecvNotify; //串口發送緩沖區空事件響應過程
procedure CommWatchThread(var lpdwParam:DWORD);//通信口監視線程
function ConInfo :String;

implementation
var
//comMask,comBuf,ComState:Integer;
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; //COMSTAT結構用于存放有關通信設備的當前信息
                    //程序中涉及各域含義如下：
                    //cbInQue :接收緩沖區中字符個數
                    //cbOutQue:發送緩沖區中字符個數
dwErrorFlag:LongWord;
hCommDev,comThreadHwnd:Thandle;//通信串口句柄和通信監視線程句柄
comMask,comBuf,comState:BOOL;
read_os,write_os:_OVERLAPPED; //OVERLAPPED 結構，用于異步操作的Win32函數中
                                //程序中涉及各域含義如下：
                                //DWORD Interval 保留給操作系統使用
                                //DWORD IntervalHigh 保留給操作系統使用
                                //DOWD hEvent 當I/O操作完成時被設置為有信號狀態
                                //的事件；當調用ReadFile和WriteFile函數之前，調
                                //用進程設置該事件
postRecvEvent,postSendEvent:Thandle;//發送緩沖區空和接收到字符事件句柄
dwThreadID1:DWORD; //通信監視線程ID號

///串口初始化函數
//該函數主要完成串口初始化設置和通信線程的啟動
//入口參數：串口號
//返回值；初始化是否成功的狀態字符
function InitR12CommDev(comNo:PChar) :String;
begin
   ///打開串口
   hCommDev:=CreateFile(comNo,   //串口好
                       GENERIC_READ or GENERIC_WRITE,//對串口以讀寫方式打開
                       0,
                       nil,
                       OPEN_EXISTING,
                       FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,//允許重疊操作
                       0
                       );
   if hCommDev=INVALID_HANDLE_VALUE then
        InitR12CommDev:='切換臺通訊端口初始化失敗.'
   else
      InitR12CommDev:='切換臺通訊端口初始化成功.';
   comMask:=SetCommMask(hCommDev,EV_RXFLAG);//設置事件掩碼
   //comBuf:=SetupComm(hCommDev,4096,4096);//設置接收和發送緩沖區大小皆為4096字節
   comBuf:=SetupComm(hCommDev,1,1);//設置接收和發送緩沖區大小皆為4096字節
   if comBuf=False then
         InitR12CommDev:='切換臺通訊端口初始化失敗.'
   else
      begin
         InitR12CommDev:='切換臺通訊端口初始化成功.';
         //清空緩沖區
         PurgeComm(hCommDev,PURGE_TXABORT or PURGE_RXABORT or
                                      PURGE_TXCLEAR or PURGE_RXCLEAR ) ;
      end;

   //以下對串口進行配置
   dcb.DCBlength:=sizeof(_DCB);
   comState:=GetCommState(hCOmmDev,dcb); //得到缺省設置
   if comState=False then
         InitR12CommDev:='切換臺通訊端口初始化失敗.'
   else
       InitR12CommDev:='切換臺通訊端口初始化成功.';
   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); //設置串口
   if comState=False then
         InitR12CommDev:='切換臺通訊端口初始化失敗.'
   else
      InitR12CommDev:='切換臺通訊端口初始化成功.';
     //設置通信接收到字符事件句柄
   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號
   if comThreadHwnd=INVALID_HANDLE_VALUE then
      InitR12CommDev:='INITR12COMM_FAILURE'
   else
      InitR12CommDev:='切換臺通訊端口初始化成功.';
end;

///切換臺切換控制函數
///輸入參數；切換命令字符串
procedure SwitchR12(WriteBuffer:PChar);
var
dwWriteByte,TxCount:DWORD;
bl:BOOL;
dwError:DWORD;

begin
     //WriteBuffer:=chr($0D)+'03A00';
     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 ); //發送完成置緩沖區空標志，并清空緩沖區
                //Result:=True;
             end;
           end;
         end;
     end;
     //Result:=True;
end;

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

begin
     //WriteBuffer:=chr($0D)+'03A00';
     TxCount:= 1 ;//StrLen(WriteBuffer);
     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 ); //發送完成置緩沖區空標志，并清空緩沖區
                //Result:=True;
             end;
           end;
         end;
     end;
     //Result:=True;
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;

{
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);//讀字符存入
       //ReadFile(hCommDev,Byte(TempBuff^),RxCount,dwReadByte,@read_os);//讀字符存入
                                              //臨時緩沖區中
       iRecvLen:=iRecvLen+dwReadByte; //接收到字符個數統計
       {
       if iRecvLen<13 then
       begin
          strcat(Recvbuff,TempBuff); //若接收到的切換臺狀態字符小于13個，
                          //將臨時緩沖區中的字符拷貝到接收命令緩沖區，準備繼續讀
       end
       else
       begin
         strcat(Recvbuff,TempBuff);
         RecvCommand:=RecvBuff;
         //若接收到13個切換臺狀態字符進行如下處理
         if (RecvCommand[7]='P')
            and(RecvCommand[8]=SendCommand[7])     //比較讀入的切換臺端口狀態
            and (RecvCommand[9]=SendCommand[8])   //是否與切換指令中切換的端口
            and (RecvCommand[10]=SendCommand[9])   //一致
            and (RecvCommand[11]=SendCommand[10]) then

         begin
            SendCommandSuccess:=True; //如果狀態一致，則置該標志為真，標志切換成功
         end
         else
         begin
           SendCommandSuccess:=False;//否則，置該標志為假，表示切換失敗
         end;
         iRecvLen:=0;
         StrCopy(RecvBuff,'');
         RecvBuffInit:=False;
         PurgeComm(hCommDev,PURGE_RXCLEAR ); //清空接收緩沖區
       end;
       }
       {
       if iRecvLen >=1 then
       begin
            inData := Byte(TempBuff^);
            if inData = $D9 then
            begin
                 SendCommandSuccess:=True; //如果狀態一致，則置該標志為真，標志切換成功

            end
            else
            begin
                 SendCommandSuccess:=False;//否則，置該標志為假，表示切換失敗
            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.