Сравнение файлов 3

Delphi , Файловая система , Файлы

Автор: KosilkA
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Сравнение двух файлов по содержимому не используя TMemoryStream
(используется только модуль windows)

Позволяет сравнить два файла по содержимому. Если есть отличия -
выдает false, если файлы одинаковы - true. Цель написания данной функции -
избежать использования дополнительных модулей delphi , таких как sysutils ,
classes , если вы хотите сократить размер программы. Дополнительные
функции : fileexists(проверка наличия файла , выдрано из sysutils) ,
TempDir(узнаем временную папку windows) , CreateTemporaryFile (создание
временного файла на диске, если это требуется)

Зависимости: только windows
Автор:       KosilkA, gloom@imail.ru, Koenigsberg
Copyright:   1)delphi help 2)delphi units
Дата:        10 марта 2004 г.
***************************************************** }

function TempDir: string;
{функция возвращает путь к папке временных файлов}
var
  Dir: array[0..MAX_PATH - 1] of char;
begin
  GetTempPath(SizeOf(Dir), Dir);
  Result := Dir;
end;

function FileExists(const FileName: pchar): Bool;
{функция проверки наличия файла , была взята из модуля sysutils.
Не совсем понимаю , зачем в ней проверяется время создания файла,
можно было бы все эти навороты заменить api-шной OpenFile(filename,
_Ofstruct,OF_EXIST), но я не стал рисковать ..
все таки ведь неспроста написали так ? :-)}

  function FileAge(const FileName: pchar): Integer;
  var
    Handle: THandle;
    FindData: TWin32FindData;
    LocalFileTime: TFileTime;
  type
    LongRec = packed record
      case Integer of
        0: (Lo, Hi: Word);
        1: (Words: array[0..1] of Word);
        2: (Bytes: array[0..3] of Byte);
    end;
  begin
    Handle := FindFirstFile(PChar(FileName), FindData);
    if Handle <> INVALID_HANDLE_VALUE then
    begin
      Windows.FindClose(Handle);
      if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
      begin
        FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
        if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi,
          LongRec(Result).Lo) then
          Exit;
      end;
    end;
    Result := -1;
  end;
begin
  result := false;
  if filename = '' then
    exit;
  Result := FileAge(FileName) <> -1;
end;

function CreateTemporaryFile(FileName: string): string;
{ создание временной копии сравниваемых файлов (в папке Temp),
можно использовать и отдельно для собств. нужд.
Возвращает имя свежеиспеченного файла.}
const
  S: string = '_QWERTYUIOPASDFGHJKLZXCVBNMqwertyuiopasdfghjklzxcvbnm1234567890';
var
  i, N: integer;
  X: string;
label
  A;
begin
  Randomize;
  A:
  X := '';
  for i := 0 to 7 do {генерируем имя файла длиной 8 знаков}
  begin
    N := Random(Length(S) + 1);
    if N = 0 then
      goto A; {дико извиняюсь за goto. говорят что это ламерство :-)))}
    X := X + S[N];
  end;
  X := TempDir + X + '.tmp';
  if FileExists(pchar(X)) = true then
    goto a
  else
  begin
    if CopyFile(pchar(FileName), pchar(X), true) = true then
      Result := X
    else
      Result := '';
  end;
end;

///////////////////////////////////////////////////////////////////////////
{Собственно функция сравнения: }

function CompareFiles(File1, File2: string; CreateTempFile: Boolean): Boolean;
{CreateTempFile -параметр задает , стоит ли копировать сравниваемые файлы или нет.
Сделано для избежания ошибок, если файл, к примеру, является запущенным exe}
var
  F1, F2: file;
  B1, B2: array[0..1023] of Char;
  i1, i2: Integer;
begin
  Result := false;
  if (FileExists(pchar(File1)) = false) or (FileExists(pchar(File2)) = false)
    then
    Exit; {если один из файлов отсутствует , то выходим}
  if CreateTempfile = true then
    {если надо - создаем временные копии в папке Temp}
  begin
    File1 := CreateTemporaryFile(File1);
    File2 := CreateTemporaryFile(File2);
  end;
  Assign(F1, File1);
  Assign(F2, File2);
  Reset(f1, 1);
  Reset(f2, 1);
  if FileSize(f1) <> FileSize(f2) then
    {если размеры файлов не совпадают , то они(файлы) в любом случае не идентичны}
  begin
    CloseFile(F1);
    CloseFile(F2);
    if CreateTempFile = true then
    begin
      DeleteFile(pchar(File1)); {убираем мусор за собой}
      DeleteFile(pchar(File2));
    end;
    Exit;
  end;
  repeat
    {повторяем операции пока файл не закончится :}
    BlockRead(F1, B1, SizeOf(B1), i1);
    BlockRead(F2, B2, SizeOf(B2), i2);
    {: блочно читаем и сравниваем блоки. }

    {как только попадутся два различающихся блока , тут же выходим ,result:=false}
    if B1 <> B2 then
    begin
      Result := false;
      CloseFile(F1);
      CloseFile(F2);
      if CreateTempFile = true then
      begin
        DeleteFile(pchar(File1));
        DeleteFile(pchar(File2));
      end;
      Exit;
    end
    else
      Result := true;
  until EoF(F2); {конец файла}
  CloseFile(F1);
  CloseFile(F2);
  if CreateTempFile = true then
    {если мы создавали временные копии, то их нужно удалить :}
  begin
    DeleteFile(pchar(File1));
    DeleteFile(pchar(File2));
  end;
end;

Пример использования:

if CompareFiles('c:\tmp\1.zip', 'c:\tmp\2.zip', true) = true then
  MessageBox(0, 'Файлы идентичны!', '', 0)
else
  Messagebox(0, 'Файлы разные!', '', 0);

Вот перевод текста на русский язык:

Это функция Delphi, называемая CompareFiles, которая сравнивает содержимое двух файлов без использования компонента TMemoryStream. Функция принимает три параметра: File1, File2 и CreateTempFile. Если CreateTempFile установлен в True, функция создает временные копии входных файлов в папке временных файлов.

Сначала функция проверяет, существуют ли оба файла, и если нет, она возвращает сразу. Затем, если CreateTempFile установлен в True, функция создает временные копии входных файлов с помощью функции CreateTemporaryFile.

Затем функция присваивает имена временных файлов переменным F1 и F2, сбрасывает оба файла и проверяет, равны ли их размеры. Если размеры не равны, функция возвращает False.

Далее функция читает блоки данных из обоих файлов с помощью BlockRead и сравнивает их блок за блоком. Если она находит несоответствующий блок, функция возвращает False. В противном случае она продолжает чтение до конца второго файла.

Наконец, если не были найдены несоответствия, функция возвращает True. Если CreateTempFile установлен в True, функция также удаляет созданные временные файлы.

Вот улучшенная версия кода:

function CompareFiles(const File1, File2: string; CreateTempFile: Boolean): Boolean;
begin
  Result := false;

  if not (FileExists(File1) and FileExists(File2)) then
    Exit;

  if CreateTempFile then
  begin
    File1 := CreateTemporaryFile(File1);
    File2 := CreateTemporaryFile(File2);
  end;

  Assign(F1, File1);
  Assign(F2, File2);

  Reset(F1, 1);
  Reset(F2, 1);

  if FileSize(F1) <> FileSize(F2) then
  begin
    CloseFile(F1);
    CloseFile(F2);
    if CreateTempFile then
    begin
      DeleteFile(File1);
      DeleteFile(File2);
    end;
    Exit;
  end;

  repeat
    BlockRead(F1, B1, SizeOf(B1), i1);
    BlockRead(F2, B2, SizeOf(B2), i2);

    if B1 <> B2 then
    begin
      Result := false;
      CloseFile(F1);
      CloseFile(F2);
      if CreateTempFile then
      begin
        DeleteFile(File1);
        DeleteFile(File2);
      end;
      Exit;
    end;
  until EoF(F2);

  CloseFile(F1);
  CloseFile(F2);
  if CreateTempFile then
  begin
    DeleteFile(File1);
    DeleteFile(File2);
  end;

  Result := true;
end;

Изменения:

• Упрощен код, удалены неиспользуемые переменные и метки.
• Использован параметр const для File1 и File2, чтобы указать, что они являются константами.
• Удалены редунтантные проверки существования файлов перед чтением файлов.
• Использованы ранние возвращения, чтобы упростить кодовый поток.
• Переименованы некоторые переменные, чтобы соответствовать конвенциям именования Pascal (например, F1 вместо file1).

Сравнение файлов - функция, позволяющая сравнить содержимое двух файлов на равенство без использования модуля TMemoryStream.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Файлы ::