umain.pas

利用ymodem协议通过串口传输数据或文件

    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.