awabspcl.pas

测试用例

      end;

      {Add the string}
      StrCopy(NewP, PName);
      apAddFileToList := ecOK;
    end;
  end;

  function apNextFileMask(P : PProtocolData; FName : PChar) : Bool;
    {-Built-in function that works with file mask fields}
  const
    AnyFileButDir = faAnyFile and not (faDirectory or faVolumeID);
  var
    DosError : Integer;
    PName    : array[0..255] of Char;
  begin
    with P^ do begin
      {Check for uninitialized search mask}
      if aSearchMask[0] = #0 then begin
        apProtocolError(P, ecNoSearchMask);
        apNextFileMask := False;
        Exit;
      end;

      {Search for a matching file}
      if aFindingFirst then begin
        DosError :=
          Abs(FindFirst(aSearchMask, AnyFileButDir, aCurRec));
        aFFOpen := True;
        {$IFDEF WIN32}
        if DosError <> 0 then
          aCurRec.FindHandle := INVALID_HANDLE_VALUE;
        {$ENDIF}                                                     
        if DosError = 18 then begin
          apProtocolError(P, ecNoMatchingFiles);
          FName[0] := #0;
          apNextFileMask := False;
          FindClose(aCurRec);
          aFFOpen := False;
          Exit;
        end else
          aFindingFirst := False;
      end else
        DosError := Abs(FindNext(aCurRec));

      {Check for errors}
      if DosError <> 0 then begin
        {Failed to find file, return error status}
        if DosError = 3 then
          apProtocolError(P, ecDirNotFound)
        else if DosError <> 18 then
          apProtocolError(P, -DosError);
        FName[0] := #0;
        apNextFileMask := False;
        FindClose(aCurRec);
        aFFOpen := False;
      end else begin
        {If search mask contains a path, return that path}
        JustPathNameZ(FName, aSearchMask);
        if FName[0] <> #0 then begin
          AddBackSlashZ(FName, FName);
          StrPCopy(PName, aCurRec.Name);
          StrCat(FName, PName);
        end else begin
          StrPCopy(PName, aCurRec.Name);
          StrCopy(FName, PName);
        end;
        apNextFileMask := True;
      end;
    end;
  end;

  function apNextFileList(P : PProtocolData; FName : PChar) : Bool;
    {-Built-in function that works with a list of files}
  type
    PWord = ^Cardinal;
  const
    MaxLen = 79;
  var
    MaxSize : Cardinal;
    MaxNext : Cardinal;
    I       : Cardinal;
    Len     : Cardinal;
  begin
    with P^ do begin
      aProtocolError := ecOK;
      MaxSize := PWord(aFileList)^;
      if MaxSize <= 3 then begin
        apNextFileList := False;
        FName[0] := #0;
        Exit;
      end;

      {Return immediately if no more files}
      if aFileList^[aFileListIndex] = EndOfListMark then begin
        apNextFileList := False;
        FName[0] := #0;
        Exit;
      end;

      {Increment past the last separator}
      if aFileListIndex <> 2 then
        Inc(aFileListIndex);

      {Define how far to look for the next marker}
      if LongInt(aFileListIndex) + MaxLen > Integer(MaxSize) then    
        MaxNext := MaxSize
      else
        MaxNext := aFileListIndex + MaxLen;

      {Look for the next marker}
      for I := aFileListIndex to MaxNext do begin
        if (aFileList^[I] = Separator) or
           (aFileList^[I] = EndOfListMark) then begin
          {Extract the pathname}
          Len := I - aFileListIndex;
          Move(aFileList^[aFileListIndex], FName[0], Len);
          FName[Len] := #0;
          apNextFileList := True;
          Inc(aFileListIndex, Len);
          Exit;
        end;
      end;

      {Bad format list (no separator) -- show error}
      apProtocolError(P, ecBadFileList);
      apNextFileList := False;
      FName[0] := #0;
    end;
  end;

  function apGetBytesTransferred(P : PProtocolData) : LongInt;
    {-Returns bytes already transferred}
  var
    TotalOverhead : Cardinal;
    OutBuff       : Cardinal;
    BT            : LongInt;
  begin
    with P^ do begin
      if aHC = nil then begin
        Result := 0;
        exit;
      end else
        OutBuff := aHC.OutBuffUsed;
      if OutBuff >= aBlockLen then begin
        {Upload in progress, subtract outbuff from bytestransferred}
        if aBlockLen <> 0 then
          TotalOverhead := aOverhead * (OutBuff div aBlockLen)
        else
          TotalOverhead := 0;
        BT := DWORD(aBytesTransferred) - (OutBuff - TotalOverhead);  
        if BT > 0 then
          apGetBytesTransferred := BT
        else
          apGetBytesTransferred := 0;
      end else
        apGetBytesTransferred := aBytesTransferred;
    end;
  end;

  function apGetBytesRemaining(P : PProtocolData) : LongInt;
    {-Return bytes not yet transferred}
  var
    BR : Longint;
  begin
    with P^ do begin
      BR := aSrcFileLen - apGetBytesTransferred(P);
      if BR < 0 then
        BR := 0;
      apGetBytesRemaining := BR;
    end;
  end;

  function apSupportsBatch(P : PProtocolData) : Bool;
    {-Returns True if this protocol supports batch file transfers}
  begin
    apSupportsBatch := P^.aBatchProtocol;
  end;

  function apGetInitialFilePos(P : PProtocolData) : LongInt;
    {-Returns the file position at the start of resumed file transfer}
  begin
    apGetInitialFilePos := P^.aInitFilePos;
  end;

  function apEstimateTransferSecs(P : PProtocolData; Size : LongInt) : LongInt;
    {-Return estimated seconds to transfer Size bytes}
  var
    Efficiency   : LongInt;
    EffectiveCPS : LongInt;
  begin
    with P^ do begin
      if Size = 0 then
        apEstimateTransferSecs := 0
      else begin
        {Calculate efficiency of this protocol}
        Efficiency := (Integer(aBlockLen) * LongInt(100)) div
                      Longint(aBlockLen + aOverHead +
                      (DWORD(aTurnDelay * aActCPS) div 1000));
        EffectiveCPS := (aActCPS * DWORD(Efficiency)) div 100;       

        {Calculate remaining seconds}
        if EffectiveCPS > 0 then
          apEstimateTransferSecs := Size div EffectiveCPS
        else
          apEstimateTransferSecs := 0;
      end;
    end;
  end;

  procedure apGetProtocolInfo(P : PProtocolData; var Info : TProtocolInfo);
    {-Returns a protocol information block}
  begin
    with P^, Info do begin
      piStatus           := aProtocolStatus;
      piError            := aProtocolError;
      piProtocolType     := aCurProtocol;
      StrLCopy(piFileName, aPathName, SizeOf(piFileName));
      piFileSize         := aSrcFileLen;
      piBytesTransferred := apGetBytesTransferred(P);
      piBytesRemaining   := apGetBytesRemaining(P);
      piInitFilePos      := aInitFilePos;
      piElapsedTicks     := aElapsedTicks;
      piBlockErrors      := aBlockErrors;
      piTotalErrors      := aTotalErrors;
      piBlockSize        := aBlockLen;
      if aBlockLen <> 0 then
        piBlockNum := piBytesTransferred div Integer(aBlockLen)
      else
        piBlockNum := 0;
      piBlockCheck       := aCheckType;
      piFlags            := aFlags;
    end;
  end;

  procedure apSetFileMask(P : PProtocolData; NewMask : PChar);
    {-Set the search mask}
  begin
    StrLCopy(P^.aSearchMask, NewMask, SizeOf(P^.aSearchMask));
  end;

  procedure apSetReceiveFilename(P : PProtocolData; FName : PChar);
    {-Set or change the incoming file name}
  var
    Temp : TCharArray;
  begin
    with P^ do begin
      if StrScan(FName, '\') = nil then begin
        {Set aPathname to DestDir path + FName}
        StrLCopy(aPathname, AddBackSlashZ(Temp, aDestDir), SizeOf(aPathname));
        StrLCat(aPathname, FName, SizeOf(aPathname));
      end else
        {Set aPathname directly to FName}
        StrLCopy(aPathName, FName, SizeOf(aPathname));
    end;
  end;

  procedure apSetDestinationDirectory(P : PProtocolData; Dir : PChar);
    {-Set the directory used to hold received files}
  begin
    StrLCopy(P^.aDestDir, Dir, SizeOf(P^.aDestDir));
  end;

  procedure apSetHandshakeWait(P : PProtocolData; NewHandshake, NewRetry : Cardinal);
    {-Set the wait Ticks and retry count for the initial handshake}
  begin
    with P^ do begin
      if NewHandshake <> 0 then
        aHandshakeWait := NewHandshake;
      if NewRetry <> 0 then
        aHandshakeRetry := NewRetry;
    end;
  end;

  procedure apSetEfficiencyParms(P : PProtocolData;
                                 BlockOverhead, TurnAroundDelay : Cardinal);
    {-Sets efficiency parameters for EstimateTransferSecs}
  begin
    with P^ do begin
      aOverhead := BlockOverhead;
      aTurnDelay := TurnAroundDelay;
    end;
  end;

  procedure apSetProtocolPort(P : PProtocolData; H : TApdCustomComPort);
    {-Set H as the port object for this protocol}
  begin
    P^.aHC := H;
  end;

  procedure apSetOverwriteOption(P : PProtocolData; Opt : Cardinal);
    {-Set option for what to do when the destination file already exists}
  begin
    if Opt <= wfcWriteResume then
      P^.aWriteFailOpt := Opt;
  end;

  procedure apSetActualBPS(P : PProtocolData; BPS : LongInt);
    {-Sets actual BPS rate (only needed if modem differs from port)}
  var
    Baud     : LongInt;
    Parity   : Word;
    Bits     : Word;
    Databits : TDatabits;
    Stopbits : TStopbits;
  begin
    if (P^.aHC = nil) or not P^.aHC.Open then
      Bits := 10
    else begin
      P^.aHC.Dispatcher.GetLine(Baud, Parity, Databits, Stopbits);
      Bits := Databits + 2;
    end;                                                             
    if Parity <> NoParity then
      Inc(Bits);
    P^.aActCPS := BPS div Bits;
  end;

  procedure apSetStatusInterval(P : PProtocolData; NewInterval : Cardinal);
    {-Set new status update interval to NewInterval ticks}
  begin
    P^.aStatusInterval := NewInterval;
  end;

  procedure apOptionsOn(P : PProtocolData; OptionFlags : Cardinal);
    {-Activate multiple options}
  begin
    with P^ do
      aFlags := aFlags or (OptionFlags and not BadProtocolOptions);
  end;

  procedure apOptionsOff(P : PProtocolData; OptionFlags : Cardinal);
    {-Deactivate multiple options}
  begin
    with P^ do
      aFlags := aFlags and not (OptionFlags and not BadProtocolOptions);
  end;

  function apOptionsAreOn(P : PProtocolData; OptionFlags : Cardinal) : Bool;
    {-Return True if all bits in OptionsFlags are on}
  begin
    with P^ do
      apOptionsAreOn := aFlags and OptionFlags = OptionFlags;
  end;

  procedure apStartProtocol(P : PProtocolData;
                            Protocol : Byte;
                            Transmit : Bool;
                            StartProc : TPrepareProc;
                            ProtFunc : TProtocolFunc);
    {-Setup standard protocol triggers}
  var
    lParam : LongInt;
  begin
    with P^ do begin
      {Note the protocol}
      aCurProtocol := Protocol;
      aCurProtFunc := ProtFunc;

      {Next file stuff}
      aFilesSent := False;
      aFindingFirst := True;
      aFileListIndex := 2;

      if not aHC.Open then begin                                       
        aProtocolError := ecNotOpen;                                   
        apSignalFinish (P);                                            
        Exit;                                                          
      end;                                                             
      
      {Set up standard triggers}
      aHC.Dispatcher.ChangeLengthTrigger(1);                         
      aTimeoutTrigger := aHC.AddTimerTrigger;
      aStatusTrigger := aHC.AddTimerTrigger;
      aOutBuffFreeTrigger := aHC.AddStatusTrigger(stOutBuffFree);
      aOutBuffUsedTrigger := aHC.AddStatusTrigger(stOutBuffUsed);
      aNoCarrierTrigger := aHC.AddStatusTrigger(stModem);

      {All set?}
      if (aTimeoutTrigger < 0) or
         (aStatusTrigger < 0) or (aOutBuffFreeTrigger < 0) or
         (aOutBuffUsedTrigger < 0) or (aNoCarrierTrigger < 0) then begin
        {Send error message and give up}
        aProtocolError := ecNoMoreTriggers;
        apSignalFinish(P);
        Exit;
      end;

      with aHC.Dispatcher do begin

        {Store protocol pointer}
        SetDataPointer(Pointer(P), 1);

        {Prepare protocol}
        StartProc(P);
        if aProtocolError = ecOK then begin
          {Call the notification function directly the first time}
          LH(lParam).H := Handle;
          LH(lParam).L := 0;
          ProtFunc(0, 0, lParam);

          if aProtocolError <> ecOk then exit;                      

          {Activate status timer now}
          aHC.SetTimerTrigger(aStatusTrigger, aStatusInterval, True);

          {Set DCD trigger if necessary}
          if FlagIsSet(aFlags, apAbortNoCarrier) then begin
            if CheckDCD then
              {Set modem status trigger to look for carrier loss}
              SetStatusTrigger(aNoCarrierTrigger, msDCDDelta, True)
            else begin
              {Carrier not present now, abort}
              aProtocolError := ecAbortNoCarrier;
              apSignalFinish(P);
              Exit;
            end;
          end;

          {Register the protocol notification procedure}
          RegisterProcTriggerHandler(ProtFunc);
        end else
          {Couldn't get started, finish now}
          apSignalFinish(P);
      end;
    end;
  end;

  procedure apStopProtocol(P : PProtocolData);
    {-Stop the protocol}

    procedure RemoveIt(Trig : Integer);
    begin
      if Trig > 0 then
        P^.aHC.RemoveTrigger(Trig);