Форум программистов, компьютерный форум, киберфорум
Free Pascal
Форум программистов и сисадминов Киберфорум > Форум программистов > Pascal (Паскаль) > Free Pascal
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Социальные группы Поиск Сообщения за день Заказать работу  
 
Рейтинг 4.65/40: Рейтинг темы: голосов - 40, средняя оценка - 4.65
0 / 0 / 0
Регистрация: 10.03.2016
Сообщений: 45
1

Поиск файла по контрольной сумме (хэшу)

16.03.2016, 21:47. Показов 8306. Ответов 13
Метки хеши (Все метки)
Author24 — интернет-сервис помощи студентам
нужно написать программу, которая ищет файл по хэшу, использовать алгоритм CRC32
нам известен хэш файла, который нужно найти в папке среди других файлов
никак не могу найти алгоритм на паскале, кто знает?
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 16.03.2016, 21:47
Ответы с готовыми решениями:

Поиск по хэшу
Помогите сделать поиск фалов по MD5. Или может у кого исходники какие есть?

Восстановить загрузочный диск по контрольной сумме
Есть диск с Windows 10, но он поврежден. Хочу скачать образ iso этого диска с сети. Нужен именно...

При копировании ошибка в контрольной сумме
Здравствуйте. Проблемы начались после полного апгрейда компьютера. От старого компа остался...

Выполнить поиск файла в определённой дериктории по его MD5 сумме
Здравствуйте: как на си шарпе выполнить поиск файла в определённой дериктории по его мд 5 сумме?...

13
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
32830 / 21168 / 8147
Регистрация: 22.10.2011
Сообщений: 36,428
Записей в блоге: 8
16.03.2016, 22:14 2
Алгоритм чего не можешь найти? Вычисления CRC32 для файла? Так в FPC есть модуль CRC (в папке \units\{target}\hash), который этим занимается. В его исходниках даже пример использования есть:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

{  Update a running crc with the bytes buf[0..len-1] and return the updated
   crc. If buf is NULL, this function returns the required initial value
   for the crc. Pre- and post-conditioning (one's complement) is performed
   within this function so it shouldn't be done by the application.
   Usage example:
 
    var
      crc : cardinal;
    begin
      crc := crc32(0, nil, 0);
 
      while (read_buffer(buffer, length) <> EOF) do
        crc := crc32(crc, buffer, length);
 
      if (crc <> original_crc) then error();
    end;
 
}
0
0 / 0 / 0
Регистрация: 10.03.2016
Сообщений: 45
17.03.2016, 20:21  [ТС] 3
volvo, да, именно этот алгоритм.

Добавлено через 27 минут
volvo, но я всё-таки не понимаю как его реализовать, если известна контрольная сумма?
0
Модератор
Эксперт Pascal/DelphiЭксперт NIX
7769 / 4598 / 2823
Регистрация: 22.11.2013
Сообщений: 13,076
Записей в блоге: 1
17.03.2016, 21:32 4
Перебираете файлы, для каждого считаете контрольную сумму, сравниваете с заданной. Как совпало -- значит нашли.
0
0 / 0 / 0
Регистрация: 10.03.2016
Сообщений: 45
17.03.2016, 21:35  [ТС] 5
bormant, это я понимаю, но как написать код не знаю
можете хотя бы примерно написать?
0
318 / 208 / 162
Регистрация: 08.12.2015
Сообщений: 863
17.03.2016, 21:44 6
Тут , видимо, нужно еще процедуру взятия 4-х байтного кода делать. Чтобы место поиска было определенным. Вам давали код поиска всех файлов, вот на его основе что то ..Еще не брался.

Добавлено через 6 минут
Prostochelovek, у вас откуда такие задачи то?
0
0 / 0 / 0
Регистрация: 10.03.2016
Сообщений: 45
17.03.2016, 21:52  [ТС] 7
capricornus CF, не поверите) в универе задают
0
318 / 208 / 162
Регистрация: 08.12.2015
Сообщений: 863
17.03.2016, 23:18 8
Лучший ответ Сообщение было отмечено Prostochelovek как решение

Решение

Я по образованию физрук. Поэтому, я не смогу точно объяснить как работает программа (не изучил я указатели еще). Модуль crc32 нашел в сети:
Сама программа (на известной вам основе):
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

Uses DOS,crc32;
var
  scanF: file of byte;
  block:byte;
  s:searchRec;
  CurDir,path,mask:string;
  hash:LongWord;
  z:integer;
 
Procedure FileFind(Dir,FindName : PathStr);
 Procedure SearchDir(Dir : PathStr);
 Var
   SRec:SearchRec;
 begin
   if Dir[Length(Dir)] <> '\' then Dir := Dir+'\';
   FindFirst(Dir + FindName, AnyFile, SRec);
   While DosError = 0 do
     begin
       With SRec do
        if Attr and (VolumeID + Directory) = 0 then
         if GetCRC(Dir + Name)=hash then
          writeln (Dir + Name,'- crc match is found');
        FindNext(SRec);
     end;
   FindFirst(Dir+'*.*', Directory or ReadOnly or Hidden or SysFile, SRec);
   While DosError = 0 do
     begin
       With SRec do
        if (Attr and Directory <> 0) and (Name[1] <> '.')  then
         SearchDir(Dir+Name);
       FindNext(SRec);
     end;
 end;
 
begin
 SearchDir(Dir);
end;
 
begin
repeat
  writeln('1) Take crc from file, 2) Find crc, 0) exit');
  readln(z);
  case z of
  1:begin
      writeln('Enter full path with filename');
      readln(path);
      hash:=GetCRC(path);
      writeln(hash);
    end;
  2:begin
      writeln('Enter full path ');
      readln(path);
      writeln('Enter mask or filemame with extention ');
      readln(mask);
      FileFind(path,mask);
    end;
    end;
until z=0;
end.
Юнит к ней:
Кликните здесь для просмотра всего текста
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135

Unit Crc32;
INTERFACE
Function  GetCRC(Const Name: string): LongWord;
Function  CalcCRC(Const s: String): LongWord;
Function  CRCstring2Num(Const f: string): LongWord;
 
IMPLEMENTATION
 
Uses Crt;
 
CONST crc_32_tab: ARRAY[0..255] OF cardinal = (
$00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535,$9e6495a3,
$0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07,$90bf1d91,
$1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551,$83d385c7,
$136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63,$8d080df5,
$3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd,$a50ab56b,
$35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf,$abd13d59,
$26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599,$b8bda50f,
$2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab,$b6662d3d,
$76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5,$e8b8d433,
$7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97,$e6635c01,
$6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1,$f50fc457,
$65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3,$fbd44c65,
$4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d,$d3d6f4fb,
$4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f,$dd0d7cc9,
$5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409,$ce61e49f,
$5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b,$c0ba6cad,
$edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615,$73dc1683,
$e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27,$7d079eb1,
$f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671,$6e6b06e7,
$fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43,$60b08ed5,
$d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd,$48b2364b,
$d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef,$4669be79,
$cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9,$5505262f,
$c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b,$5bdeae1d,
$9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785,$05005713,
$95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7,$0bdbdf21,
$86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1,$18b74777,
$88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3,$166ccf45,
$a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d,$3e6e77db,
$aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f,$30b5ffe9,
$bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729,$23d967bf,
$b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b,$2d02ef8d);
 
Function GetCRC(Const Name: string): longword;
 
  (* This function returns the 32 bit CRC of a filename. It will return *)
  (* a -1 if the file could not be found or opened.                     *)
 
  Const Size = 4096;
  Type  Buffer = Array[1..Size] of Byte;
 
  var f  : file;
      crc: longword;
      Buf: ^Buffer;
      {$IFDEF OS2}
      nr : longint;
      {$ELSE}
      nr : word;
      {$ENDIF}
      Cnt: word;
      IO : word;
 
  begin
    crc := $FFFFFFFF;
    New(Buf);
 
    assign(f,Name);
    {$I-} reset(f,1); {$I+}
    IO := IOresult;
    If IO = 162 then
    begin
      cnt := 0;
      While (Cnt < 10) and (IO = 162) do
      begin
        inc(Cnt);
        Delay(10);
        {$I-} Reset(f,1); {$I+}
        IO := IOresult;
      end;
    end;
    If IO = 0 then
    begin
      Blockread(f,Buf^,Size,Nr);
      while (nr > 0) do
      begin
        For cnt := 1 to nr do
          Crc := crc_32_tab[byte(crc xor longint(Buf^[Cnt]))] xor ((crc shr 8) and $00FFFFFF);
        Blockread(f,Buf^,Size,Nr);
      end;
      close(f);
      Crc := not Crc;
    end;
    GetCRC := Crc;
    Dispose(Buf);
  end;
 
Function CalcCRC(Const s: string): LongWord;
 
  (* This function will return the 32 bit CRC of a string *)
 
  var crc: cardinal;
      Cnt: word;
 
  begin
    crc := $FFFFFFFF;
 
    For cnt := 1 to Length(s) do
      Crc := crc_32_tab[byte(crc xor longint(s[Cnt]))] xor ((crc shr 8) and $00FFFFFF);
 
    CalcCRC := -(Crc+1);
  end;
 
Function CRCstring2Num(Const f: string): LongWord;
 
  (* This function will convert a hexidecimal representation of a 32 bit *)
  (* CRC to a numerical value                                            *)
 
  var CRC: Longint;
      Cnt: Longint;
      Weight: Longint;
 
  begin
    CRC := 0;
 
    For cnt := 8 downto 1 do
    begin
      Weight := 1 shl ((8-cnt)*4);
      If f[cnt] > #57 then
        CRC := CRC + Weight*(Ord(f[cnt])-55) else
        CRC := CRC + Weight*(Ord(f[cnt])-48);
    end;
    CRCstring2Num := Crc;
  end;
end.

все вместе , надеюсь, сможете собрать.
1
0 / 0 / 0
Регистрация: 10.03.2016
Сообщений: 45
18.03.2016, 21:24  [ТС] 9
capricornus CF, собрать всё вместе получилось. Я правильно понимаю? строка 41 - надо ввести хэш, например $А158AE1B, строка 45 - ввести путь с именем файла???
0
318 / 208 / 162
Регистрация: 08.12.2015
Сообщений: 863
18.03.2016, 21:38 10
при выборе 1) - введите полный путь и имя файла с расширением (чтобы взять из него crc)
второй раз выбираем 2) введите путь, потом введите маску (*.* или а*.* или *.exe или имя с расширением целиком)
вроде все. crc берется в десятичной сс, можете перевести в hex
0
0 / 0 / 0
Регистрация: 10.03.2016
Сообщений: 45
18.03.2016, 21:47  [ТС] 11
capricornus CF, всё понятно. Спасибо большое! долго доходит просто...
0
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
32830 / 21168 / 8147
Регистрация: 22.10.2011
Сообщений: 36,428
Записей в блоге: 8
19.03.2016, 04:52 12
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

Зачем же сторонние модули, если есть встроенный:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

uses DOS, CRC;
 
function GetCRC(s : string) : cardinal;
var
  buffer : array[0 .. 8191] of byte;
  len : integer;
  f : file;
begin
  assign(f, s); reset(f, 1);
  result := crc32(0, nil, 0);
  repeat
    BlockRead(F, buffer, Sizeof(buffer), len);
    result := crc32(result, @buffer, len);
  until len = 0;
  close(f);
end;
 
// ... дальше без изменений
При подсчете CRC для больших файлов эта функция выигрывает в скорости у функции из модуля CRC32 (использованной в предыдущем коде)
0
318 / 208 / 162
Регистрация: 08.12.2015
Сообщений: 863
19.03.2016, 10:23 13
Не сообразил, что модуль родной есть.
0
318 / 208 / 162
Регистрация: 08.12.2015
Сообщений: 863
21.03.2016, 16:50 14
Лучший ответ Сообщение было отмечено Памирыч как решение

Решение

В IDE Free Pascal работает в режиме Delphi или ObjFPC. В системных папках ищет тоже.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82

{$mode Delphi}
Uses DOS,crc;
var
  scanF: file of byte;
  block:byte;
  s:searchRec;
  CurDir,path,mask:string;
  hash:LongWord;
  z:integer;
 
function GetCRC(s : string) : cardinal;
var
  bufer:array[0 .. 8191] of byte;
  len : integer;
  f : file;
  IO:byte;
begin
  assign(f, s);
  {$I-} filemode:=0;reset(f,1); {$I+}
  IO := IOresult;
  if IO=0 then
  begin
    result := crc32(0, nil, 0);
     repeat
      BlockRead(F, bufer, Sizeof(bufer), len);
      result:= crc32(result, @bufer, len);
     until len = 0;
    close(f);
  end;
  GetCRC:=result;
end;
 
Procedure FileFind(Dir,FindName : PathStr);
 Procedure SearchDir(Dir : PathStr);
 Var
   SRec:SearchRec;
 begin
   if Dir[Length(Dir)] <> '\' then Dir := Dir+'\';
   FindFirst(Dir + FindName, AnyFile, SRec);
   While DosError = 0 do
     begin
       With SRec do
        if Attr and (VolumeID + Directory) = 0 then
         if GetCRC(Dir + Name)=hash then
          writeln (Dir + Name,' - CRC match found!!!');
        FindNext(SRec);
     end;
   FindFirst(Dir+'*.*', Directory or ReadOnly or Hidden or SysFile, SRec);
   While DosError = 0 do
     begin
       With SRec do
        if (Attr and Directory <> 0) and (Name[1] <> '.')  then
         SearchDir(Dir+Name);
       FindNext(SRec);
     end;
 end;
 
begin
 SearchDir(Dir);
end;
 
begin
repeat
  writeln('1) Take CRC from file',#10,#13,'2) CRC search',#10,#13,'0) exit');
  readln(z);
  case z of
  1:begin
      writeln('Enter full path with filename');
      readln(path);
      hash:=GetCRC(path);
      writeln(hash);
    end;
  2:begin
      writeln('Enter full path ');
      readln(path);
      writeln('Enter mask or filemame with extention ');
      readln(mask);
      FileFind(path,mask);
    end;
    end;
until z=0;
end.
0
21.03.2016, 16:50
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 21.03.2016, 16:50
Помогаю со студенческими работами здесь

Расчет контрольной суммы файла
Доброе время суток! не когда не работал с контрольными суммами, не подскажите библиотеку или...

Подсчёт контрольной суммы файла
Форумчане,добрый вечер! такой вопрос:не могли бы вы написать примерный код(Си),благодаря которому...

Подсчет контрольной суммы файла
Подсчет контрольной суммы файла (суммы байт по модулю 256). Нить считывает участок файла и считает...

Расчет контрольной суммы файла
Доброго времени, форумчане. Подскажите, пожалуйста, примеры расчета контрольной суммы файла....


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
14
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru