unit untUUID;

interface

{.$i Admin.inc}

function CreateGuid : string;
function CreateUuid : string;
function GuidToUuid(aGuid : string) : string;
function UuidToGuid(aUuid : string) : string;

implementation

uses
{$ifndef linux}
  ComObj,
{$else}
  uuid,  
{$endif}
  SysUtils;

type
  CharArray = array of char;
  uuid_t = packed record
    time_low                  : Cardinal;
    time_mid                  : Word;
    time_hi_and_version       : Word;
    clock_seq_hi_and_reserved : Byte;
    clock_seq_low             : Byte;
    Node                      : array[0..5] of word;
  end;

const
  urlchars : array[0..63] of char = '!*0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  MASK_1_2   = $03;
  MASK_1_4   = $0f;
  MASK_1_6   = $3f;
  MASK_3_6   = $3c;
  MASK_5_6   = $30;
  MASK_3_8   = $fc;
  MASK_5_8   = $f0;
  MASK_7_8   = $c0;
  MASK_5_10  = $03f0;
  MASK_7_12  = $0fc0;
  MASK_13_16 = $f000;
  MASK_11_16 = $fc00;
  MASK_13_18 = $0003f000;
  MASK_19_24 = $00fc0000;
  MASK_25_30 = $3f000000;
  MASK_31_32 = $c0000000;

procedure UuidToUuid_(aUuid : string; var Uuid_ : uuid_t);
  function sq_to_int(i : char) : integer;
  var
    range : integer;
  begin
    if      i='!' then range := 1
    else if i='*' then range := 2
    else if (i>='0') and (i<='9') then range := 3
    else if (i>='A') and (i<='Z') then range := 4
    else if (i>='a') and (i<='z') then range := 5
    else range := 0;
    case range of
      1 : result := 0;
      2 : result := 1;
      3 : result := ord(i)-46;
      4 : result := ord(i)-53;
      5 : result := ord(i)-59;
      else result := -1;
    end;
  end;
begin
  uuid_.time_low := sq_to_int(aUuid[17]);
  uuid_.time_low := uuid_.time_low shl 6;
  uuid_.time_low := uuid_.time_low + cardinal(sq_to_int(aUuid[18]));
  uuid_.time_low := uuid_.time_low shl 6;
  uuid_.time_low := uuid_.time_low + cardinal(sq_to_int(aUuid[19]));
  uuid_.time_low := uuid_.time_low shl 6;
  uuid_.time_low := uuid_.time_low + cardinal(sq_to_int(aUuid[20]));
  uuid_.time_low := uuid_.time_low shl 6;
  uuid_.time_low := uuid_.time_low + cardinal(sq_to_int(aUuid[21]));
  uuid_.time_low := uuid_.time_low shl 6;
  uuid_.time_low := uuid_.time_low + cardinal(sq_to_int(aUuid[22]));
  uuid_.time_mid := sq_to_int(aUuid[15]);
  uuid_.time_mid := uuid_.time_mid shl 6;
  uuid_.time_mid := uuid_.time_mid + sq_to_int(aUuid[16]);
  uuid_.time_mid := uuid_.time_mid shl 4;
  uuid_.time_mid := uuid_.time_mid + ((sq_to_int(aUuid[17]) and MASK_3_6) shr 2);
  uuid_.time_hi_and_version := sq_to_int(aUuid[12]);
  uuid_.time_hi_and_version := uuid_.time_hi_and_version shl 6;
  uuid_.time_hi_and_version := uuid_.time_hi_and_version + sq_to_int(aUuid[13]);
  uuid_.time_hi_and_version := uuid_.time_hi_and_version shl 6;
  uuid_.time_hi_and_version := uuid_.time_hi_and_version + sq_to_int(aUuid[14]);
  uuid_.clock_seq_hi_and_reserved := sq_to_Int(aUuid[11]);
  uuid_.clock_seq_hi_and_reserved := uuid_.clock_seq_hi_and_reserved shl 2;
  uuid_.clock_seq_hi_and_reserved := uuid_.clock_seq_hi_and_reserved + ((sq_to_int(aUuid[12]) and MASK_5_6) shr 4);
  uuid_.clock_seq_low := sq_to_int(aUuid[9]);
  uuid_.clock_seq_low := uuid_.clock_seq_low shl 6;
  uuid_.clock_seq_low := uuid_.clock_seq_low + sq_to_int(aUuid[10]);
  uuid_.node[0] := sq_to_int(aUuid[1]);
  uuid_.node[0] := uuid_.node[0] shl 6;
  uuid_.node[0] := uuid_.node[0] + sq_to_int(aUuid[2]);
  uuid_.node[1] := sq_to_int(aUuid[3]);
  uuid_.node[1] := uuid_.node[1] shl 2;
  uuid_.node[1] := uuid_.node[1] + (sq_to_int(aUuid[4]) shr 4);
  uuid_.node[2] := sq_to_int(aUuid[4]);
  uuid_.node[2] := uuid_.node[2] shl 4;
  uuid_.node[2] := uuid_.node[2] + (sq_to_int(aUuid[5]) shr 2);
  uuid_.node[3] := sq_to_int(aUuid[5]);
  uuid_.node[3] := uuid_.node[3] shl 6;
  uuid_.node[3] := uuid_.node[3] + sq_to_int(aUuid[6]);
  uuid_.node[4] := sq_to_int(aUuid[7]);
  uuid_.node[4] := uuid_.node[4] shl 2;
  uuid_.node[4] := uuid_.node[4] + (sq_to_int(aUuid[8]) shr 4);
  uuid_.node[5] := sq_to_int(aUuid[8]);
  uuid_.node[5] := uuid_.node[5] shl 4;
  uuid_.node[5] := uuid_.node[5] + (sq_to_int(aUuid[9]) shr 2);
end;

procedure GuidToUuid_(aGuid : string; var Uuid_ : uuid_t);
var
  i : integer;
  time_low : string[8];
  time_mid, time_hi_and_version : string[4];
  clock_seq_hi_and_reserved, clock_seq_low : string[2];
  node : array[0..5] of string[2];
  hi_time_low, lo_time_low : string[4];
begin
  time_low := copy(aguid, 1, 8);
  time_mid := Copy(aguid, 10,4);
  time_hi_and_version := Copy(aguid, 15,4);
  clock_seq_hi_and_reserved := Copy(aguid, 20,2);
  clock_seq_low := Copy(aguid, 22,2);
  for i := 0 to 5 do
    node[i] := Copy(aGuid,25+i*2,2);
  hi_time_low := Copy(aGuid,1,4);
  lo_time_low := Copy(aGuid,5,4);
  uuid_.time_low := strtoint('$'+hi_time_low) shl 16 + strtoint('$'+lo_time_low);
  uuid_.time_mid := strToInt('$'+time_mid);
  uuid_.time_hi_and_version := strToInt('$'+time_hi_and_version);
  uuid_.clock_seq_hi_and_reserved := strToInt('$'+clock_seq_hi_and_reserved);
  uuid_.clock_seq_low := strToInt('$'+clock_seq_low);
  for i := 0 to 5 do
    uuid_.node[i] := StrToInt('$'+node[i]);
  end;

function Uuid_To_Uuid(const Uuid : uuid_t) : string;
var
  sq_u : array[1..22] of byte;
  i : integer;
begin
  result := StringOfChar(' ',22);
  sq_u[22] := uuid.time_low and MASK_1_6;
  sq_u[21] := (uuid.time_low and MASK_7_12) shr 6;
  sq_u[20] := (uuid.time_low and MASK_13_18) shr 12;
  sq_u[19] := (uuid.time_low and MASK_19_24) shr 18;
  sq_u[18] := (uuid.time_low and MASK_25_30) shr 24;
  sq_u[17] := (uuid.time_low and MASK_31_32) shr 30;
  sq_u[17] := sq_u[17] + (uuid.time_mid and MASK_1_4) shl 2;
  sq_u[16] := (uuid.time_mid and MASK_5_10) shr 4;
  sq_u[15] := (uuid.time_mid and MASK_11_16) shr 10;
  sq_u[14] := uuid.time_hi_and_version and MASK_1_6;
  sq_u[13] := (uuid.time_hi_and_version and MASK_7_12) shr 6;
  sq_u[12] := (uuid.time_hi_and_version and MASK_13_16) shr 12;
  sq_u[12] := sq_u[12] + (uuid.clock_seq_hi_and_reserved and MASK_1_2) shl 4;
  sq_u[11] := (uuid.clock_seq_hi_and_reserved and MASK_3_8) shr 2;
  sq_u[10] := (uuid.clock_seq_low and MASK_1_6);
  sq_u[9]  := (uuid.clock_seq_low and MASK_7_8) shr 6;
  sq_u[9]  := sq_u[9] + (uuid.node[5] and MASK_1_4) shl 2;
  sq_u[8]  := ((uuid.node[5] and MASK_5_8) shr 4) + ((uuid.node[4] and MASK_1_2) shl 4);
  sq_u[7]  := (uuid.node[4] and MASK_3_8) shr 2;
  sq_u[6]  := (uuid.node[3] and MASK_1_6);
  sq_u[5]  := ((uuid.node[3] and MASK_7_8) shr 6) + ((uuid.node[2] and MASK_1_4) shl 2);
  sq_u[4]  := ((uuid.node[2] and MASK_5_8) shr 4) + ((uuid.node[1] and MASK_1_2) shl 4);
  sq_u[3]  := ((uuid.node[1] and MASK_3_8) shr 2);
  sq_u[2]  := (uuid.node[0] and MASK_1_6);
  sq_u[1]  := (uuid.node[0] and MASK_7_8) shr 6; 
  for i:= 1 to  22 do
    result[i] := urlchars[integer(sq_u[i])];
end;

function Uuid_To_Guid(const Uuid : uuid_t) : string;
var
  i : integer;
  t : string;
begin
  result := IntToHex(uuid.time_low,8)+'-'+
            IntToHex(uuid.time_mid,4)+'-'+
            IntToHex(uuid.time_hi_and_version,4)+'-'+
            IntToHex(uuid.clock_seq_hi_and_reserved,2)+
            IntToHex(uuid.clock_seq_low,2)+'-';
  for i := 0 to 5 do
    begin
      t := IntToHex(uuid.Node[i],2);
      result := result + copy(t,length(t)-1,2);
    end
end;

function CreateGuid : string;
{$ifdef linux}
var
  Guid : TGuid;
{$endif}
begin
{$ifndef linux}
  result := CreateClassID;
  result := copy(result,2,length(result)-2);
{$else}
  CreateMacGUID(Guid);
  result := GuidToStrig(Guid);
{$endif}
end;

function CreateUuid : string;
begin
  result := GuidToUuid(CreateGuid);
end;

function GuidToUuid(aGuid : string) : string;
var
  uuid : uuid_t;
begin
  GuidToUuid_(aGuid, uuid);
  result := Uuid_To_Uuid(uuid);
end;

function UuidToGuid(aUuid : string) : string;
var
  uuid : uuid_t;
begin
  UuidToUuid_(aUuid, uuid);
  result := Uuid_To_Guid(uuid);
end;

end.
