SHA1 (Контрольна сума). ВихКод. Дельфі
SHA1 (Контрольна сума). ВихКод. Дельфі
Страница: 1
Сообщений 1 страница 4 из 4
Поделиться22023-03-13 07:12:48
sha.dpr
Код:
program sha;
uses
Forms,
main in 'main.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.Поделиться32023-03-13 07:13:12
main.pas
Код:
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls,
Dialogs;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
BStop: TButton;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure BStopClick(Sender: TObject);
private { Private declarations }
public { Public declarations }
end;
var
Form1: TForm1;
// - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
const
HC0=$67452301;
HC1=$EFCDAB89;
HC2=$98BADCFE;
HC3=$10325476;
HC4=$C3D2E1F0;
K1=$5A827999;
K2=$6ED9EBA1;
K3=$8F1BBCDC;
K4=$CA62C1D6;
var H0,H1,H2,H3,H4:integer; Hout:string; //Hout - результат
StopScan:boolean;
implementation
{$R *.DFM}
function rol(const x:integer;const y:byte):integer ; //сдвиг числа x на y бит влево
begin
asm
mov eax,x
mov cl, y
rol eax,cl
mov x, eax
end;
result:=x;
end;
procedure INIT; //Инициализация - присвоить пересенным значения констант
begin
H0:=HC0;//$67452301;
H1:=HC1;//$EFCDAB89;
H2:=HC2;//$98BADCFE;
H3:=HC3;//$10325476;
H4:=HC4;//$C3D2E1F0;
Hout:='';
end;
function PADDING(s:string;FS:integer):string; //добавление одного бита (1000000=128) и добавление нулей до кратности 64 байтам
var size,i:integer;
begin
size:=Length(s)*8; //size -входной размер в битах
s:=s+char(128); //добавление одного бита (1000000=128)
while (Length(s) mod 64) <>0 do s:=s+#0; //добавление нулей до кратности 64 байтам
//############ ############# // IF ((size) >= 448) then // OLD
IF ((size mod 512) >= 448) then // если хвост превышает 48 байт то добавить пустой блок из 64 нулей
begin
s:=s+#0; //добавление нулей до кратности 64
while (Length(s) mod 64) <>0 do s:=s+#0;
end;
i:=Length(s);size:=FS*8;
while size > 0 do //запись в конец строки её размер
begin
s[i]:=char(byte(size)); //получение младшего байта
size:=size shr 8; //сдвиг вправо на 8 бит - перенос старшего байта на место младшего
i:=i-1;
end;
Result:=s;
end;
Procedure START(const S_IN:string);
var A,B,C,D,E,TEMP:integer; t,i:byte; W:array[0..79] of integer;
begin
t:=1;
for i:=1 to ((Length(S_IN)) div 4) do
begin
// W[i-1]:=ord(S_IN[t])*256*256*256+ord(S_IN[t+1])*256*256+ord(S_IN[t+2])*256+ord(S_IN[t+3]);
W[i-1]:=(ord(S_IN[t]) shl 24) +(ord(S_IN[t+1]) shl 16)+(ord(S_IN[t+2]) shl 8)+ord(S_IN[t+3]);
t:=t+4;
end;
For t:=16 to 79 do W[t]:=ROL(W[t-3] XOR W[t-8] XOR W[t-14] XOR W[t-16],1);
A:=H0;B:=H1;C:=H2;D:=H3;E:=H4;
{ for t:=0 to 79 do // Разделить на 4 цикла !!! * * * * * * * * * * * * * * *
begin
if (t>=0) AND (t<=19) then TEMP:=ROL(A,5)+((B AND C) OR ((NOT B) AND D)) +E+K1+W[t];
if (t>=20) AND (t<=39) then TEMP:=ROL(A,5)+(B XOR C XOR D) +E+K2+W[t];
if (t>=40) AND (t<=59) then TEMP:=ROL(A,5)+((B AND C) OR (B AND D) OR (C AND D))+E+K3+W[t];
if (t>=60) AND (t<=79) then TEMP:=ROL(A,5)+(B XOR C XOR D) +E+K4+W[t];
E:=D; D:=C; C:=ROL(B,30); B:=A; A:=TEMP;
end;
}
for t:=0 to 19 do
begin
TEMP:=ROL(A,5)+((B AND C) OR ((NOT B) AND D)) +E+K1+W[t];
E:=D; D:=C; C:=ROL(B,30); B:=A; A:=TEMP;
end;
for t:=20 to 39 do
begin
TEMP:=ROL(A,5)+(B XOR C XOR D) +E+K2+W[t];
E:=D; D:=C; C:=ROL(B,30); B:=A; A:=TEMP;
end;
for t:=40 to 59 do
begin
TEMP:=ROL(A,5)+((B AND C) OR (B AND D) OR (C AND D))+E+K3+W[t];
E:=D; D:=C; C:=ROL(B,30); B:=A; A:=TEMP;
end;
for t:=60 to 79 do
begin
TEMP:=ROL(A,5)+(B XOR C XOR D) +E+K4+W[t];
E:=D; D:=C; C:=ROL(B,30); B:=A; A:=TEMP;
end;
H0:=A+H0; H1:=B+H1; H2:=C+H2; H3:=D+H3; H4:=E+H4;
//Form1.memo1.Lines.Add(inttohex(H0,8)+' '+inttohex(H1,8)+' '+inttohex(H2,8)+' '+inttohex(H3,8)+' '+inttohex(H4,8));
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WindowState:=wsMaximized;
Form1.Memo1.Clear;
Button2.Enabled:=false ;
Form1.SaveDialog1.Filter := 'Text Files (*.txt)|*.TXT|All Files (*.*)|*.*';
CheckBox1.Checked:=true;
CheckBox2.Checked:=true;
Application.Title:='SHA-1';
Caption:='SHA-1';
end;
procedure Work(Z:string);
var s,s1:string; i,L,FS:integer; F:file; n:integer; Buf: array[1..65536] of char;
begin
Application.ProcessMessages;
IF StopScan then exit;
s:='';
AssignFile(F,Z);
FileMode := FmOpenRead;
Reset(F,1);
FS:=FileSize(F);
INIT;
repeat
BlockRead(F,Buf,sizeOf(Buf),n);
SetLength(s1,n);
For i:=1 to n do s1[i]:=Buf[i];
// s:=s+s1;
s:=s1;
L:=length(s1);
IF ((L<65536) and (L>0)) then
begin
s1:= PADDING(s,FS) ;
i:=1;
L:=length(s1);
while i<L do
begin
START(copy(s1,i,64));
i:=i+64;
end;
end;
IF L =65536 then begin
i:=1;
L:=length(s1);
while i<L do
begin
START(copy(s1,i,64));
i:=i+64;
end;
end;
until n=0;
CloseFile(F);
{
INIT;
s:=PADDING(s,FS) ;
L:=length(s);
i:=1;
while i<L do
begin
START(copy(s,i,64));
i:=i+64;
end;
}
Hout:=inttohex(H0,8)+' '+inttohex(H1,8)+' '+inttohex(H2,8)+' '+inttohex(H3,8)+' '+inttohex(H4,8);
s1:=Hout;
If (Form1.CheckBox1.Checked AND Form1.CheckBox2.Checked) then
Form1.memo1.Lines.Add(s1+' '+inttostr(FS)+' '+ExtractFileName(Z));
If NOT ((Form1.CheckBox1.Checked AND Form1.CheckBox2.Checked)) then
Form1.memo1.Lines.Add(s1);
If (Form1.CheckBox1.Checked AND NOT Form1.CheckBox2.Checked) then
Form1.memo1.Lines.Add(s1+' '+inttostr(FS));
If (NOT Form1.CheckBox1.Checked AND Form1.CheckBox2.Checked) then
Form1.memo1.Lines.Add(s1+' '+ExtractFileName(Z));
// abc.....opq = 84983E44 1C3BD26E BAAE4AA1 F95129E5 E54670F1
// abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnopqW = 39958831d7dd0a53e9bfba578cdf45e5ec542e8c
//abc = A9993E36 4706816A BA3E2571 7850C26C 9CD0D89D;
//abcdbcdecdefdefgefghfghighijhijkijkljklmklmnlmnomnopnop = 47B17281 0795699F E739197D 1A1F5960 700242F1
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Form1.OpenDialog1.Execute then
begin
StopScan:=false;
Work(OpenDialog1.FileName);
Button2.Enabled:=true;
end;
end;
Function ScanDir(Dir:string):string;
var SearchRec:TSearchRec; //scan_result :string;
begin
Application.ProcessMessages;
IF StopScan then exit;
if Dir<>'' then if Dir[length(Dir)]<>'\' then Dir:=Dir+'\';
if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then
repeat
if (SearchRec.name='.') or (SearchRec.name='..') then continue;
if ( (SearchRec.Attr and faDirectory)<>0) then
begin
IF Form1.CheckBox3.Checked then ScanDir(Dir+SearchRec.name)
end
else Work(Dir+SearchRec.name);
until FindNext(SearchRec)<>0;
FindClose(SearchRec);
end;
procedure TForm1.Button2Click(Sender: TObject); //Scan Button pressed
begin
IF Button2.Enabled=false then exit;
StopScan:=false;
Caption:='Scanning ...';
ScanDir(ExtractFileDir(Form1.OpenDialog1.FileName));
Caption:='SHA-1';
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Memo1.Height:=Height-70;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
If SaveDialog1.Execute then
begin
If FileExists(SaveDialog1.FileName) then
IF MessageDlg('File'+#13+SaveDialog1.FileName+#13+'already exists!'
+#13+#13+'Overwrite (Yes/No) ?',mtWarning, [mbYes, mbNo], 0) = mrNo then exit;
Memo1.Lines.SaveToFile(SaveDialog1.FileName);
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Form1.Memo1.Clear;
end;
procedure TForm1.BStopClick(Sender: TObject);
begin
StopScan:=true;
end;
end.
Поделиться42023-03-13 07:18:32
Приклад підрахунку файлів:
356A192B 7913B04C 54574D18 C28D46E6 395428AB 1 1
DA4B9237 BACCCDF1 9C0760CA B7AEC4A8 359010B0 1 2
77DE68DA ECD823BA BBB58EDB 1C8E14D7 106E83BB 1 3
C9601583 B503A219 80289035 9D378587 AAACB0C9 11277 main.dcu
F82D42E0 0B48EDFB 9B24B107 1D72A165 E5858E80 1104 sha.dof
31E6C11C 1E5BE66C 170B6539 DBA4F8B5 95494580 179 sha.dpr
660F34B6 A1B1550A 88785E72 D6B0E8D3 1E35E87F 766 sha.ico
959BF4D9 4EB8D6E7 CE8491AB D9E209C8 2561F4B0 876 sha.res
16B6D533 4E694D52 5E5AD218 57AEC9E4 588180F4 415232 sha.exe
3098E3D9 3390DABA 42BC0533 D4EC2A96 FB90EA20 31 !.txt
59EF96B5 F80B9029 BC7AE96B F37FA0C6 365EB588 9041 main.pas
E3340503 719077A4 7E17FF3A 259424DC 89184659 2006 main.dfm
B307792A 846C82C8 1A8D62CB 7B5527A4 87021085 51 main.ddp
26C74709 B4A64DAB EB6475AC 88D78391 2C5B127C 7827 main.pas.cbk
Страница: 1