{Martin Dimov, Number 09}
{$M 20000,50000,600000}
uses crt,graph,dos;

Type TData=Array[1..10000] of Longint;

     PFile=^TFile;
     TFile=Record
             Name:string[128];
             sel:Boolean;
             NextFile:PFile;
           End;

     PGroup=^TGroup;
     TGroup=Record
              FirstFile:PFile;
              sel:Boolean;
              NextGroup:PGroup;
            End;

Const KENTER=#13;
      KUp=#72;
      KDown=#80;
      kSPACE=#32;
      kTAB=#9;

Function intToStr(i:Integer):string;
Var s:string;
begin
  str(i,s);
  IntToStr:=s
end;

Function Test(FileName1,FileName2:string):Boolean;
{Return TRUE If file1 and file2 have a same contens}
Type TBuffer=Array[1..2048] of byte;
Var f1,f2:File;
    Buffer1,Buffer2:TBuffer;
    Readed,i:Word;
    Error:Boolean;
begin
  Error:=false;
  Assign(f1,FileName1);
  Assign(f2,FileName2);
  Reset(f1,1);
  Reset(f2,1);
  If filesize(f1)=FileSize(f2) then
  begin
    Repeat
      BlockRead(f1,Buffer1,SizeOf(TBuffer),readed);
      BlockRead(f2,Buffer2,SizeOf(TBuffer),readed);
      For i := 1 to readed do
        If Buffer1[i]<>Buffer2[i] then
        Begin
          Error:=true;
          Break{I don't must continue}
        End;
    Until EOF(f1) or Error;
  end
   else Error:=True;

  Close(f1);
  Close(f2);
  Test:=Not Error
end;

Procedure GetFilesSizes(dir:string;Var data:TData;Var cnt:Word);
var
 DirInfo: SearchRec;
 HaveDir:Boolean;
begin
 FindFirst(Dir+'\*.*', AnyFile, DirInfo); { Same as DIR *.* }
 while DosError = 0 do
 begin
   HaveDir:=DirInfo.Attr and Directory=Directory;{If I have directory ,Dir=true}
   If (DirInfo.Name<>'.') and (DirInfo.Name<>'..') then
   begin
     If HaveDir then
     begin
       GetFilesSizes(dir+'\'+DirInfo.name,data,cnt);
     end
      else
     begin{I have a file :}
       inc(cnt);
       data[cnt]:=Dirinfo.Size;
     end;
   end;
   FindNext(DirInfo);
 end;
end;

Procedure GetFile(Dir:string;Var number:Word;Var FileName:string);
var
 DirInfo: SearchRec;
 HaveDir:Boolean;
begin
 FindFirst(Dir+'\*.*', AnyFile, DirInfo); { Same as DIR *.* }
 while DosError = 0 do
 begin
   HaveDir:=DirInfo.Attr and Directory=Directory;{If I have directory ,Dir=true}
   If (DirInfo.Name<>'.') and (DirInfo.Name<>'..') then
   begin
     If HaveDir then
     begin
       GetFile(dir+'\'+DirInfo.name,number,FileName);
     end
      else
     begin{I have a file :}
       Dec(Number);
       FileName:=dir+'\'+DirInfo.name;
     end;
     If Number=0 then
     begin
       exit;
     end;
   end;
   FindNext(DirInfo);
 end;
end;

Function ThisGroupNotExists(File1,File2:String;Group:PGroup):Boolean;
Var HGroup:PGroup;
    HFile:PFile;
    BFile1,BFile2:Boolean;
begin
  HGroup:=Group;
  Bfile1:=False;
  Bfile2:=False;
  While HGroup<>NIL do
  begin
    HFile:=HGroup^.FirstFile;
    While HFile<>NIL do
    begin
      If File1=HFile^.name then BFile1:=true;
      If File2=HFile^.name then BFile2:=true;
      HFile:=HFile^.NextFile;
    end;
    If BFile1 and BFile2 then
    begin{=This group exists}
      ThisGroupNotExists:=FALSE;
      exit
    end;
    HGroup:=HGroup^.NextGroup;
  end;
  ThisGroupNotExists:=TRUE
end;

Procedure TestIdenticalFiles(dir:string;var Data:TData;Var cnt:Word;
                              Var Groups:PGroup);
Var i,j,File1Num,File2Num:Word;
    PrimaryFile,secondaryFile:String;
    IHaveGroup,IHaveFile1:Boolean;
    x,y:Integer;
    HGroup:PGroup;
    HFile1,HFile2:PFile;
begin
  For i := 1 to cnt-1 do
  begin
    IHaveGroup:=FALSE;

{    X:=WhereX;
    y:=Wherey;
    Gotoxy(65,3);
    Write('Statut:',i/(cnt-1)*100:4:1,'%  ');
    Gotoxy(x,y);{Return to the old coordinate}

    IHaveFile1:=false;
    For j := i+1 to cnt do
    If data[i]=data[j] then{If two files have the same size then they can have
                               THE SAME CONTENS:}
    begin
      If not IHaveFile1 then
      begin
        File1Num:=i;
        GetFile(dir,File1Num,PrimaryFile);
        IHaveFile1:=true
      end;
      File2Num:=j;
      GetFile(dir,File2Num,SecondaryFile);

      If Test(PrimaryFile,SecondaryFile) and
         ThisGroupNotExists(PrimaryFile,SecondaryFile,groups) then
      begin
        if (Not IHaveGroup) then
        begin
{          Writeln('Group :');
          writeln('  ',PrimaryFile);
          writeln('  ',SecondaryFile);}
          IHaveGroup:=true;

          New(HGroup);
          New(HFile1);
          New(HFile2);
          HFile1^.Name:=PrimaryFile;
          HFile1^.NextFile:=HFile2;
          HFile1^.Sel:=false;
          HFile2^.Name:=SecondaryFile;
          HFile2^.NextFile:=NIL;
          HFile2^.Sel:=false;
          HGroup^.FirstFile:=HFile1;
          HGroup^.NextGroup:=Groups;{set HGroups as first in the groups}
          Groups:=HGroup
        end
         else
        begin
          New(HFile1);
          HFile1^.Sel:=false;
          HFile1^.Name:=SecondaryFile;{This is not secondary,it is third or laster}
          HFile1^.NextFile:=Groups^.FirstFile;
          Groups^.FirstFile:=HFile1;
{          writeln('  ',SecondaryFile);}
        end;
      end;
    end;
{    writeln;}
  end;
end;

Procedure DestroyFile(Var FirstFile:PFile);
Var help:PFile;
begin
  While FirstFile<>NIL do
  begin
    Help:=FirstFile;
    FirstFile:=FirstFile^.NextFile;
    Dispose(help)
  end;
end;

Procedure DestroyGroups(Var Groups:PGroup);
Var help:PGroup;
begin
  While Groups<>NIL do
  begin
    DestroyFile(Groups^.FirstFile);
    help:=Groups;
    Groups:=Groups^.NextGroup;
    Dispose(help)
  end;
end;

Function ReadDirectory:String;

Type PDir=^Tdir;
     TDir=Record
            Name:string;
            next:PDir
          end;

Procedure ClearList(Var DirList:PDir);
var help:PDir;
Begin
  While DirList<>NIL do
  begin
    help:=DirList;
    DirList:=DirList^.Next;
    dispose(help);
  end;
end;

Procedure ChangeStr(Var s1,s2:string);
var h:String;
begin
  h:=s1;
  s1:=s2;
  s2:=h
end;

Procedure Sort(var Dirlist:PDir);
{Easy Dynamic Bubble sort}
var help1,help2:PDir;
begin
  help1:=dirlist;
  While help1<>NIL do
  begin
    help2:=help1^.next;
    While Help2<>NIL do
    begin
      If help1^.Name>help2^.name then
            ChangeStr(help1^.Name,help2^.Name);
      help2:=help2^.next;
    end;
    Help1:=Help1^.next;
  End;
end;

Function ReadThisDir(Var MyDirList:PDir;Var MyCNT:Integer):Boolean;
Var DirInfo:SearchRec;
    help:Pdir;
    DirList:PDir;
    CNT:Integer;
begin
  CNT:=0;
  DirList:=NIl;
  FindFirst('*.*', Directory, DirInfo); { Same as DIR *.PAS }
  while DosError = 0 do
  begin
    If (Dirinfo.Attr=Directory) AND (DirInfo.Name<>'.') then
    begin
      New(help);
      INC(CNT);
      Help^.Next:=DirList;
      Help^.Name:=DirInfo.name;
      DirList:=help;
    end;
    FindNext(DirInfo);
  end;
  Sort(DirList);
  If cnt>=2 then
  begin
    ClearList(MyDirList);
    MyDirList:=DirList;
    MyCNT:=CNT;
  end;
  ReadThisDir:=cnt>=2;
end;

Function GetDirName(Var DirList:PDir;number:Integer):string;
Var help:PDir;
begin
  help:=Dirlist;
  While help<>NIL do
  begin
    dec(number);
    if number=0 then GetDirName:=help^.name;
    help:=help^.next;
  end
end;

Var DirList:PDir;
    kl:Char;
    ext:Boolean;
    CNT,N,A,OA,ON:Integer;
    OldDIR:String;

Const Max=10;{max length of the Graph list}
      Left=100;
      Top=100;
      Width=100;
      Height=100;

Procedure WriteDirList;
var i,j:integer;
    help:PDir;
begin
  Setfillstyle(1,WHITE);
  SetColor(Red);
  Bar3d(left,top,left+width,top+height+5,0,false);
  If CNT<Max then j:=CNT else j:= Max;
  help:=DirList;
  SetColor(black);
  For i := 1 to n do help:=help^.next;
  For i := 1 to j do
  begin
    If i+n=a then SetColor(green);
    OutTextXy(left+5,top-5+i*10,help^.Name);
    If i+n=a then SetColor(Black);
    Help:=Help^.Next;
  end;
end;

begin
  SetColor(15);
  OutTextXY(250,10,'You must choose direstory for searching');
  OutTextXY(250,20,'Press UP and DOWN arrows and press ENTER');
  OutTextXY(250,30,'you change the directory.');
  OutTextXY(250,40,'If you be ready, press SPACE');
  DirList:=NIL;
  ReadThisDir(DirList,CNT);
  N:=0;{vzdalenost odvrvhu}
  A:=1;{aktivni polozka}
  OA:=0;
  Repeat
    If (OA<>A) or (ON<>N) then WriteDirList;
    kl:=readkey;
    ext:=kl=#0;{if kl is extended key}
    If ext then kl:=readkey;
    OA:=A;
    ON:=N;
    Case kl of
      KUp:begin
            If a>1 then
            begin
              dec(a);
              if a<=n then dec(n);
            end;
          end;
      KDown:begin
            If a<CNT then
            begin
              INC(a);
              if a>n+Max then inc(n);
            end;
          end;
      KEnter:Begin
               GetDir(0,olddir);
               ChDir(GetDirName(DirList,a));
               If ReadThisDir(DirList,CNT) then
               begin
                 WriteDirList;
                 n:=0;
                 a:=1;
               end
                else ChDir(olddir);
             End;
    End;
  Until (kl=KSPACE) and (GetDirName(DirList,a)<>'..');
  GetDir(0,olddir);
  If olddir[length(olddir)]<>'\' then olddir:=olddir+'\';
  ReadDirectory:=olddir+GetDirName(DirList,a);
  ClearList(Dirlist)
end;

Procedure WorkWithGroups(Var Groups:PGroup);
Const Max=30;
Var kl:Char;
    ext:Boolean;
    Oakt,aktl:Boolean;{if aktiv window=left}
    LN,RN,LA,RA,LCNT,RCNT:Integer;
    OLN,ORN,OLA,ORA:integer;
    HGroup,aktGroup:PGroup;
    HFile:PFile;

Procedure WriteL;
var i,j:integer;
    help:PGroup;
begin
  SetColor(blue+ord(aktl));
  SetFillstyle(1,8);
  Bar3d(10,10,200,400,0,true);
  If LCNT<Max then j:=LCNT else j:= Max;
  help:=Groups;
  SetColor(red);
  For i := 1 to Ln do help:=help^.nextgroup;
  For i := 1 to j do
  begin
    OutTextXy(25,5+i*10,'Group '+IntToSTR(i+ln));
    If (i+LN=La) and aktl then
    begin
      SetColor(black);
      Line(5,8+i*10,20,8+i*10);
      Line(15,5+i*10,20,8+i*10);
      Line(15,11+i*10,20,8+i*10);
      SetColor(red);
      aktGroup:=help;
    end;
    Help:=Help^.NextGroup;
  end;
end;

Procedure WriteR;
var i,j:integer;
    help:PFile;
begin
  SetColor(blue+ord(not aktl));
  SetFillstyle(1,8);
  Bar3d(210,10,500,400,0,true);
  RCNT:=0;
  help:=aktGroup^.FirstFile;
  While Help<>NIL do
  begin
    Inc(RCNT);
    Help:=Help^.nextfile;
  end;
  If RCNT<Max then j:=RCNT else j:= Max;
  help:=aktGroup^.FirstFile;
  SetColor(red);
  For i := 1 to Rn do help:=help^.NextFile;
  For i := 1 to j do
  begin
    If Help^.sel then SetColor(green);
    OuttextXy(225,5+i*10,help^.name);
    If Help^.sel then SetColor(red);
    If (i+RN=Ra) and (not aktl) then
    begin
      SetColor(black);
      Line(207,8+i*10,220,8+i*10);
      Line(215,5+i*10,220,8+i*10);
      Line(215,11+i*10,220,8+i*10);
      SetColor(red);
    end;
    Help:=Help^.NextFile;
  end;
end;

Procedure SelectFile(num:Integer);
Var h:PFile;
begin
  h:=aktgroup^.firstfile;
  while num>0 do
  begin
    dec(num);
    h:=h^.nextFile;
  end;
  h^.sel:=not h^.sel
end;

Procedure SelectGroup(num:Integer);
Var h:PGroup;
begin
  h:=groups;
  while num>0 do
  begin
    dec(num);
    h:=h^.nextgroup;
  end;
  h^.sel:=not h^.sel
end;

begin
  LCNT:=0;
  HGroup:=groups;
  While HGroup<>NIL do
  begin
    Inc(LCNT);
    HGroup:=HGROUP^.nextgroup;
  end;

  LA:=1;
  RA:=1;
  LN:=0;
  RN:=0;
  OLA:=0;
  aktl:=true;
  Repeat
    If (LA<>OLA) or (LN<>OLN) then
    begin
      RA:=1;
      RN:=0;
    end;
    If (LA<>OLA) or (LN<>OLN) or (RA<>ORA) or (RN<>ORN) or (Oakt<>aktl) then
     begin
       WriteL;
       WriteR;
     end;
    ola:=la;
    ora:=ra;
    oln:=ln;
    orn:=rn;
    oakt:=aktl;
    kl:=readkey;
    ext:=kl=#0;
    If ext then kl:=readkey;
    If aktL then
    begin
      Case kl of
        kUP:begin
              If La>1 then
              begin
                dec(La);
                if La<=Ln then dec(Ln);
              end;
            end;
      KDown:begin
              If La<LCNT then
              begin
                INC(La);
                if La>Ln+Max then inc(Ln);
              end;
          end;
       KEnter:begin
                SelectGroup(LA);
              end;
      end;
    end
     else
    begin
      Case kl of
        kUP:begin
              If Ra>1 then
              begin
                dec(Ra);
                if Ra<=Rn then dec(Rn);
              end;
            end;
      KDown:begin
              If Ra<RCNT then
              begin
                INC(Ra);
                if Ra>Rn+Max then inc(Rn);
              end;
          end;
       KEnter:begin
                SelectFile(RA);
              end;
    end;
  end;
  if kl=kTAB then aktl:=not aktl;
  Until kl=KSPace;
end;

Var Dir:String;
    Data:TData;{Data of files sizes}
    Cnt:word;{Count Number of data}
    Groups:PGroup;
    GM,GD:Integer;
    SaveOldDir:String;

begin
  GetDir(0,SaveOldDir);
  DetectGraph(GD,GM);
  InitGraph(GD,GM,'c:\bp\bgi');
  If paramcount=0 then
  begin
    Dir:=ReadDirectory;
    ClearDevice;
  end
   else Dir:=ParamStr(1);{Main diretory can be as parametr}
  GetFilesSizes(Dir,data,cnt);{Get files sizes of all files in directory dir
                       and save it in array DATA }
  TestIdenticalFiles(Dir,data,cnt,groups);

  WorkWithGroups(Groups);

  DestroyGroups(groups);
  CHDir(SaveOldDir)
end.