?? umain.~pas
字號:
tmpByte[index] := ord(s[i]);
inc(index);
end; //文件大小
for i := index to 127 do //0-127之間除有效的字節(文件名及大小)其他空字節補上$00
begin
tmpByte[index] := $00;
inc(index);
end;
ByteID := $00;
ctcBuf := UFunction.CRC16(tmpByte, 128, backHexValue); //只對128位數據位進行校驗,前三位不作校驗
UFunction.RecordLogToMemo('CRC16[' + inttostr(ByteID) + ']:backHexValue<' + backHexValue + '>', memo1);
tmpByte[index] := ctcBuf.Highbyte; inc(index);
tmpByte[index] := ctcBuf.Lowbyte; inc(index);
buf[0] := SOH;
buf[1] := ByteID;
buf[2] := $FF - ByteID;
inc(ByteID);
CopyMemory(@buf[3], @tmpByte, index);
inc(index, 3);
UFunction.ProcIntToHexs(@buf, index, tmpbuf, true);
Comm1.WriteCommData(@buf, index);
UFunction.RecordLogToMemo('Has Send Header[' + inttostr(ByteID - 1) + ']<' + inttostr(index) + '>:' + tmpBuf, Memo1);
memo1.Lines.Add('************************************************');
end;
function TFmain.SendData_128: integer;
var buf: array[0..1023] of byte;
tmpByte: array[0..1023] of byte;
tmpBuf: array[0..1023] of char;
i, Len: integer;
ctcBuf: TMyCTC16;
backHexValue: string;
begin
try
ZeroMemory(@buf, sizeof(buf));
ZeroMemory(@tmpByte, sizeof(tmpByte));
ZeroMemory(@tmpbuf, sizeof(tmpbuf));
MyFile.ReadBuffer(tmpByte, LastSize);
Len := 128;
for i := LastSize to Len - 1 do
//空字符以$1A填充
tmpByte[i] := $1A;
ctcBuf := UFunction.CRC16(tmpByte, 128, backHexValue);
UFunction.RecordLogToMemo('CRC16[' + inttostr(ByteID) + ']:backHexValue<' + backHexValue + '>', memo1);
tmpByte[Len] := ctcBuf.Highbyte; len := len + 1; //len=129
tmpByte[Len] := ctcBuf.Lowbyte; len := len + 1; //len=130
buf[0] := SOH;
buf[1] := ByteID;
buf[2] := $FF - ByteID;
inc(ByteID);
CopyMemory(@buf[3], @tmpByte, len);
len := len + 3;
UFunction.ProcIntToHexs(@buf, len, tmpbuf, true);
Comm1.WriteCommData(@buf, Len);
UFunction.RecordLogToMemo('Has Send Data[' + inttostr(ByteID - 1) + ']<' + inttostr(Len) + '>:' + tmpBuf, Memo1);
memo1.Lines.Add('************************************************');
LastSize := LastSize - 128;
Result := 0;
except
Result := -1;
end;
end;
function TFmain.SendData_1K: integer;
var buf: array[0..2048] of byte;
tmpByte: array[0..2048] of byte;
tmpBuf: array[0..4096] of char; //4096>1029*3
i, Len: Integer;
ctcBuf: TMyCTC16;
backHexValue: string;
begin
try
ZeroMemory(@buf, sizeof(buf));
ZeroMemory(@tmpByte, sizeof(tmpByte));
ZeroMemory(@tmpbuf, sizeof(tmpbuf));
Len := 1024;
if LastSize < 1024 then //小于1024則用用$1A填充
begin
MyFile.ReadBuffer(tmpByte, LastSize);
for i := LastSize to len - 1 do
tmpByte[i] := $1A;
end
else if LastSize >= 1024 then
begin
MyFile.ReadBuffer(tmpByte, 1024);
end;
ctcBuf := UFunction.CRC16(tmpByte, 1024, backHexValue);
UFunction.RecordLogToMemo('CRC16[' + inttostr(ByteID) + ']:backHexValue<' + backHexValue + '>', memo1);
tmpByte[len] := ctcBuf.Highbyte;
len := len + 1; //len=1025
tmpByte[len] := ctcBuf.Lowbyte;
len := len + 1; //len=1026
buf[0] := STX; //$02
buf[1] := ByteID;
buf[2] := $FF - ByteID;
inc(ByteID);
CopyMemory(@buf[3], @tmpByte, len);
len := len + 3; //1029
UFunction.ProcIntToHexs(@buf, len, tmpbuf, true);
Comm1.WriteCommData(@buf, Len);
UFunction.RecordLogToMemo('Has Send Data[' + inttostr(ByteID - 1) + ']<' + inttostr(Len) + '>:' + tmpBuf, Memo1);
memo1.Lines.Add('************************************************');
LastSize := LastSize - 1024;
Result := 0;
except
Result := -1;
end;
end;
function TFmain.SendEnd: integer;
var buf: array[0..1023] of byte;
i: integer;
tmpBuf: array[0..1023] of char;
begin
ZeroMemory(@buf, sizeof(buf));
ZeroMemory(@tmpbuf, sizeof(tmpbuf));
buf[0] := EOT; //結束結束$04
Comm1.WriteCommData(@buf, 1);
UFunction.RecordLogToMemo('Has Send End of Eot[$04]', Memo1);
buf[0] := SOH;
buf[1] := $00;
buf[2] := $FF; //表明后面沒有續發的文件了,
for i := 3 to 133 - 1 do
buf[i] := $00;
UFunction.ProcIntToHexs(@buf, 133, tmpbuf, true);
Comm1.WriteCommData(@buf, 133);
UFunction.RecordLogToMemo('Has Send EndData[$00]<133>:' + tmpBuf, Memo1);
memo1.Lines.Add('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
end;
procedure TFmain.BitBtn2Click(Sender: TObject);
begin
Comm1.CommName := ComboBox1.Text;
Comm1.BaudRate := strtoint(ComboBox2.Text);
Comm1.ByteSize := TByteSize(ComboBox3.ItemIndex);
Comm1.StopBits := TStopBits(ComboBox4.ItemIndex);
Comm1.Parity := (None);
try
Comm1.StartComm;
Shape1.Brush.Color := clLime;
except
end;
end;
procedure TFmain.BitBtn3Click(Sender: TObject);
begin
try
comm1.StopComm;
Shape1.Brush.Color := clRed;
FComOpenFlag := false;
UFunction.RecordLogToMemo('串口' + comm1.CommName + '關閉', Memo1);
except
end;
end;
procedure TFmain.FormCreate(Sender: TObject);
begin
memo1.Lines.Clear;
ReSetFlag;
FComOpenFlag := false;
end;
procedure TFmain.FormShow(Sender: TObject);
begin
OpenCom;
end;
procedure TFmain.SpeedButton1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
edit1.Text := OpenDialog1.FileName;
end;
procedure TFmain.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
BufferLength: Word);
var RecBuf: PByteArray;
s: string;
begin
RecBuf := Buffer;
s := '';
if RecBuf[0] = CAC then //通知發送
begin
if not ReceiveQuestOfSendFlag then
begin
ReceiveQuestOfSendFlag := true;
s := '收到CAC[請求發送]';
end
else if ReceiveQuestOfSendFlag then
begin
ReceiveQuestOfSendNextFlag := true;
FQuestNextStr := 'Rec[' + inttohex(RecBuf[0], 2) + ']>>收到CAC[請求發送下一個]';
end;
end
else if RecBuf[0] = ACK then //確認收到
begin
ReceiveRightFlag := true;
s := '收到ACK[確認收到]';
if ReceiveQuestOfSendFlag then
inc(FRecAckCnt);
RecACKAfterSendEnd := HasSendEndFlag;
end
else if RecBuf[0] = NAK then //重發
begin
ReceiveReSendFlag := true;
s := '收到NAK[請求重發]';
end
else if RecBuf[0] = CAN then //取消
begin
ReceiveCancelFlag := true;
s := '收到CAN[取消接收]';
end;
if s <> '' then
UFunction.RecordLogToMemo('Rec[' + inttohex(RecBuf[0], 2) + ']>>' + s, memo1);
end;
procedure TFmain.copy1Click(Sender: TObject);
begin
memo1.SelectAll;
memo1.CopyToClipboard;
end;
procedure TFmain.cut1Click(Sender: TObject);
begin
memo1.SelectAll;
memo1.CutToClipboard;
end;
procedure TFmain.exit1Click(Sender: TObject);
begin
close;
end;
procedure TFmain.ReSetFlag;
begin
FSendCnt := 0;
FRecAckCnt := 0;
FQuestNextStr := '';
FSendTime := 0;
ReceiveQuestOfSendFlag := false;
ReceiveReSendFlag := false;
HasSendHeadFlag := false;
ReceiveRightFlag := false;
ReceiveCancelFlag := false;
HasSendEndFlag := false;
ReceiveQuestOfSendNextFlag := false;
RecACKAfterSendEnd := false;
end;
procedure TFmain.OpenCom;
begin
Comm1.CommName := ComboBox1.Text;
Comm1.BaudRate := strtoint(ComboBox2.Text);
Comm1.ByteSize := TByteSize(ComboBox3.ItemIndex);
Comm1.StopBits := TStopBits(ComboBox4.ItemIndex);
Comm1.Parity := (None);
try
Comm1.StartComm;
FComOpenFlag := true;
Shape1.Brush.Color := clLime;
UFunction.RecordLogToMemo('串口' + comm1.CommName + '打開', Memo1);
except
Shape1.Brush.Color := clRed;
UFunction.RecordLogToMemo('串口' + comm1.CommName + '打開失敗', Memo1);
FComOpenFlag := false;
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -