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. |
