1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const espace : char = ' ';
const Buffer_Depth = 20;
var Buffer : array[0..1,0..Buffer_Depth-1] of string;
function remove_multispace( s : string ) : string;
var i,j,k : integer;
begin
i:=0;
repeat
inc(i);
if S[i] = espace then
begin
j:=0;
repeat
inc(j)
until S[i+j] <> espace; // pas besoin de tester or j=Length(S) car on a eu Trim(L) avant l'appel à
// cette routine => S ne peut finir sur des ' '
if ( j > 1 ) then // il y a j-i space contigus s[i],.., S[i +j-1 ]
begin // supprimer j-1 blancs
dec(j); // j contient le nombre de blancs à supprimer
for k:=i+2 to Length(S) - j do
S[k] := S[k+j];
S:=copy(S,1,length(S)-j)
end;
end;
until ( i = Length(S));
end;
function compare_2_lignes( L1, L2 : string;
Multi_space_allowed : boolean;
case_sensitive : boolean ) : boolean;
var i : integer;
begin
// 1 suppression des blancs de début et fin
L1 := Trim(L1);
L2 := Trim(L2);
if not case_sensitive then // on met tout en majuscule
begin
for i:=1 to Length(L1) do L1[i]:=UpCase(L1[i]);
for i:=1 to Length(L2) do L2[i]:=UpCase(L2[i]);
end;
if Multi_space_allowed then // remplacer les séries de space par 1 seul
begin
L1 := remove_multispace(L1);
L2 := remove_multispace(L2);
end;
compare_2_lignes := ( L1 = L2 );
end;
var t : array[0..1] of TextFile;
function Fill_Buffer ( l1,Nbr,num : integer; Strip_empty_lines : boolean ) : integer;
var n,i,l2 : integer; s : string;
begin
i:=l1;
l2 := l1 + Nbr;
n:=0;
repeat
readln( t[num],s);
s:=Trim(s);
if ( s <> '') or not Strip_empty_lines then
begin
inc(n);
Buffer[num][i] := s; // on conserve s si non vide ou si vide avec l'option ne pas supprimer lignes vides
inc(i);
end
until ( i = l2 ) or ( eof(t[num]));
Fill_Buffer:=n; // normalement depth sauf pour des petits fichiers où des la 1er passe on arrive en fin de fichier
end;
var N_Allowed_index : array[0..1] of integer;
failed : boolean;
function Go_On : boolean;
begin // continuer si non arriver en fin des buffers
Go_On := ( N_Allowed_index[0] > 0 ) and
( N_Allowed_index[1] > 0 ) and
not failed;
end;
procedure Load_Buffer(index : integer; nbr : integer; Strip_empty_lines : boolean ); // on essaie de remettre nbr data en fin du buffer - si t les contient encore ! -
var i,k : integer;
begin
for i:=1 to nbr do if not eof(t[index] ) then
begin
repeat
k := Fill_Buffer(N_Allowed_index[index]+1,1,index,Strip_empty_lines);
if k = 1 then // la ligne a ete ajouté.
inc(N_Allowed_index[index]);
until (k=1) or ( eof(t[index]));
end;
end;
procedure Shift_Buffer(index : integer; nbr : integer);
var i : integer;
begin
for i:=0 to Buffer_Depth-1 - nbr do
Buffer[index][i]:= Buffer[index][i+nbr];
dec( N_Allowed_index[index],nbr); // on remontra cet index ( si possible) avec Load_Buffer
end;
Function Compare_2_files( F0, F1 : string;
Strip_empty_lines : boolean;
Multi_space_allowed : boolean;
case_sensitive : boolean) : boolean;
var s : string;
i2,j2 : array[0..1] of integer;
n : integer;
OK : boolean;
begin
if not FileExists(F0) then
begin
ShowMessage('Désolé mais le fichier ' + F0 + ' est maquant');
Compare_2_files := false;
exit
end;
if not FileExists(F1) then
begin
ShowMessage('Désolé mais le fichier ' + F1 + ' est maquant');
Compare_2_files := false;
exit
end;
assignfile(t[0],F0);
reset(t[0]);
assignfile(t[1],F1);
reset(t[1]);
for n:=0 to 1 do //de 0 mettre Buffer_Depth
N_Allowed_index[n] := Fill_Buffer(0,Buffer_Depth,n,Strip_empty_lines)-1; // normalement depth - 1 si fichier assez grand
while Go_On() do
begin
// chercher dans le buffer lea 1er situation où Budder[0][i] = Buffer[1][j]
// le buffer à déjà, le cas échéant été épuré de ses lignes vides. le multi space et les majuscules
// seront tenus en compte lors de la routine compare_2_lignes
// l'égalité se trouve normalement pour i=j=0 mais on tolère les situations
// A fichiers de même taille avec quelques lignes non contigues différentes
// B fichiers de taille différente dont l'un des 2 est le début de l'autre.
// C fichiers identiques à l'exception de lignes en plus
// (au maximum 20 lignes contigues) dans uniquement
// un des 2 fichiers. Ces lignes supplémentaires peuvent se trouver
// n'importe où dans le fichier.
// D fichiers identiques à l'exception de lignes en plus
// (au maximum 20 lignes contigues) dans les 2 fichiers.
// Ces ajouts se trouvent à des endroits différents :
// il n'y a pas, au même endroit, 3 lignes en plus dans un
// fichier et 12 en plus dans l'autre.
// Ces lignes supplémentaires peuvent se trouver n'importe où dans le
// fichier.
(*
L'hypothèse C n'implique pas pour autant de le fichier contenant le + ligne
soit le + gros en taille ( l'autre pourrait contenir 1 ligne fauuse TRES longue
ce qui pourrait être acceptable) .
Sans un pré-scan qui est aussi hors condition, il n'est
pas repérable à l'avance. C'est la raison du Buffer sur les 2 fichiers
*)
i2[0]:=0;
n:=Buffer_Depth+10;
if ( N_Allowed_index[0] >0 ) and ( N_Allowed_index[1] > 0 ) then
begin
failed := true;
while ( i2[0] < N_Allowed_index[0] ) do
begin
i2[1]:=0;
while ( i2[1] < N_Allowed_index[1] ) do
begin
OK := compare_2_lignes( Buffer[0][i2[0]],Buffer[1][i2[1]],
Multi_space_allowed,case_sensitive);
if ( OK ) then // on ne peut pas se contenter de cela
begin // car B[0][0] pourrait être egal à B[1][depth-1]
failed:=false; // alors qu'1 plus proche correspondance pouurait être trouvé si
// par exemple B[0][1] = B[1][0] alors il serait + probable
if i2[0] + i2[1] < n then// qu'on ait 1 ligne de plus dans le buffer[0] que depth ligne de + dans le Buffer[1]
begin
n:=i2[0] + i2[1];
j2[0]:=i2[0]; // on conserve la situation qui est la + proche de l'origine
j2[1]:=i2[1]
end;
i2[1] := N_Allowed_index[1];
end
else
inc(i2[1])
end;
inc(i2[0])
end
end;
if not failed then // une occurence d'égalité est trouvée aux index j2[0],j2[1]
begin
// supprimer la/les lignes des 2 parties du Buffer
Shift_Buffer(0,j2[0]+1);
Shift_Buffer(1,j2[1]+1);
// completer les Buffers temps que possible et remonter en conséquence Last_index
Load_Buffer(0,j2[0]+1,Strip_empty_lines);
Load_Buffer(1,j2[1]+1,Strip_empty_lines);
end
end;
closefile(t[0]);
closefile(t[1]);
Compare_2_files := not failed; // ceci est vrai dans le domaine de tolérance donné
// rapporter + de détail sur la "distance des 2 fichiers"
end; // est certainement un must.
end. |
Partager