Форум программистов [Powered by Invision Power Board]

Код


procedure Encrypt(in_,out_:TFileName;CPROV:CurrentPar;PassWD:String);
var inp_file,out_file:file;
    pbBuffer:PByte;
    dwBlockLen:DWORD;
    dwBufferLen:DWORD;
    dwCount:DWORD;
    hash: DWORD;
    hKey :DWORD;
begin
            CryptCreateHash(CPROV.cProvContext, CPROV.cAlg_HS.aiAlgid, 0, 0, @hash);
            CryptHashData(hash, @passWD, length(PassWD), 0);
            CryptDeriveKey(CPROV.cProvContext, CPROV.cAlg_EN.aiAlgid, hash, 0, @hkey);

            AssignFile(inp_file,in_);
            AssignFile(out_file,out_);
            Reset(inp_file,1);
            Rewrite(out_file,1);
            dwBlockLen:=1000 - 1000 mod ENCRYPT_BLOCK_SIZE;
            if AlgTypeToStr(CurPar.cAlg_EN.aiAlgid)<>'поточный' then
            dwBufferLen:=dwBlockLen+ENCRYPT_BLOCK_SIZE else
            dwBufferLen:=dwBlockLen;
            GetMem(pbBuffer,dwBufferLen);
            while not Eof(inp_file) do
              begin
              BlockRead(inp_file,pbBuffer^,dwBlockLen,dwCount);
              if CryptEncrypt(hkey,0,eof(inp_file),0,pbBuffer,@dwCount,dwBufferLen) then
              BlockWrite(out_file,pbBuffer^,dwCount) else
              ShowErrorMes(GetLastError);
              end;
             FreeMem(pbBuffer);
             CloseFile(inp_file);
             CloseFile(out_file);
             CryptDestroyKey(hkey);
             CryptDestroyHash(hash);

end;

Код


procedure Decrypt(in_,out_:TFileName;CPROV:CurrentPar;PassWD:String);
var inp_file,out_file:file;
    pbBuffer:PByte;
    dwBlockLen:DWORD;
    dwBufferLen:DWORD;
    dwCount:DWORD;
    hash: DWORD;
    hKey :DWORD;
begin
            CryptCreateHash(CPROV.cProvContext, CPROV.cAlg_HS.aiAlgid, 0, 0, @hash);
            CryptHashData(hash, @passWD, length(PassWD), 0);
            CryptDeriveKey(CPROV.cProvContext, CPROV.cAlg_EN.aiAlgid, hash, 0, @hkey);

            AssignFile(inp_file,in_);
            AssignFile(out_file,out_);
            Reset(inp_file,1);
            Rewrite(out_file,1);
            dwBlockLen:=1000 - 1000 mod ENCRYPT_BLOCK_SIZE;
            dwBufferLen:=dwBlockLen;
            GetMem(pbBuffer,dwBufferLen);
            while not Eof(inp_file) do
              begin
              BlockRead(inp_file,pbBuffer^,dwBlockLen,dwCount);
              if CryptDecrypt(hkey,0,eof(inp_file),0,pbBuffer,@dwCount) then
              BlockWrite(out_file,pbBuffer^,dwCount) else
              ShowErrorMes(GetLastError);
              end;
             FreeMem(pbBuffer);
             CloseFile(inp_file);
             CloseFile(out_file);
             CryptDestroyKey(hkey);
             CryptDestroyHash(hash);
end;
end.

Код

unit crypter;

interface

uses Windows, SysUtils, Classes, WinCrypt;

type
  TCrypter = class
  private
    hProv: HCRYPTPROV;   // криптопровайдер
    hSKey: HCRYPTKEY;    // сессионный ключ
    FAlg:  ALG_ID;       // алгоритм
    function FileOp(SrcFile, DstFile: string; en: boolean): boolean;
  public
    function EncryptFile(SrcFile, DstFile: string): boolean;
    {* Шифровать файл }
    function DecryptFile(SrcFile, DstFile: string): boolean;
    {* Расшифровать файл }
    procedure Encrypt(Buf: PByte; var BufLen: DWORD);
    {* Шифрует данные }
    procedure Decrypt(Buf: PByte; var BufLen: dword);
    {* Дешифрует данные }
    constructor Create(Alg: ALG_ID; pass: string);
    {* Конструктор. На входе алгоритм и ключ }
  end;

implementation

const BufSize = $10000;

constructor TCrypter.Create(Alg: ALG_ID; pass: string);
var
  hash: HCRYPTHASH;
begin
  inherited Create;
  FAlg := Alg;
  CryptAcquireContext(@hProv, nil, nil, PROV_RSA_FULL, CRYPT_VERIFYCONTEXT);
  CryptCreateHash(hProv, CALG_SHA, 0, 0, @hash);
  CryptHashData(hash, pointer(pass), length(pass), 0);
  CryptDeriveKey(hProv, Alg, hash, 0, @hSKey);
  CryptDestroyHash(hash);
end;

function TCrypter.FileOp(SrcFile, DstFile: string; en: boolean): boolean;
var
  fs, fd: TFileStream;
  p:      PByte;
  sz:     dword;
begin
  result := false;
  if not FileExists(SrcFile) then Exit;
  try fs := TFileStream.Create(SrcFile, fmOpenRead or fmShareDenyWrite);
    try fd := TFileStream.Create(DstFile, fmCreate or fmShareDenyWrite);
      try GetMem(p, BufSize);
        try
          repeat
            sz := BufSize; sz := fs.Read(p^, sz);
            if en then Encrypt(p, sz) else Decrypt(p,sz);
            fd.Write(p^, sz);
          until sz < BufSize;
          result := true;
        finally FreeMem(p, BufSize) end;
      finally fd.Free; end;
    finally fs.Free; end;
  except end;
end;

function TCrypter.EncryptFile(SrcFile, DstFile: string): boolean;
begin
  result := FileOp(SrcFile, DstFile, true);
end;

function TCrypter.DecryptFile(SrcFile, DstFile: string): boolean;
begin
  result := FileOp(SrcFile, DstFile, false);
end;

procedure TCrypter.Encrypt(Buf: PByte; var BufLen: DWORD);
begin
  if BufLen > 0 then
    AssErt(CryptEncrypt(hSKey, 0, true, 0, Buf, @BufLen, BufSize));
end;

procedure TCrypter.Decrypt(Buf: PByte; var BufLen: dword);
begin
  if BufLen > 0 then
    AssErt(CryptDecrypt(hSKey, 0, true, 0, Buf, @BufLen), 'Decrypt Error');
end;

end.

Код

uses Crypter, WinCrypt;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with TCrypter.Create(CALG_RC2, 'Top Secret') do
  begin
    if not EncryptFile('C:\1.txt', 'C:\1.enc') then
      ShowMessage('Encryption Error');
    Free;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  with TCrypter.Create(CALG_RC2, 'Top Secret') do
  begin
    if not DecryptFile('C:\1.enc', 'C:\1.txt') then
      ShowMessage('Decryption Error');
    Free;
  end;
end;