secdemomain.pas

StreamSec Security Library含有多种算法的控件

{***************************************************************
 *
 * Unit Name: SecDemoMain
 * Purpose  : Demonstration of StreamSec Security packages
 * Author   : Henrick Hellstr鰉, Copyright (c) 2001 StreamSec
 * History  : First version
 *
 ****************************************************************}

unit SecDemoMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, StreamSec, LarArith, DiffieHellman, SecUtils;

type
  TForm1 = class(TForm)
    StreamSec1: TStreamSec;
    GroupBox1: TGroupBox;
    edtPlainTextFile: TEdit;
    Label1: TLabel;
    Button1: TButton;
    Label2: TLabel;
    edtEncFile: TEdit;
    Button2: TButton;
    rgSymmetricEnc: TRadioGroup;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    btnGenA: TButton;
    btnGenB: TButton;
    Label4: TLabel;
    btnGenSRP: TButton;
    Label5: TLabel;
    edtDecFile: TEdit;
    Button3: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    SaveDialog2: TSaveDialog;
    rgKeyExch: TRadioGroup;
    btnNegotiate: TButton;
    btnEncrypt: TButton;
    btnDecrypt: TButton;
    procedure btnGenAClick(Sender: TObject);
    procedure btnGenSRPClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure btnNegotiateClick(Sender: TObject);
    procedure btnEncryptClick(Sender: TObject);
    procedure btnDecryptClick(Sender: TObject);
    procedure StreamSec1Auth(Sender: TObject; ValidOutPos: Integer;
      Success: Boolean);
    procedure StreamSec1CodeBuf(Sender: TObject; InStream,
      OutStream: TStream; Done: Boolean);
  private
    { Keys for MTI/C0. Normally, the private keys are generated on the fly
      from the password, or stored somewhere in encrypted form.}
    PrivA: TInteger2048; // TInteger2048 is declared in LarArith
    SaltA: string;
    PrivB: TInteger2048;
    SaltB: string;
    CertA: TCert;        // TCert is declared in DiffieHellman
    CertB: TCert;
    { Password verifier for SRP. The password verifier is kept by the server
      and should be stored somewhere safe.}
    SRPSaltA: string;
    PWVer: TInteger2048;
    { Symmetric encryption key. Normally generated on the fly and burned after
      it has been used. }
    Key: string;
  public
    // TCipherClass is declared in SecUtils
    function GetCipherClass: TCipherClass;
    procedure NegElGamal;
    procedure NegMTIC0;
    procedure NegSRP;
  end;

var
  Form1: TForm1;

implementation

uses
  PasswordMain, SteakRnd, Steak, Rijndael, TwoFish, Base64, LarBarret,
  LempelZiv;

{$R *.DFM}

procedure TForm1.btnGenAClick(Sender: TObject);
var
  PW, Salt: string;
  Priv: TInteger2048;
  Cert: TCert;
  IsA: Boolean;
begin
  IsA := Sender = btnGenA;

  { Firstly, prompt the user for a password: }
  // The PasswordDlg function is declared in PasswordMain
  if not PasswordDlg('Password for A''s MTI/C0 key',PW) then Exit;

  { Secondly, generate a random variable to diffuse the private key: }
  SetLength(Salt,16);
  // The SteakRandomBuf is declared in SteakRnd
  SteakRandomBuf(Salt[1],16);

  // Just to initialize the local variable:
  FillChar(Priv,SizeOf(Priv),0);

  { Thirdly, combine the password and the salt into a private key: }
  // The PasswordToPrivKey procedure is declared in DiffieHellman
  PasswordToPrivKey(PW,Salt,Priv[LarIntMaxSize - IntNorIndex],IntByteSize);

  { Fourthly, burn the password: }
  // The ProtectClear procedure is declared in SecUtils
  ProtectClear(PW[1],Length(PW));
              
  // Just to initialize the local variable:
  FillChar(Cert,SizeOf(Cert),0);

  { Fifthly, generate a public key: }
  // The PrivKeyToPublKey procedure is declared in DiffieHellman
  PrivKeyToPublKey(Priv[LarIntMaxSize - IntNorIndex],IntByteSize,Cert.PublKey,True);

  { Sixthly, build a certificate: }
  if IsA then
    Cert.Name := 'A'
  else
    Cert.Name := 'B';
  // The SignCertificate procedure is declared in DiffieHellman
  SignCertificate(Cert,nil,Priv);
  if IsA then begin
    PrivA := Priv;
    CertA := Cert;
    SaltA := Salt;
  end else begin   
    PrivB := Priv;
    CertB := Cert;
    SaltB := Salt;
  end;

  { Lastly, burn all sensitive local variables: }
  ProtectClear(Priv,SizeOf(Priv));
  ProtectClear(Salt[1],Length(Salt));
end;

procedure TForm1.btnGenSRPClick(Sender: TObject);
var
  PW: string;
  ServerSRP: TServerSRP; // TServerSRP is declared in DiffieHellman
begin
  { Firstly, prompt the user for a password: }
  // The PasswordDlg function is declared in PasswordMain
  if not PasswordDlg('SRP password for A',PW) then Exit;
  try
    { The TServerSRP class will automatically build a verifier and a salt,
      if a non-empty password is passed to the constructor: }
    ServerSRP := TServerSRP.Create(PW);
    try
      SRPSaltA := ServerSRP.Salt;
      PWVer := ServerSRP.V;
    finally
      ServerSRP.Free;
    end;
  finally
    ProtectClear(PW[1],Length(PW));
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then edtPlainTextFile.Text := OpenDialog1.FileName;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if SaveDialog1.Execute then edtEncFile.Text := SaveDialog1.FileName;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if SaveDialog2.Execute then edtDecFile.Text := SaveDialog2.FileName;
end;

function TForm1.GetCipherClass: TCipherClass;
begin
  case rgSymmetricEnc.ItemIndex of
    0: Result := TSteakCipher;
    1: Result := TTwoFish_PCFB;
    2: Result := TTwoFish_ABC;
    3: Result := TRijndael_PCFB;
    4: Result := TRijndael_ABC;
  else
    Result := nil;
  end;
end;

procedure TForm1.btnNegotiateClick(Sender: TObject);
begin
  case rgKeyExch.ItemIndex of
    0: NegElGamal;
    1: NegMTIC0;
    2: NegSRP;
  end;
end;

procedure TForm1.NegElGamal;
var
  X: TInteger2048;
  K: TInteger2048;
  P: TInteger2048;
begin
  // Protocol actions A:
    // Initialize:
  FillChar(X,SizeOf(X),0);
  FillChar(K,SizeOf(K),0);
  FillChar(P,SizeOf(P),0);
    // Generate private key:
  SteakRandomBuf(X[LarIntMaxSize - IntNorIndex],IntByteSize);
    // Make sure it fits in the subgroup:
  while LargeCmpOffset(X,SysQ,0) >= 0 do LargeSub(X,SysQ);
    // Generate partial key data to send to B:
  LargeBarretPow4Mod(X,SysPrime,SysMicro,P);
    // Generate encryption key:
  LargeBarretExpMod(CertB.PublKey,X,SysPrime,SysMicro,K);
    // Set key:
  SetLength(Key,IntByteSize);
  Move(K[LarIntMaxSize - IntNorIndex],Key[1],IntByteSize);
                                             
  {
  // Protocol actions B:
  LargeBarretExpMod(K,PrivB,SysPrime,SysQ,K);
    // Set key:
  SetLength(Key,IntByteSize);
  Move(K[LarIntMaxSize - IntNorIndex],Key[1],IntByteSize);
  }
  ShowMessage('Ready');
end;

procedure TForm1.NegMTIC0;
var
  A, B: TMTIC0;
  ZA, ZB: string;
begin
  A := TMTIC0.Create(CertB);
  try
    B := TMTIC0.Create(CertA);
    try
      ZA := A.Z;
      ZB := B.Z;
      B.SetZ(PrivB,ZA);
      A.SetZ(PrivA,ZB);
      // Addition - verify success:
      A.M0 := B.M0;
      B.M1 := A.M1;
      if A.OK and B.OK then begin
        ShowMessage('Success');
        Key := A.K;
        {Key := B.K;}
      end else ShowMessage('Failure');
    finally
      B.Free;
    end;
  finally
    A.Free;
  end;
end;

procedure TForm1.NegSRP;
var
  A: TClientSRP;
  B: TServerSRP;
  PW: string;
  tmp: TInteger2048;
begin
  if not PasswordDlg('Enter SRP password for A',PW) then Exit;
  try
    B := TServerSRP.Create('');
    try
      // A sends her username to B.
      // B retrieves A's verifier and salt from some secure storage:
      B.V := PWVer;
      B.Salt := SRPSaltA;
      // B sends A's salt to A:
      A := TClientSRP.Create(PW,SRPSaltA);
      try
        // A sends first message to B:
        tmp := A.A;
        B.SetA(tmp);
        // B sends second message to A:
        A.SetB(B.B,B.U);
        // A sends M1 to B:
        if B.VerifyM(A.M) then begin
          // B sends M2 to A:
          if A.VerifyM(B.M) then begin
            Key := A.K;
            ShowMessage('Success');
          end else
            ShowMessage('Failure');
        end else
          ShowMessage('Failure');
      finally
        A.Free;
      end;
    finally
      B.Free;
    end;
  finally
    ProtectClear(PW[1],Length(PW));
  end;
end;

procedure TForm1.btnEncryptClick(Sender: TObject);
var
  FSIn, FSOut: TFileStream;
  MemStr: TMemoryStream;
  B: Byte;
begin
  StreamSec1.CipherClass := GetCipherClass;
  StreamSec1.Lock(Key[1],Length(Key));
  StreamSec1.EncryptionMode := True;
  FSIn := TFileStream.Create(edtPlainTextFile.Text,fmOpenRead);
  try
    MemStr := TMemoryStream.Create;
    try
      LZCompress(FSIn,MemStr);
      FSOut := TFileStream.Create(edtEncFile.Text,fmCreate);
      try
        if MemStr.Size < FSIn.Size then begin
          B := 0;
          FSOut.Write(B,1);
          MemStr.Position := 0;
          StreamSec1.CodeStream(MemStr,FSOut,True,False);
        end else begin
          B := 1;
          FSOut.Write(B,1);
          FSIn.Position := 0;
          StreamSec1.CodeStream(FSIn,FSOut,True,False);
        end;
      finally
        FSOut.Free;
      end;
    finally
      MemStr.Free;
    end;
  finally
    FSIn.Free;
  end;
end;

procedure TForm1.btnDecryptClick(Sender: TObject);
var
  FSIn, FSOut: TFileStream;
  MemStr: TMemoryStream;
  B: Byte;
begin
  StreamSec1.CipherClass := GetCipherClass;
  StreamSec1.Lock(Key[1],Length(Key));
  StreamSec1.EncryptionMode := False;
  FSIn := TFileStream.Create(edtEncFile.Text,fmOpenRead);
  try
    FSIn.Read(B,1);
    if B = 0 then begin
      MemStr := TMemoryStream.Create;
      try                      
        StreamSec1.CodeStream(FSIn,MemStr,True,False);
        FSOut := TFileStream.Create(edtDecFile.Text,fmCreate);
        try                        
          MemStr.Position := 0;
          LZDecompress(MemStr,FSOut);
        finally
          FSOut.Free;
        end;
      finally
        MemStr.Free;
      end;
    end else begin
      FSOut := TFileStream.Create(edtDecFile.Text,fmCreate);
      try
        StreamSec1.CodeStream(FSIn,FSOut,True,False);
      finally
        FSOut.Free;
      end;
    end;
  finally
    FSIn.Free;
  end;
  ShowMessage('Done');
end;

procedure TForm1.StreamSec1Auth(Sender: TObject; ValidOutPos: Integer;
  Success: Boolean);
begin
  if not Success then
    ShowMessage(Format('Failure at position %d',[ValidOutPos]));
end;

procedure TForm1.StreamSec1CodeBuf(Sender: TObject; InStream,
  OutStream: TStream; Done: Boolean);
begin
  if Done then ShowMessage('Done');
end;

end.