p align="left">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.
Страницы: 1, 2, 3, 4
|