uniprotocol_downloader.pas

很好用的串口通信工具软件。Comport目录下是用到的通信控件。

var
  i: Integer;

  function FindParams(Key: string): string;
  begin
    Result := Parameters.Values[IntToStr(cnDownLoaderID) + '_' + Key];
  end;

  function GetSubParams(Key: string; KeyIndex: Integer): string;
  var
    i: Integer;
    curKeyIndex: Integer;
    Params: string;
  begin
    Result := '';
    Params := FindParams(Key);
    if Params = '' then Exit;
    curKeyIndex := 0;
    if Params[Length(Params)] <> ',' then Params := Params + ',';
    while Pos(',', Params) > 0 do
    begin
      i := Pos(',', Params);
      if curKeyIndex = KeyIndex then
      begin
        Result := Copy(Params, 1, i - 1);
        Break;
      end;
      Delete(Params, 1, i);
      Inc(curKeyIndex);
    end;
  end;
begin

  // 处理状态改变
  case FCommState of
    csHandShake:
      begin
        FProcessRatio := 0;
        if (FindParams('AdjustHZK') <> '') and (FindParams('HZKFileName') <> '') and (FileExists(FindParams('HZKFileName'))) then
        begin
          FCommState := csAdjustHZK;
          FHZKBuff.LoadFromFile(FindParams('HZKFileName'));
          FHZKBuff.Position := 0;
        end
        else
          FCommState := csGetDataInfo;
          //FCommState := csHalt;
        FFrameNo := 0;
        FCurGUID := UniCreateGUID;
      end;
    csAdjustHZK:
      begin
        FProcessRatio := 0;
        case SendResult of
          srACK:
            begin
              if FHzkBuff.Size > 0 then
                FProcessRatio := Trunc(FHzkBuff.Position / FHzkBuff.Size * 100);
              if FHzkBuff.Position >= FHzkBuff.Size then
              begin
                FCommState := csNotifyHangup;
                FFrameNo := 0;
              end
              else
                Inc(FFrameNo);
            end;
        else
          FCommState := csHalt;
        end;
      end;
    csGetDataInfo:
      begin
        case SendResult of
          srGetData:
            begin
              FSenderSerialNO := '';
              Address_From := (Ord(Packet[3]) shl 16) + (Ord(Packet[4]) shl 8) + Ord(Packet[5]);
              Address_To := (Ord(Packet[6]) shl 16) + (Ord(Packet[7]) shl 8) + Ord(Packet[8]);
              SetLength(DownLoader_Tag, 16);
              Move(Packet[9], DownLoader_Tag[1], 16);
              FSenderSerialNO := '';
              for i := 1 to 4 do
                FSenderSerialNO := FSenderSerialNO + Format('%2.2X', [ord(Packet[24 + i])]);
              FDatas.Add('DownLoaderSerialNo=' + FSenderSerialNO);

              FSenderSerialNO := '';
              for i := 1 to 4 do
                FSenderSerialNO := FSenderSerialNO + Format('%2.2X', [ord(Packet[28 + i])]);
              FDatas.Add('ProbeSerialNo=' + FSenderSerialNO);
              FCommState := csAdjustTime;
            end;
        else
          FCommState := csHalt;
        end;
      end;
    csAdjustTime:
      begin
        case SendResult of
          srACK:
            begin
              FFrameNo := 0;
              if FindParams('Phone') <> '' then
                FCommState := csAdjustPhoneCode
              else
              begin
                if Address_From < Address_To then
                  FCommState := csRequestData
                else
                  Fcommstate := csNotifyHangup;
                FFrameNo := 0;
                FCurData := '';
              end;
            end;
        else
          FCommState := csHalt;
        end;
      end;
    csAdjustPhoneCode:
      begin
        case SendResult of
          srACK:
            begin
              if Address_From < Address_To then
                FCommState := csRequestData
              else
                Fcommstate := csNotifyHangup;
              FFrameNo := 0;
              FCurData := '';
            end;
        else
          FCommState := csHalt;
        end;
      end;
    csRequestData:
      begin
        case SendResult of
          srGetData:
            begin
              FProcessRatio := Trunc((curAddress_To - Address_From + 1) / (Address_To - Address_From + 1) * 100);
              Inc(FFrameNo);
              FCurData := FCurData + Copy(Packet, 6, last_FrameSize);
              if (curAddress_From >= Address_To) then
              begin
                FCommState := csNotifyHangup;
                FFrameNo := 0;
                if ResumeItem > -1 then
                begin
                  FCurData := FUndoneBuff^.Data + FCurData;
                  try
                    with UndoneList.LockList do
                      Delete(ResumeItem);
                  finally
                    UndoneList.UnlockList;
                  end;
                  Dispose(FUnDoneBuff);
                end;
                if length(FCurData) > Address_to - Address_From + 1 then
                  SetLength(FCurData, Address_to - Address_From + 1);
                FDatas.Text := FDatas.Text + ParseData(FCurData);
                FCurData := '';
              end;
            end;
        else
          begin
            if FCurData <> '' then
            begin
              if ResumeItem > -1 then
                FCurData := FUndoneBuff^.Data + FCurData
              else
              begin
                New(FUndoneBuff);
                with UndoneList.LockList do
                try
                  ResumeItem := Add(FUndoneBuff);
                finally
                  UndoneList.UnLockList;
                end;
              end;
              FUndoneBuff^.Tag := DownLoader_Tag;
              FUndoneBuff^.Address_From := Address_From;
              FUndoneBuff^.Address_To := Address_To;
              FUndoneBuff^.ProbeSN := FDatas.Values['ProbeSerialNo'];
              FUndoneBuff^.DownLoaderSN := FDatas.Values['DownLoaderSerialNo'];
              FUndoneBuff^.Data := FCurData;
              FCurData := '';
            end;
            FCommState := csHalt;
          end;
        end;
      end;
    csNotifyHangup:
      begin
        Inc(FFrameNo);
        if (FFrameNo = 1) then
        begin
          if (SendResult <> srACK) then FCommState := csHalt;
        end
        else
        begin
          FCommSuccess := True;
          FCommState := csHalt;
        end;
      end;
  end;

  // 根据状态(FCommState) 生成命令
  if FCommState <> csHalt then
    with FHostCmd do
    begin
      case FCommState of
        csAdjustHZK:
          begin
            Comment := '【校正汉字库】';
            Send_Interval := 1000;
            No_Response_Interval := 500;
            Max_Send_Times := 10;
            SetLength(Echos, 0);
            curACK := csACK + AddressToStr(FHzkBuff.Position);
            curACK := curACK + Chr(GenerateCRC(curACK[1], Length(curACK)));
            curNAK := csNAK + AddressToStr(FHzkBuff.Position);
            curNAK := curNAK + Chr(GenerateCRC(curNAK[1], Length(curNAK)));
            Packet := #$F9 + AddressToStr(FHzkBuff.Position);
            SetLength(Command, 69);
            Move(Packet[1], Command[1], 4);
            FHzkBuff.Read(Command[5], 64);
            Command[69] := Chr(GenerateCRC(Command[1], 68));
          end;
        csGetDataInfo:
          begin
            Comment := '【读取通信座数据信息】';
            Command := #$FE + #$10 + #$D8;
            Send_Interval := 1000;
            No_Response_Interval := 300;
            Max_Send_Times := 10;
            SetLength(Echos, 1);
            Echos[0].Echo_Head := csACK;
            Echos[0].Echo_Size := 33;
            Echos[0].Echo_HaveCRC := True;
            curACK := '';
            curNAK := '';
          end;
        csAdjustTime:
          begin
            Comment := '【校正识读器时间】';
            Command := AdjustTimeCommand;
            Send_Interval := 1000;
            No_Response_Interval := 1000;
            Max_Send_Times := 10;
            SetLength(Echos, 0);
            curACK := csACK + #$FD + #$5B;
            curNAK := csNAK + #$FD + #$08;
          end;
        csRequestData:
          begin
            Comment := '【请求识读器数据】';
            Send_Interval := 1000;
            No_Response_Interval := 1000;
            Max_Send_Times := 10;
            curACK := '';
            curNAK := '';
            if FFrameNO = 0 then
            begin
              FStartTransTime := GetTickCount;
              ResumeItem := -1;
              ResumeAddress_From := Address_From;
              // 查看是否可以断点续传
              with UndoneList.LockList do
              try
                for i := 0 to Count - 1 do
                begin
                  FUndoneBuff := Items[i];
                  if (FUndoneBuff^.Tag = DownLoader_Tag) and
                    (FUndoneBuff^.DownLoaderSN = FDatas.Values['DownLoaderSerialNo']) then
                  begin
                    ResumeItem := i;
                    ResumeAddress_From := Address_From + Length(FUndoneBuff^.Data);
                    Break;
                  end;
                end;
              finally
                UndoneList.UnLockList;
              end;
              curAddress_From := ResumeAddress_From;
              if (curAddress_From div Band_Size) <> ((curAddress_From + FFrame_Size - 1) div Band_Size) then
                curFrame_Size := Band_Size - (curAddress_From mod Band_Size)
              else
                curFrame_Size := FFrame_Size;
              curAddress_To := curAddress_From + curFrame_Size - 1;
            end;

            Command :=
              #$FB + AddressToStr(curAddress_From) + AddressToStr(curAddress_To);
            Command := Command + Chr(GenerateCRC(Command[1], length(Command)));
            SetLength(Echos, 1);
            Echos[0].Echo_Size := curFrame_Size + 6;
            Echos[0].Echo_Head := csACK + Chr(((curAddress_From and $FF0000) shr 16)) +
              Chr(((curAddress_From and $FF00) shr 8)) + Chr(curAddress_From and $FF);
            Echos[0].Echo_HaveCRC := True;
            last_FrameSize := curFrame_Size;

            // 计算好下一帧的起始地址
            curAddress_From := curAddress_To + 1;
            // 调整本帧大小使其不至于跨越Band
            if (curAddress_From div Band_Size) <> ((curAddress_From + FFrame_Size - 1) div Band_Size) then
              curFrame_Size := Band_Size - (curAddress_From mod Band_Size)
            else
              curFrame_Size := FFrame_Size;
            curAddress_To := curAddress_From + curFrame_Size - 1;
          end;
        csAdjustPhoneCode:
          begin
            Comment := '【校正通信座电话号码】';
            Command := AdjustPhoneCodeCommand(FindParams('Phone'));
            if FDatas.Values['DownLoaderSerialNo'] <> '' then
              if Pos(FDatas.Values['DownLoaderSerialNo'], FindParams('FarDownLoaders')) > 0 then
                Command := AdjustPhoneCodeCommand(FindParams('Zone') + FindParams('Phone'));
            Send_Interval := 1000;
            No_Response_Interval := 300;
            Max_Send_Times := 10;
            SetLength(Echos, 0);
            curACK := csACK + #$FC + #$05;
            curNAK := csNAK + #$FC + #$56;
          end;
        csNotifyHangup:
          begin
            Comment := '【请求挂机】';
            Command := #$F8 + FCurGUID;
            Command := Command + Chr(GenerateCRC(Command[1], Length(Command)));
            Send_Interval := 500;
            No_Response_Interval := 300;
            Max_Send_Times := 10;
            SetLength(Echos, 0);
            curACK := csACK + #$F8 + #$64;
            curNAK := '';
          end;
      end;
    end;
  Result := FHostCmd;
end;

procedure FreeUndoneList;
var
  i: Integer;
  UndoneBuff: PUndoneBuff;
begin
  with UnDoneList.LockList do
  try
    for i := 0 to Count - 1 do
    begin
      UndoneBuff := Items[i];
      Dispose(UndoneBuff);
    end;
  finally
    UnDoneList.UnlockList;
  end;
  UnDoneList.Free;
end;

{-----------------------------------------------------------------------------}

initialization
  // 注册协议处理插件
  RegisterExecutorClass(TDownLoader);
  // 生成未完成缓冲区，以便断点续传
  UnDoneList := TThreadList.Create;
finalization
  FreeUndoneList;
end.