Hi, attached you find a CreateGUID implementation that creates (time-based) guids. These follow a low-high approach, with a random part and a time part.
If available, uses libuuid.so.1 and /dev/urandom. Otherwhise uses manual implementation (which sucks - just test by while true ; do ./createguid ; done and behold all the equal guids) as a fallback. The function should be pretty usable *if* libuuid.so.1 is available, and pretty dangerous if not. I'll not be improving the fallback further though. Someone wants to step in? cheers, Danny -- www.keyserver.net key id A334AEA6
program createguid;
{$ASSERTIONS ON}
uses sysutils
(*$IFDEF WINDOWS*),
activex
(*$ENDIF WINDOWS*)
(*$IFDEF UNIX*),
dl
(*$ENDIF UNIX*);
(* unit tests need to test combinations of those: *)
(*no $DEFINE DISABLE_COCREATEGUID*)
(*no $DEFINE DISABLE_LIBUUID*)
(*no $DEFINE DISABLE_URANDOM*)
(* end unit tests need to test combinations of those *)
(*$IFNDEF WINDOWS*)
(*$DEFINE DISABLE_COCREATEGUID*)
(*$ENDIF WINDOWS*)
(*$IFNDEF UNIX*)
(*$DEFINE DISABLE_LIBUUID*)
(*$DEFINE DISABLE_URANDOM*)
(*$ENDIF UNIX*)
type
uuid_t = array[0..15] of Byte;
TUnixUuidGenerateTime = procedure(out outuid: uuid_t); cdecl;
var
urandom: file of DWORD;
urandomok: Boolean = False;
uuidlib: Pointer;
uuidlibok: Boolean = False;
uuidlibgenerate: TUnixUuidGenerateTime;
(*$IFDEF TOTALLYRANDOM*)
function CreateGUID: TGuid;
var
i: Integer;
res: TGuid;
begin (* D1..D4 is delphi *)
res.Data1 := RandomDWord;
res.Data2 := Random(65536);
res.Data3 := Random(65536);
for i := 0 to 7 do
res.Data4[i] := Random(256);
res.Data3 := (res.Data3 and not $F000) or $4000; (* *)
res.Data4[0] := (res.Data4[0] or $80 and not $40); (* variant 10.... : standard *)
CreateGUID := res;
(* the 13th nibble from the front needs to be "4" *)
(* the 17th nibble needs to be either "8", "9", "A" or "B" *)
end;
(*$ENDIF*)
(* the following is called a "time-based" guid *)
function CreateGUID: TGuid;
var
i: Integer;
res: TGuid;
function Random(rangeexcluding: DWORD): DWORD;
begin
if urandomok then
Read(urandom, Result)
else
Random := System.Random(rangeexcluding);
end;
function RandomDWord: DWORD;
begin
RandomDWord := Random(65536) * 65536 + Random(65536);
end;
var
uuid: uuid_t;
begin
(* FIXME: TGuid: D1..D4 is used in delphi, both Data1..Data4 and D1..D4 are possible in fpc *)
(*
put this to the windows activex imports:
function CoCreateGuid(out guid : TGUID) : HRESULT; stdcall; external 'ole32.dll';
thanks tom_at_work
*)
(*$IFNDEF DISABLE_COCREATEGUID*)
if Succeeded(CoCreateGuid(res)) then
begin
CreateGUID := res;
Exit;
end;
(*$ENDIF DISABLE_COCREATEGUID*)
if uuidlibok then begin
uuidlibgenerate(uuid);
assert(sizeof(uuid) = sizeof(TGuid));
Move(uuid, res, sizeof(res));
CreateGUID := res;
Exit;
end;
res.Data1 := RandomDWord;
res.Data2 := Trunc(Now);
res.Data3 := Trunc(Frac(Now) * 65536);
for i := 0 to 7 do
res.Data4[i] := Random(256);
res.Data3 := (res.Data3 and not $F000) or $1000; (* version 1: time-based version *)
res.Data4[0] := ((res.Data4[0] and not $C0) or $80); (* variant 10...... : standard *)
CreateGUID := res;
(* the 13th nibble from the front needs to be "1" for "time-based" *)
(* the 17th nibble needs to be either "8", "9", "A" or "B" *)
assert(GUIDToString(res)[13+3] = '1');
assert(GUIDToString(res)[17+4] in ['8', '9', 'A', 'B']);
end;
procedure InitLibs;
begin
(* unix *)
(*$IFNDEF DISABLE_LIBUUID*)
uuidlib := DlOpen('libuuid.so.1', RTLD_LAZY);
if Assigned(uuidlib) then begin
uuidlibgenerate := TUnixUuidGenerateTime(DlSym(uuidlib, 'uuid_generate_time'));
if Assigned(uuidlibgenerate) then begin
uuidlibok := True;
(*Debug('using libuuid.so.1');*)
end;
end;
(*$ENDIF DISABLE_LIBUUID*)
(*$IFNDEF DISABLE_URANDOM*)
if not uuidlibok then begin
try
AssignFile(urandom, '/dev/urandom');
Reset(urandom);
urandomok := True;
(*Debug('using /dev/urandom');*)
except
urandomok := False;
end;
end;
(*$ENDIF DISABLE_URANDOM*)
end;
procedure DoneLibs;
begin
if Assigned(uuidlib) then begin
DlClose(uuidlib);
uuidlib := nil;
end;
if urandomok then begin
CloseFile(urandom);
urandomok := False;
end;
end;
begin
InitLibs;
Randomize;
Writeln(GUIDToString(CreateGUID));
DoneLibs;
end.
signature.asc
Description: This is a digitally signed message part
_______________________________________________ fpc-devel maillist - [email protected] http://lists.freepascal.org/mailman/listinfo/fpc-devel
