Gracias karmany por compartir, realmente tiempo es un problema, cuando el desafío exige mucho tiempo de nosotros
Aquí esta Keygen
Parece que "reinventó la rueda", con las funciones ....
El propósito y analizar lo más profundo posible en la lógica
Pero tiene como mejorar mucho el código.
Agradecimientos especiales a todos los que participaron en este desafío.
Aprendí mucho, con todos.
¿Quién puede mejorar el código, favor dice
function HexToBin(Hex: String): String;
var
Bin: String;
k: Byte;
Begin
Bin:='';
For k:=1 to Length(Hex) do
if Hex[k]='0' then Bin:=Bin+'0000'
else if Hex[k]='1' then Bin:=Bin+'0001'
else if Hex[k]='2' then Bin:=Bin+'0010'
else if Hex[k]='3' then Bin:=Bin+'0011'
else if Hex[k]='4' then Bin:=Bin+'0100'
else if Hex[k]='5' then Bin:=Bin+'0101'
else if Hex[k]='6' then Bin:=Bin+'0110'
else if Hex[k]='7' then Bin:=Bin+'0111'
else if Hex[k]='8' then Bin:=Bin+'1000'
else if Hex[k]='9' then Bin:=Bin+'1001'
else if Hex[k]='A' then Bin:=Bin+'1010'
else if Hex[k]='B' then Bin:=Bin+'1011'
else if Hex[k]='C' then Bin:=Bin+'1100'
else if Hex[k]='D' then Bin:=Bin+'1101'
else if Hex[k]='E' then Bin:=Bin+'1110'
else if Hex[k]='F' then Bin:=Bin+'1111';
HexToBin:=Bin;
End;
function BinToHex(Bin: String): String;
var
k: Byte;
s: String;
Hex: String;
Begin
Hex:='';
While Length(Bin) mod 4<>0 do Bin:='0'+Bin;
For k:=0 to Length(Bin) div 4 -1 do
Begin
s:=Copy(Bin,k*4+1,4);
if s='0000' then s:='0'
else if s='0001' then s:='1'
else if s='0010' then s:='2'
else if s='0011' then s:='3'
else if s='0100' then s:='4'
else if s='0101' then s:='5'
else if s='0110' then s:='6'
else if s='0111' then s:='7'
else if s='1000' then s:='8'
else if s='1001' then s:='9'
else if s='1010' then s:='A'
else if s='1011' then s:='B'
else if s='1100' then s:='C'
else if s='1101' then s:='D'
else if s='1110' then s:='E'
else if s='1111' then s:='F';
Hex:=Hex+s;
End;
BinToHex:=Hex;
End;
function StrToHex(Str: String): Integer;
var
Hex:Integer;
Begin
if (str.Length=7) Then
Begin
str:='0' + str;
end;
if (str.Length=6) Then
Begin
str:='00' + str;
end;
Hex:= (strToInt(copy(Str,1,1))*128);
Hex:= Hex + (strToInt(copy(Str,2,1))*64);
Hex:= Hex + (strToInt(copy(Str,3,1))*32);
Hex:= Hex + (strToInt(copy(Str,4,1))*16);
Hex:= Hex + (strToInt(copy(Str,5,1))*8);
Hex:= Hex + (strToInt(copy(Str,6,1))*4);
Hex:= Hex + (strToInt(copy(Str,7,1))*2);
Hex:= Hex + (strToInt(copy(Str,8,1))*1);
StrToHex:=Hex;
end;
function shLeft(Str:String;N:integer): String;
var
s:String;
Begin
s:=copy(Str,N+1,32-N)+copy(Str,1,N);
shLeft:=s;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
A,B:String;
C:Integer;
Label
rotacionar,ciclo;
//F6C53333 Caractere >=32 <=126 $20 $7E
begin
A:= 'F6C53333';
B:= HexToBin(A);
ciclo:
// 8 bits
C:= strToHex(copy(B,25,8));
IF (C>31) and (C<127) Then
Begin
Edit1.text:= (intTohex(C,2)) + Edit1.text ;
B:= (Copy(B,1,24)) + '00000000';
GOTO rotacionar;
end; // fin 8 bits
//7 bits
C:= strToHex(copy(B,26,7));
IF (C>31) and (C<127) Then
Begin
Edit1.text:= (intTohex(C,2)) + Edit1.text;
B:= (Copy(B,1,25)) + '0000000';
GOTO rotacionar;
end; //fin 7 bits
//6 bits (Con 6 bits positivos no passa valor $7E No precisa testar con 5)
C:= strToHex(copy(B,27,6));
IF (C>31) and (C<127) Then
Begin
Edit1.text:= (intTohex(C,2)) + Edit1.text;
B:= (Copy(B,1,26)) + '000000';
GOTO rotacionar;
end; //fin 6 bits
rotacionar:
IF ((Copy(B,1,32)) <> '00000000000000000000000000000000') Then
begin
B:=shLeft(B,13);
goto ciclo;
//Showmessage(B);
end;
end;
Esto se basa en la lógica que ya he posteadoF6C53333 11110110110001010011001100110011
110011 33---3
11110110110001010011001100000000
10100110011000000001111011011000 58---X
10100110011000000001111010000000
00000011110100000001010011001100 4C---L
00000011110100000001010010000000
00000010100100000000000001111010 7A---z
00000010100100000000000000000000
0000001010010 52---R
RzLX3En texto, función, después al final .......Function HexToStr(s: String): String;
Var i: Integer;
Begin
Result:=''; i:=1;
While i<Length(s) Do Begin
Result:=Result+Chr(StrToIntDef('$'+Copy(s,i,2),0));
Inc(i,2);
End;
End;
Showmessage(hexTostr(Edit1.text));
Fary ¡Muy bueno su codigo, excelente desafío !!!!!
Actualización 1
Usted puede intentar con otro valor.
Pero el valor necesita estar correctamente construido, mediante función inversa!Para evitar este error, antes rotacionar:
¿Por qué con 6 bits no encontró valor válido !!!! Showmessage('¡Hummmm, valor incorrecto !!!!!');
rotacionar:
IF ((Copy(B,1,32)) <> '00000000000000000000000000000000') Then
begin
B:=shLeft(B,13);
goto ciclo;
//Showmessage(B);
end;
Gracias, Saludos