unit unitCreateAcc;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Buttons;

type
  TfrmCreateAcc = class(TForm)
    GroupBox1: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label7: TLabel;
    txtLName: TEdit;
    txtFName: TEdit;
    txtUName: TEdit;
    cmbUType: TComboBox;
    txtPword: TEdit;
    BitBtn1: TBitBtn;
    bntSave: TBitBtn;
    StatusBar1: TStatusBar;
    txtstat: TEdit;
    procedure bntSaveClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure txtLNameKeyPress(Sender: TObject; var Key: Char);
    procedure txtFNameKeyPress(Sender: TObject; var Key: Char);
    procedure txtUNameKeyPress(Sender: TObject; var Key: Char);
    procedure txtPwordKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
         procedure saveAcc;
  end;
   type
   TWordTriple = Array[0..2] of Word;
    function FileEncrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
    function FileDecrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
    function TextEncrypt(const s: string; Key: TWordTriple): string;
    function TextDecrypt(const s: string; Key: TWordTriple): string;
    function MemoryEncrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key:TWordTriple): boolean;
    function MemoryDecrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key:TWordTriple): boolean;
var
  frmCreateAcc: TfrmCreateAcc;

implementation

uses DM, unitLogin, unitUserList;

{$R *.dfm}

function MemoryEncrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
var
  pIn, pOut: ^byte;
  i : Cardinal;
begin
    if SrcSize = TargetSize then
    begin
        pIn := Src;
        pOut := Target;
        for i := 1 to SrcSize do
        begin
          pOut^ := pIn^ xor (Key[2] shr 8);
          Key[2] := Byte(pIn^ + Key[2]) * Key[0] + Key[1];
          inc(pIn);
          inc(pOut);
        end;
              Result := True;
    end else
              Result := False;
end;

function MemoryDecrypt(Src: Pointer; SrcSize: Cardinal; Target: Pointer; TargetSize: Cardinal; Key: TWordTriple): boolean;
var
  pIn, pOut: ^byte;
  i : Cardinal;
begin
  if SrcSize = TargetSize then
  begin
    pIn := Src;
    pOut := Target;
    for i := 1 to SrcSize do
    begin
      pOut^ := pIn^ xor (Key[2] shr 8);
      Key[2] := byte(pOut^ + Key[2]) * Key[0] + Key[1];
      inc(pIn);
      inc(pOut);
    end;
    Result := True;
  end else
    Result := False;
end;

function TextCrypt(const s: string; Key: TWordTriple; Encrypt: Boolean): string;
var
  bOK: Boolean;
begin
  SetLength(Result, Length(s));
  if Encrypt then
    bOK := MemoryEncrypt(PChar(s), Length(s), PChar(Result), Length(Result), Key)
  else
    bOK := MemoryDecrypt(PChar(s), Length(s), PChar(Result), Length(Result), Key);
  if not bOK then Result := '';
end; 

function FileCrypt(InFile, OutFile: String; Key: TWordTriple; Encrypt: Boolean): boolean;
var
  MIn, MOut: TMemoryStream;
begin
  MIn := TMemoryStream.Create;
  MOut := TMemoryStream.Create;
  Try
    MIn.LoadFromFile(InFile);
    MOut.SetSize(MIn.Size);
    if Encrypt then
      Result := MemoryEncrypt(MIn.Memory, MIn.Size, MOut.Memory, MOut.Size, Key)
    else
      Result := MemoryDecrypt(MIn.Memory, MIn.Size, MOut.Memory, MOut.Size, Key);
    MOut.SaveToFile(OutFile);
  finally
    MOut.Free;
    MIn.Free;
  end;
end;
function TextEncrypt(const s: string; Key: TWordTriple): string;
begin
  Result := TextCrypt(s, Key, True);
end; 

function TextDecrypt(const s: string; Key: TWordTriple): string;
begin
  Result := TextCrypt(s, Key, False);
end; 

function FileEncrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
begin
  Result := FileCrypt(InFile, OutFile, Key, True);
end; 

function FileDecrypt(InFile, OutFile: String; Key: TWordTriple): boolean;
begin
  Result := FileCrypt(InFile, OutFile, Key, False);
end;

procedure TfrmCreateAcc.bntSaveClick(Sender: TObject);
begin
      saveAcc;
end;

procedure TfrmCreateAcc.BitBtn1Click(Sender: TObject);
begin
      Close;
end;

procedure TfrmCreateAcc.saveAcc;
var endec:TWordTriple;
begin
    endec[0]:=1000;
    endec[1]:=9292;
    endec[2]:=3333;

     if DataModule1.tr.InTransaction then
          DataModule1.tr.Commit;

          DataModule1.query.SQL.Clear();
          DataModule1.query.SQL.Add('INSERT INTO USER_ACCOUNTS');
          DataModule1.query.SQL.Add('(LASTNAME,FIRSTNAME,USERNAME,USERPASS,USERACCESS,STATUS,CREATEDBY,DATEADD)');
          DataModule1.query.SQL.Add(' VALUES (:a, :b, :c, :d, :e,:f,:g,:h)');
          DataModule1.query.Params.AsString[0] := txtLName.Text;
          DataModule1.query.Params.AsString[1] := txtFName.Text;
          DataModule1.query.Params.AsString[2] := txtUName.Text;
          DataModule1.query.Params.AsString[3] := (TextEncrypt(txtPword.Text,endec));
          DataModule1.query.Params.AsString[4] := cmbUType.Text;
          DataModule1.query.Params.AsString[5] := txtstat.Text;
          DataModule1.query.Params.AsString[6] := frmLogin.fullname;
          DataModule1.query.Params.AsString[7] := DateToStr(Now());
          DataModule1.query.Prepare;
          DataModule1.query.Open();

          if DataModule1.tr.InTransaction then
              DataModule1.tr.Commit;

              ShowMessage('Account has been successfully saved.');
              frmUser.accounts;
              Close();
end;


procedure TfrmCreateAcc.txtLNameKeyPress(Sender: TObject; var Key: Char);
begin
      if key = #13 then begin
        SelectNext(Sender as tWinControl, True, True);
          if Sender = txtLName then
            key := #0;
end;
end;

procedure TfrmCreateAcc.txtFNameKeyPress(Sender: TObject; var Key: Char);
begin
      if key = #13 then begin
        SelectNext(Sender as tWinControl, True, True);
          if Sender = txtLName then
            key := #0;
end;
end;

procedure TfrmCreateAcc.txtUNameKeyPress(Sender: TObject; var Key: Char);
begin
      if key = #13 then begin
        SelectNext(Sender as tWinControl, True, True);
          if Sender = txtLName then
            key := #0;
end;
end;

procedure TfrmCreateAcc.txtPwordKeyPress(Sender: TObject; var Key: Char);
begin
      if key = #13 then begin
        SelectNext(Sender as tWinControl, True, True);
          if Sender = txtLName then
            key := #0;
end;
end;

end.
