| 應為工作需要自己編寫的RS232通訊模塊，該模塊已經編寫了蠻久，在實際使用中可能有沒有考慮和不完善的地方。 //================================================================================= //如果使用該模塊請保留該注釋，如果被修改或編輯請將修改后的代碼發送一份給我 //編寫：戴琪英 //E_Mail:qiyingdai@163.com //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; ??????????? iRecvLen:=0;
??????????? StrCopy(RecvBuff,'');
??????????? RecvBuffInit:=False;
??????????? PurgeComm(hCommDev,PURGE_RXCLEAR ); //清空接收緩沖區
?????? end
??? end;
???
??? SetEvent(postRecvEvent); //置接收事件句柄為有信號狀態，以便接收新字符 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.
| 
