awabspcl.pas

测试用例

            Exit;
          end;
        end;

      {Will this block fit in the buffer?}
      if (aFileOfs + Integer(BlockSize)) > aEndOfs then begin
        {Block won't fit, commit current buffer to disk}
        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;

        {Reset the buffer management vars}
        aStartOfs := aFileOfs;
        aEndOfs   := aStartOfs + FileBufferSize;
        aLastOfs  := aFileOfs;
      end;

      {Add this block to the buffer}
      Move(Block, aFileBuffer^[aFileOfs - aStartOfs], BlockSize);
      Inc(aLastOfs, BlockSize);
      aapWriteProtocolBlock := False;
    end;
  end;

  procedure apProtocolError(P : PProtocolData; ErrorCode : Integer);
    {-Sends message and sets aProtocolError}
  {$IFDEF WIN32}
  var
    Res : DWORD;
  {$ENDIF}
  begin
    with P^ do begin
      {$IFDEF WIN32}
      SendMessageTimeout(aHWindow, apw_ProtocolError, Cardinal(ErrorCode),
                         0, SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         1000, Res);
      {$ELSE}
      SendMessage(aHWindow, apw_ProtocolError, Cardinal(ErrorCode), 0);
      {$ENDIF}
      aProtocolError := ErrorCode;
    end;
  end;

  function apTrimZeros(S: string): String;
  var
    I, J : Integer;
  begin
    I := Length(S);
    while (I > 0) and (S[I] <= ' ') do
      Dec(I);
    J := 1;
    while (J < I) and ((S[J] <= ' ') or (S[J] = '0')) do
      Inc(J);
    Result := Copy(S, J, (I-J)+1);
  end;

  function apOctalStr(L : LongInt) : String;
    {-Convert L to octal base string}
  const
    Digits : array[0..7] of Char = '01234567';
  var
    I : Cardinal;
  begin
    {$IFDEF HugeStr}
    SetLength(Result, 12);
    {$ELSE}
    apOctalStr[0] := #12;
    {$ENDIF}
    for I := 0 to 11 do begin
      apOctalStr[12-I] := Digits[L and 7];
      L := L shr 3;
    end;
  end;

  function apOctalStr2Long(S : String) : LongInt;
    {-Convert S from an octal string to a longint}
  const
    HiMag = 11;
    Magnitude : array[1..HiMag] of LongInt = (1, 8, 64, 512, 4096,
      32768, 262144, 2097152, 16777216, 134217728, 1073741824);        
  var
    Len  : Byte;
    I    : Integer;
    J    : Integer;
    Part : LongInt;
    Res  : LongInt;
  begin
    {Assume failure}
    apOctalStr2Long := 0;

    {Remove leading blanks and zeros}
    S := apTrimZeros(S);
    Len := Length(S);

    {Return 0 for invalid strings}
    if Len > HiMag then
      Exit;

    {Convert it}
    Res := 0;
    J := 1;
    for I := Len downto 1 do begin
      if (S[I] < '0') or (S[I] > '7') then
        Exit;
      Part := Byte(S[I]) - $30;
      Res := Res + Part * Magnitude[J];
      Inc(J);
    end;
    apOctalStr2Long := Res
  end;

  function apPackToYMTimeStamp(RawTime : LongInt) : LongInt;
    {-Return date/time stamp as seconds since 1/1/1970 00:00 GMT}
  var
    Days  : LongInt;
    Secs  : LongInt;
    DT    : TDateTime;
  begin
    try
      {Get file date as Delphi-style date/time}
      DT := FileDateToDateTime(RawTime);

      {Calculate number of seconds since 1/1/1970}
      Days := Trunc(DT) - UnixDaysBase;
      Secs := Round(Frac(DT) * SecsPerDay);
      Result := (Days * SecsPerDay) + Secs;
    except
      Result := 0;
    end;
  end;

  function apYMTimeStampToPack(YMTime : LongInt) : LongInt;
    {-Return a file time stamp in packed format from a Ymodem time stamp}
  var
    DT : TDateTime;
  begin
    try
      {Convert to Delphi style date, add in unix base}
      DT := YMTime / SecsPerDay;
      DT := DT + UnixDaysBase;

      {Return as packed}
      Result := DateTimeToFileDate(DT);
    except
      Result := 0
    end;
  end;

  function apCurrentTimeStamp : LongInt;
    {-Return a Ymodem format file time stamp of the current date/time}
  begin
    Result := apPackToYMTimeStamp(DateTimeToFileDate(Now));
  end;

  function apCrc32OfFile(P : PProtocolData; FName : PChar; Len : Longint) : LongInt;
    {-Returns Crc32 of FName}
  const
    BufSize = 8192;
  type
    BufArray = array[1..BufSize] of Byte;
  var
    I         : Cardinal;
    BytesRead : Integer;
    Res       : Cardinal;
    FileLoc   : LongInt;
    Buffer    : ^BufArray;
    F         : File;

  begin
    with P^ do begin
      aBlockCheck := 0;

      {If Len is zero then check the entire file}
      if Len = 0 then
        Len := MaxLongint;

      {Get a buffer}
      Buffer := AllocMem(BufSize);

      try

        {Open the file}
        aSaveMode := FileMode;
        FileMode := fmOpenRead or fmShareDenyWrite;                  
        Assign(F, FName);
        Reset(F, 1);
        FileMode := aSaveMode;
        Res := IOResult;
        if Res <> 0 then
          apProtocolError(P, -Res)
        else begin

          {Initialize Crc}
          aBlockCheck := $FFFFFFFF;

          {Start at beginning, loop thru file calculating Crc32}
          FileLoc := 0;
          repeat
            BlockRead(F , Buffer^, BufSize, BytesRead);
            Res := IOResult;
            if Res = 0 then begin
              if Len <> MaxLongint then begin
                Inc(FileLoc, BytesRead);
                if FileLoc > Len then
                  BytesRead := BytesRead - (FileLoc - Len);
              end;
              for I := 1 to BytesRead do
                aBlockCheck := apUpdateCrc32(Byte(Buffer^[I]), aBlockCheck)
            end;
          until (BytesRead = 0) or (Res <> 0) or (FileLoc >= Len);

          Close(F);
          if IOResult = 0 then ;
        end;

      finally
        apCrc32OfFile := aBlockCheck;
        FreeMem(Buffer, BufSize);
      end;
    end;
  end;

  procedure apMsgStatus(P : PProtocolData; Options : Cardinal);
    {-Send an apw_ProtocolStatus message to the protocol window}
  {$IFDEF Win32}
  var
    Res : DWORD;
  {$ENDIF}
  begin
    with P^ do
      {$IFDEF Win32}
      SendMessageTimeout(aHWindow, apw_ProtocolStatus, Options,
                         Longint(P), SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         1000, Res);
      {$ELSE}
      SendMessage(aHWindow, apw_ProtocolStatus, Options, Longint(P));
      {$ENDIF}
  end;

  function apMsgNextFile(P : PProtocolData; FName : PChar) : Bool;
    {-Virtual method for calling NextFile procedure}
  {$IFDEF Win32}
  var
    Res : DWORD;
  {$ENDIF}
  begin
    with P^ do begin
      {$IFDEF Win32}
      SendMessageTimeout(aHWindow, apw_ProtocolNextFile, 0,
                         Longint(FName),
                         SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         1000, Res);
      apMsgNextFile := Res <> 0;
      {$ELSE}
      apMsgNextFile :=
        SendMessage(aHWindow, apw_ProtocolNextFile, 0, LongInt(FName)) <> 0;
      {$ENDIF}
    end;
  end;

  procedure apMsgLog(P : PProtocolData; Log : Cardinal);
    {-Send an apw_ProtocolLog message to the protocol window}
  {$IFDEF Win32}
  var
    Res : DWORD;
  {$ENDIF}
  begin
    with P^ do
      {$IFDEF Win32}
      SendMessageTimeout(aHWindow, apw_ProtocolLog,
                         Cardinal(Log), Longint(P),
                         SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         1000, Res);
      {$ELSE}
      SendMessage(aHWindow, apw_ProtocolLog, Cardinal(Log), LongInt(P));
      {$ENDIF}
  end;

  function apMsgAcceptFile(P : PProtocolData; FName : PChar) : Bool;
    {-Send apw_ProtocolAcceptFile message to TProtocolWindow}
  var
    {$IFDEF Win32}
    Res : DWORD;
    {$ELSE}
    Res : Cardinal;
    {$ENDIF}
  begin
    with P^ do begin
      {$IFDEF Win32}
      SendMessageTimeout(aHWindow, apw_ProtocolAcceptFile,
                         0, Longint(FName),
                         SMTO_ABORTIFHUNG + SMTO_BLOCK,
                         1000, Res);
      {$ELSE}
      Res := SendMessage(aHWindow, apw_ProtocolAcceptFile, 0, LongInt(FName));
      {$ENDIF}
      apMsgAcceptFile := Res = 1;
    end;
  end;

  function apUpdateChecksum(CurByte : Byte; CheckSum : Cardinal) : Cardinal;
    {-Returns an updated checksum}
  begin
    apUpdateCheckSum := CheckSum + CurByte;
  end;

  function apUpdateCrc(CurByte : Byte; CurCrc : Cardinal) : Cardinal;
    {-Returns an updated CRC16}
  begin
    Result := (CrcTable[((CurCrc shr 8) and 255)] xor
              (CurCrc shl 8) xor CurByte) and $FFFF;                 
  end;

  function apUpdateCrcKermit(CurByte : Byte; CurCrc : Cardinal) : Cardinal;
    {-Returns an updated Crc16 (kermit style)}
  var
    I    : Integer;
    Temp : Cardinal;
  begin
    for I := 0 to 7 do begin
      Temp := CurCrc xor CurByte;
      CurCrc := CurCrc shr 1;
      if Odd(Temp) then
        CurCrc := CurCrc xor $8408;
      CurByte := CurByte shr 1;
    end;
    Result := CurCrc;
  end;

  function apStatusMsg(P : PChar; Status : Cardinal) : PChar;
    {-Return an appropriate error message from the stringtable}
  begin
    case Status of
      psOK..psHostResume, psAbort :                                    
        AproLoadZ(P, Status);
      else
        P[0] := #0;
    end;
    Result := P;
  end;

  procedure apRegisterProtocolClass;
    {-Register the protocol window class}
  const
    Registered : Bool = False;
  var
    WClass : TWndClass;
  begin
    if Registered then
      Exit;
    Registered := True;

    with WClass do begin
      Style         := 0;
      lpfnWndProc   := @DefWindowProc;
      cbClsExtra    := 0;
      cbWndExtra    := SizeOf(Pointer);
      {$IFDEF VERSION3}
      if ModuleIsLib and not ModuleIsPackage then
        hInstance     := SysInit.hInstance
      else
        hInstance     := System.MainInstance;
      {$ELSE}
      hInstance     := System.hInstance;
      {$ENDIF}                                                     
      hIcon         := 0;
      hCursor       := LoadCursor(0, idc_Arrow);
      hbrBackground := hBrush(color_Window + 1);
      lpszMenuName  := nil;
      lpszClassName := ProtocolClassName;
    end;
    RegisterClass(WClass);
  end;

  procedure apSetProtocolMsgBase(NewBase : Cardinal);
    {-Set new base for protocol string table}
  begin
    {nothing} 
  end;

  {$IFDEF Win32}
  function apUpdateCrc32(CurByte : Byte; CurCrc : LongInt) : LongInt;
    {-Return the updated 32bit CRC}
    {-Normally a good candidate for basm, but Delphi32's code
      generation couldn't be beat on this one!}
  begin
    apUpdateCrc32 := Crc32Table[Byte(CurCrc xor CurByte)] xor
                     DWORD((CurCrc shr 8) and $00FFFFFF);             
  end;
  {$ENDIF}

procedure InitializeUnit;
var
  TmpDateSeparator : string[1];
  TmpDateFormat : string[15];
  TmpDateTime : TDateTime;
begin
  {Set Unix days base}
  TmpDateFormat := ShortDateFormat;
  {$IFDEF win32}
  SetLength(TmpDateSeparator,1);
  {$ENDIF}
  TmpDateSeparator[1] := DateSeparator;
  DateSeparator := '/';
  ShortDateFormat := 'mm/dd/yyyy';
  TmpDateTime := StrToDateTime('01/01/1970');
  UnixDaysBase := Trunc(TmpDateTime);
  DateSeparator := TmpDateSeparator[1];
  ShortDateFormat := TmpDateFormat;

  {$IFNDEF Win32}
  Crc32TableOfs := Ofs(Crc32Table);
  {$ENDIF}

  {Register protocol window class}
  apRegisterProtocolClass;
end;

initialization
  InitializeUnit;

end.