Библиографический список
1. Конспект лекций по курсу «Кодирование и защита информации» 2. Андрей Винокуров. «Алгоритм шифрования ГОСТ 28147-89, его использование и реализация для компьютеров платформы Intel x86» 3. Михаил Гук. «Процессоры Pentium II, Pentium Pro и просто Pentium», Санкт-Петербург «Питер», 1999 г. Приложение А
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)<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;
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.
Популярное: Организация как механизм и форма жизни коллектива: Организация не сможет достичь поставленных целей без соответствующей внутренней... Почему двоичная система счисления так распространена?: Каждая цифра должна быть как-то представлена на физическом носителе... Почему человек чувствует себя несчастным?: Для начала определим, что такое несчастье. Несчастьем мы будем считать психологическое состояние... ©2015-2024 megaobuchalka.ru Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав. (127)
|
Почему 1285321 студент выбрали МегаОбучалку... Система поиска информации Мобильная версия сайта Удобная навигация Нет шокирующей рекламы |