//кодирование
if ParamCount>0 then
for i:=1 to ParamCount do
begin
Files.Items.Add(ParamStr(i));
end;
Decode:=False;
procedure TMainForm.AddCmdLine(var msg: TMessage);
//var
// P: array[0..1024]of char;
// GlobalGetAtomName(msg.WParam,p,1023);
// GlobalDeleteAtom(msg.WParam);
// DoCommandLine(String(P));
procedure TMainForm.FormCreate(Sender: TObject);
Caption:='Кодирование';
DragAcceptFiles(Handle,TRUE);
if Decode then BitBtn1.Enabled:=false;
procedure TMainForm.BitBtn1Click(Sender: TObject);
OptionsForm.ShowModal;
procedure TMainForm.StopDblClick(Sender: TObject);
Close;
procedure ValidateFiles;
var
i,k: integer;
with MainForm.Files do
i:=0;
while i<=Items.Count-2 do
k:=i+1;
while k<=Items.Count-1 do
if CompareText(Items.Strings[i],Items.Strings[k])=0 then
Items.Delete(k);
continue;
inc(k);
inc(i);
procedure TMainForm.FileDrop(var msg:TWMDropFiles);
i,count: integer;
p: pchar;
s: string;
attr:LongWord;
msg.Result:=0;
count:=DragQueryFile(Msg.Drop,$ffffffff,nil,0);
getmem(p,1024);
for i:=0 to count-1 do
DragQueryFile(msg.Drop,i,p,1024);
s:=StrPas(p);
attr:=GetFileAttributes(PCHAR(s));
if attr<>$ffffffff then
if (attr and FILE_ATTRIBUTE_DIRECTORY) = 0 then
if Decode then
if Pos('.crf',lowercase(s))<>0 then
files.Items.Add(s);
end else
if Pos('.crf',lowercase(s))=0 then
freemem(p,1024);
DragFinish(msg.Drop);
ValidateFiles;
function NoMethods:Boolean;
i:integer;
result:=true;
for i:=1 to QolMethods do if used[i] then result:=false;
procedure TMainForm.GoDblClick(Sender: TObject);
i: integer;
if files.Items.Count=0 then
ShowMessage('Список файлов пуст');
Exit;
if MainKey.Text='' then begin
ShowMessage('Вы забыли ввести ключ');
exit;
if DecodeKey<>0 then begin
ShowMessage('Введен неправильный ключ');
if NoMethods then begin
ShowMessage('Не выбрано ни одного метода');
ProgressForm.InitProgress(files.Items.Count,'Декодирование');
ProgressForm.Show;
for i:=0 to files.items.count-1 do
DoDecoding(files.items.strings[i]);
ProgressForm.Hide;
ProgressForm.InitProgress(files.Items.Count,'Кодирование');
DoCoding(files.items.strings[i]);
procedure TMainForm.BitBtn2Click(Sender: TObject);
T: TRegistry;
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
files.Items.AddStrings(Open.files);
validatefiles;
T.WriteString('Lastpath',ExtractFileDir(Open.Files.Strings[Open.Files.Count-1]));
T.Free;
procedure TMainForm.BitBtn3Click(Sender: TObject);
if (files.Items.Count=0) or (files.ItemIndex=-1) then exit;
files.Items.Delete(files.ItemIndex);
procedure TMainForm.BitBtn6Click(Sender: TObject);
files.clear;
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;
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));
Used: array[1..QolMethods] of boolean = (false,
false,
false);
implementation
uses TestUnit, ProgressUnit;
Result:=0;
for i:=1 to QolMethods do
if CompareStr(S,Methods[i].MethodName)=0 then
Result:=i;
if C=Methods[i].MethodKey then
function GenerateFileName(s:string):string;
Result:=concat(s,'.crf');
function GenerateDecFileName(s:string):string;
If Pos('.CRF',UpperCase(s))<>0 then delete(s,Pos('.CRF',uppercase(s)),4);
s:=concat(s,'.dec');
Result:=s;
j,i,ks,ls,size,res,fs,pr: integer;
f,outp: file;
buf: pointer;
S1: String;
result:=0;
GetMem(buf,$10000);
fillchar(buf^,$10000,0);
if buf=nil then begin
ShowMessage('Не хватает памяти под буфер');
Result:=1;
AssignFile(f,s);
s1:=GenerateFileName(s);
AssignFile(outp,s1);
{$I-}
Reset(f,1);
fs:=filesize(f);
Rewrite(outp,1);
{$I+}
if IOResult=0 then
ProgressForm.UpdateProgress(s1,0,'Кодирование ');
size:=$10000;
while size=$10000 do
BlockRead(f,buf^,$10000,size);
ks:=0;
if (size mod 8)<>0 then
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,'Кодирование ');
BlockWrite(outp,buf^,ls,res);
if ks<>0 then blockwrite(outp,ks,1);
end
else ShowMessage('Ошибка обращения к '+S);
CloseFile(f);
CloseFile(outp);
FreeMem(buf,$10000);
ProgressForm.EndProcess;
ks,pr,i,size,res,fs: integer;
s1: string;
s1:=GenerateDecFileName(s);
ProgressForm.UpdateProgress(s1,0,'Декодирование ');
for i:=QolMethods downto 1 do
if Used[i] then Methods[i].MethodDecProc(buf,size,UsedMethods[i]);
ProgressForm.UpdateProgress(s1,pr,'Декодирование ');
ks:=byte(PCHAR(Buf)[size-1])+1;
end else ks:=0;
BlockWrite(outp,buf^,size,res);
Seek(outp,filepos(outp)-ks);
Truncate(outp);
function Coding_Kir;
function DeCoding_Kir;
unit GOST;
uses
SysUtils,
CodingTools;
function coding_GOST(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;
function coding_GOSTSE(Buf: Pointer; Size: LongWord; Param: TCodingParameters):Integer;
Key: array [0..7] of LongWord;
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);
s:word64;
s.v32[0]:=(N.v32[0] + X) mod $100000000;
for i:=0 to 3 do
//Замена по таблице младшие или старшие 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);
asm
push ecx
mov cl,11
rol DWORD[s.v32[0]],cl
pop ecx
s.v32[0]:=s.v32[0] xor N.v32[1];
N.v32[1]:=N.v32[0];
N.v32[0]:=s.v32[0];
procedure SEcoding64bits(var N:word64);
k,j: integer;
s:LongWord;
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;
procedure SEdecoding64bits(var N:word64);
procedure GOST_G_coding(var T: pointer; S:word64; Size:word);
SEcoding64bits(S);
for i:=1 to (Size div 8) do
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];
s: word64;
s.v32[0]:=0; s.v32[1]:=0;
for i:=0 to 7 do
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];
GOST_G_coding(Buf,s,Size);
SEcoding64bits(word64(Pointer(LongWord(Buf)+LongWord((i-1)*8))^));
for i:=0 to 7 do Key[i]:=0;
Страницы: 1, 2, 3, 4, 5