archiver.pas

EES Binder v1.0

unit Archiver;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, unit2, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button2: TButton;
    Edit1: TEdit;
    OpenDialog1: TOpenDialog;
    Button3: TButton;
    PopupMenu1: TPopupMenu;
    REMOVE1: TMenuItem;
    ListBox1: TListBox;
    StatusBar1: TStatusBar;
    Edit2: TEdit;
    GroupBox3: TGroupBox;
    bigname: TLabel;
    GroupBox1: TGroupBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    Button1: TButton;
    CheckBox6: TCheckBox;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Fsize: TLabel;
    Label7: TLabel;
    ListBox2: TListBox;
    Button4: TButton;
    Procedure stats(dat : string);
    Function  extractright(dat : string; find : string) :string;
    function kilobyte(bytes : string):string;
    procedure filenumb(numb : string);
    Procedure Addfile;
    procedure removefile;
    procedure ressize;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure CheckBox6Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure CheckBox3Click(Sender: TObject);
    procedure resetcheck;
    procedure REMOVE1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox6MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure CheckBox2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure CheckBox3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  total : integer;
  FS : String = '%%%FS';
  FE : String = '%%%FE';

implementation

{$R *.dfm}

procedure Tform1.stats(dat : string);
Begin
statusbar1.SimpleText := dat;
end;

function TForm1.extractright(dat : string ; find : string) : string;
VAR
P: integer;
Begin
 P := length(dat);
  repeat
   if dat[p] <> find then dec(p);
  until dat[p] = find;
 result := copy(dat,p + 1,length(dat));
END;

function tform1.kilobyte(bytes : string): string;
Var
kilo, bite : integer;
Begin
bite := strtoint(bytes);
kilo := 0;
 if bite > 1024
   then
    begin
     repeat
      inc(kilo);
      bite := bite - 1024;
     until bite < 1024;
     if bite > 899 then bite := 9;
     result := inttostr(kilo) + '.' + inttostr(bite) + ' K';
    End;
End;

procedure TForm1.Filenumb(numb : string);
VAR
FN : integer;
Begin
 if numb = '-'
  then
   begin
    FN := strtoint(label4.Caption);
    dec(FN);
    label4.Caption := inttostr(FN);
   end;
 if numb = '+'
  then
   begin
    FN := strtoint(label4.Caption);
    inc(FN);
    label4.Caption := inttostr(FN);
   end;
End;

procedure TForm1.ressize;
Var
A : integer;
Begin
 a := strtoint(fsize.Caption) + strtoint(label2.Caption);
 label7.Caption := kilobyte(inttostr(a));
 total := a;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin

 opendialog1.Execute;
 edit1.Text := extractfilename(opendialog1.FileName);
 resetcheck;
end;

procedure TForm1.Addfile;
VAR
F : File;
big :integer;
Begin
 Assignfile(F,opendialog1.FileName);
  reset(F,1);
  big := strtoint(Fsize.Caption) + filesize(F);
  Fsize.Caption := inttostr(big);
  closefile(F);
  filenumb('+');
  ressize;
End;

procedure TForm1.removefile;
VAR
  P, fs : integer;
  F : file;
begin
p := listbox1.ItemIndex;
 if p = -1
  then
   begin
    showmessage('No file to remove');
    exit;
   end
  else
   begin
    Assignfile(F,listbox2.Items[p]);
    reset(F,1);
    fs := filesize(F);
    fs := strtoint(fsize.Caption) - fs;
    fsize.Caption := inttostr(fs);
    listbox1.DeleteSelected;
    listbox2.Selected[p] := true;
    listbox2.DeleteSelected;
    bigname.Caption := '';
    filenumb('-');
    ressize;
   end;
End;

procedure tform1.resetcheck;
begin
checkbox6.Checked := true;
checkbox1.Checked := true;
checkbox2.Checked := false;
checkbox3.Checked := false;
checkbox4.Checked := False;
end;


procedure TForm1.Button1Click(Sender: TObject);
VAR
Specs :string;
begin
if edit1.Text = ''
 then
  Begin
   beep;
   showmessage('No file selected.');
   Exit;
  END;


addfile;
specs := edit1.text + ':[';


  if checkbox1.Checked = true then specs := specs + 'E';
  if checkbox1.Checked = false then specs := specs + '0';
  if checkbox6.Checked = true then specs := specs + 'T';
  if checkbox2.Checked = true then specs := specs + 'W';
  if checkbox3.Checked = true then specs := specs + 'S';
  if checkbox4.Checked = true then specs := specs + 'A';
  if checkbox4.Checked = false then specs := specs + '0';
  specs := specs + ']';
listbox1.AddItem(Specs,listbox1);
Listbox2.AddItem(opendialog1.FileName,listbox2);
edit1.Text := '';

end;

procedure TForm1.Button4Click(Sender: TObject);
begin
form2 := TFORM2.Create(SELF);
FORM2.Show;
end;

procedure TForm1.CheckBox6Click(Sender: TObject);
VAR
CNUM : integer;
begin
cnum := 0;
if checkbox6.Checked
 then
  BEGIN
  checkbox2.Checked := false;
  checkbox3.Checked := False;
  End;

if checkbox2.Checked = false then inc(cnum);
if checkbox3.Checked = false then inc(cnum);
if checkbox6.Checked = false then inc(cnum);
if cnum = 3 then checkbox6.Checked;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
if checkbox2.Checked
 then
  BEGIN
  checkbox6.Checked := false;
  checkbox3.Checked := False;
  End;
end;

procedure TForm1.CheckBox3Click(Sender: TObject);
begin
 if checkbox3.Checked
 then
  BEGIN
  checkbox2.Checked := false;
  checkbox6.Checked := False;
  End;
end;

procedure TForm1.REMOVE1Click(Sender: TObject);
Begin
Removefile;
end;

procedure TForm1.Button3Click(Sender: TObject);
VAR
F, RF : file;
log: textfile;
TFILE,Heder: string;
PI, SPOS, EPOS, read, wrote: integer;
buff : array[1..1000] of char;

begin

if listbox1.Items.Count = 0
 THEN
  begin
   showmessage('No files to archive');
   stats('Archive Failed! invalid number of files.');
   exit;
  END;

PI := 0;
progressbar1.Min := 0;
progressbar1.Max := total;

if edit2.Text = '' then edit2.Text := 'Result.exe';

//*************************************************************start LOGG file
 assignfile(log,extractfilepath(paramstr(0)) + 'ALOG.log');
 rewrite(LOG);

//*************************************************************start result file
 assignfile(RF,extractfilepath(paramstr(0)) + edit2.Text);
 rewrite(RF,1);

//*************************************************************start Adding STUB
 assignfile(F,extractfilepath(paramstr(0)) + 'EES_STUB\EESSTUB.EXE');
 reset(F,1);
  repeat
    blockread(F,bufF,1000,read);
    Blockwrite(RF,BUFF,read,Wrote);
   progressbar1.Position := progressbar1.Position + read;
  until read = 0;
 closefile(F);

//****************************************************************CREATE ARCHIVE
 repeat

  tfile := listbox2.Items[PI];
  if fileexists(TFILE) then stats(extractfilename(tfile) + ' found, loading into archive');

   seek(RF,filepos(RF)+1);

  assignfile(F,TFile);
  Reset(F,1);
    spos :=  filepos(RF);
    epos := fileSize(F);
  repeat
    blockread(F,bufF,1000,read);
    Blockwrite(RF,BUFF,read,Wrote);
    progressbar1.Position := progressbar1.Position + read;
  until read = 0;

   seek(RF,filepos(RF)+1);

  heder := '%%%FS' + inttostr(PI) + ':';
  heder := heder + listbox1.Items[PI] + ':';
  heder := heder + inttostr(Spos) + ':' + inttostr(Epos) + ':';
  heder := heder + '%%%FE' + inttostr(PI);
  Writeln(log,heder);

   closefile(F);

  inc(PI);
 until PI  = listbox1.Items.Capacity;

closefile(log);

//************************************************************start Adding SPECs
 assignfile(F,extractfilepath(paramstr(0)) + 'ALOG.log');
 reset(F,1);
  repeat
    blockread(F,bufF,1000,read);
    Blockwrite(RF,BUFF,read,Wrote);
   progressbar1.Position := progressbar1.Position + read;
  until read = 0;

closefile(F);
Closefile(RF);

stats('Archive Completed.');
deletefile(extractfilepath(paramstr(0)) + 'ALOG.log');
beep;
showmessage('Archive Completed.');
end;


procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  VAR
  P : integer;
begin
p := listbox1.ItemIndex;
if p <> -1 then
begin
bigname.Caption :=listbox2.Items[p];
stats('selected file ' + inttostr(p + 1) + ' : ' + listbox1.Items[p]);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
VAR
F : File;
begin
if fileexists(extractfilepath(paramstr(0)) + 'VIP_STUB\VIP_STUB.EXE')
 Then
  Begin
  showmessage('Using VIP STUB.');

   assignfile(F,extractfilepath(paramstr(0)) + 'VIP_STUB\VIP_STUB.EXE');
   reset(F,1);
   label2.Caption := inttostr(filesize(F));
   closefile(F);
   ressize;
   stats('You are using an EES VIP program');
   exit;
  end;
if fileexists(extractfilepath(paramstr(0)) + 'EES_STUB\EESSTUB.EXE')
 Then
  Begin
   assignfile(F,extractfilepath(paramstr(0)) + 'EES_STUB\EESSTUB.EXE');
   reset(F,1);
   label2.Caption := inttostr(filesize(F));
   closefile(F);
   ressize;
  end
   ELSE
    showmessage('EESSTUB.exe not found in local folder.');


end;



procedure TForm1.CheckBox6MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
 VAR
  cnum : integer;
begin
cnum := 0;
if checkbox2.Checked = false then inc(cnum);
if checkbox3.Checked = false then inc(cnum);
if checkbox6.Checked = false then inc(cnum);
if cnum = 3 then checkbox6.Checked := true;

end;

procedure TForm1.CheckBox2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
 VAR
  cnum : integer;
begin
cnum := 0;
if checkbox2.Checked = false then inc(cnum);
if checkbox3.Checked = false then inc(cnum);
if checkbox6.Checked = false then inc(cnum);
if cnum = 3 then checkbox2.Checked := true;
end;

procedure TForm1.CheckBox3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
    VAR
  cnum : integer;
begin
cnum := 0;
if checkbox2.Checked = false then inc(cnum);
if checkbox3.Checked = false then inc(cnum);
if checkbox6.Checked = false then inc(cnum);
if cnum = 3 then checkbox3.Checked := true;
end;

end.