?? serialdebug.pas
字號:
unit SerialDebug;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, OleCtrls, MSCommLib_TLB, iComponent,
iVCLComponent, iCustomComponent, iLed, iLedRound;
type
TMainForm = class(TForm)
mmReceive: TMemo;
Panel2: TPanel;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label6: TLabel;
cmbbxComNum: TComboBox;
cmbbxBaud: TComboBox;
cmbbxDataNum: TComboBox;
cmbbxStopBit: TComboBox;
cmbbxCheckBit: TComboBox;
btnSerial: TButton;
shpSerial: TShape;
mmSend: TMemo;
btnSend: TButton;
chckbxHexSend: TCheckBox;
chckbxTimer: TCheckBox;
edtTime: TEdit;
Label7: TLabel;
MSComm: TMSComm;
tmrSend: TTimer;
btnClear: TButton;
chckbxHexShow: TCheckBox;
Panel3: TPanel;
chckbxRTS: TCheckBox;
chckbxDTR: TCheckBox;
Label5: TLabel;
Label8: TLabel;
Label9: TLabel;
shpDSR: TShape;
shpCTS: TShape;
shpCD: TShape;
iLedRound1: TiLedRound;
procedure FormCreate(Sender: TObject);
procedure btnSerialClick(Sender: TObject);
procedure chckbxDTRClick(Sender: TObject);
procedure chckbxRTSClick(Sender: TObject);
procedure chckbxTimerClick(Sender: TObject);
procedure MSCommComm(Sender: TObject);
procedure chckbxHexShowClick(Sender: TObject);
procedure chckbxHexSendClick(Sender: TObject);
procedure btnSendClick(Sender: TObject);
procedure btnClearClick(Sender: TObject);
procedure tmrSendTimer(Sender: TObject);
procedure Panel2Click(Sender: TObject);
private
{ Private declarations }
HexShow:Boolean;
HexSend:Boolean;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
//該函數接收1個
//轉換成功.輸出字符對應的數
//轉換失敗.輸出-1
function hex(c:char):Integer ; //十六進制的字符轉化為對應的十進制的數字
var
x:integer;
begin
if c=' ' then
x:=0
else if (Ord(c)>=ord('0')) and (Ord(c)<=ord('9')) then //0-9
x:=Ord(c)-Ord('0')
else if (Ord(c)>=ord('a')) and (Ord(c)<=ord('f')) then//10-15
x:=Ord(c)-Ord('a')+10
else if (Ord(c)>=ord('A')) and (Ord(c)<=ord('F')) then//10-15
x:=Ord(c)-Ord('A')+10
else
//輸入錯誤
x:=-1;
Result:=x;
end;
//該函數接收1個至2個字符
//轉換成功.輸出對應16進制數的值
//轉換失敗.輸出-1。
function HexToInt(S:String): Integer; //十六進制字符轉化為先對應的十進制數字
var
tmpInt1,tmpInt2:Integer ;
begin
if Length(S)=1 then
begin
Result:=hex(S[1]);
end
else if Length(S)=2 then
begin
tmpInt1:=hex(S[1]);
tmpInt2:=hex(S[2]);
if (tmpInt1=-1) or (tmpInt2=-1) then
Result:=-1
else
Result:= tmpInt1*16+tmpInt2;
end
else
//輸入錯誤，轉換失敗
Result:=-1;
end;
//程序的初始化
procedure TMainForm.FormCreate(Sender: TObject);
begin
HexShow:=False;
cmbbxComNum.ItemIndex:=0;
shpSerial.Brush.Color:=clWhite;
shpCD.Brush.Color:=clWhite;
shpCTS.Brush.Color:=clWhite;
shpDSR.Brush.Color:=clWhite;
Panel1.Enabled:=True;
end;
//打開或者關閉串口，并變換指示燈的狀態
procedure TMainForm.btnSerialClick(Sender: TObject); //打開或關閉串口并對串口進行配置
var
ComSetting:String;
begin
if not MSComm.PortOpen then
begin
//打開串口
MSComm.CommPort :=cmbbxComNum.ItemIndex +1;//設置串口號
//默認值為 '9600,N,8,1' 設置波特率，奇偶校驗，數據位，停止位（查表）
ComSetting:=cmbbxBaud.Text;
ComSetting:=ComSetting+','+cmbbxCheckBit.Text;
ComSetting:=ComSetting+','+cmbbxDataNum.Text;
ComSetting:=ComSetting+','+cmbbxStopBit.Text;
MSComm.Settings:=ComSetting;
MSComm.PortOpen:=True;
//變換各個組件的狀態 打開串口之后各個組件的顯示狀態
shpSerial.Brush.Color:=clRed; //指示燈變紅
Panel1.Enabled:=False; //串口一打開 所有基本的配置便不可行
btnSerial.Caption :='關閉串口';
chckbxHexShow.Enabled:=False;
end
else begin
//關閉串口
//變換各個組件的狀態
MSComm.PortOpen:=False;
shpSerial.Brush.Color:=clWhite;//指示燈變白
Panel1.Enabled:=True; //關閉串口之后，可重新進行串口的配置
btnSerial.Caption :='打開串口';
chckbxHexShow.Enabled:=True;
end;
end;
//設置DTR線狀態
procedure TMainForm.chckbxDTRClick(Sender: TObject);
begin
MSComm.DTREnable :=chckbxDTR.Checked
end;
//設置RTS線狀態
procedure TMainForm.chckbxRTSClick(Sender: TObject);
begin
MSComm.RTSEnable :=chckbxRTS.Checked
end;
//開啟定時器，定時發送數據
procedure TMainForm.chckbxTimerClick(Sender: TObject);
begin
if chckbxTimer.Checked then
begin
tmrSend.Interval:=StrToInt(edtTime.Text);
tmrSend.Enabled:=True;
end
else begin
tmrSend.Enabled:=False;
end;
end;
//處理控件的該事件，獲取底層交換的數據和連線的狀態
//接收數據程序
procedure TMainForm.MSCommComm(Sender: TObject); //啟動OnComms事件
var
i,InputLen:Integer;
tmpInt:Integer;
tmpvar:Variant;
InputString:String;
begin
if MScomm.CommEvent=ComEventFrame then
begin
iledround1.Active:=true;
end
else
iledround1.Active:=false;
if MSComm.CommEvent=ComEvReceive then
begin
InputLen:=MSComm.InBufferCount;//讀取緩存區內的等待讀取的字節的個數
//接收二進制數據（整形），轉換為十六進制顯示 HexShow為窗體的全局變量
if HexShow then
begin
tmpvar:=MSComm.Input; //將緩存區的數據(數據類型為變體Variant)暫存于tmpvar變量中
InputString:=''; // 接收到的數據存于InputString中
for i:= 0 to InputLen-1 do//將變體類型轉為字符串類型
begin
tmpInt:=tmpvar[i];
InputString:=InputString+' '+LowerCase(IntToHex(tmpInt,2));
end;
end
//直接接收字符文本格式（字符類型）
else begin
InputString:=MSComm.Input; //變體字符串可直接賦值給字符串
end;
MainForm.mmReceive.Text :=MainForm.mmReceive.Text +InputString; //接收到的字符顯示出來
end
//顯示CD線的狀態
else if MSComm.CommEvent=ComEvCD then
begin
if MSComm.CDHolding then
shpCD.Brush.Color:=clRed
else
shpCD.Brush.Color:=clWhite;
end
//顯示CTS線的狀態
else if MSComm.CommEvent=ComEvCTS then
begin
if MSComm.CTSHolding then
shpCTS.Brush.Color:=clRed
else
shpCTS.Brush.Color:=clWhite;
end
//顯示DSR線的狀態
else if MSComm.CommEvent=ComEvDSR then
begin
if MSComm.DSRHolding then
shpDSR.Brush.Color:=clRed
else
shpDSR.Brush.Color:=clWhite;
end;
end;
//設置MSComm控件的數據接收的方式
procedure TMainForm.chckbxHexShowClick(Sender: TObject);
begin
if chckbxHexShow.Checked then
begin
MSComm.InputMode:=1; //通過input屬性以二進制方式取回數據
HexShow:=True;
end
else begin
MSComm.InputMode:=0; //通過input屬性以文本方式取回數據
HexShow:=False;
end;
end;
//設置參數HexSend的值，以告訴程序如何發送數據
procedure TMainForm.chckbxHexSendClick(Sender: TObject);
begin
HexSend:=chckbxHexSend.Checked;
end;
//發送數據
procedure TMainForm.btnSendClick(Sender: TObject);
var
Len:Integer;
i,count,tmpInt:Integer;
tmpVar:Variant;
tmpStr,Output:String;
begin
if not MSComm.PortOpen then //PortOpen的初始值是false
begin
showmessage('沒有打開串口！');
Exit;//退出函數
end
else begin
//發送二進制數，需要使用Variant變量矩陣，矩陣大小自動調節
if HexSend then
begin
Output:=mmSend.Text;
Len:=Length(Output);
if Len>0 then
begin
i:=1;
count:=1;
//創建一個Variant數組
tmpVar:=VarArrayCreate([1,1],varByte);
while(i<Len) do
begin
//每3個字符串中截取2個字符，轉換為16進制
tmpStr:=Copy(Output,i,2);
tmpStr:=LowerCase(tmpStr);
tmpInt:=HexToInt(tmpStr);
if tmpInt=-1 then
begin
showmessage('發送的數據格式有問題！');
exit;
end
else begin
tmpVar[Count]:=tmpInt;
Inc(count);
//增大Variant數組
VarArrayRedim(tmpVar,count);
end;
i:=i+3;
end;
MSComm.Output :=tmpVar;
end;
end
else begin //發送文本
MSComm.Output :=mmSend.Text;
end;
end;
end;
//清空數據顯示區
procedure TMainForm.btnClearClick(Sender: TObject);
begin
mmReceive.Text:='';
end;
//定時器在指定的事件內觸發該事件，實現數據的定時發送
procedure TMainForm.tmrSendTimer(Sender: TObject);
begin
//如果串口已經打開，則發送數據
if MSComm.PortOpen then
btnSendClick(sender);
end;
function ReadFromPLC(ReadChar:Array of char; ReadAddress:Array of Byte;
ReadBytes :Integer): Boolean;
var
ReadDataSum:integer;
DataSumCheck:integer;
tmpStr:String;
tmpchr,chr1,chr2:char;
tmpVar:Variant;
Input:Variant;
InputLen,i,tmpInt:Integer;
begin
DataSumCheck:=0;
tmpVar:=VarArrayCreate([1,11],varByte);
tmpVar[1]:=$02;//STX
tmpVar[2]:=$30;//CMDO
DataSumCheck:=DataSumCheck+$30;
tmpVar[3]:=ReadAddress[0];
DataSumCheck:=DataSumCheck+ReadAddress[0];
tmpVar[4]:=ReadAddress[1];
DataSumCheck:=DataSumCheck+ReadAddress[1];
tmpVar[5]:=ReadAddress[2];
DataSumCheck:=DataSumCheck+ReadAddress[2];
tmpVar[6]:=ReadAddress[3];
DataSumCheck:=DataSumCheck+ReadAddress[3];
tmpStr:=IntToHex(ReadBytes,2);
tmpChr:=tmpStr[1];
tmpVar[7]:=Ord(tmpChr);
DataSumCheck:=DataSumCheck+Ord(tmpChr);
tmpChr:=tmpStr[2];
tmpVar[8]:=Ord(tmpChr);
DataSumCheck:=DataSumCheck+Ord(tmpChr);
tmpVar[9]:=$03;//ETX
DataSumCheck:=DataSumCheck+$03;
tmpStr:=IntToHex(DataSumCheck,2);
tmpChr:=tmpStr[1];
tmpVar[10]:=Ord(tmpChr);
tmpChr:=tmpStr[2];
tmpVar[11]:=Ord(tmpChr);
MainForm.MSComm.Output:=tmpVar;
sleep(1000);
InputLen:=MainForm.MSComm.InBufferCount;
Input:=MainForm.MSComm.Input;
if InputLen>0 then
begin
if Input[0]=$02 then//STX
begin
ReadDataSum:=0;
for i:=1 to ReadBytes do
begin
tmpInt:=Input[i];
ReadChar[i-1]:=chr(tmpInt);
ReadDataSum:=ReadDataSum+Input[i];
end;
inc(i);
if Input[i]=$03 then
begin
ReadDataSum:=ReadDataSum+$03;
tmpStr:=IntToHex(ReadDataSum,2);
chr1:=tmpStr[1];
chr2:=tmpStr[2];
if (ord(chr1)=Input[1]) and (ord(chr1)=Input[1]) then
begin
Result:=True;
ShowMessage('DataRead succeed');
end
else begin
Result:=False;
ShowMessage('DataRead check fail');
end;
end;
end
else
Result:=False;
end
else
Result:=False;
end;
function WritePLC(WriteChar:Array of char; WriteAddress:Array of Byte;
WriteBytesCount :Integer): Boolean;
var
ReadDataSum:integer;
DataSumCheck:integer;
tmpStr:String;
tmpchr,chr1,chr2:char;
tmpVar:Variant;
Input:Variant;
InputLen,i,tmpInt:Integer;
begin
DataSumCheck:=0;
tmpInt:=11+WriteBytesCount;
tmpVar:=VarArrayCreate([1,tmpInt],varByte);
tmpVar[1]:=$02;//STX
tmpVar[2]:=$31;//CMDO
DataSumCheck:=DataSumCheck+$31;
tmpVar[3]:=WriteAddress[0];
DataSumCheck:=DataSumCheck+WriteAddress[0];
tmpVar[4]:=WriteAddress[1];
DataSumCheck:=DataSumCheck+WriteAddress[1];
tmpVar[5]:=WriteAddress[2];
DataSumCheck:=DataSumCheck+WriteAddress[2];
tmpVar[6]:=WriteAddress[3];
DataSumCheck:=DataSumCheck+WriteAddress[3];
tmpStr:=IntToHex(WriteBytesCount,2);
tmpChr:=tmpStr[1];
tmpVar[7]:=Ord(tmpChr);
DataSumCheck:=DataSumCheck+Ord(tmpChr);
tmpChr:=tmpStr[2];
tmpVar[8]:=Ord(tmpChr);
DataSumCheck:=DataSumCheck+Ord(tmpChr);
tmpVar[9]:=$03;//ETX
DataSumCheck:=DataSumCheck+$03;
for i:=0 to WriteBytesCount-1 do
begin
tmpVar[10+i]:=ord(WriteChar[i]);
DataSumCheck:=DataSumCheck+ord(WriteChar[i]);
end;
tmpStr:=IntToHex(DataSumCheck,2);
tmpChr:=tmpStr[1];
tmpVar[10+WriteBytesCount]:=Ord(tmpChr);
tmpChr:=tmpStr[2];
tmpVar[11+WriteBytesCount]:=Ord(tmpChr);
MainForm.MSComm.Output:=tmpVar;
sleep(1000);
InputLen:=MainForm.MSComm.InBufferCount;
Input:=MainForm.MSComm.Input;
if InputLen>0 then
begin
if Input[0]=$06 then//STX
begin
Result:=True;
ShowMessage('DataWrite succeed');
end
else begin
Result:=False;
ShowMessage('DataWrite check fail');
end;
end
else
Result:=False;
end;
procedure TMainForm.Panel2Click(Sender: TObject);
var
tmpWord:Word;
str:string;
ch:char;
begin
tmpWord:=3;
str:=IntToHex(3,2);
ch:=str[1];
Caption:=ch;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -