TPS_AU Delphi Source Code

[zombi]

Delphi ve diğer dillerden anlayanlar için iyi fikir verir uses kısmındaki
SysUtils, Classes, utils, ArbFilt, saveToBin, GUI, iniManager, RC6, ElAES isimli diğer source lara ulaşırsırsanız codlar çalışır. Bunun burda bi sakıncası varsa lütfen modlar topiği silsin.

Bu da pas dosyası halinde

unit TPS_AU;

interface

procedure startTPS_AU;
procedure stopTPS_AU;
function isRunning_TPS_AU: boolean;


implementation

uses
SysUtils, Classes, utils, ArbFilt, saveToBin, GUI, iniManager, RC6, ElAES;

type
TPS_keys = record
timeStamp: array[0..3] of byte;
key1: array[0..15] of byte;
key2: array[0..15] of byte;
key3: array[0..15] of byte;
flag0: byte;
flag1: byte;
flag2: byte;
flag3: byte;
end;

const
bad_key3_1: array[0..2] of byte = ($00, $87, $BF); //headers inside!
bad_key2_1: array[0..2] of byte = ($00, $87, $BB); //headers inside!
rc6_AES_keys: array[0..127] of byte = (
$36, $1B, $3E, $2B, $64, $C0, $8A, $22, $3C, $6B, $12, $B8, $D4, $A9, $29, $F3,
$A1, $19, $36, $61, $94, $44, $6D, $3A, $C9, $DD, $3C, $96, $D1, $24, $73, $23,
$67, $01, $9F, $28, $A0, $47, $6E, $9C, $5B, $8C, $51, $C3, $63, $19, $4A, $7B,
$9F, $0D, $0B, $F5, $46, $02, $B0, $38, $4B, $27, $BA, $F3, $F9, $AC, $16, $2B,
$37, $00, $EB, $28, $8C, $59, $0B, $6A, $8E, $24, $88, $7E, $B0, $58, $A9, $85,
$12, $D5, $B0, $B2, $60, $AF, $62, $89, $B5, $AC, $51, $1E, $27, $6B, $36, $DB,
$54, $E6, $1C, $9E, $BA, $BE, $65, $36, $29, $E4, $EC, $0B, $10, $64, $F9, $16,
$46, $1B, $7A, $0B, $DA, $5E, $27, $E5, $5A, $62, $64, $BE, $08, $A0, $FF, $C4);
end_of_key_set: array[0..8] of byte =
($66, $6C, $61, $73, $68, $2F, $61, $64, $6D);
TimeStampsStart: array[0..30] of byte =
($6F, $61, $64, $63, $61, $73, $74, $2E, $63, $68, $61, $6E, $6E,
$65, $6C, $2E, {; oadcast.channel.}
$31, $33, $35, $2E, $34, $35, $31, $09, $05, $4F, $00, $00, $00,
$00, $00 {; 135.451..O.....});
keys_beginning: array[0..1] of byte = (1, 1);
cosmeticKey: array[0..15] of byte =
($36, $1B, $3E, $2B, $64, $C0, $8A, $22, $3C, $6B, $12, $B8, $D4, $A9, $29, $F3);
ident_key1: array[0..1] of byte = ($09, $10);
ident_key2: array[0..1] of byte = ($0A, $10);


var
All_TPS_Keys: array of TPS_keys;
fs1: TFileStream = nil;
buf1: pbytearray;
whole_size: integer;
lastCallPos, total_keys_no: integer;
isEncrypted: boolean = False;
rc6_AES_KeyIndex: integer = 0;
isAES: boolean = False;
isRC6: boolean = False;


procedure decryptRC6_CBC(ideaKey: array of byte; InBlock: array of byte;
var outBlock: array of byte);
var
Data: TRC6Data;
begin
fillchar(outBlock, 16, 0);
RC6Init(Data, @ideaKey, Sizeof(ideaKey), nil);
RC6DecryptCBC(Data, @InBlock, @outBlock);
RC6Burn(Data);
end;

function decrypt_AES(Key: array of byte; InBlock: array of byte;
var outBlock: array of byte): string;
var
TempBuf: TAESBuffer;
Buffer: TAESBuffer;
ExpandedKey: TAESExpandedKey128;
Key128: TAESKey128;
begin
move(key[0], key128[0], 16);
ExpandAESKeyForDecryption(Key128, ExpandedKey);
move(InBlock[0], Buffer[0], 16);
DecryptAES(Buffer, ExpandedKey, TempBuf);
move(TempBuf[0], outBlock[0], 16);
end;


procedure readWholeFileToMem;
begin
//2007_01_30 10-28-25_FRANCE 5_PID_4850_data.bin
fs1 := TFileStream.Create(get_dll_full_path() + 'raw_tps.bin', fmOpenRead);
try
whole_size := fs1.size;
getmem(buf1, whole_size);
fs1.Read(buf1^, whole_size);
whole_size := fs1.size;
lastCallPos := 0;
finally
FreeAndNil(fs1);
end;
end;

//look for
//0000a5abh: 62 72 6F 61 64 63 61 73 74 2E 63 68 61 6E 6E 65 ; broadcast.channe
//0000a5bbh: 6C ; l
function makeTimeStamps(): boolean;
var
i, len, n, j, addSpecial: integer;
inData: array[0..15] of byte;
outData: array[0..15] of byte;
RC6_AES_Key: array[0..15] of byte;
encryptedBuf: array of byte;
lenArr, kk: integer;
begin
isEncrypted := False;
isAES := False;
isRC6 := False;

i := lastCallPos;
len := whole_size; // <----buf len
while (i + 31) < len do
begin
if CompareMem(@buf1[i], @TimeStampsStart[0], 31) then
break
else
Inc(i);
end;

total_keys_no := buf1[i + 32] - 1;
if total_keys_no < 5 then
begin
Result := False;
lastCallPos := i + 34;
exit;
end;

if buf1[i + 32 + 4] <> 0 then
begin
isEncrypted := True;
rc6_AES_KeyIndex := buf1[i + 32 + 4 + 1];
if buf1[i + 32 + 4] = 1 then
isAES := True;
if buf1[i + 32 + 4] = 2 then
isRC6 := True;
GUI.PushMSG_Info('TPS keys are encrypted..., Algo No:' +
IntToStr(buf1[i + 32 + 4]) + ', Key No:' + IntToStr(buf1[i + 32 + 4 + 1]));
end
else
GUI.PushMSG_Info('TPS keys are not encrypted.');

setlength(All_TPS_Keys, total_keys_no);

Inc(i, 31);

i := i + 7;
n := 0;
while i < len do
begin
All_TPS_Keys[n].timeStamp[3] := buf1[i];
Inc(n);
if buf1[i] = $FF then
begin
if n > total_keys_no then
break;
end;
Inc(i);
end;

if i + 4 >= len then
begin
Result := False;
lastCallPos := i;
exit;
end;

Inc(i);
n := 0;
while i < len do
begin
All_TPS_Keys[n].timeStamp[2] := buf1[i];
Inc(n);
if buf1[i] = $FF then
begin
if n > total_keys_no then
break;
end;
Inc(i);
end;

if i + 4 >= len then
begin
Result := False;
lastCallPos := i;
exit;
end;


Inc(i);
n := 0;
while i < len do
begin
All_TPS_Keys[n].timeStamp[1] := buf1[i];
Inc(n);
if buf1[i] = $FF then
begin
if n > total_keys_no then
break;
end;
Inc(i);
end;

if i + 4 >= len then
begin
Result := False;
lastCallPos := i;
exit;
end;


Inc(i);
n := 0;
while i < len do
begin
All_TPS_Keys[n].timeStamp[0] := buf1[i];
Inc(n);
if buf1[i] = $FF then
begin
if n > total_keys_no then
break;
end;
Inc(i);
end;

lastCallPos := i;
Result := True;

if isEncrypted then
begin
i := lastCallPos + 160 + 160;
move(rc6_AES_keys[rc6_AES_KeyIndex * 16], RC6_AES_Key[0], 16);
lenArr := 0;
while (i + 16) < len do
begin
if CompareMem(@buf1[i], @end_of_key_set[0], 9) then
begin
lenArr := i - (lastCallPos + 160 + 160);
setLength(encryptedBuf, len);
move(buf1[lastCallPos + 160 + 160], encryptedBuf[0], lenArr);
break;
end
else
Inc(i);
end;

i := 0;
kk := 0;
while i < lenArr do
begin
move(encryptedBuf[i], inData[0], 16);

j := 0;
addSpecial := 0;
while (j + 3) < 15 do
begin
if CompareMem(@inData[j], @bad_key2_1[0], 3) then
begin
move(encryptedBuf[i + j + 25], inData[5], 11);
addSpecial := 15 + 14;
break;
end;

if CompareMem(@inData[j], @bad_key3_1[0], 3) then
begin
move(encryptedBuf[i + j + 25], inData[2], 14);
addSpecial := 15 + 14;
break;
end;
Inc(j);
end;

if isRC6 then
decryptRC6_CBC(RC6_AES_Key, inData, outData);
if isAES then
decrypt_AES(RC6_AES_Key, inData, outData);
move(outData[0], buf1[lastCallPos + 160 + 160 + kk], 16);
Inc(i, 16 + addSpecial);
Inc(kk, 16);
end;

end;
end;

function makeKeys(): boolean;
var
res: boolean;
var
i, len, n: integer;
myFile: file;
CurrentKey: array[0..4 + 16 + 16 + 16 + 3] of byte;
begin
i := lastCallPos;
len := whole_size;
n := 0;

AssignFile(myFile, get_dll_full_path() + 'v_tps.db');
ReWrite(myFile, 1);
res := True;
while i < len do
begin
if n > total_keys_no then
break;

while (i + 2) < len do
begin
if CompareMem(@buf1[i], @keys_beginning[0], 2) then
break
else
Inc(i);
end;
if i + 16 >= len then
break;

All_TPS_Keys[n].flag0 := 0; //dummy
All_TPS_Keys[n].flag3 := $1C; //dummy

Inc(i, 4);
All_TPS_Keys[n].flag1 := buf1[i];
if All_TPS_Keys[n].flag1 > 3 then
begin
res := False;
lastCallPos := i;
break; // incomplete key set ...
end;
Inc(i);
All_TPS_Keys[n].flag2 := buf1[i];
if All_TPS_Keys[n].flag2 > 3 then
begin
lastCallPos := i;
res := False;
break; // incomplete key set ...
end;

while i + 2 < len do
begin
if CompareMem(@buf1[i], @ident_key1[0], 2) then
break
else
Inc(i);
end;
if i + 16 >= len then
break;

move(cosmeticKey[0], All_TPS_Keys[n].key1[0], 16); //dummy
move(buf1[i + 2], All_TPS_Keys[n].key2[0], 16);

if CompareMem(@buf1[i + 2 + 7 - 1], @bad_key2_1[0], 3) then
begin
move(buf1[i + 2], All_TPS_Keys[n].key2[0], 2);
move(buf1[i + 33], All_TPS_Keys[n].key2[2], 14);
end;

Inc(i, 16);

while i + 2 < len do
begin
if CompareMem(@buf1[i], @ident_key2[0], 2) then
break
else
Inc(i);
end;
if i + 16 >= len then
break;

move(buf1[i + 2], All_TPS_Keys[n].key3[0], 16);

if CompareMem(@buf1[i + 2 + 16 + 3], @bad_key3_1[0], 3) then
begin
All_TPS_Keys[n].key3[15] := buf1[i + 2 + 16 + 3 + 25];
end;


//write to file
move(All_TPS_Keys[n].timeStamp[0], CurrentKey[0], 4);
move(All_TPS_Keys[n].Key1[0], CurrentKey[4], 16);
move(All_TPS_Keys[n].Key2[0], CurrentKey[20], 16);
move(All_TPS_Keys[n].Key3[0], CurrentKey[36], 16);
move(All_TPS_Keys[n].flag0, CurrentKey[52], 1);
move(All_TPS_Keys[n].flag1, CurrentKey[53], 1);
move(All_TPS_Keys[n].flag2, CurrentKey[54], 1);
move(All_TPS_Keys[n].flag3, CurrentKey[55], 1);
BlockWrite(myFile, CurrentKey, length(CurrentKey));

Inc(i, 16);
Inc(n);
lastCallPos := i;
end;

CloseFile(myFile);
Result := res;
lastCallPos := i;
end;

procedure extractKeys();
var
res: boolean;
cnt: integer;
begin
readWholeFileToMem;
cnt := 0;
while lastCallPos < whole_size do
begin
if makeTimeStamps then
begin
res := makeKeys();
if res then
break;
end;

Inc(cnt);
if cnt > 30 then
break; //do not hang ...!
end;

FreeMem(buf1);
end;

var
terminateMon: boolean = False;
isRunning: boolean = False;

type
TMonitorPidThread = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
public
end;

procedure TMonitorPidThread.Execute;
begin
FreeOnTerminate := True;
isRunning := True;
while True do
begin
if terminateMon then
break;

if saveToBin.alen > 512000 then
begin
StopArb_Filt();
extractKeys();
break;
end;

sleep(30);
end;
isRunning := False;
GUI.PushMSG_Info('TPS-AU Finished.');
end;


procedure startTPS_AU;
begin
if isRunning then
exit;
if use_TPS_AU() <> 1 then
exit;

terminateMon := False;

TMonitorPidThread.Create(False);
GUI.PushMSG_Info('TPS-AU started. Plz wait a minute...');
StartArb_Filt(4850, 'raw_tps.bin');
end;

procedure stopTPS_AU;
begin
if isRunning then
begin
terminateMon := True;
StopArb_Filt();
end;
end;

function isRunning_TPS_AU: boolean;
begin
Result := isRunning;
end;

initialization

finalization
terminateMon := True;

end.

[phyton]

teşekkürler inceleyeceğim.

[zombi]

Viacces1 , seca ,nagravision1 ve irdeto algoritmalarınıda incelemek istersen verebilirim. Ancak hepside Delphi ile..
Güvenlik açısından adını açık açık yazmayacağım (o kendini biliyor) bi arkadaşımdan başka destek ve yardım eden olmadı.Delphi ile olan kodları yaygınlaştırmak için algoritmaları verebilirim.

[softbal10]

Delphiyi çok severim delphi ile yazmak bence bir ayrıcalıktır.Kodları inceledim üstünde çalışmak güzel olur fakat şu günler itbari ile ne bilgisayarım var nede bir ortamım kodları sağlam bir yere upload edip daha sonra incelemek gerek
örneğin.
www.skystar.org

[phyton]

kodları yayınlayabilirseniz sevinirim. Bende Delphi programcısıyım. İşime yarayabilir. Teşekkürler.

[zombi]

arkadaşlar algoritmaları www.skystar.org adresine yükleyip burdan link veririm en kısa zamanda. Ama bunlar sadece şifreleme sistemlerine ait algoritmalar. Bir plugine ait örnek isterseniz size biss ve grolandsat örneklerini verebilirim. Şimdilik arkadaşımla ortak olan pluginin kodlarını açmayı düşünmüyoruz.

[zombi]

Buyrun bunlarda yukarda bahsettiğim Viacces1 , seca ,nagravision1 ve irdeto algoritmaları .pas uzantılı dır. Benden size bu kadar fayda umarım güzel çalışmalar çıkartırsınız. Emu konularında Türklerinde sözü olsun ama unutmayın bu tür konularda Delphi ile yazılmış örnek kodlara ulaşmak nerdeyse imkansız.
İNDİR

************************************************** ******
Unit ALG_Iderto;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TPlainKey = array[0..7] of Byte;
THexKey = array[0..9] of Byte;
PHexKey = ^THexKey;
Procedure Decrypt_IDERTO (worddata_I,MK_PK_I,date_Iderto : string);
procedure RotateKey(Key: PByteArray);
function SigCalc(plainmasterkey, plainkey : array of byte) : THexKey;
function VerifySignature( ins_idert , MK_PK_I ,sig_idert,date_Iderto : string ) : Boolean;
procedure CryptKey(N: Word; Key1, Key2: PByteArray);
procedure RotateKey2(N: Word; Key: PByteArray);
function VerifySignatureEMM( ins_idert ,MK_PK_I ,sig_idert : string ) : Boolean;
var
CW_I : array[0..7] of Byte;
Date_I : array[0..1] of Byte;
BK_I : array[0..9] of Byte;
PK_I : array[0..7] of Byte;
key : array[0..7] of Byte;
Tmp_EK_I : array[0..7] of Byte;
EK_I : array[0..7] of Byte;
Test_III : Byte ;
Buffer: array[0..256] of Byte;
SigKey: TPlainKey;
implementation

const
RotTable1: array[0..15] of Byte = (0, 1, 2, 3, 4, 5, 6, 7, 0, 3, 6, 1, 4, 7, 2, 5);
AsciTable: array[0..7] of Byte = ($61, $62, $63, $64, $65, $66, $67, $FE);
Table1: array[0..255] of Byte = (
$DA,$26,$E8,$72,$11,$52,$3E,$46,$32,$FF,$8C,$1E,$A 7,$BE,$2C,$29,
$5F,$86,$7E,$75,$0A,$08,$A5,$21,$61,$FB,$7A,$58,$6 0,$F7,$81,$4F,
$E4,$FC,$DF,$B1,$BB,$6A,$02,$B3,$0B,$6E,$5D,$5C,$D 5,$CF,$CA,$2A,
$14,$B7,$90,$F3,$D9,$37,$3A,$59,$44,$69,$C9,$78,$3 0,$16,$39,$9A,
$0D,$05,$1F,$8B,$5E,$EE,$1B,$C4,$76,$43,$BD,$EB,$4 2,$EF,$F9,$D0,
$4D,$E3,$F4,$57,$56,$A3,$0F,$A6,$50,$FD,$DE,$D2,$8 0,$4C,$D3,$CB,
$F8,$49,$8F,$22,$71,$84,$33,$E0,$47,$C2,$93,$BC,$7 C,$3B,$9C,$7D,
$EC,$C3,$F1,$89,$CE,$98,$A2,$E1,$C1,$F2,$27,$12,$0 1,$EA,$E5,$9B,
$25,$87,$96,$7B,$34,$45,$AD,$D1,$B5,$DB,$83,$55,$B 0,$9E,$19,$D7,
$17,$C6,$35,$D8,$F0,$AE,$D4,$2B,$1D,$A0,$99,$8A,$1 5,$00,$AF,$2D,
$09,$A8,$F5,$6C,$A1,$63,$67,$51,$3C,$B2,$C0,$ED,$9 4,$03,$6F,$BA,
$3F,$4E,$62,$92,$85,$DD,$AB,$FE,$10,$2E,$68,$65,$E 7,$04,$F6,$0C,
$20,$1C,$A9,$53,$40,$77,$2F,$A4,$FA,$6D,$73,$28,$E 2,$CD,$79,$C8,
$97,$66,$8E,$82,$74,$06,$C7,$88,$1A,$4A,$6B,$CC,$4 1,$E9,$9D,$B8,
$23,$9F,$3D,$BF,$8D,$95,$C5,$13,$B9,$24,$5A,$DC,$6 4,$18,$38,$91,
$7F,$5B,$70,$54,$07,$B6,$4B,$0E,$36,$AC,$31,$E6,$D 6,$48,$AA,$B4);
Table2 : Array[0..255] of Byte = (
$8E,$D5,$32,$53,$4B,$18,$7F,$95,$BE,$30,$F3,$E0,$2 2,$E1,$68,$90,
$82,$C8,$A8,$57,$21,$C5,$38,$73,$61,$5D,$5A,$D6,$6 0,$B7,$48,$70,
$2B,$7A,$1D,$D1,$B1,$EC,$7C,$AA,$2F,$1F,$37,$58,$7 2,$88,$FF,$87,
$1C,$CB,$00,$E6,$4E,$AB,$EB,$B3,$F7,$59,$71,$6A,$6 4,$2A,$55,$4D,
$FC,$C0,$51,$01,$2D,$C4,$54,$E2,$9F,$26,$16,$27,$F 2,$9C,$86,$11,
$05,$29,$A2,$78,$49,$B2,$A6,$CA,$96,$E5,$33,$3F,$4 6,$BA,$D0,$BB,
$5F,$84,$98,$E4,$F9,$0A,$62,$EE,$F6,$CF,$94,$F0,$E A,$1E,$BF,$07,
$9B,$D9,$E9,$74,$C6,$A4,$B9,$56,$3E,$DB,$C7,$15,$E 3,$80,$D7,$ED,
$EF,$13,$AC,$A1,$91,$C2,$89,$5B,$08,$0B,$4C,$02,$3 A,$5C,$A9,$3B,
$CE,$6B,$A7,$E7,$CD,$7B,$A0,$47,$09,$6D,$F8,$F1,$8 B,$B0,$12,$42,
$4A,$9A,$17,$B4,$7E,$AD,$FE,$FD,$2C,$D3,$F4,$B6,$A 3,$FA,$DF,$B8,
$D4,$DA,$0F,$50,$93,$66,$6C,$20,$D8,$8A,$DD,$31,$1 A,$8C,$06,$D2,
$44,$E8,$23,$43,$6E,$10,$69,$36,$BC,$19,$8D,$24,$8 1,$14,$40,$C9,
$6F,$2E,$45,$52,$41,$92,$34,$FB,$5E,$0D,$F5,$76,$2 5,$77,$63,$65,
$AF,$4F,$CC,$03,$9D,$0C,$28,$39,$85,$DE,$B5,$7D,$6 7,$83,$BD,$C3,
$DC,$3C,$AE,$99,$04,$75,$8F,$97,$C1,$A5,$9E,$35,$0 E,$3D,$1B,$79);

function VerifySignature( ins_idert ,MK_PK_I ,sig_idert , date_Iderto : string ) : Boolean;
var
I,J:Integer;
TmpMKey:THexKey;
B0,B1,B2,B3:SmallInt;
tmp_I:string;
begin
//
for i:=0 to ((Length(ins_idert)DIV 2)-1) do Buffer[i]:=strtoint('$'+copy(ins_idert,i*2+1,2));
for i:= 0 to 7 do tmpMKey[i]:=strtoint('$'+copy(MK_PK_I,i*2+1,2));
for i:= 0 to 1 do tmpMKey[i+8]:=strtoint('$'+copy(MK_PK_I,i*2+1,2)) Xor strtoint('$'+copy(date_Iderto,i*2+1,2));
tmp_I:='';B0:=0;B2:=0;B3:=0;
for i := 0 to 9 do if tmpMKey[i]>$F then tmp_I:=tmp_I+Format('%2x',[tmpMKey[i]])
else tmp_I:=tmp_I+Format('0%1x',[tmpMKey[i]]);
//
FillChar(SigKey[0],SizeOf(SigKey),0);I:=Length(ins_idert)DIV 2 ;
while I > 0 do
begin
B1:=0;J:=0;
if I < 8 then B1 := (8 - I);
while (8 - B1) > J do
begin
SigKey[J] := SigKey[J] xor Buffer[(B3 shl 3) + B0 + J];Inc(J);
end;
J:=8;J:=J-B1;
while (J < 8) do
begin
SigKey[J] := SigKey[J] xor ascitable[B2];Inc(B2);Inc(J);
end;
if B1 = 0 then CryptKey($28, @TmpMKey, @SigKey)
else CryptKey($68, @TmpMKey, @SigKey);
Inc(B3);I:=I-8;
end;
tmp_I:='';
for i:= 0 to 4 do if SigKey[i]>$F then tmp_I:=tmp_I+format('%2x',[SigKey[i]])
else tmp_I:=tmp_I+format('0%1x',[SigKey[i]]);
if tmp_I=sig_idert then Result:=True else Result:=False;
end;
function VerifySignatureEMM( ins_idert ,MK_PK_I ,sig_idert : string ) : Boolean;
var
I,J:Integer;
TmpMKey:THexKey;
B0,B1,B2,B3:SmallInt;
tmp_I:string;
begin

for i:=0 to ((Length(ins_idert)DIV 2)-1) do Buffer[i]:=strtoint('$'+copy(ins_idert,i*2+1,2));
for i:= 0 to 7 do tmpMKey[i]:=00;
for i:= 0 to 1 do tmpMKey[i+8]:=00;
tmp_I:='';B0:=0;B2:=0;B3:=0;
for i := 0 to 9 do if tmpMKey[i]>$F then tmp_I:=tmp_I+Format('%2x',[tmpMKey[i]]) // 9
else tmp_I:=tmp_I+Format('0%1x',[tmpMKey[i]]);
//
FillChar(SigKey[0],SizeOf(SigKey),0);I:=Length(ins_idert)DIV 2 ;
while I > 0 do
begin
B1:=0;J:=0;
if I < 8 then B1 := (8 - I);
while (8 - B1) > J do
begin
SigKey[J] := SigKey[J] xor Buffer[(B3 shl 3) + B0 + J];Inc(J);
end;
J:=8;J:=J-B1;
while (J < 8) do
begin
SigKey[J] := SigKey[J] xor ascitable[B2];Inc(B2);Inc(J);
end;
if B1 = 0 then CryptKey($28, @TmpMKey, @SigKey)
else CryptKey($68, @TmpMKey, @SigKey);
Inc(B3);I:=I-8;
end;
tmp_I:='';
for i:= 0 to 4 do if SigKey[i]>$F then tmp_I:=tmp_I+format('%2x',[SigKey[i]])
else tmp_I:=tmp_I+format('0%1x',[SigKey[i]]);
if tmp_I=sig_idert then Result:=True else Result:=False;
end;
procedure CryptKey(N: Word; Key1, Key2: PByteArray);
var
I, J, K, L: Integer;
begin
I := 0;
while I < N do
begin
J:=I mod 10;
K:=I mod 8;
L:=(I+1) mod 8;
if J=0 then RotateKey2(10, Key1);
if (Key1[J] and 1) <> 0 then Key2[L] := Key2[L] xor Table1[Key2[K] xor Key1[J]]
else Key2[L] := Key2[L] xor Table2[Key2[K] xor Key1[J]];
Inc(I)
end;
RotateKey2(10, Key1);
end;

Procedure Decrypt_IDERTO (worddata_I,MK_PK_I,date_Iderto : string);
Var
i:integer;
tmp_I:string;
begin
//
for i:= 0 to 7 do CW_I[i]:=strtoint('$'+copy(worddata_I,i*2+1,2));
for i:= 0 to 7 do PK_I[i]:=strtoint('$'+copy(MK_PK_I,i*2+1,2));
for i:= 0 to 1 do date_I[i]:=strtoint('$'+copy(date_Iderto,i*2+1,2));
//
for I := 0 to 9 do BK_I[i] := PK_I[I mod 8];
for I := 0 to 1 do BK_I[8 + I] := BK_I[8 + I] xor date_I[i];
//
SigCalc(PK_I, CW_I );
//
tmp_I:='';
for i:= 0 to 7 do if Tmp_EK_I[i]>$F then tmp_I:=tmp_I+format('%2x',[Tmp_EK_I[i]]) else tmp_I:=tmp_I+format('0%1x',[Tmp_EK_I[i]]);
end;

function SigCalc(plainmasterkey, plainkey : array of byte ) : THexKey;
var
I, J, K, L: Integer;
begin
I := 0;
while (I < 128) do
begin
J := I mod 10;
K := RotTable1[I mod 16];
L := RotTable1[(I + 1) mod 16];
if J = 0 then RotateKey(@BK_I[0]);
if ((BK_I[J] and 1) = 1) Then plainkey[L] := plainkey[L] xor Table1[plainkey[K] xor BK_I[J]]
else plainkey[L] := plainkey[L] xor Table2[plainkey[K] xor BK_I[J]];
Inc(I);
end;
for i:=0 to 9 do Tmp_EK_I[i]:=plainkey[i];
end;

procedure RotateKey(Key: PByteArray);
var
i: Integer;
OKey: Byte;
begin
OKey := Key[9];
for i := 9 downto 1 do Key[i] := (Key[i] shr 1) or (Key[i - 1] shl 7);
Key[0] := (Key[0] shr 1) or (OKey shl 7);
end;

procedure RotateKey2(N: Word; Key: PByteArray);
var
OKey: Byte;
begin
N:=N-1;
OKey:=Key[N];
while N > 0 do
begin
Key[N] := (Key[N] shr 1) or (Key[N - 1] shl 7);
Dec(N);
end;
Key[0]:=(Key[0] shr 1)or(OKey shl 7)
end;


end.
************************************************** *******
Unit ALG_NAGRA;


interface

// 00807037033571011031154B10CA535102BDA224CB7EDE085D 0A185693C04D211B049B62A877E3D439D792057DD446DDDB7A 105011EADAEAC757AD
// 0081703703357101103115839BC963F54994C024CB7EDE085D 0A1858F85AF524E8C67329D432F0A7581517057DD446DDDB7A 101AFE8AD531E75274


uses
SysUtils;//IdGlobal;

var
carry: Word;
xhi: Byte;
xlo: Byte;
yhi: Byte;
ylo: Byte;
r0: Byte;
r1: Byte;
r2: Byte;
r3: Byte;
r4: Byte;
r5: Byte;
r6: Byte;
r7: Byte;
r8: Byte;
r9: Byte;
r10: Byte;
r11: Byte;
r12: Byte;
r13: Byte;
r14: Byte;
r15: Integer;
r16: Byte;
r17: Byte;
r18: Byte;
r19: Byte;
r20: Byte;
r21: Byte;
r22: Byte;
r23: Byte;
r24: Byte;
r25: Byte;
procedure encnagra(Var k0: array of byte;Var tin: array of byte;Var tout: array of byte);
procedure decnagra(Var k0: array of byte;Var tin: array of byte;Var tout: array of byte);
procedure Hashnagra(Var e: byte ;Var Vf: array of byte; Var data: array of byte;Var RHashN: array of byte);
procedure DecBrutnagra(Var key0: array of byte;Var verify_key: array of byte;Var data: array of byte;Var RHashN: array of byte);


const
decode: array[0..255] of Byte = (
$F7,$E2,$3C,$BF,$04,$5B,$9A,$EC,$9B,$87,$06,$59,$A D,$F4,
$E0,$0A,$62,$08,$95,$63,$5F,$36,$49,$95,$38,$D1,$7 3,$AE,
$91,$AD,$8E,$F0,$10,$7F,$55,$1A,$E7,$92,$F9,$25,$4 E,$11,
$C3,$CC,$3B,$C8,$2C,$56,$CF,$93,$66,$DD,$B4,$E9,$3 A,$70,
$A2,$24,$AD,$37,$48,$1E,$D1,$AB,$85,$BB,$88,$4D,$7 6,$61,
$7D,$DA,$E9,$42,$B3,$94,$1F,$8C,$04,$67,$D0,$66,$4 B,$F8,
$2C,$DF,$12,$35,$07,$39,$EE,$03,$CA,$40,$B1,$CE,$7 B,$C8,
$F4,$22,$DC,$06,$A3,$8D,$B0,$AB,$2A,$77,$66,$71,$5 F,$B4,
$2E,$55,$11,$8F,$82,$B9,$CD,$4A,$59,$F0,$D7,$EC,$F 5,$2E,
$68,$13,$C4,$B2,$51,$8F,$BE,$C5,$2B,$46,$32,$28,$6 C,$33,
$DD,$9E,$D7,$F0,$F3,$64,$EA,$59,$C5,$5B,$90,$2C,$6 8,$8D,
$0F,$0A,$06,$31,$69,$C7,$27,$DD,$2A,$B6,$52,$08,$4 C,$75,
$84,$43,$BF,$60,$EB,$A4,$81,$9A,$1D,$01,$90,$EF,$2 E,$B7,
$F9,$12,$D3,$7E,$C5,$99,$78,$4B,$16,$6C,$B2,$18,$F C,$F5,
$1F,$F3,$CA,$80,$04,$ED,$89,$A6,$61,$2E,$76,$39,$4 D,$F2,
$33,$CF,$F0,$8C,$A5,$5A,$97,$5B,$DE,$71,$AB,$E7,$0 8,$A4,
$EB,$A6,$47,$19,$82,$68,$34,$E7,$5D,$3B,$7A,$D0,$3 8,$D5,
$E1,$0C,$70,$CD,$AC,$2A,$49,$12,$5F,$B4,$AE,$91,$1 3,$4F,
$95,$7E,$B6,$D3);
implementation
uses ULiveInet;
procedure show(str: string;d: array of byte;s: Integer);
var
i: Integer;
begin
write(str);
for i:=0 to 7 do write(IntToHex(d[i],2) + ' ');
writeln;
end;

procedure dumpregs(str: string);
begin
writeln('str=',str);
writeln('r00=',IntToHex(r0,2),' R01=',IntToHex(r1,2),' r02=',IntToHex(r2,2),' r03=',IntToHex(r3,2),' r04=',IntToHex(r4,2));
writeln('r05=',IntToHex(r5,2),' R06=',IntToHex(r6,2),' r07=',IntToHex(r7,2),' r08=',IntToHex(r8,2),' r09=',IntToHex(r9,2));
writeln('r06=',IntToHex(r6,2),' R07=',IntToHex(r7,2),' r08=',IntToHex(r8,2),' r09=',IntToHex(r9,2),' r10=',IntToHex(r10,2));
writeln('r11=',IntToHex(r11,2),' R12=',IntToHex(r12,2),' r13=',IntToHex(r13,2),' r14=',IntToHex(r14,2),' r15=',IntToHex(r15,2));
writeln('r16=',IntToHex(r16,2));
writeln('r17=',IntToHex(r17,2));
writeln('r18=',IntToHex(r18,2));
writeln('r19=',IntToHex(r19,2));
writeln('r20=',IntToHex(r20,2));
writeln('r21=',IntToHex(r21,2));
writeln('r22=',IntToHex(r22,2));
writeln('r23=',IntToHex(r23,2));
writeln('r24=',IntToHex(r24,2));
writeln('r25=',IntToHex(r25,2));
end;

function flop(c: Byte): Byte;
var
i: Integer;
r: Byte;
begin
r := 0;
for i:=0 to 7 do
begin
r := r shl 1;
r := r + c and 1;
c := c shr 1;
flop := r;
end;
end;

function brs(t: Byte;b: Integer): Integer;
begin
t := t shr b;
t := t and 1;
brs := t;
end;


function lsr(t: Word): Integer;
begin
carry := 0;
if (t and 1) = 1 then carry := 1;
lsr := t shr 1;
end;


function ror(t: Byte): Integer;
var
nc, v: Word;
begin
nc := 0;
if (t and 1) = 1 then nc := 1;
t := t shr 1;
v := carry shl 7;
t := t or v;
carry := nc;
ror := t;
end;

function rol(t: Byte): Integer;
var
nc: Word;
begin
nc := 0;
if ((t shr 7) and 1) = 1 then nc := 1;
t := t shl 1;
t := t or carry;
carry := nc;
rol := t;
end;

procedure xor1(cin_a: array of byte; cin_b: array of byte;var cout: array of byte);
var
i: Integer;
begin
for i:=0 to 7 do cout[i] := cin_a[i] xor cin_b[i];
end;

procedure p0557(var out: array of byte);
begin
r17 := $00;
r18 := $00;
r19 := $40;
r20 := $01;
r21 := $80;
r22 := $02;
r23 := $C0;
r24 := $03;
r25 := $00;
r16 := out[0];
if brs(r16,0) = 1 then r20 := r20 or $40;
if brs(r16,1) = 1 then r20 := r20 or $04;
if brs(r16,2) = 1 then r18 := r18 or $80;
if brs(r16,3) = 1 then r19 := r19 or $01;
if brs(r16,4) = 1 then r18 := r18 or $08;
if brs(r16,5) = 1 then r19 := r19 or $08;
r16 := out[1];
if brs(r16,2) = 1 then r20 := r20 or $80;
if brs(r16,3) = 1 then r20 := r20 or $10;
if brs(r16,4) = 1 then r17 := r17 or $01;
if brs(r16,5) = 1 then r17 := r17 or $20;
if brs(r16,6) = 1 then r20 := r20 or $20;
if brs(r16,7) = 1 then r25 := r25 or $01;
r16 := out[2];
if brs(r16,0) = 1 then r25 := r25 or $04;
if brs(r16,1) = 1 then r25 := r25 or $02;
if brs(r16,2) = 1 then r17 := r17 or $04;
if brs(r16,3) = 1 then r18 := r18 or $04;
if brs(r16,4) = 1 then r25 := r25 or $08;
if brs(r16,5) = 1 then r20 := r20 or $08;
r16 := out[3];
if brs(r16,2) = 1 then r18 := r18 or $10;
if brs(r16,3) = 1 then r18 := r18 or $20;
if brs(r16,4) = 1 then r19 := r19 or $10;
if brs(r16,5) = 1 then r19 := r19 or $02;
if brs(r16,6) = 1 then r19 := r19 or $04;
if brs(r16,7) = 1 then r17 := r17 or $10;
r16 := out[4];
if brs(r16,0) = 1 then r22 := r22 or $08;
if brs(r16,1) = 1 then r22 := r22 or $10;
if brs(r16,2) = 1 then r22 := r22 or $04;
if brs(r16,3) = 1 then r24 := r24 or $20;
if brs(r16,4) = 1 then r24 := r24 or $04;
if brs(r16,5) = 1 then r25 := r25 or $80;
r16 := out[5];
if brs(r16,2) = 1 then r24 := r24 or $40;
if brs(r16,3) = 1 then r23 := r23 or $04;
if brs(r16,4) = 1 then r24 := r24 or $10;
if brs(r16,5) = 1 then r23 := r23 or $01;
if brs(r16,6) = 1 then r24 := r24 or $80;
if brs(r16,7) = 1 then r21 := r21 or $10;
r16 := out[6];
if brs(r16,0) = 1 then r25 := r25 or $40;
if brs(r16,1) = 1 then r22 := r22 or $80;
if brs(r16,2) = 1 then r25 := r25 or $20;
if brs(r16,3) = 1 then r21 := r21 or $20;
if brs(r16,4) = 1 then r22 := r22 or $40;
if brs(r16,5) = 1 then r21 := r21 or $02;
r16 := out[7];
if brs(r16,2) = 1 then r22 := r22 or $20;
if brs(r16,3) = 1 then r21 := r21 or $01;
if brs(r16,4) = 1 then r23 := r23 or $02;
if brs(r16,5) = 1 then r25 := r25 or $10;
if brs(r16,6) = 1 then r23 := r23 or $08;
if brs(r16,7) = 1 then r21 := r21 or $04;
if brs(r14,0) = 1 then r19 := r19 or $20;
if brs(r14,1) = 1 then r17 := r17 or $02;
if brs(r14,2) = 1 then r18 := r18 or $40;
if brs(r14,3) = 1 then r17 := r17 or $08;
if brs(r14,4) = 1 then r23 := r23 or $10;
if brs(r14,5) = 1 then r21 := r21 or $08;
if brs(r14,6) = 1 then r24 := r24 or $08;
if brs(r14,7) = 1 then r23 := r23 or $20;
end;

procedure revbits(var b: array of byte);
var
i: integer;
begin
for i:=0 to 7 do b[i] := flop(b[i]);
end;

procedure p0443(var out: array of byte);
begin
r17 := $00;
r18 := $00;
r19 := $40;
r20 := $01;
r21 := $80;
r22 := $02;
r23 := $C0;
r24 := $03;
r25 := $00;
r16 := out[0];
if brs(r16,0) = 1 then r18 := r18 or $10;
if brs(r16,1) = 1 then r25 := r25 or $02;
if brs(r16,2) = 1 then r19 := r19 or $04;
if brs(r16,3) = 1 then r25 := r25 or $08;
if brs(r16,4) = 1 then r20 := r20 or $80;
if brs(r16,5) = 1 then r18 := r18 or $20;
r16 := out[1];
if brs(r16,2) = 1 then r19 := r19 or $08;
if brs(r16,3) = 1 then r17 := r17 or $10;
if brs(r16,4) = 1 then r20 := r20 or $04;
if brs(r16,5) = 1 then r20 := r20 or $08;
if brs(r16,6) = 1 then r25 := r25 or $04;
if brs(r16,7) = 1 then r17 := r17 or $04;
r16 := out[2];
if brs(r16,0) = 1 then r17 := r17 or $08;
if brs(r16,1) = 1 then r20 := r20 or $20;
if brs(r16,2) = 1 then r20 := r20 or $40;
if brs(r16,3) = 1 then r17 := r17 or $20;
if brs(r16,4) = 1 then r20 := r20 or $10;
if brs(r16,5) = 1 then r25 := r25 or $01;
r16 := out[3];
if brs(r16,2) = 1 then r17 := r17 or $02;
if brs(r16,3) = 1 then r19 := r19 or $20;
if brs(r16,4) = 1 then r18 := r18 or $08;
if brs(r16,5) = 1 then r18 := r18 or $40;
if brs(r16,6) = 1 then r17 := r17 or $01;
if brs(r16,7) = 1 then r18 := r18 or $04;
r16 := out[4];
if brs(r16,0) = 1 then r24 := r24 or $08;
if brs(r16,1) = 1 then r23 := r23 or $20;
if brs(r16,2) = 1 then r24 := r24 or $80;
if brs(r16,3) = 1 then r25 := r25 or $20;
if brs(r16,4) = 1 then r22 := r22 or $80;
if brs(r16,5) = 1 then r23 := r23 or $08;
r16 := out[5];
if brs(r16,2) = 1 then r21 := r21 or $04;
if brs(r16,3) = 1 then r21 := r21 or $01;
if brs(r16,4) = 1 then r21 := r21 or $02;
if brs(r16,5) = 1 then r24 := r24 or $04;
if brs(r16,6) = 1 then r23 := r23 or $10;
if brs(r16,7) = 1 then r23 := r23 or $02;
r16 := out[6];
if brs(r16,0) = 1 then r22 := r22 or $20;
if brs(r16,1) = 1 then r24 := r24 or $10;
if brs(r16,2) = 1 then r22 := r22 or $08;
if brs(r16,3) = 1 then r24 := r24 or $40;
if brs(r16,4) = 1 then r25 := r25 or $10;
if brs(r16,5) = 1 then r25 := r25 or $80;
r16 := out[7];
if brs(r16,2) = 1 then r21 := r21 or $10;
if brs(r16,3) = 1 then r25 := r25 or $40;
if brs(r16,4) = 1 then r22 := r22 or $10;
if brs(r16,5) = 1 then r21 := r21 or $08;
if brs(r16,6) = 1 then r22 := r22 or $04;
if brs(r16,7) = 1 then r22 := r22 or $40;
if brs(r14,0) = 1 then r18 := r18 or $80;
if brs(r14,1) = 1 then r19 := r19 or $02;
if brs(r14,2) = 1 then r19 := r19 or $01;
if brs(r14,3) = 1 then r19 := r19 or $10;
if brs(r14,4) = 1 then r24 := r24 or $20;
if brs(r14,5) = 1 then r23 := r23 or $04;
if brs(r14,6) = 1 then r23 := r23 or $01;
if brs(r14,7) = 1 then r21 := r21 or $20;
end;

procedure p06af(var out: array of byte);
begin
out[0] := r17;
out[1] := r18;
out[2] := r19;
out[3] := r20;
out[4] := r21;
out[5] := r22;
out[6] := r23;
out[7] := r24;
r14 := r25;
end;

procedure p06bd(var out: array of byte);
var
i: integer;
begin
for i:=0 to 7 do
begin
r7 := lsr(r7);
r16 := rol(r16);
r6 := lsr(r6);
r16 := rol(r16);
r9 := lsr(r9);
r16 := rol(r16);
r8 := lsr(r8);
r16 := rol(r16);
r11 := lsr(r11);
r16 := rol(r16);
r10 := lsr(r10);
r16 := rol(r16);
r13 := lsr(r13);
r16 := rol(r16);
r12 := lsr(r12);
r16 := rol(r16);
out[i] := r16;
end;
end;

procedure p05f9(var out: array of byte);
begin
xlo := 0;
xhi := 0;
ylo := 0;
yhi := 0;
r16 := r7;
r16 := rol(r16);
r16 := r13;
r16 := rol(r16);
r16 := r16 and $3F;
r16 := r16 xor r17;
r0 := decode[r16];
if brs(r0,0) = 1 then xhi := xhi or $01;
if brs(r0,1) = 1 then ylo := ylo or $01;
if brs(r0,2) = 1 then ylo := ylo or $40;
if brs(r0,3) = 1 then yhi := yhi or $40;
r16 := r11;
r16 := ror(r16);
r16 := r13;
r16 := ror(r16);
r16 := r16 and $FC;
r16 := r16 xor r18;
r0 := decode[r16];
if brs(r0,4) = 1 then xhi := xhi or $10;
if brs(r0,5) = 1 then yhi := yhi or $08;
if brs(r0,6) = 1 then xlo := xlo or $02;
if brs(r0,7) = 1 then ylo := ylo or $02;
r16 := r13;
r16 := rol(r16);
r16 := r11;
r16 := rol(r16);
r16 := r16 and $3F;
r16 := r16 xor r19;
r0 := decode[r16];
if brs(r0,0) = 1 then ylo := ylo or $80;
if brs(r0,1) = 1 then xhi := xhi or $80;
if brs(r0,2) = 1 then yhi := yhi or $20;
if brs(r0,3) = 1 then xlo := xlo or $20;
r16 := r9;
r16 := ror(r16);
r16 := r11;
r16 := ror(r16);
r16 := r16 and $FC;
r16 := r16 xor r20;
r0 := decode[r16];
if brs(r0,4) = 1 then yhi := yhi or $02;
if brs(r0,5) = 1 then ylo := ylo or $08;
if brs(r0,6) = 1 then xhi := xhi or $02;
if brs(r0,7) = 1 then xlo := xlo or $01;
r16 := r11;
r16 := rol(r16);
r16 := r9;
r16 := rol(r16);
r16 := r16 and $3F;
r16 := r16 xor r21;
r0 := decode[r16];
if brs(r0,0) = 1 then xlo := xlo or $80;
if brs(r0,1) = 1 then xhi := xhi or $20;
if brs(r0,2) = 1 then yhi := yhi or $01;
if brs(r0,3) = 1 then xlo := xlo or $04;
r16 := r7;
r16 := ror(r16);
r16 := r9;
r16 := ror(r16);
r16 := r16 and $FC;
r16 := r16 xor r22;
r0 := decode[r16];
if brs(r0,4) = 1 then xlo := xlo or $08;
if brs(r0,5) = 1 then yhi := yhi or $10;
if brs(r0,6) = 1 then xhi := xhi or $04;
if brs(r0,7) = 1 then ylo := ylo or $04;
r16 := r9;
r16 := rol(r16);
r16 := r7;
r16 := rol(r16);
r16 := r16 and $3F;
r16 := r16 xor r23;
r0 := decode[r16];
if brs(r0,0) = 1 then yhi := yhi or $80;
if brs(r0,1) = 1 then xhi := xhi or $08;
if brs(r0,2) = 1 then ylo := ylo or $20;
if brs(r0,3) = 1 then xlo := xlo or $40;
r16 := r13;
r16 := ror(r16);
r16 := r7;
r16 := ror(r16);
r16 := r16 and $FC;
r16 := r16 xor r24;
r0 := decode[r16];
if brs(r0,4) = 1 then xlo := xlo or $10;
if brs(r0,5) = 1 then yhi := yhi or $04;
if brs(r0,6) = 1 then xhi := xhi or $40;
if brs(r0,7) = 1 then ylo := ylo or $10;
r16 := r12;
r16 := r16 xor xlo;
r12 := r13;
r13 := r16;
r16 := r10;
r16 := r16 xor xhi;
r10 := r11;
r11 := r16;
r16 := r8;
r16 := r16 xor ylo;
r8 := r9;
r9 := r16;
r16 := r6;
r16 := r16 xor yhi;
r6 := r7;
r7 := r16;
r15 := r15 - 1;
if r15 >= 0 then
p06af(out)
else
p06bd(out);
end;

procedure p5d9(t: array of byte; var out: array of byte);
var
r18save: byte;
y: byte;
// dummy: byte;
begin
r16 := $0F;
r15 := r16;
r16 := $40;
r4 := r16;
r16 := $81;
r5 := r16;
y := 0;
r18save := r18;
r18 := $08;
while r18 <> 0 do
begin
r16 := t[y];
y := y + 1;
r16 := lsr(r16);
r13 := ror(r13);
r16 := lsr(r16);
r12 := ror(r12);
r16 := lsr(r16);
r11 := ror(r11);
r16 := lsr(r16);
r10 := ror(r10);
r16 := lsr(r16);
r9 := ror(r9);
r16 := lsr(r16);
r8 := ror(r8);
r16 := lsr(r16);
r7 := ror(r7);
r16 := lsr(r16);
r6 := ror(r6);
r18 := r18 - 1;
end; { End while }
r18 := r18save;
p05f9(out);
end;

procedure p3b1(t1: array of byte;k: array of byte;var out: array of byte);
begin
r17 := $00;
r18 := $00;
r19 := $40;
r20 := $01;
r21 := $80;
r22 := $02;
r23 := $C0;
r24 := $03;
r25 := $00;

r16 := k[0];
if brs(r16,0) = 1 then r22 := r22 or $04;
if brs(r16,1) = 1 then r17 := r17 or $10;
if brs(r16,2) = 1 then r25 := r25 or $01;
if brs(r16,3) = 1 then r17 := r17 or $02;
if brs(r16,4) = 1 then r25 := r25 or $08;
if brs(r16,5) = 1 then r22 := r22 or $20;
if brs(r16,6) = 1 then r21 := r21 or $08;
if brs(r16,7) = 1 then r24 := r24 or $40;
r16 := k[1];
if brs(r16,0) = 1 then r23 := r23 or $04;
if brs(r16,1) = 1 then r21 := r21 or $04;
if brs(r16,2) = 1 then r20 := r20 or $80;
if brs(r16,3) = 1 then r18 := r18 or $80;
if brs(r16,4) = 1 then r25 := r25 or $02;
if brs(r16,5) = 1 then r19 := r19 or $10;
if brs(r16,6) = 1 then r24 := r24 or $04;
if brs(r16,7) = 1 then r25 := r25 or $20;
r16 := k[2];
if brs(r16,0) = 1 then r22 := r22 or $80;
if brs(r16,1) = 1 then r22 := r22 or $08;
if brs(r16,2) = 1 then r24 := r24 or $80;
if brs(r16,3) = 1 then r18 := r18 or $04;
if brs(r16,4) = 1 then r17 := r17 or $04;
if brs(r16,5) = 1 then r19 := r19 or $02;
if brs(r16,6) = 1 then r20 := r20 or $10;
if brs(r16,7) = 1 then r21 := r21 or $10;
r16 := k[3];
if brs(r16,0) = 1 then r23 := r23 or $20;
if brs(r16,1) = 1 then r23 := r23 or $02;
if brs(r16,2) = 1 then r21 := r21 or $01;
if brs(r16,3) = 1 then r22 := r22 or $40;
if brs(r16,4) = 1 then r19 := r19 or $08;
if brs(r16,5) = 1 then r19 := r19 or $04;
if brs(r16,6) = 1 then r20 := r20 or $20;
if brs(r16,7) = 1 then r18 := r18 or $08;
r16 := k[4];
if brs(r16,0) = 1 then r25 := r25 or $04;
if brs(r16,1) = 1 then r25 := r25 or $80;
if brs(r16,2) = 1 then r24 := r24 or $10;
if brs(r16,3) = 1 then r24 := r24 or $08;
if brs(r16,4) = 1 then r23 := r23 or $10;
if brs(r16,5) = 1 then r17 := r17 or $20;
if brs(r16,6) = 1 then r20 := r20 or $40;
if brs(r16,7) = 1 then r18 := r18 or $40;
r16 := k[5];
if brs(r16,0) = 1 then r18 := r18 or $10;
if brs(r16,1) = 1 then r19 := r19 or $01;
if brs(r16,2) = 1 then r21 := r21 or $20;
if brs(r16,3) = 1 then r22 := r22 or $10;
if brs(r16,4) = 1 then r25 := r25 or $40;
if brs(r16,5) = 1 then r25 := r25 or $10;
if brs(r16,6) = 1 then r18 := r18 or $20;
if brs(r16,7) = 1 then r17 := r17 or $01;
r16 := k[6];
if brs(r16,0) = 1 then r19 := r19 or $20;
if brs(r16,1) = 1 then r20 := r20 or $04;
if brs(r16,2) = 1 then r17 := r17 or $08;
if brs(r16,3) = 1 then r23 := r23 or $08;
if brs(r16,4) = 1 then r21 := r21 or $02;
if brs(r16,5) = 1 then r23 := r23 or $01;
if brs(r16,6) = 1 then r24 := r24 or $20;
if brs(r16,7) = 1 then r20 := r20 or $08;
p5d9(t1,out);
repeat
r4 := ror(r4);
r5 := ror(r5);
if carry = 0 then
begin
p0443(out);
p06af(out);
end;
p0443(out);
p05f9(out);
until not (r15 >= 0);

end;

procedure p396(keyi: array of byte;var keyo: array of byte);
var
i,x: integer;
r16,r17: integer;
r15, c, nc: byte;
begin
for i:=0 to 7 do keyo[i] := flop(keyi[i]);
r17 := 0;
c := 0;
while true do { 3a4 }
begin
r16 := r17;
x := 7;

while true do
begin
r15 := keyo[x];
nc := r15 shr 7;
r15 := r15 shl 1;
keyo[x] := r15 or c;
c := nc;
x := x - 1;
if x < 0 then exit;
r16 := r16 - 1;
if r16 >= 0 then continue;
r17 := r17 + 1;
break;
end;
end;
end;

procedure p04c5(t1: array of byte;k: array of byte;var out: array of byte);

begin
r17 := $00;
r18 := $00;
r19 := $40;
r20 := $01;
r21 := $80;
r22 := $02;
r23 := $C0;
r24 := $03;
r25 := $00;
r0 := k[0];
if brs(r0,0) = 1 then r24 := r24 or $40;
if brs(r0,1) = 1 then r18 := r18 or $08;
if brs(r0,2) = 1 then r19 := r19 or $20;
if brs(r0,3) = 1 then r20 := r20 or $04;
if brs(r0,4) = 1 then r17 := r17 or $08;
if brs(r0,5) = 1 then r23 := r23 or $01;
if brs(r0,6) = 1 then r24 := r24 or $20;
if brs(r0,7) = 1 then r23 := r23 or $08;
r0 := k[1];
if brs(r0,0) = 1 then r25 := r25 or $20;
if brs(r0,1) = 1 then r22 := r22 or $04;
if brs(r0,2) = 1 then r17 := r17 or $10;
if brs(r0,3) = 1 then r25 := r25 or $01;
if brs(r0,4) = 1 then r17 := r17 or $02;
if brs(r0,5) = 1 then r25 := r25 or $08;
if brs(r0,6) = 1 then r22 := r22 or $20;
if brs(r0,7) = 1 then r21 := r21 or $08;
r0 := k[2];
if brs(r0,0) = 1 then r21 := r21 or $10;
if brs(r0,1) = 1 then r23 := r23 or $04;
if brs(r0,2) = 1 then r21 := r21 or $04;
if brs(r0,3) = 1 then r20 := r20 or $80;
if brs(r0,4) = 1 then r18 := r18 or $80;
if brs(r0,5) = 1 then r25 := r25 or $02;
if brs(r0,6) = 1 then r19 := r19 or $10;
if brs(r0,7) = 1 then r24 := r24 or $04;
r0 := k[3];
if brs(r0,0) = 1 then r21 := r21 or $02;
if brs(r0,1) = 1 then r22 := r22 or $80;
if brs(r0,2) = 1 then r22 := r22 or $08;
if brs(r0,3) = 1 then r24 := r24 or $80;
if brs(r0,4) = 1 then r18 := r18 or $04;
if brs(r0,5) = 1 then r17 := r17 or $04;
if brs(r0,6) = 1 then r19 := r19 or $02;
if brs(r0,7) = 1 then r20 := r20 or $10;
r0 := k[4];
if brs(r0,0) = 1 then r18 := r18 or $40;
if brs(r0,1) = 1 then r23 := r23 or $20;
if brs(r0,2) = 1 then r23 := r23 or $02;
if brs(r0,3) = 1 then r21 := r21 or $01;
if brs(r0,4) = 1 then r22 := r22 or $40;
if brs(r0,5) = 1 then r19 := r19 or $08;
if brs(r0,6) = 1 then r19 := r19 or $04;
if brs(r0,7) = 1 then r20 := r20 or $20;
r0 := k[5];
if brs(r0,0) = 1 then r17 := r17 or $01;
if brs(r0,1) = 1 then r25 := r25 or $04;
if brs(r0,2) = 1 then r25 := r25 or $80;
if brs(r0,3) = 1 then r24 := r24 or $10;
if brs(r0,4) = 1 then r24 := r24 or $08;
if brs(r0,5) = 1 then r23 := r23 or $10;
if brs(r0,6) = 1 then r17 := r17 or $20;
if brs(r0,7) = 1 then r20 := r20 or $40;
r0 := k[6];
if brs(r0,0) = 1 then r20 := r20 or $08;
if brs(r0,1) = 1 then r18 := r18 or $10;
if brs(r0,2) = 1 then r19 := r19 or $01;
if brs(r0,3) = 1 then r21 := r21 or $20;
if brs(r0,4) = 1 then r22 := r22 or $10;
if brs(r0,5) = 1 then r25 := r25 or $40;
if brs(r0,6) = 1 then r25 := r25 or $10;
if brs(r0,7) = 1 then r18 := r18 or $20;
p5d9(t1,out);
repeat
carry := 0;
r4 := ror(r4);
r5 := ror(r5);
if carry = 0 then
begin
p0557(out);
p06af(out);
end;
p0557(out);
p05f9(out);
until not (r15 >= 0);
end;

procedure encnagra(Var k0: array of byte;Var tin: array of byte;Var tout: array of byte);
var
k0p: array[0..7] of byte;
//t1: array[0..7] of byte;
i: integer;
begin

p396(k0,k0p);
for i:=0 to 7 do tin[i] := flop(tin[i]);
p04c5(tin,k0p,tout);
revbits(tout);
end;

procedure decnagra(Var k0: array of byte;Var tin: array of byte;Var tout: array of byte);
var
k0p: array[0..7] of byte;
t1: array[0..7] of byte;
i: integer;
begin
p396(k0,k0p);
for i:=0 to 7 do t1[i] := flop(tin[i]);
p3b1(t1,k0p,tout);
revbits(tout);
end;

function h2d(d: Char): Byte;
begin
case d of
'0': h2d := 0;
'1': h2d := 1;
'2': h2d := 2;
'3': h2d := 3;
'4': h2d := 4;
'5': h2d := 5;
'6': h2d := 6;
'7': h2d := 7;
'8': h2d := 8;
'9': h2d := 9;
'A': h2d := 10;
'a': h2d := 10;
'B': h2d := 11;
'b': h2d := 11;
'C': h2d := 12;
'c': h2d := 12;
'D': h2d := 13;
'd': h2d := 13;
'E': h2d := 14;
'e': h2d := 14;
'F': h2d := 15;
'f': h2d := 15;
else
// writeln('invalid hex digit ' + chr(d));
h2d := 0;
end;
end;
{
procedure gethex(line: PChar; var data: array of byte; size: Integer);
var
r, i: Integer;
d: Byte;
begin
r:=0;
i:=0;
d:=0;
while r < size do
begin
while line[i] = ' ' do i := i + 1;
if (i > StrLen(line)-2) then break;
d := h2d(line[i]);
d := d*16;
i := i + 1;
d := d+h2d(line[i]);
i := i + 1;
data[r] := d;
r := r + 1;
end;
end;
}

procedure Hashnagra(Var e: Byte;Var Vf: array of byte;Var data: array of byte;Var RHashN: array of byte);
var
i,j :integer;
result: array[0..256] of byte;
verify_key: array[0..7] of byte;
prev_data: array[0..256] of byte;
dataTN: array[0..7] of byte;
begin

for i:=0 to 7 do verify_key[i] := vf[i];
for i:=0 to 7 do verify_key[i] := vf[i];
for i:=0 to ((e+1)*8-1) do prev_data[i] := data[i];
// enc( key, data block, result )
for i:= 0 to 7 do dataTN[i]:=data[i];
encnagra(verify_key,dataTN,result);
for i:= 0 to 7 do dataTN[i]:=prev_data[i];
xor1(result,dataTN,result);
//


//
for j := 1 to e do
Begin
for i:= 0 to 7 do dataTN[i]:=data[j*8+i];
encnagra(result,dataTN,result);
for i:= 0 to 7 do dataTN[i]:=prev_data[j*8+i];
xor1(result,dataTN,result);
end;
// Computed hash:
for i:=0 to 7 do RHashN[i]:=result[i];
end;
procedure DecBrutnagra(Var key0: array of byte;Var verify_key: array of byte;Var data: array of byte;Var RHashN: array of byte);
var
i,j,ss : integer;
dataTN: array[0..7] of byte;
dataTN2: array[0..7] of byte;
identTestNag,testHNag,testHNag2,identTestNag3,iden tTestNag4,identTestNag5 : string;
result,identTestNag2: array[0..256] of byte;
e :byte;
begin
// faire le test de la longueur afin de savoir les datas à decrypter
LiveInetClass.LB_NagraECM.items.Add('--Brut Decrypt--');
identTestNag4:='';identTestNag5:='';
//if LiveInetClass.edit7.Text='' then LiveInetClass.edit7.Text:='3';
ss:=23;
e:=0;
e:=data[2]DIV 8 - 3;
if (e>6) then
begin
e:=e+1;
ss:=21;
end;
if LiveInetClass.CheckBox1.Checked then ss:=strtoint(LiveInetClass.edit8.Text);
{ if data[2]=$35 then e:=3;
if data[2]=$3D then e:=4;
if data[2]=$53 then begin e:=8; ss:=21; end; }

LiveInetClass.edit7.Text:=inttostr(e);
LiveInetClass.edit8.Text:=inttostr(ss);

// IF ss=23 then
BEGIN
for i:= 0 to e do
begin
//for j:= 0 to 7 do dataTN2[j]:=0;
identTestNag:='';
for j:= 0 to 7 do
begin
dataTN[j]:=data[ss+(i*8)+j]; //+23
if dataTN[j]>$F then identTestNag:=identTestNag+format('%2x ',[dataTN[j]])
else identTestNag:=identTestNag+format('0%1x ',[dataTN[j]]);
identTestNag4:=identTestNag4+identTestNag;
//identTestNag2[(i*8)+j]:=dataTN[j];
end;

decnagra(key0,dataTN,dataTN2);
identTestNag3:='';
for j:= 0 to 7 do
begin
RHashN[i*8+j]:=dataTN2[j];
identTestNag2[(i*8)+j]:=dataTN2[j];
if dataTN2[j]>$F then
identTestNag3:=identTestNag3+format('%2x ',[dataTN2[j]])
else
identTestNag3:=identTestNag3+format('0%1x ',[dataTN2[j]]);
end;
identTestNag5:=identTestNag5+identTestNag3;
LiveInetClass.LB_NagraECM.items.Add(identTestNag+'--> '+identTestNag3);
end;
// END else BEGIN





END;
//
//
LiveInetClass.LB_NagraECM.items.Add('--test Hash--');

testHNag:='';
for i:=0 to 7 do begin
if data[23-8+i]>$F then testHNag:=testHNag+format('%2x ',[data[23-8+i]])
else testHNag:=testHNag+format('0%1x ',[data[23-8+i]]);
end;
//testHNag:=testHNag+'<-> ';
testHNag2:='';
Hashnagra(e,key0,identTestNag2,Result); //verify_key
for i:=0 to 7 do begin
if result[i]>$F then testHNag2:=testHNag2+format('%2x ',[result[i]])
else testHNag2:=testHNag2+format('0%1x ',[result[i]]);
end;
if testHNag2=testHNag then testHNag:=testHNag+'<-> '+testHNag2+' GOOD HASH'
else testHNag:=testHNag+'<-> '+testHNag2+' WRONG HASH';

LiveInetClass.LB_NagraECM.items.Add('DATAHASH : '+identTestNag5);
LiveInetClass.LB_NagraECM.items.Add(testHNag);

//
//
LiveInetClass.LB_NagraECM.items.Add('--Search CW--');
//
testHNag:='';
for j:=0 to 7 do
begin
dataTN[j]:=identTestNag2[$02+j];
if dataTN[j]>$F then testHNag:=testHNag+format('%2x ',[dataTN[j]])
else testHNag:=testHNag+format('0%1x ',[dataTN[j]]);
end;
testHNag:='CW1 : '+testHNag+'--> ';
encnagra(verify_key,dataTN,dataTN2);
for i:=0 to 7 do if dataTN2[i]>$F then testHNag:=testHNag+format('%2x ',[dataTN2[i]])
else testHNag:=testHNag+format('0%1x ',[dataTN2[i]]);
LiveInetClass.LB_NagraECM.items.Add(testHNag);
//
testHNag:='';
for j:=0 to 7 do
begin
dataTN[j]:=identTestNag2[$0B+j];
if dataTN[j]>$F then testHNag:=testHNag+format('%2x ',[dataTN[j]])
else testHNag:=testHNag+format('0%1x ',[dataTN[j]]);
end;
testHNag:='CW2 : '+testHNag+'--> ';
encnagra(verify_key,dataTN,dataTN2);
for i:=0 to 7 do if dataTN2[i]>$F then testHNag:=testHNag+format('%2x ',[dataTN2[i]])
else testHNag:=testHNag+format('0%1x ',[dataTN2[i]]);
LiveInetClass.LB_NagraECM.items.Add(testHNag);





end;
{
procedure doit(fname: string);
var
fp: TextFile;
sline: string;
line: PChar;
irdkey: array[0..7] of byte;
key0: array[0..7] of byte;
key1: array[0..7] of byte;
verify_key: array[0..7] of byte;
nipper0: array[0..7] of byte;
nipper1: array[0..7] of byte;
nipper2: array[0..7] of byte;
h: array[0..8] of byte;
data: array[0..99] of byte;
prev_data: array[0..99] of byte;
result: array[0..99] of byte;
eout: array[0..15] of byte;
i,e,ss: integer;
begin

AssignFile(fp, fname);
FileMode := 0; //readonly

Reset(fp);
if IOResult <> 0 then
begin
writeln('Not can open file: ' + fname);
readln;
EndThread(0);
end;

while not Eoln(fp) do
begin
Readln(fp, sline);
line := PChar(sline);
if line[0] = '*' then continue;
if line[0] = ';' then continue;


// writeln(line);

if StrLIComp(line,'QUIT',4) = 0 then break;

if StrLIComp(line,'IRDKEY=',7) = 0 then
begin
gethex(line+7,irdkey,8);
show('IRDKEY=',irdkey,8);
continue;
end;
if StrLIComp(line,'HASH=',5) = 0 then
begin
gethex(line+5,h,9);
show('HASH=',h,9);
continue;
end;
if StrLIComp(line,'KEY0=',5) = 0 then
begin
gethex(line+5,key0,8);
show('KEY0=',key0,8);
continue;
end;
if StrLIComp(line,'KEY1=',5) = 0 then
begin
gethex(line+5,key1,8);
show('KEY1=',key1,8);
continue;
end;
if StrLIComp(line,'NIP0=',5) = 0 then
begin
gethex(line+5,nipper0,8);
continue;
end;
if StrLIComp(line,'NIP1=',5) = 0 then
begin
gethex(line+5,nipper1,8);
continue;
end;
if StrLIComp(line,'NIP2=',5) = 0 then
begin
gethex(line+5,nipper2,8);
continue;
end;
if StrLIComp(line,'VERIFY=',7) = 0 then
begin
gethex(line+5,verify_key,8);
continue;
end;
if StrLIComp(line,'SHOW=',5) = 0 then
begin
writeln(line+5);
end;
if StrLIComp(line,'DEC0=',5) = 0 then
begin
gethex(line+5,data,8);
dec(key0,data,result);
writeln('decrypted:');
for i:=0 to 7 do
write(IntToHex(result[i],2) + ' ');
writeln;
continue;
end;
if StrLIComp(line,'DECI=',5) = 0 then
begin
gethex(line+5,data,8);
dec(irdkey,data,result);
writeln('decrypted:');
for i:=0 to 7 do
write(IntToHex(result[i],2) + ' ');
writeln;
continue;
end;
if StrLIComp(line,'ENC0=',5) = 0 then
begin
gethex(line+5,data,8);
enc(key0,data,result);
writeln('ENCODED USING KEY0:');
for i:=0 to 7 do
write(IntToHex(result[i],2) + ' ');
writeln;
continue;
end;
if StrLIComp(line,'ENCI=',5) = 0 then
begin
gethex(line+5,data,8);
enc(irdkey,data,result);
writeln('ENCODED USING IRDKEY:');
for i:=0 to 7 do
write(IntToHex(result[i],2) + ' ');
writeln;
continue;
end;
if StrLIComp(line,'DOHASH=',7) = 0 then
begin
gethex(line+7,data,40);
for i:=0 to 39 do prev_data[i] := data[i];
// enc( key, data block, result )
enc(verify_key,data,result);
xor1(result,prev_data,result);
enc(result,&data[8],result);
xor1(result,&prev_data[8],result);
enc(result,&data[16],result);
xor1(result,&prev_data[16],result);
enc(result,&data[24],result);
xor1(result,&prev_data[24],result);
enc(result,&data[32],result);
xor1(result,&prev_data[32],result);

write('Computed hash: ');
for i:=0 to 7 do
write(IntToHex(result[i],2));
writeln;
continue;
end;
if StrLIComp(line,'DATA=',5) = 0 then
begin
gethex(line+5,data,100);
e:=0;
ss:=23;
if (data[2]=$35)then e:=4;
if (data[2]=$3D) then e:=5;
if (data[2]=$53) then begin e:=8;ss:=21; end;
if (e=0)then
begin
writeln('unknown data type, length incorrect');
continue;
end;
if ( ss = 23 ) then
begin
for i := 0 to (e-1) do dec(key0,data[ss+(i*8)],result[i*8]);
//*printf("data[%d] = %02X\n", ss+(i*8), data[ss+(i*8)] );*/
end else begin
if ((data[12]and$0C)=0)
then for i := 0 to (e-1) do dec(nipper0,data[ss+(i*8)],result[i*8]);
if ((data[12]and$0C)=1)
//then for (i = 0; i < e ; ++i)do dec(nipper1,&data[ss+(i*8)],&result[i*8]);
then for i := 0 to (e-1) do dec(nipper1,data[ss+(i*8)],result[i*8]);
if ((data[12]and$0C)=2)
then for i := 0 to (e-1) do dec(nipper2,data[ss+(i*8)],result[i*8]);
end;
//*x=result[i];*/
// printf("decrypted:\n");
for (i = 0; i < (8*e) ; ++i)
//
// printf('%2X ',result[i]);
// /*if (i) x=x^result[i];*/
// if (0 == (i+1) % 8) printf("\n");
//
if (data[8]= 0)then continue;
enc(irdkey,&result[0x02],eout);
enc(irdkey,&result[0x0B],&eout[0x08]);
printf("cmd 13 should contain:\n");
printf("12 xx 1B ; 93 17 B1 01 \n11 08 ");
for (i = 0; i < 8; ++i)
//
printf("%02X ",eout[i]);
//
printf("\n12 08 ");
for (i = 8; i < 16; ++i)
//
printf("%02X ",eout[i]);
//
printf("\n90 00 checksum\n");
continue;

end;
if StrLIComp(line,'DATH=',5) = 0 then
begin

end;

end;


CloseFile(fp);
end;
}
end.
*******************************