filecomparer.pas 6.1 KB

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