Author: david bolton
Sometimes you are only interested in knowing if two files are the same- you might
have hit return a few times in the editor so one looks bigger than the other and
has a later save date but it might be the same otherwise...
Answer:
The utility listed below (both .pas and .dfm source) accepts as input two file
names. For convenience these filenames (with associated paths) are saved out
between runs and you can copy the filename from the first box to the second (click
the red down arrow) - it combines the first filename with the existing 2nd path.
Both edit boxes allow you to browse for files.
File comparison is simple and fast. Each file is read into a memory stream and then
a count of each of the 256 possible characters is made. You could argue that by
cutting and moving text elsewhere in a text file file that this would break my
method (as char counts would be unaffected) and you'd be right but I think for most
purposes this method is probably sufficient and it works with binary as well as
text files. I realise a CRC calculation could also be added- feel free to do so.
When there are differences the output is a string showing each character value
(0-255) followed by the count in brackets.
For something thrown together quickly in an hour or so, it has served me well and
compares files of a few megabytes pretty quickly.
Pascal Source
1 unit viewdiff;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, Buttons;
8
9 type
10 TDBDiff = class
11 Ffilename1: string;
12 FfileName2: string;
13 FBuff1: TmemoryStream;
14 FBuff2: TmemoryStream;
15 FCounts1: array[0..255] of integer;
16 FCounts2: array[0..255] of integer;
17 FProcessed: boolean;
18 fDifferenceStr: string;
19 FDifferent: boolean;
20 private
21
22 function GetDiffCount(ch: char): integer;
23 function GetDifferences: boolean;
24 procedure Clear;
25 procedure BuildDiffTable(Mem1, Mem2: pointer; size1, size2: integer);
26 procedure BuildDifferenceStr;
27 function CheckIfSame: boolean;
28 public
29 constructor Create;
30 destructor Destroy; override;
31 property Different: boolean read GetDifferences;
32 property DifferenceStr: string read fDifferenceStr;
33 property DiffCount[ch: char]: integer read GetDiffCount;
34 property Filename1: string read FFilename1 write FFilename1;
35 property Filename2: string read FFilename2 write FFilename2;
36 end; // TdbDiff
37
38 TForm1 = class(TForm)
39 Button1: TButton;
40 Button2: TButton;
41 fileopen: TOpenDialog;
42 Edit1: TEdit;
43 Edit2: TEdit;
44 GoBtn: TButton;
45 btnCopyDown: TBitBtn;
46 procedure Button1Click(Sender: TObject);
47 procedure Button2Click(Sender: TObject);
48 procedure FormCreate(Sender: TObject);
49 procedure GoBtnClick(Sender: TObject);
50 procedure FormActivate(Sender: TObject);
51 procedure FormDestroy(Sender: TObject);
52 procedure btnCopyDownClick(Sender: TObject);
53 private
54 procedure CheckGoBtn;
55 procedure LoadEditBoxes;
56 procedure SaveEditBoxes;
57 { Private declarations }
58 public
59 { Public declarations }
60 Aftercreate: boolean;
61 Diff: tDbDiff;
62 StartPath: string;
63 end;
64
65 var
66 Form1: TForm1;
67
68 implementation
69
70 {$R *.DFM}
71
72 const
73 editsavefilename = 'diff.ini';
74 CrLf = #13#10;
75
76 procedure TForm1.Button1Click(Sender: TObject);
77 begin
78 if Edit1.Text <> '' then
79 FileOpen.Initialdir := ExtractFileDir(Edit1.Text);
80 if FileOpen.execute then
81 edit1.Text := FileOpen.Filename;
82 CheckGobtn;
83 end;
84
85 procedure Tform1.checkGoBtn;
86 var
87 filename: string;
88 begin
89 Gobtn.enabled := false;
90 Filename := trim(Edit1.Text);
91 if (Filename <> '') and fileexists(Filename) then
92 begin
93 Filename := trim(Edit2.Text);
94 if (Filename <> '') and fileexists(Filename) then
95 GoBtn.Enabled := True;
96 end;
97 end;
98
99 procedure TForm1.Button2Click(Sender: TObject);
100 begin
101 if Edit2.Text <> '' then
102 FileOpen.Initialdir := ExtractFileDir(Edit2.Text);
103 if FileOpen.execute then
104 edit2.Text := FileOpen.Filename;
105 CheckGoBtn;
106 end;
107
108 procedure TForm1.FormCreate(Sender: TObject);
109 begin
110 Aftercreate := true;
111 end;
112
113 { TDBDiff }
114
115 procedure TdbDiff.Clear;
116 begin
117 fFilename1 := '';
118 fFilename2 := '';
119 fillchar(fCounts1, sizeof(fcounts1), 0);
120 fillchar(fCounts2, sizeof(fcounts2), 0);
121 fDifferenceStr := '';
122 fProcessed := false;
123 end;
124
125 constructor TDBDiff.Create;
126 begin
127 fBuff1 := TmemoryStream.Create;
128 fBuff2 := TmemoryStream.Create;
129 Clear;
130 end;
131
132 destructor TDBDiff.Destroy;
133 begin
134 FBuff2.Free;
135 FBuff1.Free;
136 end;
137
138 function TDBDiff.GetDiffCount(ch: char): integer;
139 begin
140 result := fCounts1[ord(ch)] - Fcounts2[ord(ch)];
141 end;
142
143 procedure TdbDiff.BuildDifferenceStr;
144 var
145 Index: integer;
146 begin
147 fDifferenceStr := '';
148 for Index := 0 to 255 do
149 if fcounts1[Index] <> fCounts2[Index] then
150 begin
151 fDifferenceStr := fDifferencestr +
152 ' #' + inttostr(Index) + '(' + inttostr(fcounts1[Index] - Fcounts2[Index]) +
153 ')';
154 end;
155 end;
156
157 function TDBDiff.CheckIfSame: boolean;
158 var
159 Index: integer;
160 begin
161 result := true;
162 for Index := 0 to 255 do
163 if fcounts1[Index] <> fcounts2[Index] then
164 begin
165 Result := false;
166 exit;
167 end;
168 end;
169
170 procedure TDBDiff.BuildDiffTable(mem1, mem2: pointer; size1, size2: integer);
171 type
172 Bytemap = array[0..2000000000] of byte;
173 BytemapPtr = ^ByteMap;
174 var
175 MapPtr: ByteMapPtr;
176 Index: integer;
177 begin
178 MapPtr := ByteMapPtr(mem1);
179 for Index := 0 to size1 - 1 do
180 inc(fcounts1[MapPtr^[Index]]);
181 MapPtr := ByteMapPtr(mem2);
182 for Index := 0 to size2 - 1 do
183 inc(fcounts2[MapPtr^[Index]]);
184 end;
185
186 function TDBDiff.GetDifferences: boolean;
187 var
188 fs: TFileStream;
189 begin
190 if fProcessed then
191 Result := Fdifferent
192 else
193 begin
194 Result := false;
195 if (trim(Ffilename1) = '') or (trim(FFilename2) = '') then
196 exit;
197 fProcessed := true;
198 fs := TfileStream.Create(fFilename1, fmOpenRead);
199 fbuff1.LoadFromStream(fs);
200 fs.free;
201 fs := TfileStream.Create(fFilename2, fmOpenRead);
202 fbuff2.LoadFromStream(fs);
203 fs.free;
204 BuildDiffTable(fbuff1.memory, fbuff2.memory, fbuff1.size, fbuff2.size);
205 BuildDifferenceStr;
206 Result := not CheckIfSame;
207 end;
208 end;
209
210 procedure TForm1.GoBtnClick(Sender: TObject);
211
212 begin
213 diff.Clear;
214 diff.Filename1 := edit1.text;
215 diff.Filename2 := edit2.text;
216 if diff.Different then
217 ShowMessage(
218 'Differences between ' + Crlf +
219 diff.Filename1 + Crlf +
220 diff.Filename2 + Crlf + Crlf +
221 diff.DifferenceStr)
222 else
223 ShowMessage('Files identical');
224 end;
225
226 procedure TForm1.FormActivate(Sender: TObject);
227 begin
228 if AfterCreate then
229 begin
230 AFterCreate := false;
231 diff := tdbdiff.Create;
232 GetDir(0, StartPath);
233 if StartPath[Length(StartPath)] <> '\' then
234 StartPath := StartPath + '\';
235 LoadEditBoxes;
236 end;
237 end;
238
239 procedure Tform1.LoadEditBoxes;
240 var
241 tf: textfile;
242 s: string;
243 begin
244 if fileexists(StartPath + EditSaveFilename) then
245 begin
246 assignfile(tf, StartPath + EditSavefilename);
247 reset(tf);
248 try
249 readln(tf, s);
250 edit1.text := s;
251 readln(tf, s);
252 edit2.text := s;
253 finally
254 Closefile(Tf);
255 CheckGoBtn;
256 end;
257 end;
258 end;
259
260 procedure Tform1.SaveEditBoxes;
261 var
262 tf: textfile;
263 s: string;
264 begin
265 assignfile(tf, StartPath + EditSavefilename);
266 rewrite(tf);
267 try
268 s := edit1.text;
269 writeln(tf, s);
270 s := edit2.text;
271 writeln(tf, s);
272 finally
273 Closefile(Tf);
274 end;
275 end;
276
277 procedure TForm1.FormDestroy(Sender: TObject);
278 begin
279 SaveEditBoxes;
280 end;
281
282 procedure TForm1.btnCopyDownClick(Sender: TObject);
283 begin
284 edit2.text := ExtractFileDir(Edit2.Text) + '\' +
285 ExtractFileName(Edit1.Text);
286 end;
287
288 end.
DFM Source
object Form1: TForm1
Left = 338
Top = 555
Width = 462
Height = 172
Caption = 'Difference Utility'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnActivate = FormActivate
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 12
Top = 30
Width = 75
Height = 25
Caption = '1st File'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 12
Top = 78
Width = 75
Height = 25
Caption = '2nd File'
TabOrder = 1
OnClick = Button2Click
end
object Edit1: TEdit
Left = 96
Top = 30
Width = 343
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 2
end
object Edit2: TEdit
Left = 96
Top = 78
Width = 343
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 3
end
object GoBtn: TButton
Left = 96
Top = 114
Width = 75
Height = 25
Caption = 'Compare'
Enabled = False
TabOrder = 4
OnClick = GoBtnClick
end
object btnCopyDown: TBitBtn
Left = 240
Top = 54
Width = 26
Height = 23
TabOrder = 5
OnClick = btnCopyDownClick
Glyph.Data = {
76010000424D7601000000000000760000002800000020000000100000000100
0400000000000001000000000000000000001000000010000000000000000000
800000800000008080008000000080008000808000007F7F7F00BFBFBF000000
FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333303333
333333333337F33333333333333033333333333333373F333333333333090333
33333333337F7F33333333333309033333333333337373F33333333330999033
3333333337F337F33333333330999033333333333733373F3333333309999903
333333337F33337F33333333099999033333333373333373F333333099999990
33333337FFFF3FF7F33333300009000033333337777F77773333333333090333
33333333337F7F33333333333309033333333333337F7F333333333333090333
33333333337F7F33333333333309033333333333337F7F333333333333090333
33333333337F7F33333333333300033333333333337773333333}
NumGlyphs = 2
end
object fileopen: TOpenDialog
DefaultExt = '*'
Filter = 'Any File|*.*'
Left = 354
end
end
|