umain.pas

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

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ComCtrls, SPComm, Menus;
const SOH = $01;
const STX = $02;
const EOT = $04;
const ACK = $06;
const NAK = $15;
const CAN = $18;
const CAC = $43; //'C'

{//帧格式
<SOH>  <blk#> <255 - blk#> <data 128> <crch> <crcl>       //128字节数据帧
<STX>  <blk#> <255 - blk#> <data 1024> <crch> <crcl>     //1024字节数据帧

//应答方式
       Sender                                            Receiver
                                            <-                 <C>
<soh> <00> <255> ........<crch> <crcl>     ->                         //filename and length etc
                                           <-                 <ack>
                                           <-                 <C>
<sxt>  <01> <254>  .......<crch> <crcl>    ->                       //data
                                           <-                 <ack>    //nak for tars again
<sxt> <02>  <253> ........ <crch> <crcl>   ->
                                           <-                 <ack>
............................................................
                                           <-                  <ack>
<eot>                                      ->                            //tarsmition over
                                           <-                  <ack>
                                           <-                  <C>   //next file
<soh> <00> .... <crch> <crcl>              ->
..................................................................}

type
  TFmain = class(TForm)
    OpenDialog1: TOpenDialog;
    Comm1: TComm;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Panel2: TPanel;
    Memo1: TMemo;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    ComboBox5: TComboBox;
    ComboBox6: TComboBox;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Shape1: TShape;
    ProgressBar1: TProgressBar;
    PopupMenu1: TPopupMenu;
    copy1: TMenuItem;
    cut1: TMenuItem;
    N1: TMenuItem;
    exit1: TMenuItem;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure BitBtn1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure copy1Click(Sender: TObject);
    procedure cut1Click(Sender: TObject);
    procedure exit1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    FBlockNumber: integer;
    FUse1KBlocks: Boolean;
    FModeChar: integer;
    { Private declarations }
    MyFile: TMemoryStream;
    LastSize: integer;
    ByteID: byte;
    ReceiveQuestOfSendFlag, ReceiveQuestOfSendNextFlag, ReceiveReSendFlag, ReceiveRightFlag, ReceiveCancelFlag: boolean;
    HasSendHeadFlag, HasSendEndFlag, RecACKAfterSendEnd: boolean;
    FName: string; FSize: integer;
    FComOpenFlag: boolean;
    FSendCnt, FRecAckCnt: integer;
    FQuestNextStr: string;
    FSendTime: integer;
    procedure OpenCom;
  public
    { Public declarations }

    function SendHead(FName: string; Fsize: integer): integer;
    function SendData_1K: integer;
    function SendData_128: integer;
    function SendEnd: integer;

    procedure ReSetFlag;
  end;

var
  Fmain: TFmain;

implementation
uses uFunction;
{$R *.dfm}

{ TForm1 }

procedure TFmain.Timer1Timer(Sender: TObject);
var iTime: integer; s: string;
begin
  if not ReceiveQuestOfSendFlag then exit;
  if (ReceiveQuestOfSendFlag) and (not HasSendHeadFlag) then
  begin
    FSendCnt := 0;
    FSendTime := GetTickCount;
    SendHead(FName, FSize);
    inc(FSendCnt);
    HasSendHeadFlag := true;
    HasSendEndFlag := false;
    ReceiveRightFlag := false;
    ProgressBar1.Position := ProgressBar1.Position + 10;
    exit;
  end;

  if (HasSendHeadFlag) and (LastSize > 128) then //and (ReceiveRightFlag)
  begin
    SendData_1K;
    inc(FSendCnt);
    ReceiveRightFlag := false;
    ProgressBar1.Position := ProgressBar1.Position + 10;
    exit;
  end
  else if (HasSendHeadFlag) and (LastSize > 0) and (LastSize <= 128) then // and (ReceiveRightFlag)
  begin
    SendData_128;
    inc(FSendCnt);
    ReceiveRightFlag := false;
    ProgressBar1.Position := ProgressBar1.Position + 10;
    exit;
  end
  else if (HasSendHeadFlag) and (LastSize <= 0) and (not HasSendEndFlag) then // and (ReceiveRightFlag)
  begin
    SendEnd;
    inc(FSendCnt); //有时此次发送会返回一个确认，有时会有两个确认，故后面判断时应为（FRecAckCnt>=FSendCnt）
    HasSendEndFlag := true;
    ReceiveRightFlag := false;
    ProgressBar1.Position := ProgressBar1.Position + 10;
    UFunction.RecordLogToMemo(FName+'发送完毕!', memo1);
    exit;
  end
  else if (HasSendHeadFlag) and (ReceiveRightFlag) and (LastSize <= 0) and (HasSendEndFlag) then
  begin
    if (FRecAckCnt >= FSendCnt) then
    begin
      timer2.Enabled := false;
      iTime := GetTickCount - FSendTime;
      s := '共耗时' + inttostr(iTime div 1000) + '秒';
      timer1.Enabled := false;
      ReSetFlag;
      ProgressBar1.Position := ProgressBar1.Max;
      UFunction.RecordLogToMemo('确认发送完毕!' + s, memo1);
    end
    else if ReceiveQuestOfSendNextFlag then
    begin
      timer2.Enabled := false;
      iTime := GetTickCount - FSendTime;
      s := '共耗时' + inttostr(iTime div 1000) + '秒';
      ProgressBar1.Position := ProgressBar1.Max;
      UFunction.RecordLogToMemo('确认发送完毕!' + s, memo1);
      UFunction.RecordLogToMemo(FQuestNextStr, memo1);
      ReSetFlag;
      timer1.Enabled := false;
    end
    else timer2.Enabled:=true;
  end;
end;

procedure TFmain.Timer2Timer(Sender: TObject);
var iTime: integer; s: string;
begin
  if RecACKAfterSendEnd then
  begin
    iTime := GetTickCount - FSendTime;
    s := '共耗时' + inttostr(iTime div 1000) + '秒';
    UFunction.RecordLogToMemo('延时确认发送完毕!' + s, memo1);
    timer2.Enabled := false;
  end;
end;

procedure TFmain.BitBtn1Click(Sender: TObject);
var Cnt: integer;
begin
  if not FComOpenFlag then
  begin
    UFunction.RecordLogToMemo('串口未打开，不能发送...', memo1);
    exit;
  end;
  FName := trim(edit1.Text);
  if not FileExists(FName) then
  begin
    UFunction.RecordLogToMemo('您所发送的文件不存在...', memo1);
    exit;
  end;
  if MyFile <> nil then MyFile.Free;
  MyFile := TMemoryStream.Create; //创建流
  MyFile.LoadFromFile(FName);
  FSize := MyFile.Size;
  UFunction.RecordLogToMemo('File('+FName+')[Size=' + inttostr(FSize) + 'Byte]等待发送...', Memo1);
  LastSize := FSize;
  Cnt := 0;
  if FSize <= 1024 then cnt := 3 //包括头和尾的发送
  else if FSize > 1024 then
  begin
    Cnt := FSize div 1024 + 1;
    cnt := cnt + 2; //加上头和尾的发送
  end;
  ProgressBar1.Min := 0;
  ProgressBar1.Max := Cnt * 10;
  ProgressBar1.Position := ProgressBar1.Min;

  timer1.Enabled := true;
  {SendHead(FName, FSize);

  if LastSize > 128 then
  begin
    while LastSize > 128 do //>128则用1K发送
      SendData_1K;

    if (LastSize > 0) and (LastSize <= 128) then //<128则用128发送]
      SendData_128;
  end
  else if (LastSize > 0) and (LastSize <= 128) then
    SendData_128;

  if LastSize <= 0 then
    SendEnd; }
end;

function TFmain.SendHead(FName: string; Fsize: integer): integer;
var buf: array[0..1023] of byte;
  tmpByte: array[0..1023] of byte;
  tmpBuf: array[0..1023] of char;
  s: string;
  i: integer;
  index: integer;
  ctcBuf: TMyCTC16;
  backHexValue: string;
begin
  ZeroMemory(@buf, sizeof(buf));
  ZeroMemory(@tmpByte, sizeof(tmpByte));
  ZeroMemory(@tmpbuf, sizeof(tmpbuf));   
  //head:01 00 FF +Data{Data(128Byte)=test.txt+00+size(test.txt=1573)+00(一直到第126Byte)+66+57(后2位为CRC16校验位)
  index := 0;
  s := copy(FName, 4, length(FName)); //D:\test.txt;从第3位开始
  for i := 1 to Length(S) do
  begin
    tmpByte[index] := ord(s[i]);
    inc(index);
  end; //文件名
  tmpByte[index] := $00; inc(index); //分隔符00

  s := IntToStr(Fsize);
  for i := 1 to length(s) do
  begin