работа с архивами zip

[Luxor]

В каталоге X:arh/ есть архив XXXX.ZIP
Каким образом можно извлечь содержимое этого архива в текущий каталог "X:arh/"?
Как добавить два файла в один архив YYY.zip?

[WAYFARER]

Архивация

[Odyssey]

Я бы использовал классы TZipper/TUnzipper из стандартной библиотеки FreePascal.
http://wiki.freepascal.org/paszlib

[MetallDoctor]

Что бы не плодить темы без необходимости – спрошу в этой.
Такая программка (в двух словах – хочу скормить папку, в которую накачивается музыка с сервиса thankyou.ru в архивах, что бы программка вытащила музыку, разложила по папкам, поправила имена файлов и папок и id3 теги так, как мне удобно, я думаю проще написать программу, чем по новой перелопачивать 15+ ГБ архивов):

Код: Выделить всё

unit TankYouExtractor;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, Zipper;

type

  { TFormThankYouExtractor }

  TFormThankYouExtractor = class(TForm)
    SourceBtn: TButton;
    DestinationBtn: TButton;
    GoBtn: TButton;
    procedure GoBtnClick(Sender: TObject);
    procedure SourceBtnClick(Sender: TObject);
    procedure DestinationBtnClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

  TInfo = RECORD
    Artist, Album:STRING;
    Year:Integer;
    Tracks:ARRAY OF STRING;
  end;

var
  FormThankYouExtractor: TFormThankYouExtractor;
  Source, Destination: STRING;
  Albums: TStringList;

implementation

{$R *.lfm}

{ TFormThankYouExtractor }

//Полный оригинальный код для копирования:
//http://delphiworld.narod.ru/base/copy_dirs.html
//Правки для Lazarus сделаны на основе:
//http://freepascal.ru/forum/viewtopic.php?t=9259 (содержит ошибки)
function GetListAlbums(SourceDir: string): Boolean;
var
  SR: TSearchRec;
  I: Integer;
begin
  Result := False;
  SourceDir := IncludeTrailingBackslash(SourceDir);
  I := FindFirstUTF8(SourceDir + '*.zip', faAnyFile, SR);
  try
    while I = 0 do begin
      if(SR.Name<>'')and(SR.Name<>'.')and(SR.Name<>'..')AND(SR.Attr<>faDirectory)then
        Albums.Add(Copy(SR.Name,1, Length(SR.Name)-4));
      I := FindNextUTF8(SR)
    end;
    Result := True
  finally
    SysUtils.FindClose(SR);
  end;
end;

procedure TFormThankYouExtractor.SourceBtnClick(Sender: TObject);
VAR
  SD: TSelectDirectoryDialog;
begin
  sd := TSelectDirectoryDialog.Create(Application);
  if sd.Execute then Source:= IncludeTrailingBackslash(sd.FileName);
  FreeAndNil(sd);
end;

procedure TFormThankYouExtractor.DestinationBtnClick(Sender: TObject);
VAR
  SD: TSelectDirectoryDialog;
begin
  sd := TSelectDirectoryDialog.Create(Application);
  if sd.Execute then Destination := IncludeTrailingBackslash(sd.FileName);
  FreeAndNil(sd);
end;

PROCEDURE UnZip(Zip:STRING);
var
  UnZipper: TUnZipper;
begin
  UnZipper := TUnZipper.Create;
  try
    UnZipper.FileName := Source + Zip + '.zip';
    UnZipper.OutputPath := IncludeTrailingBackslash(Source + Zip);
    UnZipper.Examine;
    UnZipper.UnZipAllFiles;
  finally
    UnZipper.Free;
  end;
end;

FUNCTION GetValue(S:STRING):STRING;
BEGIN
  Result:=S
end;

PROCEDURE GetInfo(VAR Info: TInfo; Folder: STRING);
VAR
  ReadMe,F:TextFile;
  S:String;
  N,I:Integer;
BEGIN
  TRY
    Assign (ReadMe, Folder+'readme.txt');
    Reset (ReadMe);
    IF NOT EoF(ReadMe) THEN BEGIN
      ReadLn(ReadMe,S);
      WHILE (Pos('01.', S) = 0) AND NOT EoF(ReadMe) DO BEGIN
        IF Pos('Исполнитель:',S)=1 THEN Info.Artist:=GetValue(S);
        IF Pos('Название альбома:',S)=1 THEN Info.Album:=GetValue(S);
        IF Pos('Год выпуска альбома:',S)=1 THEN Info.Year:=StrToInt(GetValue(S));
        ReadLn(ReadMe,S)
      end;
      Info.Album:=IntToStr(Info.Year)+' – '+Info.Album;
      N:=0;
      IF Pos('01.',S)=1 THEN REPEAT
          Inc(N);
          SetLength(Info.Tracks, Length(Info.Tracks)+1);
          Info.Tracks[N]:=(Copy(S,5,Length(S)-15));
          IF N<9 THEN Info.Tracks[N]:='0'+IntToStr(N+1)+Info.Tracks[N]
          ELSE Info.Tracks[N]:=IntToStr(N+1)+Info.Tracks[N];
          ReadLn(ReadMe,S);
      UNTIL (Length(S)=0) or EoF(ReadMe);
      TRY
        Assign(F, Destination+'txt.txt');
        ReWrite(F);
        WriteLn(F,Info.Artist);
        WriteLn(F,Info.Album);
        WriteLn(F,Info.Year);
        FOR I:=0 TO N DO WriteLn(F,Info.Tracks[I])
      finally
        Close(F);
      end;
    END ELSE ShowMessage('readme.txt пуст')
  EXCEPT
    ShowMessage('Проблемы при обращении к readme.txt')
  end;
  Close(F);
end;

procedure TFormThankYouExtractor.GoBtnClick(Sender: TObject);
VAR
  I: Integer;
  Info: TInfo;
begin
  TRY
    Albums := TStringList.Create;
    IF Source = '' THEN
      ShowMessage('Каталог с архивами не указан')
    ELSE
      IF Destination = '' then
        ShowMessage('Целевой каталог не указан')
      ELSE BEGIN
        GetListAlbums(Source);
        FOR I := 0 TO (Albums.Count-1) DO BEGIN
          UnZip(Albums[I]);
          GetInfo(Info, IncludeTrailingBackslash(
           IncludeTrailingBackslash(Source)+Albums[I]))
        end
    end;
  finally
    Albums.Free
  end;
end;

end.

До самого интересного программа ещё не дошла.
Сейчас падает при начале работы с архивом (на строке «UnZipper.Examine;», если её закоментировать – на следующей). Весь код для процедуры разархивации – отсюда. Сам архив целый и живой, проходит тестирование 7z нормально, права все есть, руками открывается. Тестирую на этом, если вдруг это вопрос алгоритмов упаковки.

Ошибка Unable to open file "%FullFilePathAndName%" выглядит так.

Если бы писал только для себя и на 1 раз – остановился бы на использовании 7z.exe и GNU/Linux-аналога для другого компа, но хочется полноценной кроссплатформерности и программной независимости единого продукта.

Если TUnZipper – не очень удачная вещь, то, буду благодарен и за совет, что показывает себя лучше.

P.S. Если кто-то уже работал с id3 и мимоходом скинет ссылочку на проверенные примеры кода для Lazarus'а – буду сильно благодарен, сам ещё не искал.

[Лекс Айрин]

MetallDoctor, судя по тексту ошибки траблы с правами. Примерный текст сообщения "файл не может быть открыт". Второй вариант -- неправильная кодировка в строке адреса. В Лазарусе UTF8 а в системе, если судить по окну сообщения, ANSI (win1251). То, что имя файла нормально отображается ничего не значит.

ЗЫ: в следующий раз указывайте ось и версию lazarus/FPC.

[MetallDoctor]

С правами – навряд ли. Программа выполняется от моего имени, а с правами там полный порядок.

Перепроверил (хотя, казалось, что уже так делал и отмёл этот вариант) с папками без русских путей – C:\1\arch.zip и C:\2\ – отработало нормально

Мне казалось, что в viewtopic.php?t=9259 описывается кроссплатформерное решение.
Подскажите тогда, пожалуйста, как сделать реально кроссплатформерный вариант, что бы не стругать две параллельных ветки?

P.S. Добавил в подпись.

[Лекс Айрин]

с папками без русских путей – C:\1\arch.zip и C:\2\ – отработало нормально

Значит, точно надо играться с кодировками. Попробуй путь задаваемый функции пропустить через функцию Utf8toSys. (если не хочешь заморачиваться с условной компиляцией, то и в других осях можно будет оставить)

[Vadim]

MetallDoctor
Архив, который Вы открываете, какой имеет размер?