awabspcl.pas

测试用例

    end;

  begin
    with P^ do begin
      {Remove the protocol triggers}
      if aTimeoutTrigger <> 0 then
        RemoveIt(aTimeoutTrigger);
      aTimeoutTrigger := 0;
      if aStatusTrigger <> 0 then
        RemoveIt(aStatusTrigger);
      aStatusTrigger := 0;
      if aOutBuffFreeTrigger <> 0 then
        RemoveIt(aOutBuffFreeTrigger);
      aOutBuffFreeTrigger := 0;
      if aOutBuffUsedTrigger <> 0 then
        RemoveIt(aOutBuffUsedTrigger);
      aOutBuffUsedTrigger := 0;
      if aNoCarrierTrigger <> 0 then
        RemoveIt(aNoCarrierTrigger);
      aNoCarrierTrigger := 0;                                         

      {Remove our trigger handler}
      if (aHC <> nil) and aHC.Open then
        aHC.Dispatcher.DeregisterProcTriggerHandler(aCurProtFunc);

      {Close findfirst, if it's still open}
      if aFFOpen then begin
        aFFOpen := False;
        FindClose(aCurRec);
      end;
      {Close the file, if it's still open}
      if aFileOpen then begin
        Close(aWorkFile);
        aFileOpen := False;
      end;                                                           
    end;
  end;

{Internal routines}

  procedure apResetStatus(P : PProtocolData);
    {-Reset status vars}
  begin
    with P^ do begin
      if aInProgress = 0 then begin
        aSrcFileLen := 0;
        aBytesRemaining := 0;
      end;
      aBytesTransferred := 0;
      aBlockNum := 0;
      aElapsedTicks := 0;
      aBlockErrors := 0;
      aTotalErrors := 0;
      aProtocolStatus := psOK;
      aProtocolError := ecOK;
    end;
  end;

  procedure apShowFirstStatus(P : PProtocolData);
    {-Show (possible) first status}
  const
    Option : array[Boolean] of Cardinal = ($00, $01);
  begin
    with P^ do begin
      apShowStatus(P, Option[aInProgress=0]);
      Inc(aInProgress);
    end;
  end;

  procedure apShowLastStatus(P : PProtocolData);
    {-Reset field and show last status}
  const
    Option : array[Boolean] of Cardinal = ($00, $02);                
  begin
    with P^ do begin
      if aInProgress <> 0 then begin
        Dec(aInProgress);
        apShowStatus(P, Option[aInProgress=0]);
      end;
    end;
  end;

  procedure apSignalFinish(P : PProtocolData);
    {-Send finish message to parent window}
  var
    DT: TDispatchType;
    ErrMsg: String;
  begin
    with P^ do begin
      apStopProtocol(P);

      {Flag some final status codes as error codes}
      if aProtocolError = ecOk then begin
        case aProtocolStatus of
          psCancelRequested : aProtocolError := ecCancelRequested;
          psTimeout         : aProtocolError := ecTimeout;
          psProtocolError   : aProtocolError := ecProtocolError;
          psSequenceError   : aProtocolError := ecSequenceError;
          psFileRejected    : aProtocolError := ecFileRejected;
          psCantWriteFile   : aProtocolError := ecCantWriteFile;
          psAbortNoCarrier  : aProtocolError := ecAbortNoCarrier;
          psAbort           : aProtocolError := ecProtocolAbort;       
        end;
      end;
      case aCurProtocol of
        Xmodem,
        XmodemCRC,
        Xmodem1K,
        Xmodem1KG   : DT := dtXModem;
        Ymodem,
        YmodemG     : DT := dtYModem;
        Zmodem      : DT := dtZModem;
        Kermit      : DT := dtKermit;
        Ascii       : DT := dtAscii;
        BPlus       : DT := dtBPlus;
        else          DT := dtNone;
      end;
      ErrMsg := 'ErrorCode:' + IntToStr(aProtocolError);
      aHC.ValidDispatcher.AddDispatchEntry(DT, dstStatus, 0,
        @ErrMsg[1], Length(ErrMsg));                                   
      PostMessage(aHWindow, apw_ProtocolFinish,
                  Cardinal(aProtocolError), Longint(P));
    end;
  end;

  procedure aapPrepareReading(P : PProtocolData);
    {-Prepare to send protocol blocks (usually opens a file)}
  var
    Res : Cardinal;
  begin
    with P^ do begin
      aProtocolError := ecOK;

      {If file is already open then leave without doing anything}
      if aFileOpen then
        Exit;

      {Report notfound error for empty filename}
      if aPathName[0] = #0 then begin
        apProtocolError(P, ecFileNotFound);
        Exit;
      end;

      {Allocate a file buffer}
      aFileBuffer := AllocMem(FileBufferSize);

      {Open up the previously specified file}
      aSaveMode := FileMode;
      FileMode := fmOpenRead or fmShareDenyWrite;                      
      Assign(aWorkFile, aPathName);
      Reset(aWorkFile, 1);
      FileMode := aSaveMode;
      Res := IOResult;
      if Res <> 0 then begin
        apProtocolError(P, -Res);
        FreeMem(aFileBuffer, FileBufferSize);
        Exit;
      end;

      {Show file name and size}
      aSrcFileLen := FileSize(aWorkFile);
      if IOResult <> 0 then
        aSrcFileLen := 0;
      aBytesRemaining := aSrcFileLen;
      apShowStatus(P, 0);

      {Note file date/time stamp (for those protocols that care)}
      aSrcFileDate := FileGetDate(TFileRec(aWorkFile).Handle);

      {Initialize the file buffering variables}
      aFileOfs := 0;
      aStartOfs := 0;
      aEndOfs := 0;
      aLastOfs := 0;
      aEndPending := False;
      aFileOpen := True;
    end;
  end;

  procedure aapFinishReading(P : PProtocolData);
    {-Clean up after reading protocol blocks}
  begin
    with P^ do begin
      if aFileOpen then begin
        Close(aWorkFile);
        if IOResult <> 0 then ;
        FreeMem(aFileBuffer, FileBufferSize);
        aFileOpen := False;
      end;
    end;
  end;

  function aapReadProtocolBlock(P : PProtocolData;
                                var Block : TDataBlock;
                                var BlockSize : Cardinal) : Bool;
    {-Return with a block to transmit (True to quit)}
  var
    BytesRead   : Integer;
    BytesToMove : Integer;
    BytesToRead : Integer;
    Res         : Cardinal;
  begin
    with P^ do begin
      if aFileOfs >= aSrcFileLen then begin
        BlockSize := 0;
        aapReadProtocolBlock := True;
        Exit;
      end;

      {Check for a request to start further along in the file (recovering)}
      if aFileOfs > aEndOfs then
        {Skipping blocks - force a read}
        aEndOfs := aFileOfs;

      {Check for a request to retransmit an old block}
      if aFileOfs < aLastOfs then
        {Retransmit - reset end-of-buffer to force a read}
        aEndOfs := aFileOfs;

      if (aFileOfs + Integer(BlockSize)) > aEndOfs then begin          
        {Buffer needs to be updated, first shift end section to beginning}
        BytesToMove := aEndOfs - aFileOfs;
        if BytesToMove > 0 then
          Move(aFileBuffer^[aFileOfs - aStartOfs], aFileBuffer^, BytesToMove);

        {Fill end section from file}
        BytesToRead := FileBufferSize - BytesToMove;
        Seek(aWorkFile, aEndOfs);
        BlockRead(aWorkFile, aFileBuffer^[BytesToMove], BytesToRead, BytesRead);
        Res := IOResult;
        if (Res <> 0) then begin
          {Exit on error}
          apProtocolError(P, -Res);
          aapReadProtocolBlock := True;
          BlockSize := 0;
          Exit;
        end else begin
          {Set buffering variables}
          aStartOfs := aFileOfs;
          aEndOfs := aFileOfs + FileBufferSize;
        end;

        {Prepare for the end of the file}
        if BytesRead < BytesToRead then begin
          aEndOfDataOfs := BytesToMove + BytesRead;
          FillChar(aFileBuffer^[aEndofDataOfs], FileBufferSize - aEndOfDataOfs,
                   BlockFillChar);
          Inc(aEndOfDataOfs, aStartOfs);
          aEndPending := True;
        end else
          aEndPending := False;
      end;

      {Return the requested block}
      Move(aFileBuffer^[(aFileOfs - aStartOfs)], Block, BlockSize);
      aapReadProtocolBlock := False;
      aLastOfs := aFileOfs;

      {If it's the last block then say so}
      if aEndPending and ((aFileOfs + Integer(BlockSize)) >= aEndOfDataOfs) then begin  
        aapReadProtocolBlock := True;
        BlockSize := aEndOfDataOfs - aFileOfs;
      end;
    end;
  end;

  procedure aapPrepareWriting(P : PProtocolData);
    {-Prepare to save protocol blocks (usually opens a file)}
  var
    Res  : Cardinal;
    S    : string[fsPathName];
    Dir  : string[fsDirectory];
    Name : string[fsName];
  label
    ExitPoint;
  begin
    with P^ do begin
      {Allocate a file buffer}
      aFileBuffer := AllocMem(FileBufferSize);

      {Does the file exist already?}
      aSaveMode := FileMode;
      FileMode := 0;
      Assign(aWorkFile, aPathName);
      Reset(aWorkFile, 1);
      FileMode := aSaveMode;
      Res := IOResult;

      {Exit on errors other than FileNotFound}
      if (Res <> 0) and (Res <> 2) then begin
        apProtocolError(P, -Res);
        goto ExitPoint;
      end;

      {Exit if file exists and option is WriteFail}
      if (Res = 0) and (aWriteFailOpt = wfcWriteFail) then begin
        aProtocolStatus := psCantWriteFile;
        aForceStatus := True;
        goto ExitPoint;
      end;

      Close(aWorkFile);
      if IOResult = 0 then ;

      {Change the file name if it already exists and the option is WriteRename}
      if (Res = 0) and (aWriteFailOpt = wfcWriteRename) then begin
        S := StrPas(aPathName);
        Dir := ExtractFilePath(S);
        Name := ExtractFileName(S);
        Name[1] := '$';
        S := Dir + Name;
        StrPCopy(aPathName, S);
      end;

      {Give status a chance to show that the file was renamed}
      apShowStatus(P, 0);

      {Ok to rewrite file now}
      Assign(aWorkFile, aPathname);
      Rewrite(aWorkFile, 1);
      Res := IOResult;
      if Res <> 0 then begin
        apProtocolError(P, -Res);
        goto ExitPoint;
      end;

      {Initialized the buffer management vars}
      aStartOfs := 0;
      aLastOfs := 0;
      aEndOfs := aStartOfs + FileBufferSize;
      aFileOpen := True;
      Exit;

ExitPoint:
      Close(aWorkFile);
      if IOResult <> 0 then ;
      FreeMem(aFileBuffer, FileBufferSize);
    end;
  end;

  procedure aapFinishWriting(P : PProtocolData);
    {-Cleans up after saving all protocol blocks}
  var
    Res          : Cardinal;
    BytesToWrite : Integer;
    BytesWritten : Integer;
  begin
    with P^ do begin
      if aFileOpen then begin
        {Error or end-of-protocol, commit buffer and cleanup}
        BytesToWrite := aFileOfs - aStartOfs;
        BlockWrite(aWorkFile, aFileBuffer^, BytesToWrite, BytesWritten);
        Res := IOResult;
        if Res <> 0 then
          apProtocolError(P, -Res)
        else if BytesToWrite <> BytesWritten then
          apProtocolError(P, ecDiskFull);

        {Get file size and time for those protocols that don't know}
        aSrcFileLen := FileSize(aWorkFile);
        aSrcFileDate := FileGetDate(TFileRec(aWorkFile).Handle);

        Close(aWorkFile);
        Res := IOResult;
        if Res <> 0 then
          apProtocolError(P, -Res);
        FreeMem(aFileBuffer, FileBufferSize);
        aFileOpen := False;
      end;
    end;
  end;

  function aapWriteProtocolBlock(P : PProtocolData;
                                 var Block : TDataBlock;
                                 BlockSize : Cardinal) : Bool;
    {-Write a protocol block (return True to quit)}
  var
    Res          : Cardinal;
    BytesToWrite : Integer;
    BytesWritten : Integer;

    procedure BlockWriteRTS;
      {-Set RTS before BlockWrite}
    begin
      with P^ do begin
        {Lower RTS if requested}
        if FlagIsSet(aFlags, apRTSLowForWrite) then
          if (aHC <> nil) and aHC.Open then
            aHC.Dispatcher.SetRTS(False);

        BlockWrite(aWorkFile, aFileBuffer^, BytesToWrite, BytesWritten);

        {Raise RTS if it was lowered}
        if FlagIsSet(aFlags, apRTSLowForWrite) then
          if (aHC <> nil) and aHC.Open then
            aHC.Dispatcher.SetRTS(True);
      end;
    end;

  begin
    with P^ do begin
      aProtocolError := ecOK;
      aapWriteProtocolBlock := True;

      if not aFileOpen then begin
        apProtocolError(P, ecNotOpen);
        Exit;
      end;

      if aFileOfs < aLastOfs then
        {This is a retransmitted block}
        if aFileOfs > aStartOfs then begin
          {aFileBuffer has some good data, commit that data now}
          Seek(aWorkFile, aStartOfs);
          BytesToWrite := aFileOfs - aStartOfs;
          BlockWriteRTS;
          Res := IOResult;
          if (Res <> 0) then begin
            apProtocolError(P, -Res);
            Exit;
          end;
          if (BytesToWrite <> BytesWritten) then begin
            apProtocolError(P, ecDiskFull);
            Exit;
          end;
        end else begin
          {Block is before data in buffer, discard data in buffer}
          aStartOfs := aFileOfs;
          aEndOfs := aStartOfs + FileBufferSize;
          {Position file just past last good data}
          Seek(aWorkFile, aFileOfs);
          Res := IOResult;
          if Res <> 0 then begin
            apProtocolError(P, -Res);