Simba/Units/MMLAddon/mmisc.pas

unit mmisc;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,bzip2, bzip2comn,bzip2stream, libtar,mufasabase,mufasatypes;

function DecompressBZip2(const input : TStream; const BlockSize : Cardinal = 4096) : TMemoryStream;
function UnTar(const Input : TStream) : TStringArray;overload;
function UnTar(const Input : TStream;const outputdir : string; overwrite : boolean): boolean;overload;

type
  { TProcThread }
  TProcThread = class(TThread)
  public
    StartWait : Cardinal;
    ClassProc : procedure of object;
    NormalProc : procedure;
    constructor Create;
    procedure Execute; override;
  end;

  { TDecompressThread }

  TDecompressThread = class(TThread)
  private
    FFinished : boolean;
    Finput : TStream;
    FBlockSize : Cardinal;
  public
    Result : TMemoryStream;
    constructor Create(const input : TStream; const BlockSize : Cardinal = 4096);
    procedure Execute; override;
    property Finished : boolean read FFinished;
  end;

  { TUntarThread }

  TUntarThread = class(TThread)
  private
    FFinished : boolean;
    Finput : TStream;
    FOverWrite : boolean;
    FOutputDir : string;
  public
    Result : boolean;
    constructor Create(const Input : TStream;const outputdir : string; overwrite : boolean);
    procedure Execute; override;
    property Finished : boolean read FFinished;
  end;

implementation

uses
  FileUtil;

function DecompressBZip2(const input: TStream; const BlockSize: Cardinal): TMemoryStream;
var
  Unzipper : TDecompressBzip2Stream;
  Blocks : array of Byte;
  ReadSize : cardinal;
begin
  SetLength(Blocks,BlockSize);
  try
    Unzipper := TDecompressBzip2Stream.Create(input);
  except
    on e : exception do
    begin;
      mDebugLn(e.message);
      exit;
    end;
  end;
  Result := TMemoryStream.Create;
  try
    repeat
      ReadSize := BlockSize;
      ReadSize := Unzipper.read(blocks[0],readsize);  //Read ReadSize amount of bytes.
      Result.Write(Blocks[0],ReadSize);
    until readsize = 0;
  except
    on e : EBzip2 do
     if E.ErrCode <> bzip2_endoffile then
       raise Exception.CreateFmt('Decompression error: %s %d',[e.message,e.errcode]);
  end;
  Unzipper.Free;
end;

function UnTar(const Input : TStream) : TStringArray;overload;
var
  Tar : TTarArchive;
  DirRec : TTarDirRec;
  Len : integer;
begin;
  Tar := TTarArchive.Create(input);
  Tar.reset;
  Len := 0;
  while Tar.FindNext(DirRec) do
  begin
    inc(len);
    SetLength(result,len*2);
    result[len*2-2] := DirRec.Name;
    result[len*2-1] := Tar.ReadFile;
  end;
  Tar.Free;
end;

function UnTar(const Input: TStream; const outputdir: string; overwrite: boolean): boolean; overload;
var
  Tar : TTarArchive;
  Succ : boolean;
  DirRec : TTarDirRec;
  FS : TFileStream;
begin;
  result := false;
  if not DirectoryExists(outputdir) then
    if not CreateDir(outputdir) then
      exit;
  Tar := TTarArchive.Create(input);
  Tar.reset;
  Succ := True;
  while Tar.FindNext(DirRec) do
  begin
    if (DirRec.FileType = ftDirectory) then
    begin;
      if not DirectoryExists(outputdir + DirRec.Name) and not CreateDir(outputdir + DirRec.Name) then
      begin
        Succ := false;
        break;
      end;
    end else if (DirRec.FileType = ftNormal) then
    begin;
      if FileExistsUTF8(outputdir + dirrec.name) and not overwrite then
        continue;
      try
        FS := TFileStream.Create(UTF8ToSys(outputdir +dirrec.name),fmCreate);
        tar.ReadFile(fs);
        FS.Free;
      except
        Succ := false;
        break;
      end;
    end else
      mDebugLn(format('Unknown filetype in archive. %s',[dirrec.name]));
  end;
  Tar.Free;
  Result := Succ;
end;

constructor TProcThread.Create;
begin
  inherited Create(true);
  FreeOnTerminate:= True;
end;


{ TProcThread }

procedure TProcThread.Execute;
begin
  if startwait <> 0 then
    sleep(StartWait);
  if NormalProc <> nil then
    NormalProc;
  if ClassProc <> nil then
    ClassProc;
end;

constructor TDecompressThread.Create(const input: TStream;
  const BlockSize: Cardinal);
begin
  inherited Create(True);
  FFinished:= False;
  FBlockSize:= BlockSize;
  FInput := Input;
  Result := nil;
end;

{ TDecompressThread }

procedure TDecompressThread.Execute;
begin
  if Finput <> nil then
    result := DecompressBZip2(Finput,FBlocksize);
  Ffinished := True;
end;

{ TUntarThread }

constructor TUntarThread.Create(const Input: TStream; const outputdir: string;
  overwrite: boolean);
begin
  inherited Create(true);
  FFinished:= false;
  FInput := Input;
  FOutputDir:= OutputDir;
  FOverWrite:= overwrite;
  Result:= False;
end;

procedure TUntarThread.Execute;
begin
  if (Finput <> nil) and (FOutputDir <> '') then
    result := UnTar(FInput,Foutputdir,FOverWrite);
  FFinished:= True;
end;

end.