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)<Methods[i].KeyMinLength then
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('\Software\Laynik 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;