filecomparer.pas 6.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265
  1. unit filecomparer;
  2. {$mode objfpc}
  3. interface
  4. uses Classes;
  5. type
  6. TFileComparer = class(TObject)
  7. private
  8. protected
  9. function LoadFromFile(const aFilename: String): TMemoryStream;
  10. function Compare(const aFileName1, aFilename2: String; var aMsg: String): boolean;
  11. public
  12. procedure CompareFiles(aNoSourcefileExt, aNoDestfileExt, aSilent: boolean; const aSourceMask, aDestPath, aDestFileExtension: String);
  13. end;
  14. implementation
  15. uses SysUtils;
  16. function CompareX(M1, M2:pbyte;Size:sizeint): sizeint;
  17. var k : sizeint;
  18. begin
  19. CompareX:=0;
  20. if size >0 then
  21. for k:=0 to size-1 do
  22. begin
  23. if M1^<>M2^ then begin CompareX:=k; break; end;
  24. inc(m1);
  25. inc(m2);
  26. end;
  27. end;
  28. { TFileComparer }
  29. function TFileComparer.Compare(const aFileName1,
  30. aFilename2: String; var aMsg: String): boolean;
  31. var
  32. MStream1: TMemoryStream;
  33. MStream2: TMemoryStream;
  34. DiffAt : sizeint;
  35. begin
  36. result := false;
  37. aMsg := '';
  38. if not(FileExists(aFileName1)) then
  39. begin
  40. aMsg := format('file "%s" not found', [aFileName1]);
  41. end
  42. else if not(FileExists(aFileName2)) then
  43. begin
  44. aMsg := format('file "%s" not found', [aFileName2]);
  45. end
  46. else
  47. begin
  48. MStream1 := LoadFromFile(aFilename1);
  49. try
  50. MStream1.Position := 0;
  51. MStream2 := LoadFromFile(aFilename2);
  52. try
  53. MStream2.Position := 0;
  54. if MStream1.Size < 1 then aMsg := format('file "%s": start or endmarker not found', [aFilename1])
  55. else if MStream2.Size < 1 then
  56. begin
  57. aMsg := format('file "%s": start or endmarker not found', [aFilename2]);
  58. aMsg := aMsg + #13#10 + format('Size: %d', [MStream2.Size]);
  59. end
  60. else
  61. begin
  62. if MStream1.Size< MStream2.Size then
  63. DiffAt:=CompareX(MStream1.Memory, MStream2.Memory,MStream1.Size)+1
  64. else
  65. DiffAt:=CompareX(MStream1.Memory, MStream2.Memory,MStream2.Size)+1;
  66. if MStream1.Size <> MStream2.Size then aMsg := format('diff: file: "%s" size: %d - file: "%s" size: %d (at %d)',
  67. [aFilename1, MStream1.Size,
  68. aFilename2, MStream2.Size, DiffAt])
  69. else
  70. begin
  71. if CompareMem(MStream1.Memory, MStream2.Memory, MStream1.Size) then result := true
  72. else aMsg := format('diff: file: "%s" <> file: "%s" (at %d)', [aFileName1, aFileName2, DiffAt]);
  73. end;
  74. end;
  75. finally
  76. FreeAndNil(MStream2);
  77. end;
  78. finally
  79. FreeAndNil(MStream1);
  80. end;
  81. end;
  82. end;
  83. procedure TFileComparer.CompareFiles(aNoSourcefileExt, aNoDestfileExt, aSilent: boolean; const aSourceMask, aDestPath, aDestFileExtension: String);
  84. var
  85. i: integer;
  86. sl: TStringList;
  87. sr: TSearchRec;
  88. Path: String;
  89. FileName: String;
  90. SourceFileName: String;
  91. DestFileName: String;
  92. DestFileExtension: String;
  93. Msg: String;
  94. begin
  95. Path := IncludeTrailingBackslash(ExtractFilePath(aSourceMask));
  96. DestFileExtension := aDestFileExtension;
  97. if (DestFileExtension <> '') and
  98. (copy(DestFileExtension, 1, 1) <> '.') then
  99. begin
  100. DestFileExtension := '.' + DestFileExtension;
  101. end;
  102. sl := TStringList.Create;
  103. try
  104. if FindFirst(aSourceMask, faAnyFile - faDirectory - faVolumeID , sr) = 0 then
  105. repeat
  106. if not((aNoSourcefileExt) and (ExtractFileExt(sr.Name) <> '')) then sl.Add(sr.Name);
  107. until FindNext(sr) <> 0;
  108. FindClose(sr);
  109. for i := 0 to sl.Count - 1 do
  110. begin
  111. sl.Sort;
  112. if aDestFileExtension <> '' then
  113. begin
  114. FileName := copy(sl[i], 1, length(sl[i]) - length(ExtractFileExt(sl[i])));
  115. if FileName = '' then FileName := sl[i];
  116. end
  117. else
  118. begin
  119. if aNoDestfileExt then
  120. begin
  121. if ExtractFileExt(sl[i]) = '' then Filename := sl[i]
  122. else
  123. begin
  124. FileName := copy(sl[i], 1, length(sl[i]) - length(ExtractFileExt(sl[i])));
  125. end;
  126. end
  127. else Filename := sl[i];
  128. end;
  129. SourceFileName := Path + sl[i];
  130. DestFileName := IncludeTrailingBackslash(aDestpath) + FileName + DestFileExtension;
  131. if FileExists(SourceFileName) then
  132. begin
  133. if FileExists(DestFileName) then
  134. begin
  135. if Compare(SourceFileName, DestFileName, Msg) then
  136. begin
  137. if not(aSilent) then writeln(format('compare = equal (source: "%s" destination: "%s")', [SourceFileName, DestFileName]));
  138. end
  139. else if Msg <> '' then writeln(ErrOutPut, Msg);
  140. end
  141. else writeln(ErrOutPut, format('Comparefile "%s" not found', [DestFileName]));
  142. end
  143. else writeln(ErrOutPut, format('Sourcefile "%s" not found', [SourceFileName]));
  144. end;
  145. finally
  146. FreeAndNil(sl);
  147. end;
  148. end;
  149. function TFileComparer.LoadFromFile(
  150. const aFilename: String): TMemoryStream;
  151. var
  152. MStream : TMemoryStream;
  153. StartPos : integer;
  154. EndPos : integer;
  155. function FindPos(aStream: TStream; aStartPos: integer; aEndPos: boolean): integer;
  156. var
  157. NopCount : integer;
  158. ch : byte;
  159. begin
  160. result := -1;
  161. if assigned(aStream) then
  162. begin
  163. aStream.Position := aStartPos;
  164. NopCount := 0;
  165. while aStream.Position < aStream.Size do
  166. begin
  167. aStream.Read(ch, 1);
  168. if ch = 144 then
  169. begin
  170. inc(NopCount);
  171. end
  172. else
  173. begin
  174. if NopCount >= 10 then
  175. begin
  176. if not(aEndPos) then result := aStream.Position
  177. else result := aStream.Position - NopCount - 1;
  178. break;
  179. end
  180. else NopCount := 0;
  181. end;
  182. end;
  183. if NopCount >= 10 then
  184. begin
  185. if (result < 0) and
  186. (aStream.Position = aStream.Size) then
  187. begin
  188. if not(aEndPos) then result := aStream.Position
  189. else result := aStream.Position - NopCount;
  190. end;
  191. end
  192. end;
  193. end;
  194. begin
  195. result := TMemoryStream.Create;
  196. if FileExists(aFileName) then
  197. begin
  198. MStream := TMemoryStream.Create;
  199. try
  200. MStream.LoadFromFile(aFileName);
  201. StartPos := FindPos(MStream, 0, false);
  202. if StartPos >= 0 then
  203. begin
  204. if MStream.Size > StartPos + 16384 then
  205. begin
  206. EndPos := FindPos(MStream, MStream.Size - 16384, true);
  207. if EndPos < 0 then
  208. begin
  209. EndPos := FindPos(MStream, StartPos, true);
  210. end;
  211. end
  212. else EndPos := FindPos(MStream, StartPos, true);
  213. end;
  214. if (StartPos < 0) OR
  215. (EndPos < 0) then exit;
  216. MStream.Position := StartPos - 1;
  217. result.CopyFrom(MStream, EndPos - StartPos + 1);
  218. finally
  219. FreeAndNil(MStream);
  220. end;
  221. end;
  222. end;
  223. end.