Author: Tomas Rutkauskas
Does anyone know of sample code that compares two files and indicates if there is a
difference or not (like FC)? I could use filestreams and compare bit by bit but I'm
hoping someone has done this in a more optimized fashion.
Answer:
Use CreateFileMapping and compare pointers. Look at my unfinished unit below for an
example:
1 unit findin;
2
3 interface
4
5 uses
6 Windows, SysUtils, findstr;
7
8 type
9 TFindInFile = class;
10
11 TFindIn = class
12 protected
13 FFindInFile: TFindInFile;
14 FHandle: THandle;
15 function GetPartNum: Integer; virtual; abstract;
16 function GetPartLen(Index: Integer): Cardinal; virtual; abstract;
17 public
18 constructor Create(FindInFile: TFindInFile; FileName: string); virtual;
19 destructor Destroy; override;
20 function CanUseMem: Boolean; virtual; abstract;
21 function UseMemSize: Cardinal; virtual; abstract;
22 function GetPart(Index: Integer; Len: Cardinal): Pointer; virtual; abstract;
23 property PartNum: Integer read GetPartNum;
24 property PartLen[Index: Integer]: Cardinal read GetPartLen;
25 end;
26
27 TFindInClass = class of TFindIn;
28
29 TBMSearchFunc = function(var Buffer; BufLength: Cardinal; var BT: TBMTbl;
30 MatchString: PAnsiChar; var Pos: Cardinal): Boolean;
31
32 TFindInFile = class
33 protected
34 FFindIn: TFindIn;
35 FFindInClass: TFindInClass;
36 FFindStrParams: PFindStrParams;
37 FMemHandle: THandle;
38 FMem: Pointer;
39 FStrLen: Cardinal;
40 FDriveTp: UINT;
41 FBMSearchFunc: TBMSearchFunc;
42 function GetDriveTp(Root: string): UINT;
43 public
44 constructor Create(FindStrParams: PFindStrParams);
45 destructor Destroy; override;
46 function Find(FileName: string): Cardinal;
47 function SwitchToRoot(Root: string): Boolean; virtual;
48 end;
49
50 TFindInHDD = class(TFindIn)
51 private
52 FSize: Cardinal;
53 protected
54 FMapPtr: Pointer;
55 function GetPartNum: Integer; override;
56 function GetPartLen(Index: Integer): Cardinal; override;
57 public
58 constructor Create(FindInFile: TFindInFile; FileName: string); override;
59 destructor Destroy; override;
60 function CanUseMem: Boolean; override;
61 function UseMemSize: Cardinal; override;
62 function GetPart(Index: Integer; Len: Cardinal): Pointer; override;
63 end;
64
65 PIntArr = ^TIntArr;
66 TIntArr = array[0..1] of Cardinal;
67
68 TFindInRemovable = class(TFindIn)
69 private
70 FSize: Cardinal;
71 protected
72 FPartNum: Integer;
73 function GetPartNum: Integer; override;
74 function GetPartLen(Index: Integer): Cardinal; override;
75 public
76 constructor Create(FindInFile: TFindInFile; FileName: string); override;
77 function CanUseMem: Boolean; override;
78 function UseMemSize: Cardinal; override;
79 function GetPart(Index: Integer; Len: Cardinal): Pointer; override;
80 end;
81
82 implementation
83
84 resourcestring
85 SInvalidDrive = 'Invalid drive - "%s".';
86
87 { TFindIn }
88
89 constructor TFindIn.Create(FindInFile: TFindInFile; FileName: string);
90 begin
91 inherited Create;
92 FFindInFile := FindInFile;
93 FHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ,
94 nil, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0);
95 if FHandle = INVALID_HANDLE_VALUE then
96 RaiseLastWin32Error;
97 end;
98
99 destructor TFindIn.Destroy;
100 begin
101 if FHandle <> 0 then
102 CloseHandle(FHandle);
103 inherited Destroy;
104 end;
105
106 { TFindInHDD }
107
108 constructor TFindInHDD.Create(FindInFile: TFindInFile; FileName: string);
109 var
110 hFile: THandle;
111 begin
112 inherited Create(FindInFile, FileName);
113 FSize := GetFileSize(FHandle, nil);
114 hFile := CreateFileMapping(FHandle, nil, PAGE_READONLY, 0, 0, nil);
115 CloseHandle(FHandle);
116 FHandle := hFile;
117 if FHandle <> 0 then
118 begin
119 FMapPtr := MapViewOfFile(FHandle, FILE_MAP_READ, 0, 0, 0);
120 if FMapPtr = nil then
121 RaiseLastWin32Error;
122 end
123 else
124 RaiseLastWin32Error;
125 end;
126
127 destructor TFindInHDD.Destroy;
128 begin
129 if FMapPtr <> nil then
130 UnmapViewOfFile(FMapPtr);
131 inherited Destroy;
132 end;
133
134 function TFindInHDD.GetPartNum: Integer;
135 begin
136 Result := 1;
137 end;
138
139 function TFindInHDD.GetPartLen(Index: Integer): Cardinal;
140 begin
141 Result := FSize;
142 end;
143
144 function TFindInHDD.GetPart(Index: Integer; Len: Cardinal): Pointer;
145 begin
146 Result := FMapPtr;
147 end;
148
149 function TFindInHDD.CanUseMem: Boolean;
150 begin
151 Result := False;
152 end;
153
154 function TFindInHDD.UseMemSize: Cardinal;
155 begin
156 Result := 0;
157 end;
158
159 { TFindInRemovable }
160
161 constructor TFindInRemovable.Create(FindInFile: TFindInFile; FileName: string);
162 var
163 S: Cardinal;
164 begin
165 inherited Create(FindInFile, FileName);
166 FSize := GetFileSize(FHandle, nil);
167 if FSize = $FFFFFFFF then
168 RaiseLastWin32Error;
169 S := UseMemSize - Pred(FFindInFile.FStrLen);
170 FPartNum := FSize div S;
171 if FSize mod S <> 0 then
172 Inc(FPartNum);
173 end;
174
175 function TFindInRemovable.GetPartNum: Integer;
176 begin
177 Result := FPartNum;
178 end;
179
180 function TFindInRemovable.GetPartLen(Index: Integer): Cardinal;
181 begin
182 Result := UseMemSize;
183 if (Index = Pred(FPartNum)) and (FSize mod (Result - FFindInFile.FStrLen) <> 0)
184 then
185 Result := FSize - (Result - Pred(FFindInFile.FStrLen)) * Pred(FPartNum);
186 end;
187
188 function TFindInRemovable.GetPart(Index: Integer; Len: Cardinal): Pointer;
189 var
190 Dist: ULONG;
191 Reading: DWORD;
192 begin
193 Result := FFindInFile.FMem;
194 Dist := Index * (UseMemSize - Pred(FFindInFile.FStrLen));
195 SetFilePointer(FHandle, Dist, nil, FILE_BEGIN);
196 if not ReadFile(FHandle, Result^, Len, Reading, nil) then
197 RaiseLastWin32Error;
198 end;
199
200 function TFindInRemovable.CanUseMem: Boolean;
201 begin
202 Result := True;
203 end;
204
205 function TFindInRemovable.UseMemSize: Cardinal;
206 begin
207 Result := 8; {512 * 1024;}
208 end;
209
210 { TFindInFile }
211
212 function Max(V1, V2: Integer): Integer; assembler; register;
213 asm
214 CMP EAX,EDX
215 JG @@1
216 MOV EAX,EDX
217 @@1:
218 end;
219
220 constructor TFindInFile.Create(FindStrParams: PFindStrParams);
221 var
222 I: Integer;
223 begin
224 inherited Create;
225 FDriveTp := $FFFFFFFF;
226 FFindStrParams := FindStrParams;
227 if FFindStrParams^.CaseSensitive then
228 FBMSearchFunc := BMSearch
229 else
230 FBMSearchFunc := BMSearchUC;
231 FStrLen := 0;
232 for I := 0 to Pred(FFindStrParams^.Substr.Count) do
233 FStrLen := Max(FStrLen, length(FFindStrParams^.Substr[I]));
234 end;
235
236 destructor TFindInFile.Destroy;
237 begin
238 if FMemHandle <> 0 then
239 begin
240 GlobalUnlock(FMemHandle);
241 GlobalFree(FMemHandle);
242 end;
243 inherited Destroy;
244 end;
245
246 function TFindInFile.GetDriveTp(Root: string): UINT;
247 begin
248 Result := GetDriveType(PChar(ExtractFileDrive(Root) + '\'));
249 end;
250
251 function TFindInFile.Find(FileName: string): Cardinal;
252 var
253 I, J, K: Integer;
254 L: Cardinal;
255 P: Pointer;
256 PI: PFindStrInfo;
257 BMSFunc: TBMSFunc;
258 begin
259 Result := NotFound;
260 FFindIn := FFindInClass.Create(Self, FileName);
261 try
262 if FFindIn.CanUseMem and (FMem = nil) then
263 begin
264 FMemHandle := GlobalAlloc(GMEM_MOVEABLE, FFindIn.UseMemSize);
265 if FMemHandle = 0 then
266 RaiseLastWin32Error;
267 FMem := GlobalLock(FMemHandle);
268 end;
269 for I := 0 to Pred(FFindIn.PartNum) do
270 for J := 0 to Pred(FFindStrParams^.Substr.Count) do
271 begin
272 L := FFindIn.PartLen[I];
273 P := FFindIn.GetPart(I, L);
274 Result := FindString(P^, L, J, FFindStrParams);
275 PI := PFindStrInfo(FFindStrParams.Substr.Objects[J]);
276 if FBMSearchFunc(P^, L, PI^.BMTbl, PI^.FindS, Result) then
277 begin
278 if I > 0 then
279 for K := 1 to I - 1 do
280 Inc(Result, FFindIn.PartLen[K]);
281 Exit;
282 end;
283 end;
284 finally
285 FFindIn.Free;
286 end;
287 end;
288
289 function TFindInFile.SwitchToRoot(Root: string): Boolean;
290 var
291 Tp: UINT;
292 begin
293 Tp := GetDriveTp(Root);
294 if Tp <> FDriveTp then
295 case Tp of
296 0, 1: Exception.CreateFmt(SInvalidDrive, [Root]);
297 DRIVE_FIXED: FFindInClass := TFindInHDD;
298 else
299 {DRIVE_REMOVABLE:
300 DRIVE_REMOTE:
301 DRIVE_CDROM:
302 DRIVE_RAMDISK:}
303 FFindInClass := TFindInRemovable;
304 end;
305 end;
306
307 end.
|
