create key (delphi)

[jauninjais]

are this Delphi code correct??

function crtKey(mlock:string):string;
var i:integer;
key : string;

begin

key := char(ord(mlock[1]) xor ord(mlock[length(mlock)]) xor ord(mlock[length(mlock)-1]) xor 5);

for i:=2 to length(mlock) do
begin
key:=key + char( ord(mlock) xor ord(mlock[i-1]));
end;



for i:=1 to length(key) do
begin
if (ord(key) = 0) or (ord(key) = 5) or (ord(key) = 36) or (ord(key) = 96) or (ord(key) = 124) or (ord(key) = 126) then
begin
if ord(key) = 0 then
result:=result+'/%DCN000%/';
if ord(key) = 5 then
result:=result+'/%DCN005%/';
if ord(key) = 36 then
result:=result+'/%DCN036%/';
if ord(key[i]) = 96 then
result:=result+'/%DCN096%/';
if ord(key[i]) = 124 then
result:=result+'/%DCN124%/';
if ord(key[i]) = 126 then
result:=result+'/%DCN126%/'
end
else
result:=result+key[i];

end;


result:=key;

end;

[qqzm]

You need to do a bit of nibble-swapping in there.

Try this (which definitely works)...

Code: Select all

function LockToKey(iLock: String): String;

  function SwapNibble(x: byte): byte;
  begin
    result:= (x shl 4) or (x shr 4);
  end;

var
  tmp, Lock: string;
  i: integer;
  a,b: byte;
begin
  if pos(' Pk', ilock) <> 0 then
    lock:= copy(ilock, 1, pos(' Pk', ilock) - 1)
  else
    lock:= ilock;

  if Lock = 'EXTENDEDPROTOCOLABCABCABCABCABCABC' then
    begin
      Result:= 'ÑÀ° A ѱ±ÀÀ0�0 0 0 0 0 0';
      Exit;
    end;

  a:= ord(lock[length(lock) - 1]);
  b:= ord(lock[length(lock)]);
  tmp:= chr(SwapNibble(ord(lock[1]) xor a xor b xor 5));

  for i:= 2 to length(lock) do
    tmp:= tmp + chr(SwapNibble(ord(lock[i]) xor ord(lock[i-1])));

  for i := 1 to length(tmp) do
  begin
    case ord(tmp[i]) of
      0  : result:= result + '/%DCN000%/';
      5  : result:= result + '/%DCN005%/';
      36 : result:= result + '/%DCN036%/';
      96 : result:= result + '/%DCN096%/';
      124: result:= result + '/%DCN124%/';
      126: result:= result + '/%DCN126%/';
    else
      result:= result + tmp[i];
    end;        
  end;          
end;