Защита информации от несанкционированного доступа

program Hazard;

uses

Windows,

Messages,

SysUtils,

Forms,

TestUnit in "TestUnit.pas" {MainForm},

CodingUnit in "CodingUnit.pas",

OptionsUnit in "OptionsUnit.pas" {OptionsForm},

K1 in "K1.pas",

K2 in "K2.pas",

K3 in "K3.pas",

ProgressUnit in "ProgressUnit.pas" {ProgressForm},

GOST in "GOST.pas";

{$R *.RES}

{$R Laynik.res}

function AlreadyRunning: boolean;

begin

Result:=False;

if FindWindow("TMainForm","Кодирование")<>0 then

Result:=True;

end;

begin

Decode:=false;

If not AlreadyRunning then

begin

Application.Initialize;

Application.Title := "[LG] Hazard";

Application.CreateForm(TMainForm, MainForm);

Application.CreateForm(TOptionsForm, OptionsForm);

Application.CreateForm(TProgressForm, ProgressForm);

MainForm.DoCommandLine(String(system.CmdLine));

Application.Run;

end else

begin

MessageBox(0,"Приложение уже запущено","Ошибка",MB_ICONSTOP+MB_OK);

end

end.

unit K1;

interface

uses CodingTools;

function Coding_K1(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

function DeCoding_K1(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

implementation

const

FShTable: TConvertTable64 =

(57,49,41,33,25,17, 9, 1,59,51,

43,35,27,19,11, 3,61,53,45,37,

29,21,13, 5,63,55,47,39,31,23,

15, 7,56,48,40,32,24,16, 8, 0,

58,50,42,34,26,18,10, 2,60,52,

44,36,28,20,12, 4,62,54,46,38,

30,22,14, 6);

LShTable: TConvertTable64 =

(39, 7,47,15,55,23,63,31,38,6,

46,14,54,22,62,30,37, 5,45,13,

53,21,61,29,36, 4,44,12,52,20,

60,28,35, 3,43,11,51,19,59,27,

34, 2,42,10,50,18,58,26,33, 1,

41, 9,49,17,57,25,32, 0,40, 8,

48,16,56,24);

procedure K1Coding64bits(A: word64; var R: word64; K1:word64);

begin

convert(A,FShTable,R);

asm

push esi

mov esi,DWORD[R]

mov eax,DWORD[K1]

xor [esi],eax

add esi,4

mov eax,DWORD[K1+4]

xor [esi],eax

pop esi

end;

end;

procedure K1DeCoding64bits(A: word64; var R: word64; K1:word64);

begin

asm

mov eax,DWORD[K1]

xor DWORD[A],eax

mov eax,DWORD[K1+4]

xor DWORD[A+4],eax

end;

convert(A,LShTable,R);

end;

function Coding_K1(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

var

i,j,l:integer;

a,r: ^word64;

k: word64;

begin

for i:=0 to 7 do

k.v8[i]:=BYTE(Param.Key[i]);

convert(K,LshTable,K);

l:=Size div 8;

for i:=1 to Param.WayCount do

begin

for j:=0 to l-1 do

begin

a:=Pointer(LongWord(Buf)+j*8);

r:=a;

K1Coding64bits(A^,R^,K);

end;

end;

result:=0;

end;

function DeCoding_K1(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

var

i,j,l:integer;

a,r:^word64;

k: word64;

begin

for i:=0 to 7 do

k.v8[i]:=BYTE(Param.Key[i]);

convert(K,LshTable,K);

l:=Size div 8;

for i:=1 to Param.WayCount do

begin

for j:=0 to l-1 do

begin

a:=Pointer(LongWord(Buf)+j*8);

r:=a;

K1DeCoding64bits(A^,R^,K);

end;

end;

result:=0;

end;

end.

unit K2;

interface

uses CodingTools;

function Coding_K2(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

function DeCoding_K2(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

implementation

const

FShTable: TConvertTable64 =

(57,49,41,33,25,17, 9, 1,59,51,

43,35,27,19,11, 3,61,53,45,37,

29,21,13, 5,63,55,47,39,31,23,

15, 7,56,48,40,32,24,16, 8, 0,

58,50,42,34,26,18,10, 2,60,52,

44,36,28,20,12, 4,62,54,46,38,

30,22,14, 6);

LShTable: TConvertTable64 =

(39, 7,47,15,55,23,63,31,38,6,

46,14,54,22,62,30,37, 5,45,13,

53,21,61,29,36, 4,44,12,52,20,

60,28,35, 3,43,11,51,19,59,27,

34, 2,42,10,50,18,58,26,33, 1,

41, 9,49,17,57,25,32, 0,40, 8,

48,16,56,24);

procedure K2Coding64bits(A: word64; var R: word64; B: byte);

begin

convert(A,FShTable,R);

asm

push esi

mov esi,DWORD[R]

mov cl,[b]

ror dword[esi],cl

add esi,4

mov cl,[b]

ror dword[esi],cl

pop esi

end;

end;

procedure K2DeCoding64bits(A: word64; var R: word64; B: Byte);

begin

asm

mov cl,[b]

rol DWORD[A],cl

mov cl,[b]

rol DWORD[A+4],cl

end;

convert(A,LShTable,R);

end;

function Coding_K2(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

var

i,j,l:integer;

a,r: ^word64;

k: word64;

b: byte;

begin

b:=0;

for i:=0 to 7 do

k.v8[i]:=BYTE(Param.Key[i]);

convert(K,LshTable,K);

for i:=0 to 7 do b:=b xor K.v8[i];

l:=Size div 8;

for i:=1 to Param.WayCount do

begin

for j:=0 to l-1 do

begin

a:=Pointer(LongWord(Buf)+j*8);

r:=a;

K2Coding64bits(A^,R^,B);

end;

end;

result:=0;

end;

function DeCoding_K2(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

var

i,j,l:integer;

a,r:^word64;

k: word64;

b: byte;

begin

b:=0;

for i:=0 to 7 do

k.v8[i]:=BYTE(Param.Key[i]);

convert(K,LshTable,K);

for i:=0 to 7 do b:=b xor K.v8[i];

l:=Size div 8;

for i:=1 to Param.WayCount do

begin

for j:=0 to l-1 do

begin

a:=Pointer(LongWord(Buf)+j*8);

r:=a;

K2DeCoding64bits(A^,R^,B);

end;

end;

result:=0;

end;

end.

unit K3;

interface

uses CodingTools;

function Coding_K3(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

function DeCoding_K3(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

implementation

uses SysUtils;

const

FShTable: TConvertTable64 =

(57,49,41,33,25,17, 9, 1,59,51,

43,35,27,19,11, 3,61,53,45,37,

29,21,13, 5,63,55,47,39,31,23,

15, 7,56,48,40,32,24,16, 8, 0,

58,50,42,34,26,18,10, 2,60,52,

44,36,28,20,12, 4,62,54,46,38,

30,22,14, 6);

LShTable: TConvertTable64 =

(39, 7,47,15,55,23,63,31,38,6,

46,14,54,22,62,30,37, 5,45,13,

53,21,61,29,36, 4,44,12,52,20,

60,28,35, 3,43,11,51,19,59,27,

34, 2,42,10,50,18,58,26,33, 1,

41, 9,49,17,57,25,32, 0,40, 8,

48,16,56,24);

procedure K3Coding64bits(A: word64; var R: word64; B: byte);

begin

convert(A,FShTable,R);

asm

push esi

mov esi,DWORD[R]

mov cl,[b]

ror dword[esi],cl

add esi,4

mov cl,[b]

ror dword[esi],cl

pop esi

end;

end;

procedure K3DeCoding64bits(A: word64; var R: word64; B: Byte);

begin

asm

mov cl,[b]

rol DWORD[A],cl

mov cl,[b]

rol DWORD[A+4],cl

end;

convert(A,LShTable,R);

end;

function Coding_K3(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

var

i,j:integer;

a,r: ^word64;

k: word64;

b: byte;

begin

b:=0;

k.v32[0]:=0;

k.v32[1]:=0;

for i:=0 to StrLen(Param.Key)-1 do

k.v8[i]:=BYTE(Param.Key[i]);

convert(K,LshTable,K);

for i:=0 to 7 do b:=b xor K.v8[i];

for i:=1 to Param.WayCount do

begin

for j:=0 to Size-8 do

begin

a:=Pointer(LongWord(Buf)+j);

r:=a;

K3Coding64bits(A^,R^,B);

end;

end;

result:=0;

end;

function DeCoding_K3(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

var

i,j:integer;

a,r:^word64;

k: word64;

b: byte;

begin

b:=0;

k.v32[0]:=0;

k.v32[1]:=0;

for i:=0 to StrLen(Param.Key)-1 do

k.v8[i]:=BYTE(Param.Key[i]);

convert(K,LshTable,K);

for i:=0 to 7 do b:=b xor K.v8[i];

for i:=1 to Param.WayCount do

begin

for j:=Size-8 downto 0 do

begin

a:=Pointer(LongWord(Buf)+j);

r:=a;

K3DeCoding64bits(A^,R^,B);

end;

end;

result:=0;

end;

end.

unit OptionsUnit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Buttons, Spin, ExtCtrls;

type

TOptionsForm = class(TForm)

UsedMethodsBox: TListBox;

MethodsBox: TListBox;

Label1: TLabel;

Label2: TLabel;

BitBtn1: TBitBtn;

BitBtn2: TBitBtn;

BitBtn3: TBitBtn;

BitBtn4: TBitBtn;

BitBtn5: TBitBtn;

KeyEdit: TEdit;

Label3: TLabel;

DirectionGroup: TRadioGroup;

WayCountEdit: TSpinEdit;

Label4: TLabel;

DescMemo: TMemo;

procedure BitBtn5Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure BitBtn4Click(Sender: TObject);

procedure BitBtn3Click(Sender: TObject);

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure UsedMethodsBoxClick(Sender: TObject);

procedure DirectionGroupExit(Sender: TObject);

procedure KeyEditExit(Sender: TObject);

procedure WayCountEditExit(Sender: TObject);

procedure EnableKeys(B: Boolean);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

public

{ Public declarations }

end;

var

OptionsForm: TOptionsForm;

implementation

{$R *.DFM}

uses CodingUnit, TestUnit;

procedure TOptionsForm.EnableKeys;

begin

DirectionGroup.Enabled:=B;

KeyEdit.Enabled:=B;

WayCountEdit.Enabled:=B;

end;

procedure TOptionsForm.BitBtn5Click(Sender: TObject);

begin

Close;

MainForm.GenerateKey;

end;

procedure TOptionsForm.FormCreate(Sender: TObject);

var i: integer;

begin

for i:=1 to QolMethods do

begin

MethodsBox.Items.Add(Methods[i].MethodName);

Used[i]:=false;

end;

UsedMethodsBox.Clear;

EnableKeys(False);

DescMemo.Clear;

end;

procedure TOptionsForm.BitBtn4Click(Sender: TObject);

var

i: integer;

begin

UsedMethodsBox.Clear;

for i:=1 to QolMethods do Used[i]:=false;

EnableKeys(False);

DescMemo.Clear;

end;

procedure TOptionsForm.BitBtn3Click(Sender: TObject);

begin

If UsedMethodsBox.ItemIndex=-1 then exit;

Used[MethodIndex(UsedMethodsBox.Items.Strings[UsedMethodsBox.ItemIndex])]:=false
;

UsedMethodsBox.Items.Delete(UsedMethodsBox.ItemIndex);

If UsedMethodsBox.Items.Count=0 then EnableKeys(False);

DescMemo.Clear;

end;

procedure TOptionsForm.BitBtn2Click(Sender: TObject);

begin

If MethodsBox.ItemIndex=-1 then exit;

if UsedMethodsBox.Items.IndexOf(Methods[MethodsBox.ItemIndex+1].MethodName)=-1 then

begin

UsedMethodsBox.Items.Add(Methods[MethodsBox.ItemIndex+1].MethodName);

Used[MethodsBox.ItemIndex+1]:=true;

EnableKeys(True);

UsedMethodsBox.ItemIndex:=UsedMethodsBox.Items.Count-1;

UsedMethodsBox.onclick(Self);

end;

end;

procedure TOptionsForm.BitBtn1Click(Sender: TObject);

var i: integer;

begin

UsedMethodsBox.Clear;

for i:=1 to QolMethods do

begin

UsedMethodsBox.Items.Add(Methods[i].MethodName);

Used[i]:=true;

end;

EnableKeys(True);

end;

procedure TOptionsForm.UsedMethodsBoxClick(Sender: TObject);

var

i: integer;

begin

If (UsedMethodsBox.ItemIndex=-1)or

(UsedMethodsBox.Items.Count=0) then

begin

EnableKeys(False);

DescMemo.Clear;

Exit;

end else

begin

EnableKeys(True);

end;

i:=MethodIndex(UsedMethodsBox.Items.Strings[UsedMethodsBox.ItemIndex]);

if i=0 then exit;

DirectionGroup.ItemIndex:=UsedMethods[i].Direction-1;

KeyEdit.MaxLength:=Methods[i].KeyMaxLength;

KeyEdit.Text:=String(UsedMethods[i].Key);

WayCountEdit.Value:=UsedMethods[i].WayCount;

DescMemo.Clear;

DescMemo.Lines.Append(Methods[i].MethodDescription);

end;

procedure TOptionsForm.DirectionGroupExit(Sender: TObject);

var

i: integer;

begin

If (UsedMethodsBox.ItemIndex=-1)or

(UsedMethodsBox.Items.Count=0) then Exit;

i:=MethodIndex(UsedMethodsBox.Items.Strings[UsedMethodsBox.ItemIndex]);

if i=0 then exit;

UsedMethods[i].Direction:=DirectionGroup.ItemIndex+1;

end;

procedure TOptionsForm.KeyEditExit(Sender: TObject);

var

i: integer;

begin

If (UsedMethodsBox.ItemIndex=-1)or

(UsedMethodsBox.Items.Count=0) then

Exit;

i:=MethodIndex(UsedMethodsBox.Items.Strings[UsedMethodsBox.ItemIndex]);

if i=0 then exit;

StrPCopy(UsedMethods[i].Key,KeyEdit.Text);

end;

procedure TOptionsForm.WayCountEditExit(Sender: TObject);

var

i: integer;

begin

If (UsedMethodsBox.ItemIndex=-1)or

(UsedMethodsBox.Items.Count=0) then

Exit;

i:=MethodIndex(UsedMethodsBox.Items.Strings[UsedMethodsBox.ItemIndex]);

if i=0 then exit;

UsedMethods[i].WayCount:=WayCountEdit.Value;

end;

procedure TOptionsForm.FormClose(Sender: TObject;

var Action: TCloseAction);

var

i: integer;

begin

Action:=caHide;

for i:=1 to QolMethods do

begin

if Used[i] then

begin

if StrLen(UsedMethods[i].Key)

begin

ShowMessage(Methods[i].MethodName+": "+Methods[i].KeyMinMessage);

Action:=caNone;

Exit;

end else

if StrLen(UsedMethods[i].Key)>Methods[i].KeyMaxLength then

begin

ShowMessage(Methods[i].MethodName+": "+Methods[i].KeyMaxMessage);

Action:=caNone;

Exit;

end;

end;

end;

end;

end.

unit ProgressUnit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

ComCtrls, StdCtrls;

type

TProgressForm = class(TForm)

Label1: TLabel;

PBOne: TProgressBar;

PBAll: TProgressBar;

Label2: TLabel;

private

{ Private declarations }

public

Current: integer;

procedure UpdateProgress(fn: String;perc:integer;Cap:String);

procedure InitProgress(qol:integer;Cap:String);

procedure EndProcess;

{ Public declarations }

end;

var

ProgressForm: TProgressForm;

implementation

{$R *.DFM}

procedure TProgressForm.EndProcess;

begin

inc(current);

end;

procedure TProgressForm.UpdateProgress;

begin

ProgressForm.Caption:=Cap+" - "+inttostr(round(PBAll.Position*100/PBAll.Max))+"%";

Label1.Caption:=Cap+fn;

PBOne.Position:=perc;

PBAll.Position:=100*Current+perc;

end;

procedure TProgressForm.InitProgress;

begin

Caption:=Cap;

Label1.Caption:="Подготовка...";

PBOne.Position:=0;

PBOne.Max:=100;

PBAll.Position:=0;

PBAll.Max:=qol*100;

Current:=0;

end;

end.

unit TestUnit;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ActnList, ExtCtrls, ComCtrls, ToolWin, Grids, Outline, DirOutln,

Buttons, ShellApi, Registry;

type

TMainForm = class(TForm)

Label1: TLabel;

RecurseBox: TCheckBox;

BitBtn1: TBitBtn;

StaticText1: TStaticText;

MainKey: TEdit;

BitBtn2: TBitBtn;

Open: TOpenDialog;

BitBtn3: TBitBtn;

BitBtn4: TBitBtn;

BitBtn5: TBitBtn;

BitBtn6: TBitBtn;

files: TListBox;

procedure FileDrop(var Msg: TWMDropFiles); message WM_DROPFILES;

procedure AddCmdLine(var msg: TMessage); message WM_USER;

procedure FormCreate(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

procedure DoCommandLine(S: String);

procedure StopDblClick(Sender: TObject);

procedure GoDblClick(Sender: TObject);

procedure GenerateKey;

function DecodeKey: integer;

procedure BitBtn2Click(Sender: TObject);

procedure BitBtn3Click(Sender: TObject);

procedure BitBtn6Click(Sender: TObject);

private

{ Private declarations }

public

end;

var

MainForm: TMainForm;

Decode: boolean;

implementation

uses CodingUnit, OptionsUnit, ProgressUnit;

{$R *.DFM}

procedure TMainForm.GenerateKey;

var

i,k,l: integer;

s: string;

begin

for i:=1 to QolMethods do

begin

If Used[i] then

begin

k:=random(9)+1;

s:=concat(s,Methods[i].MethodKey);

s:=concat(s,IntToStr(k));

l:=strlen(UsedMethods[i].Key)+k*6;

s:=concat(s,Format("%2d",[l]));

s:=concat(s,StrPas(UsedMethods[i].Key));

s:=concat(s,Format("%2d",[strlen(UsedMethods[i].Key)+k*5+UsedMethods[i].Direction]));

s:=concat(s,Format("%2d",[strlen(UsedMethods[i].Key)+k*4+UsedMethods[i].WayCount]));

end;

end;

for i:=1 to length(s) do if s[i]=" " then s[i]:="-";

MainKey.Text:=S;

end;

function TMainForm.DecodeKey;

var

i,k,l,t: integer;

s: string;

begin

Result:=0;

s:=MainKey.Text;

for i:=1 to length(s) do if s[i]="-" then s[i]:="0";

try

while s<>"" do

begin

t:=MethodByChar(s[1]);

Used[t]:=true;

delete(s,1,1);

k:=strtoint(copy(s,1,1));

delete(s,1,1);

l:=strtoint(copy(s,1,2))-k*6;

delete(s,1,2);

StrPCopy(UsedMethods[t].Key,copy(s,1,l));

delete(s,1,l);

UsedMethods[t].Direction:=strtoint(copy(s,1,2))-l-k*5;

delete(s,1,2);

UsedMethods[t].WayCount:=strtoint(copy(s,1,2))-l-k*4;

delete(s,1,2);

end;

except

on E:Exception do Result:=1;

end;

end;

Procedure TMainForm.DoCommandLine(S: String);

var

i: integer;

tmp: string;

begin

System.CmdLine:=PChar(S);

tmp:=ParamStr(1);

if CompareText(tmp,"/D")=0 then

begin

// декодирование

Decode:=true;

StaticText1.Caption:="Введите ключ";

MainKey.Color:=clWindow;

MainKey.ReadOnly:=false;

MainKey.Text:="";

if ParamCount>1 then

begin

for i:=2 to ParamCount do

begin

Files.Items.Add(ParamStr(i));

end;

end;

end else

begin

//кодирование

if ParamCount>0 then

for i:=1 to ParamCount do

begin

Files.Items.Add(ParamStr(i));

end;

Decode:=False;

end;

end;

procedure TMainForm.AddCmdLine(var msg: TMessage);

//var

// P: array[0..1024]of char;

begin

// GlobalGetAtomName(msg.WParam,p,1023);

// GlobalDeleteAtom(msg.WParam);

// DoCommandLine(String(P));

end;

procedure TMainForm.FormCreate(Sender: TObject);

begin

Caption:="Кодирование";

DragAcceptFiles(Handle,TRUE);

if Decode then BitBtn1.Enabled:=false;

end;

procedure TMainForm.BitBtn1Click(Sender: TObject);

begin

OptionsForm.ShowModal;

end;

procedure TMainForm.StopDblClick(Sender: TObject);

begin

Close;

end;

procedure ValidateFiles;

var

i,k: integer;

begin

with MainForm.Files do

begin

i:=0;

while i<=Items.Count-2 do

begin

k:=i+1;

while k<=Items.Count-1 do

begin

if CompareText(Items.Strings[i],Items.Strings[k])=0 then

begin

Items.Delete(k);

continue;

end;

inc(k);

end;

inc(i);

end;

end;

end;

procedure TMainForm.FileDrop(var msg:TWMDropFiles);

var

i,count: integer;

p: pchar;

s: string;

attr:LongWord;

begin

msg.Result:=0;

count:=DragQueryFile(Msg.Drop,$ffffffff,nil,0);

getmem(p,1024);

for i:=0 to count-1 do

begin

DragQueryFile(msg.Drop,i,p,1024);

s:=StrPas(p);

attr:=GetFileAttributes(PCHAR(s));

if attr<>$ffffffff then

begin

if (attr and FILE_ATTRIBUTE_DIRECTORY) = 0 then

begin

if Decode then

begin

if Pos(".crf",lowercase(s))<>0 then

files.Items.Add(s);

end else

begin

if Pos(".crf",lowercase(s))=0 then

files.Items.Add(s);

end;

end;

end;

end;

freemem(p,1024);

DragFinish(msg.Drop);

ValidateFiles;

end;

function NoMethods:Boolean;

var

i:integer;

begin

result:=true;

for i:=1 to QolMethods do if used[i] then result:=false;

end;

procedure TMainForm.GoDblClick(Sender: TObject);

var

i: integer;

begin

if files.Items.Count=0 then

begin

ShowMessage("Список файлов пуст");

Exit;

end;

ValidateFiles;

if Decode then

begin

if MainKey.Text="" then begin

ShowMessage("Вы забыли ввести ключ");

exit;

end;

if DecodeKey<>0 then begin

ShowMessage("Введен неправильный ключ");

Exit;

end;

if NoMethods then begin

ShowMessage("Не выбрано ни одного метода");

Exit;

end;

ProgressForm.InitProgress(files.Items.Count,"Декодирование");

ProgressForm.Show;

for i:=0 to files.items.count-1 do

begin

DoDecoding(files.items.strings[i]);

end;

ProgressForm.Hide;

end else

begin

if NoMethods then begin

ShowMessage("Не выбрано ни одного метода");

Exit;

end;

ProgressForm.InitProgress(files.Items.Count,"Кодирование");

ProgressForm.Show;

for i:=0 to files.items.count-1 do

begin

DoCoding(files.items.strings[i]);

end;

ProgressForm.Hide;

end;

end;

procedure TMainForm.BitBtn2Click(Sender: TObject);

var

T: TRegistry;

begin

T:=TRegistry.Create;

T.RootKey:=HKEY_LOCAL_MACHINE;

T.OpenKey("SoftwareLaynik Group[LG] Hazard Encrypter 2000",True);

Open.InitialDir:=T.ReadString("Lastpath");

if Open.Execute then

begin

files.Items.AddStrings(Open.files);

validatefiles;

T.WriteString("Lastpath",ExtractFileDir(Open.Files.Strings[Open.Files.Count-1]));

end;

T.Free;

end;

procedure TMainForm.BitBtn3Click(Sender: TObject);

begin

if (files.Items.Count=0) or (files.ItemIndex=-1) then exit;

files.Items.Delete(files.ItemIndex);

end;

procedure TMainForm.BitBtn6Click(Sender: TObject);

begin

files.clear;

end;

end.

unit CodingUnit;

interface

uses Classes,SysUtils,Dialogs,CodingTools,K1,K2,K3,GOST;

Const

PIECE_LENGTH = $FFFF;

// Direction constants

diForward = 1;

diBackward = 0;

// ERROR VALUES

CL_ERROR_EMPTYLINE = -1;

CL_ERROR_NOFILENAME = -2;

function Coding_Kir(Buf: Pointer; Size: LongInt; Param: TCodingParameters): Integer;

function DeCoding_Kir(Buf: Pointer; Size: LongInt; Param: TCodingParameters): Integer;

function DoCoding(S: String): integer;

function DoDecoding(S: String): integer;

function MethodIndex(const S: String):integer;

function MethodByChar(const C: Char):integer;

const

QolMethods = 4;

Methods:array[1..QolMethods] of TCodingFunction =

((MethodName:"ГОСТ 28147-89 (ПЗ)";MethodKey:"G";MethodProc:Coding_GOST;MethodDecProc:Coding_GOST;

KeyMinLength:32;KeyMaxLength:32;KeyMinMessage:"Ключ должен быть длиной 32 символa";KeyMaxMessage:"Ключ должен быть длиной 32 символa";

MethodDescription:"Кодирование по ГОСТ 28147-89 (простая замена)"),

(MethodName:"ГОСТ 28147-89 (Г)";MethodKey:"G";MethodProc:Coding_GOST;MethodDecProc:Coding_GOST;

KeyMinLength:32;KeyMaxLength:32;KeyMinMessage:"Ключ должен быть длиной 32 символa";KeyMaxMessage:"Ключ должен быть длиной 32 символa";

MethodDescription:"Кодирование по ГОСТ 28147-89 (гаммирование)"),

(MethodName:"К1";MethodKey:"K";MethodProc:Coding_K1;MethodDecProc:DeCoding_K1;

KeyMinLength:8;KeyMaxLength:8;KeyMinMessage:"Ключ должен быть длиной 8 символов";KeyMaxMessage:"Ключ должен быть длиной 8 символов";

MethodDescription:"Сумма по модулю два"),

(MethodName:"К2";MethodKey:"L";MethodProc:Coding_K2;MethodDecProc:DeCoding_K2;

KeyMinLength:3;KeyMaxLength:8;KeyMinMessage:"Минимальная длина ключа - 3 символа";KeyMaxMessage:"Ключ должен быть длиной менее 9 символов";

MethodDescription:"Циклический сдвиг"));

UsedMethods:array[1..QolMethods] of TCodingParameters =

((Key:"";WayCount:1;Direction:1),

(Key:"";WayCount:1;Direction:1),

(Key:"";WayCount:1;Direction:1),

(Key:"";WayCount:1;Direction:1));

Used: array[1..QolMethods] of boolean = (false,

false,

false,

false);

implementation

uses TestUnit, ProgressUnit;

function MethodIndex(const S: String):integer;

var

i: integer;

begin

Result:=0;

for i:=1 to QolMethods do

begin

if CompareStr(S,Methods[i].MethodName)=0 then

Result:=i;

end;

end;

function MethodByChar(const C: Char):integer;

var

i: integer;

begin

Result:=0;

for i:=1 to QolMethods do

begin

if C=Methods[i].MethodKey then

Result:=i;

end;

end;

function GenerateFileName(s:string):string;

begin

Result:=concat(s,".crf");

end;

function GenerateDecFileName(s:string):string;

begin

If Pos(".CRF",UpperCase(s))<>0 then delete(s,Pos(".CRF",uppercase(s)),4);

s:=concat(s,".dec");

Result:=s;

end;

function DoCoding(S: String): integer;

var

j,i,ks,ls,size,res,fs,pr: integer;

f,outp: file;

buf: pointer;

S1: String;

begin

result:=0;

GetMem(buf,$10000);

fillchar(buf^,$10000,0);

if buf=nil then begin

ShowMessage("Не хватает памяти под буфер");

Result:=1;

exit;

end;

AssignFile(f,s);

s1:=GenerateFileName(s);

AssignFile(outp,s1);

{$I-}

Reset(f,1);

fs:=filesize(f);

Rewrite(outp,1);

{$I+}

if IOResult=0 then

begin

ProgressForm.UpdateProgress(s1,0,"Кодирование ");

size:=$10000;

while size=$10000 do

begin

BlockRead(f,buf^,$10000,size);

for i:=1 to QolMethods do

begin

ks:=0;

if (size mod 8)<>0 then

begin

ls:=(8*((size div 8)+1));

ks:=ls-size;

for j:=size to ls-1 do PCHAR(buf)[j]:=#0;

end else ls:=size;

if Used[i] then Methods[i].MethodProc(buf,ls,UsedMethods[i]);

if fs<>0 then pr:=round(filepos(f)*100 / fs) else pr:=round((100*i) / qolmethods);

ProgressForm.UpdateProgress(s1,pr,"Кодирование ");

end;

BlockWrite(outp,buf^,ls,res);

end;

if ks<>0 then blockwrite(outp,ks,1);

end

else ShowMessage("Ошибка обращения к "+S);

CloseFile(f);

CloseFile(outp);

FreeMem(buf,$10000);

ProgressForm.EndProcess;

end;

function DoDecoding(S: String): integer;

var

ks,pr,i,size,res,fs: integer;

f,outp: file;

buf: pointer;

s1: string;

begin

result:=0;

GetMem(buf,$10000);

fillchar(buf^,$10000,0);

if buf=nil then begin

ShowMessage("Не хватает памяти под буфер");

Result:=1;

exit;

end;

AssignFile(f,s);

s1:=GenerateDecFileName(s);

AssignFile(outp,s1);

{$I-}

Reset(f,1);

fs:=filesize(f);

Rewrite(outp,1);

{$I+}

if IOResult=0 then

begin

ProgressForm.UpdateProgress(s1,0,"Декодирование ");

size:=$10000;

while size=$10000 do

begin

BlockRead(f,buf^,$10000,size);

for i:=QolMethods downto 1 do

begin

if Used[i] then Methods[i].MethodDecProc(buf,size,UsedMethods[i]);

if fs<>0 then pr:=round(filepos(f)*100 / fs) else pr:=round((100*i) / qolmethods);

ProgressForm.UpdateProgress(s1,pr,"Декодирование ");

if (size mod 8)<>0 then

begin

ks:=byte(PCHAR(Buf)[size-1])+1;

end else ks:=0;

end;

BlockWrite(outp,buf^,size,res);

end;

Seek(outp,filepos(outp)-ks);

Truncate(outp);

end

else ShowMessage("Ошибка обращения к "+S);

CloseFile(f);

CloseFile(outp);

FreeMem(buf,$10000);

ProgressForm.EndProcess;

end;

function Coding_Kir;

begin

Result:=0;

end;

function DeCoding_Kir;

begin

Result:=0;

end;

end.

unit GOST;

interface

uses

SysUtils,

CodingTools;

function coding_GOST(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

function coding_GOSTSE(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

implementation

var

Key: array [0..7] of LongWord;

const

ExchTable: array [0..7,0..15] of byte =

((2,5,3,7,12,1,15,14,9,4,6,8,10,0,11,13),

(8,3,1,9,10,15,2,14,13,5,11,7,0,12,4,3),

(15,1,14,2,13,3,12,4,11,5,10,0,6,9,7,8),

(1,3,5,7,9,2,4,6,8,10,11,13,15,12,14,0),

(1,4,7,10,13,2,5,8,11,0,14,3,6,9,12,15),

(1,5,9,13,2,6,10,0,14,3,7,11,15,4,8,12),

(1,6,11,2,7,12,0,3,8,13,4,9,14,5,10,15),

(1,7,0,13,2,8,14,3,9,15,4,10,5,11,6,12));

C1 = $1010101;

C2 = $1010104;

procedure BaseStep(var N:word64; X: longword);

var

i:integer;

s:word64;

begin

s.v32[0]:=(N.v32[0] + X) mod $100000000;

for i:=0 to 3 do

begin

//Замена по таблице младшие или старшие 4 бита

s.v8[i]:=(ExchTable[i*2,(s.v8[i] and $0F)]) or (ExchTable[i*2+1,((s.v8[i] shr 4) and $0F)] shl 4);

end;

asm

push ecx

mov cl,11

rol DWORD[s.v32[0]],cl

pop ecx

end;

s.v32[0]:=s.v32[0] xor N.v32[1];

N.v32[1]:=N.v32[0];

N.v32[0]:=s.v32[0];

end;

procedure SEcoding64bits(var N:word64);

var

k,j: integer;

s:LongWord;

begin

for k:=1 to 3 do

for j:=0 to 7 do BaseStep(N,Key[j]);

for j:=7 downto 0 do BaseStep(N,Key[j]);

s:=N.v32[0];

N.v32[0]:=N.v32[1];

N.v32[1]:=s;

end;

procedure SEdecoding64bits(var N:word64);

var

k,j: integer;

s:LongWord;

begin

for j:=0 to 7 do BaseStep(N,Key[j]);

for k:=1 to 3 do

for j:=7 downto 0 do BaseStep(N,Key[j]);

s:=N.v32[0];

N.v32[0]:=N.v32[1];

N.v32[1]:=s;

end;

procedure GOST_G_coding(var T: pointer; S:word64; Size:word);

var

i:integer;

begin

SEcoding64bits(S);

for i:=1 to (Size div 8) do

begin

S.v32[0]:=(S.v32[0]+C1) mod $100000000;

S.v32[1]:=((S.v32[1]+C2-1) mod ($ffffffff)) +1;

word64(Pointer(LongWord(T)+LongWord((i-1)*8))^).v32[0]:=

word64(Pointer(LongWord(T)+LongWord((i-1)*8))^).v32[0] xor S.v32[0];

word64(Pointer(LongWord(T)+LongWord((i-1)*8))^).v32[1]:=

word64(Pointer(LongWord(T)+LongWord((i-1)*8))^).v32[1] xor S.v32[1];

end;

end;

function coding_GOST(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

var

i: integer;

s: word64;

begin

s.v32[0]:=0; s.v32[1]:=0;

for i:=0 to 7 do

begin

Key[i]:=(BYTE(Param.Key[i*4+3]) shr 24) or (BYTE(Param.Key[i*4+2]) shr 16) or

(BYTE(Param.Key[i*4+1]) shr 8) or (BYTE(Param.Key[i*4]));

s.v32[i mod 2]:=s.v32[i mod 2]+Key[i];

end;

GOST_G_coding(Buf,s,Size);

end;

function coding_GOSTSE(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;

var

i: integer;

begin

for i:=0 to 7 do

begin

Key[i]:=(BYTE(Param.Key[i*4+3]) shr 24) or (BYTE(Param.Key[i*4+2]) shr 16) or

(BYTE(Param.Key[i*4+1]) shr 8) or (BYTE(Param.Key[i*4]));

end;

for i:=1 to (Size div 8) do

begin

SEcoding64bits(word64(Pointer(LongWord(Buf)+LongWord((i-1)*8))^));

end;

end;

var

i: integer;

begin

for i:=0 to 7 do Key[i]:=0;

end.