abbrowse.pas

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

{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.DoChange;                                
begin
  if Assigned(FOnChange) then begin
    FOnChange(Self);
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.DoConfirmProcessItem(Sender : TObject;
                                              Item : TAbArchiveItem;
                                              ProcessType : TAbProcessType;
                                              var Confirm : Boolean);
begin
  Confirm := True;
  if Assigned(FItemProgressMeter) then
    FItemProgressMeter.Reset;
  if Assigned(FOnConfirmProcessItem) then
    FOnConfirmProcessItem(Self, Item, ProcessType, Confirm);
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.DoLoad(Sender : TObject);
begin
  if Assigned(FOnLoad) then
    FOnLoad(Self);
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.DoProcessItemFailure(Sender : TObject;
                                              Item : TAbArchiveItem;
                                              ProcessType : TAbProcessType;
                                              ErrorClass : TAbErrorClass;
                                              ErrorCode : Integer);
begin
  if Assigned(FOnProcessItemFailure) then
    FOnProcessItemFailure(Self, Item, ProcessType, ErrorClass, ErrorCode);
end;
{ -------------------------------------------------------------------------- }
function TAbBaseBrowser.FindItem(aItem : TAbArchiveItem) : Integer;
begin
  if Assigned(FArchive) then
    Result := FArchive.FindItem(aItem)
  else
    Result := -1;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseBrowser.FindFile(const aFileName : string) : Integer;
begin
  if Assigned(FArchive) then
    Result := FArchive.FindFile(aFileName)
  else
    Result := -1;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseBrowser.GetSpanned : Boolean;
begin
  if Assigned(FArchive) then
    Result := FArchive.Spanned
  else
    Result := False;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseBrowser.GetStatus : TAbArchiveStatus;
begin
  if Assigned(FArchive) then
    Result := FArchive.Status
  else
    Result := asInvalid;
end;
{ -------------------------------------------------------------------------- }
function TAbBaseBrowser.GetCount : Integer;
begin
  if Assigned(FArchive) then
    Result := FArchive.Count
  else
    Result := 0;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.InitArchive;
begin
  ResetMeters;
  if Assigned(FArchive) then begin
    {properties}
    FArchive.SpanningThreshold     := FSpanningThreshold;
    FArchive.LogFile               := FLogFile;
    FArchive.Logging               := FLogging;
    FArchive.TempDirectory         := FTempDirectory;
    SetBaseDirectory(FBaseDirectory);
    {events}
    FArchive.OnArchiveProgress     := DoArchiveProgress;
    FArchive.OnArchiveItemProgress := DoArchiveItemProgress;
    FArchive.OnConfirmProcessItem  := DoConfirmProcessItem;
    FArchive.OnLoad                := DoLoad;
    FArchive.OnProcessItemFailure  := DoProcessItemFailure;
    FArchive.OnRequestImage        := FOnRequestImage;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.Loaded;
begin
  inherited Loaded;
  DoChange;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.Notification(Component: TComponent;
                                      Operation: TOperation);
begin
  inherited Notification(Component, Operation);
  if (Operation = opRemove) then
    if Component = FItemProgressMeter then
      FItemProgressMeter := nil
    else if Component = FArchiveProgressMeter then
      FArchiveProgressMeter := nil
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.OpenArchive(const aFileName : string);
  {opens the archive}
begin
  FileName := AFileName;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.ResetMeters;
begin
  if Assigned(FArchiveProgressMeter) then
    FArchiveProgressMeter.Reset;
  if Assigned(FItemProgressMeter) then
    FItemProgressMeter.Reset;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.SetBaseDirectory(const Value : string);
begin
  if Assigned(FArchive) then begin
    FArchive.BaseDirectory := Value;
    FBaseDirectory := FArchive.BaseDirectory;
  end else
    FBaseDirectory := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.SetSpanningThreshold(Value : Longint);
begin
  FSpanningThreshold := Value;
  if Assigned(FArchive) then
    FArchive.SpanningThreshold := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.SetLogFile(const Value : string);
begin
  FLogFile := Value;
  if (csDesigning in ComponentState) then
    Exit;
  if Assigned(FArchive) then
    FArchive.LogFile := Value;
  SetLogging(Value <> '');
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.SetLogging(Value : Boolean);
begin
  FLogging := Value;
  if (csDesigning in ComponentState) then
    Exit;
  if Assigned(FArchive) then
    FArchive.Logging:= Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.SetOnRequestImage(Value : TAbRequestImageEvent);
begin
  FOnRequestImage := Value;
  if Assigned(FArchive) then
    FArchive.OnRequestImage := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.SetTempDirectory(const Value : string);
begin
  FTempDirectory := Value;
  if Assigned(FArchive) then
    FArchive.TempDirectory := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.TagItems(const FileMask : string);
  {tag all items that match the mask}
begin
  if Assigned(FArchive) then
    FArchive.TagItems(FileMask)
  else
    raise EAbNoArchive.Create;
end;
{ -------------------------------------------------------------------------- }
procedure TAbBaseBrowser.UnTagItems(const FileMask : string);
  {clear tags for all items that match the mask}
begin
  if Assigned(FArchive) then
    FArchive.UnTagItems(FileMask)
  else
    raise EAbNoArchive.Create;
end;
{ -------------------------------------------------------------------------- }

procedure TAbBaseBrowser.SetCompressionType(const Value: TAbArchiveType);
begin
  if not Assigned(FArchive) or (Status <> asInvalid) then
    FArchiveType := Value
  else
    raise EAbArchiveBusy.Create;
end;

{ -------------------------------------------------------------------------- }
function AbDetermineArcType(const FN : string; AssertType : TAbArchiveType) : TAbArchiveType;
var
  Ext : string;
  FS : TFileStream;
begin
  Ext := UpperCase(ExtractFileExt(FN));
  Result := atUnknown;

  if AssertType = atUnknown then begin { use file extension as first guess }
    if not FileExists(FN) or (AbFileGetSize(FN) = 0) then begin          {!!.01}
    { file doesn't exist (or is empty) so presume to make one }          {!!.01}
      if Ext = '.ZIP' then
        Result := atZip;
      if Ext = '.TAR' then
        Result := atTar;
      if (Ext = '.GZ') then
        Result := atGzip;
      if (Ext = '.TGZ') then
        Result := atGzippedTar;
      if (Ext = '.CAB') then
        Result := atCab;
    end
    else begin  { file exists so guess that's what it is and double check }
      FS := TFileStream.Create(FN, fmOpenRead or fmShareDenyNone);
      try
        Ext := UpperCase(ExtractFileExt(FN));

        if Ext = '.EXE' then
          Result := VerifySelfExtracting(FS);
        if Ext = '.ZIP' then
          Result := VerifyZip(FS);
        if Ext = '.TAR' then
          Result := VerifyTar(FS);
        if (Ext = '.GZ') or (Ext = '.TGZ') then
          Result := VerifyGzip(FS);
{$IFDEF MSWINDOWS}
        if (Ext = '.CAB') then
          Result := VerifyCab(FN);
{$ENDIF}
      finally
        FS.Free;
      end;
    end;

  end
  else begin  { we're told what it's supposed to be, so ignore file extension }
    if not FileExists(FN) then
      Result := AssertType
    else begin
      FS := TFileStream.Create(FN, fmOpenRead or fmShareDenyNone);
      try
        case AssertType of
          atZip : begin
            Result := VerifyZip(FS);
          end;
          atSelfExtZip : begin
            Result := VerifySelfExtracting(FS);
          end;
          atTar : begin
            Result := VerifyTar(FS);
          end;
          atGzip, atGzippedTar: begin
            Result := VerifyGzip(FS);
          end;
{$IFDEF MSWINDOWS}
          atCab : begin
            Result := VerifyCab(FN);
          end;
{$ENDIF}
        end;
      finally
        FS.Free;
      end;
    end;
  end;
end;
{ -------------------------------------------------------------------------- }


end.