suuid.inc 1.2 KB

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