Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Сравнение файлов [D7]


Страницы:   1 2

nikfel ©   (2007-08-24 12:10:00) 

Подскажите пожалуйста. Вот функция для сравнения файлов, не знаю откуда взята, но у меня не работает.
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;

Leonid Troyanovsky   (2007-08-25 10:41:00) [1]


> clickmaker ©   (24.08.07 16:37) [13]

> function CompareFileContents(const lpFile1: PChar; const
> lpFile2: PChar): integer;


function CompareStreams(Stream1, Stream2: TStream): Boolean;
const
 BufSize = 4096;
var
 StreamSize: Int64;
 nb1, nb2: Cardinal;
 buf1, buf2: array [0..BufSize-1] of Byte;
begin
 StreamSize := Stream1.Size;
 Result := StreamSize = Stream2.Size;
 if not Result then
   Exit;
 while (Stream1.Position < StreamSize) do
   begin
     nb1 := Stream1.Read(buf1, BufSize);
     nb2 := Stream2.Read(buf2, BufSize);
     if nb1 <> nb2 then
       raise EReadError.Create('Compare error');
     Result := CompareMem(@buf1, @buf2, nb1);
     if not Result then
       Exit;
   end;
end;

Осталось только найти желающих сравнить :)

--
Regards, LVT.

Leonid Troyanovsky   (2007-08-25 10:18:00) [2]


> sniknik ©   (25.08.07 09:52) [24]

> наверное было бы и быстрей через mmf если бы они полностью
> влезли в память... а то получается не отображение в памяти,
>  а в файле подкачки (в ссылке 200*2=400 отображается в 256-
> система=?).

NT4, кажись.
Но, там изначально было то самое условие, когда отображения
файлов не могут поместиться полностью.

Однако, страницы отображений в своп не попадают (для них
есть место в файле, а если они только для чтения, то
даже туда не сбрасыватся).
Страдают только соседние процессы.

Интересно, что и  для скользящего окна результат хужей.
Почему, Дмитрий как-то объяснял, но ссылку ту я уже найду.

--
Regards, LVT.

sniknik   (2007-08-25 09:52:00) [3]

> Возможно, что и удобней, но не быстрей, чем обычное чтение буферов и их сравнение.
наверное было бы и быстрей через mmf если бы они полностью влезли в память... а то получается не отображение в памяти, а в файле подкачки (в ссылке 200*2=400 отображается в 256-система=?).

Leonid Troyanovsky   (2007-08-25 08:45:00) [4]


> Игорь Шевченко ©   (24.08.07 12:29) [5]

> Сравнение двух файлов очень удобно делается через MMF

Возможно, что и удобней, но не быстрей, чем обычное чтение
буферов и их сравнение.

http://groups.google.com/group/fido7.su.win32.prog/msg/e4edc3fb35401f38?dmode=source&output=gplain

То есть, предложенному clickmaker ©   (24.08.07 16:37) [13]
можно противопоставить обычные TStream.
Уверен, что код будет короче и понятней для начинающих,
да, и домашнее задание не придется делать :)

--
Regards, LVT.

Riply   (2007-08-24 17:39:00) [5]

> [20] clickmaker ©   (24.08.07 17:30)
>это ладно. я мог бы и memcmp оставить :)
А может и стоило так сделать.
Я не сторонница приподношений готового кода "на блюдечке с голубой каемочкой".
Мне кажется, что это вредит человеку.
Подтолкнуть в нужном направлении или дать скелет решения - другое дело.
Но это только imho.

iXT   (2007-08-24 17:32:00) [6]

> [19] Riply ©   (24.08.07 17:28)

:)

clickmaker   (2007-08-24 17:30:00) [7]


>  [19] Riply ©   (24.08.07 17:28)

это ладно. я мог бы и memcmp оставить :)

Riply   (2007-08-24 17:28:00) [8]

> [18] iXT ©   (24.08.07 17:25)
>Зачем?
Для перевода: if (hMapping1 != NULL) then

iXT   (2007-08-24 17:25:00) [9]

> [17] Riply ©   (24.08.07 17:23)

Зачем?

Riply   (2007-08-24 17:23:00) [10]

> [13] clickmaker ©   (24.08.07 16:37)
>RaiseLastWin32Error при ошибках расставить - домашнее задание

А чтобы жизнь медом не казалалась, для компиляции данной функции,
надо еще пройти маленький ликбез по С :)

iXT   (2007-08-24 17:04:00) [11]

> [15] max_   (24.08.07 16:52)

Что не прокаило?

max_   (2007-08-24 16:52:00) [12]


> Бред полный. Кто тебе сказал что файл текстовый? Ты не слушай
> никого :)

блин, не прокатило...

iXT   (2007-08-24 16:50:00) [13]

> [11] max_   (24.08.07 16:22)

Бред полный. Кто тебе сказал что файл текстовый? Ты не слушай никого :)

clickmaker   (2007-08-24 16:37:00) [14]

function CompareFileContents(const lpFile1: PChar; const lpFile2: PChar): integer;
var
 hFile1, hFile2: THandle;
 hMapping1, hMapping2: THandle;
 lpBuff1, lpBuff2: PByte;
 dwSize1, dwSize2: Cardinal;
begin
 Result := 1;

 hFile1 := CreateFile(lpFile1, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0);
 if (hFile1 <> INVALID_HANDLE_VALUE) then
 begin
   hFile2 := CreateFile(lpFile2, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0);
   if (hFile2 <> INVALID_HANDLE_VALUE) then
   begin
     dwSize1 := GetFileSize(hFile1, nil);
     dwSize2 := GetFileSize(hFile2, nil);
     if (dwSize1 = dwSize2) then
     begin
       hMapping1 := CreateFileMapping(hFile1, NULL, PAGE_READONLY, 0, 0, NULL);
       if (hMapping1 != NULL) then
       begin
         hMapping2 := CreateFileMapping(hFile2, NULL, PAGE_READONLY, 0, 0, NULL);
         if (hMapping2 <> 0) then begin
           lpBuff1 := PByte(MapViewOfFile(hMapping1, FILE_MAP_READ, 0, 0, 0));
           if (lpBuff1 <> nil) then
           begin
             lpBuff2 := PByte(MapViewOfFile(hMapping2, FILE_MAP_READ, 0, 0, 0));
             if (lpBuff2 <> nil) then
             begin
               Result := CompareMem(lpBuff1, lpBuff2, dwSize1);
               UnmapViewOfFile(lpBuff2);
             end;
             UnmapViewOfFile(lpBuff1);
           end;
           CloseHandle(hMapping2);
         end;
         CloseHandle(hMapping1);
       end;
     end;
     CloseHandle(hFile2);
   end;
   CloseHandle(hFile1);
 end;
end;

RaiseLastWin32Error при ошибках расставить - домашнее задание

max_   (2007-08-24 16:30:00) [15]

*поправка - не or, а and

max_   (2007-08-24 16:22:00) [16]

может быть так:

var
f1,f2 :textfile;
s1,s2:string;
line:integer=0;
.........
assignedfile(f1, filename1);
assignedfile(f2, filename2);

if not fileexecute(filename1) then message('error - file not found: ' + filename1)
else if not fileexecute(filename2) then message('error - file not found: ' + filename2);

while not eof(f1) or not eof(f2) do begin

readln(f1, s1);
readln(f2, s2);

inc(line);

if s1 <> s2 then begin message('error - line: ' + line + '[' + s1 + ', ' + s2 + ']');

end;

if eof(f1)<>eof(f2) then message('error - sizes');

closefile(f1);
closefile(f2);

Anatoly Podgoretsky   (2007-08-24 16:21:00) [17]

Да запятые тут не помогут и гуда всталять

clickmaker   (2007-08-24 16:10:00) [18]


> [8] Anatoly Podgoretsky ©   (24.08.07 15:27)

Анатолий, Ваша нелюбовь к запятым иногда выдает забавные фразы ) иногда даже с эротическим уклоном )

Anatoly Podgoretsky   (2007-08-24 15:27:00) [19]

Он уже вставил и не работает.

max_   (2007-08-24 15:20:00) [20]

не слушай, что тебе говорят, вставляй этот код и не парься!

Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо