abziptyp.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

    StrDispose( FItemInfo.FExtraField );
  FItemInfo.FExtraField := nil;
  if Length( Value ) > 0 then begin
    FItemInfo.FExtraField := StrAlloc( succ( FItemInfo.FExtraFieldLength ) );
    StrPCopy( FItemInfo.FExtraField, Value );
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipItem.SetFileComment( Value : string );
begin
  FItemInfo.FileCommentLength := Length( Value );
  if Assigned( FItemInfo.FFileComment ) then
    StrDispose( FItemInfo.FFileComment );
  FItemInfo.FFileComment := nil;

  if Length( Value ) > 0 then begin
    FItemInfo.FFileComment := StrAlloc( succ( FItemInfo.FFileCommentLength ) );
    StrPCopy( FItemInfo.FFileComment, Value );
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipItem.SetFileName( Value : string );
begin
  FFileName := Value;
  FItemInfo.FileNameLength := Length( Value );
  if Assigned( FItemInfo.FFileName ) then
    StrDispose( FItemInfo.FFileName );
  FItemInfo.FFileName := nil;
  if Length( Value ) > 0 then begin
    FItemInfo.FFileName := StrAlloc( succ( FItemInfo.FFileNameLength ) );
    StrPCopy( FItemInfo.FFileName, Value );
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipItem.SetGeneralPurposeBitFlag( Value : Word );
begin
  FItemInfo.GeneralPurposeBitFlag := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipItem.SetInternalFileAttributes( Value : Word );
begin
  FItemInfo.InternalFileAttributes := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipItem.SetLastModFileDate( const Value : Word );
begin
  FItemInfo.LastModFileDate := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipItem.SetLastModFileTime( const Value : Word );
begin
  FItemInfo.LastModFileTime := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipItem.SetRelativeOffset( Value : Longint );
begin
  FItemInfo.RelativeOffset := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipItem.SetUncompressedSize( const Value : Longint );
begin
  inherited SetUncompressedSize( Value );
  FItemInfo.UncompressedSize:= Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipItem.SetVersionMadeBy( Value : Word );
begin
  FItemInfo.VersionMadeBy := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipItem.SetVersionNeededToExtract( Value : Word );
begin
  FItemInfo.VersionNeededToExtract := Value;
end;
{ -------------------------------------------------------------------------- }


{ TAbZipArchive implementation ============================================= }
constructor TAbZipArchive.Create( FileName : string; Mode : Word );
begin
  inherited Create( FileName, Mode );
  FCompressionMethodToUse := smBestMethod;
  FInfo := TAbZipDirectoryFileFooter.Create;
  StoreOptions := StoreOptions + [soStripDrive];
  FDeflationOption := doNormal;
  FPasswordRetries := AbDefPasswordRetries;
  FTempDir := '';
  SpanningThreshold := AbDefZipSpanningThreshold;
  FCurrentDisk := Word(-1); {!!}
end;
{ -------------------------------------------------------------------------- }
constructor TAbZipArchive.CreateFromStream( aStream : TStream;
                                            ArchiveName : string );
begin
  inherited CreateFromStream( aStream, ArchiveName );
  FInfo := TAbZipDirectoryFileFooter.Create;
  FPasswordRetries := AbDefPasswordRetries;                            
end;
{ -------------------------------------------------------------------------- }
destructor TAbZipArchive.Destroy;
begin
  FInfo.Free;
  FInfo := nil;
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
function TAbZipArchive.CreateItem( const FileSpec : string ): TAbArchiveItem;
var
  Buff : array [0..MAX_PATH] of Char;
begin
  Result := TAbZipItem.Create;
  with TAbZipItem( Result ) do begin
    CompressionMethod := cmDeflated;
    GeneralPurposeBitFlag := 0;
    CompressedSize := 0;
    CRC32 := 0;
    ExtraField := '';
    StrPCopy(Buff, ExpandFileName(FileSpec));
{!!.03 - Added }
{$IFDEF Linux}
 { do nothing to Buff }
{$ELSE}
    if AreFileApisANSI then begin
      AnsiToOEM(Buff, Buff);
    end;
{$ENDIF}
{!!.03 - End Added }
    DiskFileName := StrPas(Buff);
    StrPCopy(Buff, FixName(FileSpec));
{!!.03 - Added }
{$IFDEF Linux}
 { do nothing to Buff }
{$ELSE}
    if AreFileApisANSI then begin
      AnsiToOEM(Buff, Buff);
    end;
{$ENDIF}
{!!.03 - End Added }
    FileName := StrPas(Buff);
    RelativeOffset := 0;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipArchive.DoExtractHelper(Index : Integer; NewName : string);
begin
  if Assigned(FExtractHelper) then
    FExtractHelper(Self, ItemList[Index], NewName)
  else
    raise EAbZipNoExtraction.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipArchive.DoExtractToStreamHelper(Index : Integer;
                                                aStream : TStream);
begin
  if Assigned(FExtractToStreamHelper) then
    FExtractToStreamHelper(Self, ItemList[Index], aStream)
  else
    raise EAbZipNoExtraction.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipArchive.DoTestHelper(Index : Integer);
begin
  if Assigned(FTestHelper) then
    FTestHelper(Self, ItemList[Index])
  else
    raise EAbZipNoExtraction.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipArchive.DoInsertHelper(Index : Integer; OutStream : TStream);
begin
  if Assigned(FInsertHelper) then
    FInsertHelper(Self, ItemList[Index], OutStream)
  else
    raise EAbZipNoInsertion.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipArchive.DoInsertFromStreamHelper(Index : Integer;
  OutStream : TStream);
begin
  if Assigned(FInsertFromStreamHelper) then
    FInsertFromStreamHelper(Self, ItemList[Index], OutStream, InStream)
  else
    raise EAbZipNoInsertion.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipArchive.DoRequestLastDisk( var Abort : Boolean );
var
  pMessage : string;
  pCaption : string;
begin
  Abort := False;
  if Assigned( FOnRequestLastDisk ) then
    FOnRequestLastDisk( Self, Abort )
  else begin
    pMessage := AbStrRes(AbLastDiskRequest);
    pCaption := AbStrRes(AbDiskRequest);
{$IFDEF MSWINDOWS}
    Abort := Windows.MessageBox( 0, PChar(pMessage), PChar(pCaption),
      MB_TASKMODAL or MB_OKCANCEL ) = IDCANCEL;
{$ENDIF}
{$IFDEF LINUX}
{$IFDEF NoQt}
    WriteLn(pMessage);
{$ELSE }
    Abort := QDialogs.MessageDlg(pCaption, pMessage, mtWarning, mbOKCancel, 0) = mrCancel;
{$ENDIF}
{$ENDIF}
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipArchive.DoRequestNthDisk( DiskNumber : Byte;
                                          var Abort : Boolean );
var
  pMessage : string;
  pCaption : string;
  FMessage : string;
begin
  Abort := False;
  if Assigned( FOnRequestNthDisk ) then
    FOnRequestNthDisk( Self, DiskNumber, Abort )
  else begin
    pMessage := AbStrRes(AbDiskNumRequest);
    FMessage := Format(pMessage, [DiskNumber] );
    pMessage := FMessage;
    pCaption := AbStrRes(AbDiskRequest);
{$IFDEF MSWINDOWS}
    Abort := Windows.MessageBox( 0, PChar(pMessage), PChar(pCaption),
      MB_TASKMODAL or MB_OKCANCEL ) = IDCANCEL;                      
{$ENDIF}
{$IFDEF LINUX}
{$IFDEF NoQt }
    WriteLn(pMessage);
{$ELSE }
    Abort := QDialogs.MessageDlg(pCaption, pMessage, mtWarning, mbOKCancel, 0) = mrCancel;
{$ENDIF }
{$ENDIF}
  end;

//  if not Abort and (FStream is TAbSpanStream) then                       {!!.01}
//    TAbSpanStream(FStream).SpanNumber := DiskNumber;                     {!!.01}

end;
{ -------------------------------------------------------------------------- }
procedure TAbZipArchive.DoRequestBlankDisk( var Abort : Boolean );
var
  pMessage : string;
  pCaption : string;
begin
  Abort := False;
  FSpanned := True;

  if Assigned( FOnRequestBlankDisk ) then
    FOnRequestBlankDisk( Self, Abort )
  else begin
    pMessage := AbStrRes(AbBlankDisk);
    pCaption := AbStrRes(AbDiskRequest);
{$IFDEF MSWINDOWS}
    Abort := Windows.MessageBox( 0, PChar(pMessage), PChar(pCaption),
      MB_TASKMODAL or MB_OKCANCEL ) = IDCANCEL;
{$ENDIF}
{$IFDEF LINUX}
{$IFDEF NoQt}
    WriteLn(pMessage);
{$ELSE }
    Abort := QDialogs.MessageDlg(pCaption, pMessage, mtWarning, mbOKCancel, 0) = mrCancel;
{$ENDIF}
{$ENDIF}
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipArchive.DoRequestNthImage(ImageNumber : Integer;
  var Stream : TStream; var Abort : Boolean);
var
  ImageName : string;
  i : Integer;
  Found : Boolean;
  MediaType : TAbMediaType;
begin
  Abort := False;
  ImageName := FArchiveName;

  {--spanned disk set--}
  MediaType := mtLocal;
  if FDriveIsRemovable then begin
{$IFDEF LINUX}
    raise EAbException.Create('Floppy Spanning not supported on Linux'); {!!.01}
{$ENDIF}
    MediaType := mtRemoveable;

    if (ImageNumber > AbLastDisk) then
      DoRequestNthDisk(Succ(ImageNumber), Abort);
    if Abort then
      raise EAbUserAbort.Create;

    Stream.Free;
    Stream := TAbSpanStream.Create(ImageName, fmOpenRead, MediaType, FSpanningThreshold);

    TAbSpanStream(Stream).OnRequestImage := DoSpanningMediaRequest;
    TAbSpanStream(Stream).OnArchiveProgress := DoArchiveSaveProgress;

{!!.04 - changed}
//    if FindCentralDirectoryTail(Stream) = -1 {not found} then
    if (CurrentDisk = Word(-1))
      and (FindCentralDirectoryTail(Stream) = -1) {not found} then
{!!.04 - changed end}
      DoRequestLastDisk(Abort);
    if Abort then
      raise EAbUserAbort.Create;

    Exit;
  end;

  {--spanned image set--}
  { first check if the current image contains the CDT }                  {!!.03}
  if FindCentralDirectoryTail(Stream) > -1 {not found} then begin        {!!.03}
    Exit;                                                                {!!.03}
  end;                                                                   {!!.03}

  {if OnRequestImage assigned, then fire event}
  if Assigned(FOnRequestImage) then begin

    FOnRequestImage(Self, ImageNumber, ImageName, Abort);
    if Abort then
      raise EAbUserAbort.Create;
    Stream.Free;
    Stream := TAbSpanStream.Create(ImageName, fmOpenRead, MediaType, FSpanningThreshold);
    TAbSpanStream(Stream).OnRequestImage := DoSpanningMediaRequest;
    TAbSpanStream(Stream).OnArchiveProgress := DoArchiveSaveProgress;  {!!.04}
//    TAbSpanStream(Stream).SpanNumber := ImageNumber;                     {!!.01}
    Exit;
  end;

  {if not last image requested, then simply auto-generate image name}
  if (ImageNumber > AbLastImage) then begin
    if (ImageNumber = 0) then
      ImageName := FArchiveName
    else
      AbIncFilename(ImageName, ImageNumber);
    if not FileExists(ImageName) then
      raise EAbFileNotFound.Create;
    Stream.Free;
    Stream := TAbSpanStream.Create(ImageName, fmOpenRead, MediaType, FSpanningThreshold);
    TAbSpanStream(Stream).OnRequestImage := DoSpanningMediaRequest;
    TAbSpanStream(Stream).OnArchiveProgress := DoArchiveSaveProgress;  {!!.04}
//    TAbSpanStream(Stream).SpanNumber := ImageNumber;                     {!!.01}
    Exit;
  end;




  {search for last image, assuming images were auto-generated}
  Stream.Free;                                                         {!!.04}
  FAutoGen := True;                                                  {!!.02}
  for i := 1 to 99 do begin
    AbIncFilename(ImageName, i);
    if not FileExis