unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, RzButton, StdCtrls, RzEdit, OleCtrls, MSCommLib_TLB, ExtCtrls, dateutils,
Buttons;
type
treceivetext = record
Amount: integer;
rectext: string;
end;
type Tinstruction = record
com: string;
retextlength: integer;
runtimes: integer;
end;
type
TForm1 = class(TForm)
MSComm1: TMSComm;
RzMemo1: TRzMemo;
RzButton1: TRzButton;
procedure FormCreate(Sender: TObject);
procedure RzButton1Click(Sender: TObject);
procedure MSComm1Comm(Sender: TObject);
private
{ Private declarations }
currcom, commtemp, lastcom: string;
receivetextlength: integer;
public
{ Public declarations }
Cominfo: Tinstruction;
reclist: tstringlist;
procedure sendcom(com: string; rectxtlength: integer);
end;
var
Form1: TForm1;
sendok, receiveok, linkinterrupt: boolean;
receivetext: treceivetext;
Readrecordcount, dalayMS, Trytoconnect, stateinfo: INTEGER;
currjh: string;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
Trytoconnect := 3;
end;
procedure TForm1.sendcom(com: string; rectxtlength: integer);
begin
mscomm1.OutBufferCount := 0;
mscomm1.inBufferCount := 0;
MSComm1.sThreshold := 1;
MSComm1.RThreshold := rectxtlength;
MSComm1.Output := com;
end;
procedure TForm1.RzButton1Click(Sender: TObject);
var firsttickcount: real;
temp: string;
i: integer;
begin
reclist := tstringlist.Create;
MSCOMM1.CommPort := 9;
MSComm1.InBufferSize := 2048;
MSComm1.OutBufferSize := 256;
MSComm1.Settings := '9600,n,8,1';
MSComm1.InputLen := 0;
MSComm1.InBufferCount := 0;
MSComm1.OutBufferCount := 0;
MSComm1.RThreshold := 3;
MSComm1.InputMode := comInputModeText;
mscomm1.SThreshold := 0;
mscomm1.PortOpen := true;
mscomm1.InitControlData;
currjh := '01';
Readrecordcount := 10;
currcom := 'SA' + currjh + '!';
cominfo.com := currcom;
cominfo.retextlength := 11;
sendcom(cominfo.com, cominfo.retextlength);
cominfo.runtimes := 0;
rzmemo1.Lines.Add('執行' + cominfo.com);
stateinfo := 0;
reclist.Clear;
i := 0;
repeat
Application.ProcessMessages;
inc(i);
if (stateinfo = -1) or (stateinfo = 1) then
begin
if reclist.Count > 0 then
rzmemo1.Lines.AddStrings(reclist);
end;
rzmemo1.Lines.add('i:=' + inttostr(i));
until (stateinfo = -1) or (stateinfo = 1);
if mscomm1.PortOpen then
begin
mscomm1.OutBufferCount := 0;
rzmemo1.Lines.Add('執行完畢！');
mscomm1.PortOpen := false;
end;
reclist.Clear;
end;
procedure TForm1.MSComm1Comm(Sender: TObject);
var str, temp, tempstr, xfsjstr: string;
num, je: string;
i, reclength: integer;
recno, amount, realgetrec, tempamount: integer;
readeof: boolean;
firsttickcount: real;
begin
if linkinterrupt then EXIT;
RZMEMO1.LineS.Add('MSComm1.CommEvent:' + inttostr(MSComm1.CommEvent));
case MSComm1.CommEvent of
comEvReceive:
begin
Application.ProcessMessages;
receiveok := TRUE;
temp := mscomm1.Input;
if temp = '' then exit;
RZMEMO1.LineS.Add(CURRCOM + ':' + TEMP);
if currcom = 'SK' + currjh + '!' then
begin
if temp = 'E000000001!' then
begin
sleep(1000);
if cominfo.runtimes < Trytoconnect then
begin
sendcom(cominfo.com, cominfo.retextlength);
end
else
begin
stateinfo := -1;
end;
end
else
if temp = 'E000000002!' then
begin
stateinfo := 1;
end
else
if LENGTH(trim(temp)) = 11 then
begin
tempstr := temp;
str := copy(tempstr, 1, 5);
tempstr := copy(tempstr, 6, 5);
recno := strtoint(str);
amount := strtoint(tempstr);
if amount > Readrecordcount then
realgetrec := Readrecordcount
else
realgetrec := amount;
tempstr := format('%.2d', [realgetrec]);
commtemp := str + tempstr;
currcom := 'DA' + commtemp + '!';
cominfo.com := currcom;
cominfo.retextlength := realgetrec * 40;
sendcom(cominfo.com, cominfo.retextlength);
cominfo.runtimes := 0;
end
else
begin
showmessage(temp);
if cominfo.runtimes < Trytoconnect then
begin
sendcom(cominfo.com, cominfo.retextlength);
end
else
begin
stateinfo := -1;
end;
end;
end
else
if currcom = 'DA' + commtemp + '!' then
begin
if length(temp) = MSComm1.RThreshold then
begin
currcom := 'OK!';
cominfo.com := currcom;
cominfo.retextlength := 5;
sendcom(cominfo.com, cominfo.retextlength);
cominfo.runtimes := 0;
end
else
begin
if cominfo.runtimes < Trytoconnect then
begin
sendcom(cominfo.com, cominfo.retextlength);
end
else
begin
stateinfo := -1;
end;
end;
end
else
if currcom = 'OK!' then
begin
if (temp = 'OVER!') then
begin
i := 0;
while i < receivetext.Amount do
begin
Application.ProcessMessages;
str := copy(receivetext.rectext, i * 40 + 1, 40);
inc(i);
str := '01' + str;
reclist.Add(str);
end;
RZMEMO1.Lines.AddStrings(reclist);
currcom := 'SK' + currjh + '!';
cominfo.com := currcom;
cominfo.retextlength := 11;
sendcom(cominfo.com, cominfo.retextlength);
cominfo.runtimes := 0;
end
else
begin
if cominfo.runtimes < Trytoconnect then
begin
sendcom(cominfo.com, cominfo.retextlength);
end
else
begin
stateinfo := -1;
end;
end;
end;
end;
ComEvSend:
begin
Application.ProcessMessages;
receiveok := FALSE;
//TIMER1.Enabled := TRUE;
linkinterrupt := FALSE;
cominfo.runtimes := cominfo.runtimes + 1;
firsttickcount := GetTickCount;
i := 0;
repeat
Application.ProcessMessages;
inc(i);
rzmemo1.Lines.Add(inttostr(i));
if receiveok then break;
until (GetTickCount - firsttickcount) > 1000;
if not receiveok then
begin
if cominfo.runtimes < 3 then
begin
sendcom(cominfo.com, cominfo.retextlength);
end
else
begin
linkinterrupt := TRUE;
stateinfo := -1;
mscomm1.OutBufferCount := 0;
mscomm1.InBufferCount := 0;
RZMEMO1.LineS.Add('連接中斷');
end;
end;
end
else
begin
if cominfo.runtimes < Trytoconnect then
begin
sendcom(cominfo.com, cominfo.retextlength);
end
else
begin
stateinfo := -1;
end;
end;
end;
end;
end.
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/101768.html
標籤：VCL組件開發及應用
上一篇：Mscomm串口控制元件使用Input方法報錯，用其他方法就行，如Inbuffercount
下一篇：急，DELPHI串口發送不出資料