| Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
ProgressBar1: TProgressBar;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// криптоблок
const
bsz = 65532;
ADVAPI32 = 'advapi32.dll';
PROV_RSA_FULL = 1;
SIMPLEBLOB = $1;
CRYPT_VERIFYCONTEXT = $F0000000;
CALG_RC4 = ((3 shl 13) or (4 shl 9) or 1);
CALG_SHA = ((4 shl 13) or 0 or 4);
type
HCRYPTPROV = ULONG;
HCRYPTKEY = ULONG;
ALG_ID = ULONG;
PHCRYPTPROV = ^HCRYPTPROV;
PHCRYPTKEY = ^HCRYPTKEY;
LPAWSTR = PWideChar;
HCRYPTHASH = ULONG;
PHCRYPTHASH = ^HCRYPTHASH;
function CryptAcquireContext(Prov:PHCRYPTPROV;Container:LPAWSTR;Provider:LPAWSTR;ProvType:DWORD;Flags:DWORD):BOOL;stdcall;external ADVAPI32 name 'CryptAcquireContextW';
function CryptCreateHash(Prov:HCRYPTPROV;Algid:ALG_ID;Key:HCRYPTKEY;Flags:LongInt;Hash:PHCRYPTHASH):BOOL;stdcall;external ADVAPI32 name 'CryptCreateHash';
function CryptHashData(Hash:HCRYPTHASH;Data:PBYTE;DataLen :LongInt;Flags:LongInt):BOOL;stdcall;external ADVAPI32 name 'CryptHashData';
function CryptDeriveKey(Prov:HCRYPTPROV;Algid:ALG_ID;BaseData:HCRYPTHASH;Flags:LongInt;Key:PHCRYPTKEY) :BOOL;stdcall;external ADVAPI32 name 'CryptDeriveKey';
function CryptDestroyHash(hHash :HCRYPTHASH) :BOOL;stdcall;external ADVAPI32 name 'CryptDestroyHash';
function CryptReleaseContext(hProv:HCRYPTPROV;dwFlags:DWORD):BOOL;stdcall;external ADVAPI32 name 'CryptReleaseContext';
function CryptEncrypt(Key:HCRYPTKEY;Hash:HCRYPTHASH;Final:BOOL;Flags:DWORD;Data:PBYTE;Len:PDWORD;BufLen:DWORD):BOOL;stdcall;external ADVAPI32 name 'CryptEncrypt';
function CryptDecrypt(Key:HCRYPTKEY;Hash:HCRYPTHASH;Final:BOOL;Flags:DWORD;Data:PBYTE;Len:PDWORD):BOOL;stdcall;external ADVAPI32 name 'CryptDecrypt';
var
hProv: HCRYPTPROV;
hSKey: HCRYPTKEY;
procedure Init(Password: string);
var
hash: HCRYPTHASH;
begin
CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
CryptCreateHash(hProv, CALG_SHA, 0, 0, @hash);
CryptHashData(hash, @Password[1], length(Password), 0);
CryptDeriveKey(hProv, CALG_RC4, hash, 0, @hSKey);
CryptDestroyHash(hash);
end;
procedure Done;
begin
CryptReleaseContext(hProv, 0);
end;
procedure Process(InFile, OutFile, Password: string; Crypt: boolean);
var
fs,fd: TFileStream;
s: string;
sz: dword;
begin
SetLength(s, bsz); Init(Password);
try
fs := TFileStream.Create(InFile, $40);
fd := TFileStream.Create(OutFile, $FFFF);
Form1.ProgressBar1.Max := fs.Size div bsz;
try
repeat
sz := fs.Read(s[1], bsz);
if Crypt then CryptEncrypt(hSKey, 0, (sz < bsz), 0, pointer(s), @sz, sz)
else CryptDecrypt(hSKey, 0, (sz < bsz), 0, pointer(s), @sz);
fd.Write(s[1], sz);
Form1.ProgressBar1.Position := fs.Position div bsz;
until sz < bsz;
finally
fs.Free; fd.Free;
end;
finally
Done;
end;
end;
procedure Crypt(InFile, OutFile, Password: string);
begin
Process(InFile, OutFile, Password, true);
end;
procedure Decrypt(InFile, OutFile, Password: string);
begin
Process(InFile, OutFile, Password, false);
end;
// Кончился криптоблок
// Батоны:
procedure TForm1.Button1Click(Sender: TObject);
begin
Crypt('C:\1.dat', 'C:\2.dat', 'VerySecretPassword'); // шифруем
ShowMessage('Зашифровано!');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Decrypt('C:\2.dat', 'C:\3.dat', 'VerySecretPassword'); // расшифровываем
ShowMessage('Расшифровано!');
end;
end.
|
|
