應為工作需要自己編寫的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.
新聞熱點
疑難解答
