[ТЕМА ЗАКРЫТА]
Опции темы
04.02.2007 23:37  
OlegON
Код:
{1.}  

function Are2FilesEqual(const File1, File2: TFileName): Boolean;  
var  
  ms1, ms2: TMemoryStream;  
begin  
  Result := False;  
  ms1 := TMemoryStream.Create;  
  try  
    ms1.LoadFromFile(File1);  
    ms2 := TMemoryStream.Create;  
    try  
      ms2.LoadFromFile(File2);  
      if ms1.Size = ms2.Size then  
        Result := CompareMem(ms1.Memory, ms2.memory, ms1.Size);  
    finally  
      ms2.Free;  
    end;  
  finally  
    ms1.Free;  
  end  
end;  

procedure TForm1.Button1Click(Sender: TObject);  
begin  
  if Opendialog1.Execute then  
    if Opendialog2.Execute then  
      if Are2FilesEqual(Opendialog1.FileName, Opendialog2.FileName) then  
        ShowMessage('Files are equal.');  
end;  

{********************************************}  

{2.}  

function FilesAreEqual(const File1, File2: TFileName): Boolean;  
const    
  BlockSize = 65536;  
var    
  fs1, fs2: TFileStream;    
  L1, L2: Integer;    
  B1, B2: array[1..BlockSize] of Byte;  
begin    
  Result := False;    
  fs1 := TFileStream.Create(File1, fmOpenRead or fmShareDenyWrite);  
  try      
    fs2 := TFileStream.Create(File2, fmOpenRead or fmShareDenyWrite);  
    try        
      if fs1.Size = fs2.Size then   
      begin          
        while fs1.Position < fs1.Size do   
        begin            
          L1 := fs1.Read(B1[1], BlockSize);  
          L2 := fs2.Read(B2[1], BlockSize);  
          if L1 <> L2 then   
          begin              
            Exit;  
          end;            
          if not CompareMem(@B1[1], @B2[1], L1) then Exit;          
        end;          
        Result := True;        
      end;      
    finally        
      fs2.Free;      
    end;    
  finally      
    fs1.Free;    
  end;  
end;  


function CompareFiles(Filename1,FileName2:string):longint; 
{ 
  Сравнение файлов 

  возвращает номер несовпадающего байта, 
  (байты отсчитываются с 1)или: 
  0 - не найдено отличий, 
  -1 - ошибка файла 1 
  -2 - ошибка файла 2 
  -3 - другие ошибки 
} 
const 
  Buf_Size=16384; 
var 
  F1,F2:TFileStream; 
  i:longint; 
  Buff1,Buff2:PByteArray; 
  BytesRead1,BytesRead2:integer; 
begin 
  Result:=0; 
  try 
    F1:=TFileStream.Create(FileName1,fmShareDenyNone); 
  except 
    Result:=-1; 
    exit; 
  end; 
  try 
    F2:=TFileStream.Create(FileName2,fmShareDenyNone); 
  except 
    Result:=-2; 
    F1.Free; 
    exit; 
  end; 
  GetMem(Buff1,Buf_Size); 
  GetMem(Buff2,Buf_Size); 
  try 
    if F1.Size> F2.Size then Result:=F2.Size+1 
    else if F1.SizeF1.Position) and (Result=0) do begin 
      BytesRead1 :=F1.Read(Buff1^,Buf_Size); 
      BytesRead2 :=F2.Read(Buff2^,Buf_Size); 
      if (BytesRead1=BytesRead2) then begin 
        for i:= 0 to BytesRead1-1 do begin 
          if Buff1^[i]< > Buff2^[i] 
          then begin 
            result:=F1.Position-BytesRead1+i+1; 
            break; 
          end; 
        end; 
      end else begin 
        Result:=-3; 
        break; 
      end; 
    end; 
  end; 
  except 
    Result:=-3; 
  end; 
  F1.Free; 
  F2.Free; 
  FreeMem(Buff1,Buf_Size); 
  FreeMem(Buff2,Buf_Size); 
end;
 
06.02.2007 17:37  
twix
а чем fc не устраивает?
 
06.02.2007 17:39  
OlegON
Угу, будешь его stdout разбирать, чтобы понять, в чем разница?
 
06.02.2007 17:45  
twix
olegon, ну... он имеет довольно удобный вывод с ключом /b
довольно полезно для создания кряков после обработки файликов при помощи хекс-редакторов и дасмов. только вот софтайс у меня странно работает - один раз отработал, выдал синий экран, а после этого винды переставляй, если снова хочешь его поюзать...
вот. но это мы уже от темы программирования ушли. отключаюсь. пш-ш....
 
 
Опции темы



Часовой пояс GMT +3, время: 05:28.

Все в прочитанное - Календарь - RSS - - Карта - Вверх 👫 Яндекс.Метрика
Форум сделан на основе vBulletin®
Copyright ©2000 - 2016, Jelsoft Enterprises Ltd. Перевод: zCarot и OlegON
В случае заимствования информации гипертекстовая индексируемая ссылка на Форум обязательна.