suuid.inc 1.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354
  1. {
  2. $Id: sysutils.pp,v 1.59 2005/03/25 22:53:39 jonas Exp $
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 2006 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. uuidgen for Solaris
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. Const
  14. RandomDevice = '/dev/urandom';
  15. Function GetURandomBytes(Var Buf; NBytes : Integer) : Boolean;
  16. Var
  17. fd,I : Integer;
  18. P : PByte;
  19. begin
  20. P:=@Buf;
  21. fd:=FileOpen(RandomDevice,fmOpenRead);
  22. Result:=(fd>=0);
  23. if Result then
  24. Try
  25. While (NBytes>0) do
  26. begin
  27. I:=FileRead(fd,P^,nbytes);
  28. If I>0 then
  29. begin
  30. Inc(P,I);
  31. Dec(NBytes,I);
  32. end;
  33. end;
  34. Finally
  35. FileClose(Fd);
  36. end;
  37. end;
  38. Function SysCreateGUID(out GUID : TGUID) : Integer;
  39. begin
  40. if not GetUrandomBytes(Guid,SizeOf(GUID)) then
  41. GetRandomBytes(GUID,SizeOf(Guid));
  42. Result:=0;
  43. end;