unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ShellCtrls, RzButton, StdCtrls, RzLabel, ExtCtrls,
  RzPanel, JclCompression,StrUtils,shellapi, RzPrgres;

type
  TForm3 = class(TForm)

    RzPanel2: TRzPanel;
    RzLabel1: TRzLabel;
    RzPanel1: TRzPanel;
    ProgressBar2: TRzProgressBar;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    ShellTreeView1: TShellTreeView;
    CheckBox1: TCheckBox;
    RzBitBtn4: TRzBitBtn;
    procedure RzBitBtn3Click(Sender: TObject);
    procedure RzBitBtn4Click(Sender: TObject);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ArchiveProgress3(Sender: TObject; const Value, MaxValue: Int64);
  private
    { Private declarations }
  public
    { Public declarations }
        Dpdir,Dp:string;
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

uses unit1;

procedure TForm3.ArchiveProgress3(Sender: TObject; const Value, MaxValue: Int64);
var
  MyValue, MyMaxValue:int64;


begin
  MyValue := Value;
  MyMaxValue := MaxValue;
  while MyMaxValue > High(Word) do
  begin
    MyMaxValue := MyMaxValue shr 8;
    MyValue := MyValue shr 8;
  end;
   Application.ProcessMessages;
  form3.ProgressBar2.TotalParts:=mymaxvalue;
    form3.ProgressBar2.PartsComplete:=MyValue;

//  ProgressBar1.Max := MyMaxValue;
//  ProgressBar1.Position := MyValue;


//Gauge1.MaxValue := MyMaxValue;
//  Gauge1.Progress := MyValue;

//Synchronize(Setprogress);

end;


function ExtractDPdir(Extractdir:string;ArchiveFilename:string;DPdir:string):tstringlist;
var
  AFormat: TJclDecompressArchiveClass;
  i:integer;
  posInf:integer;
  FArchive: TJclCompressionArchive;
begin
   result:=Tstringlist.create;

    AFormat := GetArchiveFormats.FindDecompressFormat(ArchiveFileName);

    if AFormat <> nil then
    begin

      FArchive := AFormat.Create(ArchiveFileName, 0, false);
     FArchive.OnProgress := form3.ArchiveProgress3;

      if FArchive is TJclDecompressArchive then
        TJclDecompressArchive(FArchive).ListFiles
      else
      if FArchive is TJclUpdateArchive then
        TJclUpdateArchive(FArchive).ListFiles;

        for i:=0 to FArchive.ItemCount-1 do
//          if FArchive.Items[i].Kind=ikDirectory then
              begin


              posInf:=pos(AnsiUpperCase(DPdir), AnsiUpperCase(FArchive.Items[i].PackedName));

              if posinf > 0 then
              begin
              Result.Add(FArchive.Items[i].PackedName);
//              ShowMessage(FArchive.Items[i].PackedName);
                  FArchive.Items[i].Selected:=true;
              end;
              end;

   if FArchive is TJclDecompressArchive then
      begin
      Application.ProcessMessages;
      TJclDecompressArchive(FArchive).ExtractSelected(Extractdir, True);
      end
    else
       if FArchive is TJclUpdateArchive then
       begin
           Application.ProcessMessages;
           TJclUpdateArchive(FArchive).ExtractSelected(Extractdir, True);
//           Application.ProcessMessages;
       end
    end
    else
      ShowMessage('Формат Архива не поддерживается');

  FreeAndNil(FArchive); //закрытие АРХИВА
end;


procedure TForm3.RzBitBtn3Click(Sender: TObject);
begin
close;
end;

procedure TForm3.RzBitBtn4Click(Sender: TObject);
var
 Dir: string;
 i: integer;
begin
Randomize;
 Dir:=ShellTreeView1.Path+'\Новая папка '+intToStr(random(100));
 i:=2;
 while DirectoryExists(Dir) do
 begin
  Dir:=ShellTreeView1.Path+'\Новая папка '+intToStr(random(100));
  inc(i)
 end;
 forceDirectories(Dir);

 //ExtractFileDir()
 if pos(':\\',dir)>0 then
  dir:=AnsiReplaceText(dir,':\\',':\');

 ShellTreeView1.Refresh(ShellTreeView1.Selected);
 ShellTreeView1.Path:=Dir;
  ShellTreeView1.SetFocus;
 ShellTreeView1.Selected.EditText;



end;

procedure TForm3.RzBitBtn2Click(Sender: TObject);
begin

ExtractDPdir(ShellTreeView1.Path,dp,Dpdir);

//ShowMessage(ShellTreeView1.Path+dpdir);
if CheckBox1.Checked then
ShellExecute(0,PChar('explore'),
               PChar(ShellTreeView1.Path+'\'+dpdir),
               Nil,Nil,SW_SHOW);
close;

end;

procedure TForm3.FormShow(Sender: TObject);
begin
//ShowMessage(dpdir+#13+dp);
end;

end.




