Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2007.09.16;
Скачать: [xml.tar.bz2];

Вниз

Сравнение файлов   Найти похожие ветки 

 
nikfel ©   (2007-08-24 12:10) [0]

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


 
@!!ex ©   (2007-08-24 12:13) [1]

Что конкретно не работает?


 
Riply ©   (2007-08-24 12:17) [2]

> [0] nikfel ©   (24.08.07 12:10)
Я бы выбросила эту функцию и попробовала бы написать свою. imho.


 
@!!ex ©   (2007-08-24 12:21) [3]

> [2] Riply ©   (24.08.07 12:17)

Да я тоже так подумал.
Но принципиально отличающееся не сделать. ВСе равно будет что-то сильно похожее на приведенное.


 
Riply ©   (2007-08-24 12:24) [4]

> [3] @!!ex ©   (24.08.07 12:21)
>Да я тоже так подумал.
>Но принципиально отличающееся не сделать.
За то, в ходе этого процесса(переписывания), узнаешь новые вещи и поймешь почему "не работает" :)


 
Игорь Шевченко ©   (2007-08-24 12:29) [5]

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


 
iXT ©   (2007-08-24 12:30) [6]

Соглашусь. Вставлять чужой код, да еще который не понимаешь как работает, в свой проект, бррррррррр.
ЗЫ В код сильно не углублялся, но по первому взгляду, читает, сравнивает..... Что конкретно не работает?
ЗЗЫ Написать подобную функцию автору будет весма полезно, даже если она будет типа:
f1,f2: file of byte
....
Read(f1, a1);
Read(f2, a2);
if a1 <> a2......
Потом перейдет к TFileStream
ЗЗЗЫ
 Почему Buf_Size=16384?


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

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


 
Anatoly Podgoretsky ©   (2007-08-24 15:27) [8]

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


 
clickmaker ©   (2007-08-24 16:10) [9]


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

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


 
Anatoly Podgoretsky ©   (2007-08-24 16:21) [10]

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


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

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

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);


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

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


 
clickmaker ©   (2007-08-24 16:37) [13]

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 при ошибках расставить - домашнее задание


 
iXT ©   (2007-08-24 16:50) [14]

> [11] max_   (24.08.07 16:22)

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


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


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

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


 
iXT ©   (2007-08-24 17:04) [16]

> [15] max_   (24.08.07 16:52)

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


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

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

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


 
iXT ©   (2007-08-24 17:25) [18]

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

Зачем?


 
Riply ©   (2007-08-24 17:28) [19]

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


 
clickmaker ©   (2007-08-24 17:30) [20]


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

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


 
iXT ©   (2007-08-24 17:32) [21]

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

:)


 
Riply ©   (2007-08-24 17:39) [22]

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


 
Leonid Troyanovsky ©   (2007-08-25 08:45) [23]


> Игорь Шевченко ©   (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.


 
sniknik ©   (2007-08-25 09:52) [24]

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


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


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

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

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

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

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

--
Regards, LVT.


 
Leonid Troyanovsky ©   (2007-08-25 10:41) [26]


> 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.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.09.16;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.53 MB
Время: 0.033 c
15-1186923739
textExpanser
2007-08-12 17:02
2007.09.16
Сверхбыстрое хэширование (hashing)


15-1187269943
Ega23
2007-08-16 17:12
2007.09.16
О корректном разрыве соединения с сервером БД


2-1188129926
nord489
2007-08-26 16:05
2007.09.16
Свойства Формы


2-1187615507
Poroshm
2007-08-20 17:11
2007.09.16
Проблема с MdiaPlayer


15-1187298274
Petr V. Abramov
2007-08-17 01:04
2007.09.16
дайте урок англицкого





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский