* new unit uuid that follows RFC 4122

    * defined version enumeration for md5

git-svn-id: trunk@5613 -

.gitattributes

@@ -1403,6 +1403,7 @@ packages/base/hash/md5.ref -text
 packages/base/hash/md5test.pp svneol=native#text/plain
 packages/base/hash/ntlm.pas svneol=native#text/plain
 packages/base/hash/unixcrypt.pas -text
+packages/base/hash/uuid.pas svneol=native#text/plain
 packages/base/httpd/Makefile svneol=native#text/plain
 packages/base/httpd/Makefile.fpc svneol=native#text/plain
 packages/base/httpd/examples/Makefile svneol=native#text/plain

packages/base/hash/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/11/20]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2006/12/16]
 #
 default: all
-MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos sparc-linux sparc-netbsd sparc-solaris x86_64-linux x86_64-freebsd x86_64-win64 arm-linux arm-palmos arm-wince arm-gba powerpc64-linux
+MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded powerpc64-linux powerpc64-embedded
 BSDs = freebsd netbsd openbsd darwin
 UNIXs = linux $(BSDs) solaris qnx
 LIMIT83fs = go32v2 os2 emx watcom
@@ -233,127 +233,151 @@ PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages/base $(FPCDIR)/packages/ext
 override PACKAGE_NAME=hash
 override PACKAGE_VERSION=2.0.0
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_UNITS+=md5 crc ntlm  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-beos)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-qnx)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-wdosx)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-watcom)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
+endif
+ifeq ($(FULL_TARGET),i386-embedded)
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_UNITS+=md5 crc ntlm  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),m68k-atari)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
+endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_UNITS+=md5 crc ntlm  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),powerpc-macos)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_UNITS+=md5 crc ntlm  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
+endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_UNITS+=md5 crc ntlm  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
+endif
+ifeq ($(FULL_TARGET),x86_64-embedded)
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_UNITS+=md5 crc ntlm  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),arm-gba)
-override TARGET_UNITS+=md5 crc ntlm
+override TARGET_UNITS+=md5 crc ntlm uuid
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+override TARGET_UNITS+=md5 crc ntlm uuid
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_UNITS+=md5 crc ntlm  unixcrypt
+override TARGET_UNITS+=md5 crc ntlm uuid  unixcrypt
+endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+override TARGET_UNITS+=md5 crc ntlm uuid
 endif
 ifeq ($(FULL_TARGET),i386-linux)
 override TARGET_EXAMPLES+=md5test
@@ -406,6 +430,9 @@ endif
 ifeq ($(FULL_TARGET),i386-wince)
 override TARGET_EXAMPLES+=md5test
 endif
+ifeq ($(FULL_TARGET),i386-embedded)
+override TARGET_EXAMPLES+=md5test
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 override TARGET_EXAMPLES+=md5test
 endif
@@ -427,6 +454,9 @@ endif
 ifeq ($(FULL_TARGET),m68k-palmos)
 override TARGET_EXAMPLES+=md5test
 endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+override TARGET_EXAMPLES+=md5test
+endif
 ifeq ($(FULL_TARGET),powerpc-linux)
 override TARGET_EXAMPLES+=md5test
 endif
@@ -445,6 +475,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
 override TARGET_EXAMPLES+=md5test
 endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+override TARGET_EXAMPLES+=md5test
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 override TARGET_EXAMPLES+=md5test
 endif
@@ -454,6 +487,9 @@ endif
 ifeq ($(FULL_TARGET),sparc-solaris)
 override TARGET_EXAMPLES+=md5test
 endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+override TARGET_EXAMPLES+=md5test
+endif
 ifeq ($(FULL_TARGET),x86_64-linux)
 override TARGET_EXAMPLES+=md5test
 endif
@@ -463,6 +499,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-win64)
 override TARGET_EXAMPLES+=md5test
 endif
+ifeq ($(FULL_TARGET),x86_64-embedded)
+override TARGET_EXAMPLES+=md5test
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 override TARGET_EXAMPLES+=md5test
 endif
@@ -475,9 +514,18 @@ endif
 ifeq ($(FULL_TARGET),arm-gba)
 override TARGET_EXAMPLES+=md5test
 endif
+ifeq ($(FULL_TARGET),arm-nds)
+override TARGET_EXAMPLES+=md5test
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+override TARGET_EXAMPLES+=md5test
+endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 override TARGET_EXAMPLES+=md5test
 endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+override TARGET_EXAMPLES+=md5test
+endif
 override INSTALL_FPCPACKAGE=y
 ifdef REQUIRE_UNITSDIR
 override UNITSDIR+=$(REQUIRE_UNITSDIR)
@@ -1274,6 +1322,9 @@ endif
 ifeq ($(FULL_TARGET),i386-wince)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),i386-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1295,6 +1346,9 @@ endif
 ifeq ($(FULL_TARGET),m68k-palmos)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),powerpc-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1313,6 +1367,9 @@ endif
 ifeq ($(FULL_TARGET),powerpc-morphos)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1322,6 +1379,9 @@ endif
 ifeq ($(FULL_TARGET),sparc-solaris)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),x86_64-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1331,6 +1391,9 @@ endif
 ifeq ($(FULL_TARGET),x86_64-win64)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),x86_64-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),arm-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
@@ -1343,9 +1406,18 @@ endif
 ifeq ($(FULL_TARGET),arm-gba)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),arm-nds)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
 REQUIRE_PACKAGES_RTL=1
 endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+REQUIRE_PACKAGES_RTL=1
+endif
 ifdef REQUIRE_PACKAGES_RTL
 PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
 ifneq ($(PACKAGEDIR_RTL),)

packages/base/hash/Makefile.fpc

@@ -7,7 +7,7 @@ name=hash
 version=2.0.0
 
 [target]
-units=md5 crc ntlm
+units=md5 crc ntlm uuid
 units_linux=unixcrypt
 examples=md5test
 

packages/base/hash/md5.pp

@@ -25,15 +25,25 @@ unit md5;
 
 interface
 
+
+(******************************************************************************
+ * types and constants
+ ******************************************************************************)
+
 const
-  DefBufSize = 1024;
+  MDDefBufSize = 1024;
 
 type
+  TMDVersion = (
+    MD_VERSION_4,
+    MD_VERSION_5
+  );
+
   PMDDigest = ^TMDDigest;
   TMDDigest = array[0..15] of Byte;
 
-  TMDContext = packed record
-    Version : Cardinal;
+  TMDContext = record
+    Version : TMDVersion;
     State   : array[0..3] of Cardinal;
     Length  : PtrUInt;
     BufCnt  : PtrUInt;
@@ -41,17 +51,24 @@ type
   end;
 
 
-{ Raw methods }
 
-procedure MDInit(var Context: TMDContext; const Version: Cardinal);
+(******************************************************************************
+ * Raw functions
+ ******************************************************************************)
+
+procedure MDInit(var Context: TMDContext; const Version: TMDVersion);
 procedure MDUpdate(var Context: TMDContext; var Buf; const BufLen: PtrUInt);
 procedure MDFinal(var Context: TMDContext; var Digest: TMDDigest);
 
-{ Auxiliary methods }
 
-function MDString(const S: String; const Version: Cardinal): TMDDigest;
-function MDBuffer(var Buf; const BufLen: PtrUInt; const Version: Cardinal): TMDDigest;
-function MDFile(const Filename: String; const Version: Cardinal; const Bufsize: PtrUInt = DefBufSize): TMDDigest;
+
+(******************************************************************************
+ * Auxilary functions
+ ******************************************************************************)
+
+function MDString(const S: String; const Version: TMDVersion): TMDDigest;
+function MDBuffer(var Buf; const BufLen: PtrUInt; const Version: TMDVersion): TMDDigest;
+function MDFile(const Filename: String; const Version: TMDVersion; const Bufsize: PtrUInt = MDDefBufSize): TMDDigest;
 function MDPrint(const Digest: TMDDigest): String;
 function MDMatch(const Digest1, Digest2: TMDDigest): Boolean;
 
@@ -206,7 +223,7 @@ begin
 end;
 
 
-procedure MDInit(var Context: TMDContext; const Version: Cardinal);
+procedure MDInit(var Context: TMDContext; const Version: TMDVersion);
 begin
   Context.Version := Version;
   Context.State[0] := $67452301;
@@ -242,8 +259,8 @@ begin
     if Context.BufCnt = 64 then
     begin
       case Context.Version of
-        4: MD4Transform(Context, @Context.Buffer);
-        5: MD5Transform(Context, @Context.Buffer);
+        MD_VERSION_4: MD4Transform(Context, @Context.Buffer);
+        MD_VERSION_5: MD5Transform(Context, @Context.Buffer);
       end;
       Context.BufCnt := 0;
     end;
@@ -254,8 +271,8 @@ begin
   while Num >= 64 do
   begin
     case Context.Version of
-      4: MD4Transform(Context, Src);
-      5: MD5Transform(Context, Src);
+      MD_VERSION_4: MD4Transform(Context, Src);
+      MD_VERSION_5: MD5Transform(Context, Src);
     end;
     Src := Pointer(PtrUInt(Src) + 64);
     Num := Num - 64;
@@ -296,7 +313,7 @@ begin
 end;
 
 
-function MDString(const S: String; const Version: Cardinal): TMDDigest;
+function MDString(const S: String; const Version: TMDVersion): TMDDigest;
 var
   Context: TMDContext;
 begin
@@ -306,7 +323,7 @@ begin
 end;
 
 
-function MDBuffer(var Buf; const BufLen: PtrUInt; const Version: Cardinal): TMDDigest;
+function MDBuffer(var Buf; const BufLen: PtrUInt; const Version: TMDVersion): TMDDigest;
 var
   Context: TMDContext;
 begin
@@ -316,7 +333,7 @@ begin
 end;
 
 
-function MDFile(const Filename: String; const Version: Cardinal; const BufSize: PtrUInt): TMDDigest;
+function MDFile(const Filename: String; const Version: TMDVersion; const BufSize: PtrUInt): TMDDigest;
 var
   F: File;
   Buf: Pchar;

packages/base/hash/ntlm.pas

@@ -366,7 +366,7 @@ begin
     inc(pos);
   end;
 
-  Result := MDBuffer(wpwd, 2*pos, 4);
+  Result := MDBuffer(wpwd, 2*pos, MD_VERSION_4);
   FillChar(wpwd, Sizeof(wpwd), 0);
 end;
 

packages/base/hash/uuid.pas

@@ -0,0 +1,390 @@
+{
+    This file is part of the Free Pascal packages.
+    Copyright (c) 1999-2006 by the Free Pascal development team
+
+    Implements a UUID generation algorithm (RFC 4122)
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit uuid;
+
+interface
+
+{$mode objfpc}
+{$h+}
+
+uses
+  SysUtils, DateUtils, md5, sockets;
+
+
+
+(******************************************************************************
+ * types and constants
+ ******************************************************************************)
+
+type
+  uuid_t          = TGuid;
+  uuid_time_t     = qword;
+  uuid_node_t     = array[0..5] of byte;
+  unsigned16      = word;
+
+  uuid_state      = record
+    ts   : uuid_time_t;   // saved timestamp
+    node : uuid_node_t;   // saved node ID
+    cs   : unsigned16;    // saved clock sequence
+  end;
+
+const
+  UUID_VERSION_1  = $1;   // The time-based version specified in this document.
+  UUID_VERSION_2  = $2;   // DCE Security version, with embedded POSIX UIDs.
+  UUID_VERSION_3  = $3;   // The name-based version specified in this document that uses MD5 hashing.
+  UUID_VERSION_4  = $4;   // The randomly or pseudo-randomly generated version specified in this document.
+  UUID_VERSION_5  = $5;   // The name-based version specified in this document that uses SHA-1 hashing.
+
+{ set the following to the number of 100ns ticks of the actual resolution of your system's clock }
+  UUIDS_PER_TICK  = 1024;
+
+
+
+(******************************************************************************
+ * core uuid functions
+ ******************************************************************************)
+
+{ uuid_create -- generator a UUID }
+function uuid_create(var uuid: uuid_t): boolean;
+
+{ uuid_create_md5_from_name -- create a version 3 (MD5) UUID using a "name" from a "name space" }
+procedure uuid_create_md5_from_name(var uuid: uuid_t; const nsid: uuid_t; const name: string);
+
+{ uuid_create_sha1_from_name -- create a version 5 (SHA-1) UUID using a "name" from a "name space" }
+procedure uuid_create_sha1_from_name(var uuid: uuid_t; const nsid: uuid_t; const name: string);
+
+{ uuid_compare --  Compare two UUID's "lexically" }
+function uuid_compare(const u1, u2: uuid_t): integer;
+
+
+
+(******************************************************************************
+ * auxilary functions
+ ******************************************************************************)
+
+{ read_state -- read UUID generator state from non-volatile store }
+function read_state(var clockseq: unsigned16; var timestamp: uuid_time_t; var node: uuid_node_t): boolean;
+
+{ write_state -- save UUID generator state back to non-volatile storage }
+procedure write_state(var clockseq: unsigned16; const timestamp: uuid_time_t; const node: uuid_node_t);
+
+{ format_uuid_v1 -- make a UUID from the timestamp, clockseq, and node ID }
+procedure format_uuid_v1(var uuid: uuid_t; const clockseq: unsigned16; const timestamp: uuid_time_t; const node: uuid_node_t);
+
+{ format_uuid_v3or5 -- make a UUID from a (pseudo)random 128-bit number }
+procedure format_uuid_v3or5(var uuid: uuid_t; const hash: pointer; const v: integer);
+
+{ get_current_time -- get time as 60-bit 100ns ticks since UUID epoch. Compensate for the fact that real clock resolution is less than 100ns. }
+procedure get_current_time(var timestamp: uuid_time_t);
+
+
+
+(******************************************************************************
+ * system functions
+ ******************************************************************************)
+
+{ get_system_time -- system dependent call to get the current system time. Returned as 100ns ticks since UUID epoch, but resolution may be less than 100ns. }
+procedure get_system_time(var timestamp: uuid_time_t);
+
+{ get_system_node_identifier -- system dependent call to get IEEE node ID }
+procedure get_system_node_identifier(var node: uuid_node_t);
+
+{ true_random -- generate a crypto-quality random number. }
+function true_random: unsigned16;
+
+implementation
+
+
+{ uuid_create }
+
+function uuid_create(var uuid: TGuid): boolean;
+var
+  timestamp: uuid_time_t;
+  last_time: uuid_time_t;
+  clockseq: unsigned16;
+  node: uuid_node_t;
+  last_node: uuid_node_t;
+  f: boolean;
+begin
+  (* acquire system-wide lock so we're alone *)
+// LOCK;
+
+  (* get time, node ID, saved state from non-volatile storage *)
+  get_current_time(timestamp);
+  get_system_node_identifier(node);
+  f := read_state(clockseq, last_time, last_node);
+
+  (* if no NV state, or if clock went backwards, or node ID
+     changed (e.g., new network card) change clockseq *)
+   if not f or CompareMem(@node, @last_node, sizeof(node)) then
+     clockseq := true_random() else
+   if timestamp < last_time then
+     clockseq := clockseq + 1;
+
+   (* save the state for next time *)
+   write_state(clockseq, timestamp, node);
+
+// UNLOCK;
+
+   (* stuff fields into the UUID *)
+   format_uuid_v1(uuid, clockseq, timestamp, node);
+
+   Result := true;
+end;
+
+
+{ uuid_create_md5_from_name -- create a version 3 (MD5) UUID using a "name" from a "name space" }
+
+procedure uuid_create_md5_from_name(var uuid: uuid_t; const nsid: uuid_t; const name: string);
+var
+  net_nsid: uuid_t;
+  c: TMDContext;
+  hash: TMDDigest;
+begin
+  (* put name space ID in network byte order so it hashes the same
+     no matter what endian machine we're on *)
+  net_nsid := nsid;
+  net_nsid.time_low := htonl(net_nsid.time_low);
+  net_nsid.time_mid := htons(net_nsid.time_mid);
+  net_nsid.time_hi_and_version := htons(net_nsid.time_hi_and_version);
+
+  MDInit(c, MD_VERSION_4);
+  MDUpdate(c, net_nsid, sizeof(net_nsid));
+  MDUpdate(c, pchar(name)^, Length(name));
+  MDFinal(c, hash);
+
+  (* the hash is in network byte order at this point *)
+  format_uuid_v3or5(uuid, @hash, UUID_VERSION_3);
+end;
+
+
+{ uuid_create_sha1_from_name }
+
+procedure uuid_create_sha1_from_name(var uuid: uuid_t; const nsid: uuid_t; const name: string);
+var
+  net_nsid: uuid_t;
+{  c: TMDContext;
+  hash: TMDDigest;}
+begin
+  (* put name space ID in network byte order so it hashes the same
+     no matter what endian machine we're on *)
+  net_nsid := nsid;
+  net_nsid.time_low := htonl(net_nsid.time_low);
+  net_nsid.time_mid := htons(net_nsid.time_mid);
+  net_nsid.time_hi_and_version := htons(net_nsid.time_hi_and_version);
+
+  {SHAInit(c, SHA_VERSION_1);
+  SHAUpdate(c, net_nsid, sizeof(net_nsid));
+  SHAUpdate(c, pchar(name)^, Length(name));
+  SHAFinal(c, hash);}
+
+  (* the hash is in network byte order at this point *)
+  format_uuid_v3or5(uuid, @hash, UUID_VERSION_5);
+end;
+
+
+{ uuid_compare }
+
+function uuid_compare(const u1, u2: uuid_t): integer;
+begin
+  Result := pinteger(@u1)[0] - pinteger(@u2)[0];
+  if Result <> 0 then Exit;
+  Result := pinteger(@u1)[1] - pinteger(@u2)[1];
+  if Result <> 0 then Exit;
+  Result := pinteger(@u1)[2] - pinteger(@u2)[2];
+  if Result <> 0 then Exit;
+  Result := pinteger(@u1)[3] - pinteger(@u2)[3];
+end;
+
+
+{ read_state }
+
+var
+  read_state_inited: boolean = false;
+  st: uuid_state;
+
+function read_state(var clockseq: unsigned16; var timestamp: uuid_time_t; var node: uuid_node_t): boolean;
+begin
+  (* only need to read state once per boot *)
+  if not read_state_inited then
+  begin
+    {fp = fopen("state", "rb");
+    if (fp == NULL)
+      return 0;
+    fread(&st, sizeof st, 1, fp);
+    fclose(fp);}
+    read_state_inited := true;
+  end;
+
+  clockseq := st.cs;
+  timestamp := st.ts;
+  node := st.node;
+
+  Result := true;
+end;
+
+
+{ write_state }
+
+var
+  write_state_inited: boolean = false;
+  next_save: uuid_time_t;
+
+procedure write_state(var clockseq: unsigned16; const timestamp: uuid_time_t; const node: uuid_node_t);
+begin
+  if not write_state_inited then
+  begin
+    next_save := timestamp;
+    write_state_inited := true;
+  end;
+
+  (* always save state to volatile shared state *)
+  st.cs := clockseq;
+  st.ts := timestamp;
+  st.node := node;
+
+  if timestamp >= next_save then
+  begin
+    {fp = fopen("state", "wb");
+    fwrite(&st, sizeof st, 1, fp);
+    fclose(fp);}
+
+    (* schedule next save for 10 seconds from now *)
+    next_save := timestamp + (10 * 10 * 1000 * 1000);
+  end;
+end;
+
+
+{ format_uuid_v1 }
+
+procedure format_uuid_v1(var uuid: uuid_t; const clockseq: unsigned16; const timestamp: uuid_time_t; const node: uuid_node_t);
+begin
+  uuid.time_low := timestamp and $FFFFFFFF;
+  uuid.time_mid := (timestamp shr 32) and $FFFF;
+  uuid.time_hi_and_version := (timestamp shr 48) and $0FFF;
+  uuid.time_hi_and_version := uuid.time_hi_and_version or (UUID_VERSION_1 shl 12);
+  uuid.clock_seq_low := clockseq and $FF;
+  uuid.clock_seq_hi_and_reserved := (clockseq shr 8) and $3F;
+  uuid.clock_seq_hi_and_reserved := uuid.clock_seq_hi_and_reserved or $80;
+  uuid.node := node;
+end;
+
+
+{ format_uuid_v3or5 }
+
+procedure format_uuid_v3or5(var uuid: uuid_t; const hash: pointer; const v: integer);
+begin
+  (* convert UUID to local byte order *)
+  move(hash^, uuid, sizeof(uuid));
+  uuid.time_low := ntohl(uuid.time_low);
+  uuid.time_mid := ntohs(uuid.time_mid);
+  uuid.time_hi_and_version := ntohs(uuid.time_hi_and_version);
+
+  (* put in the variant and version bits *)
+  uuid.time_hi_and_version := uuid.time_hi_and_version and $0FFF;
+  uuid.time_hi_and_version := uuid.time_hi_and_version or (v shl 12);
+  uuid.clock_seq_hi_and_reserved := $3F;
+  uuid.clock_seq_hi_and_reserved := uuid.clock_seq_hi_and_reserved or $80;
+end;
+
+
+{ get_current_time }
+
+var
+  get_current_time_inited: boolean = false;
+  time_last: uuid_time_t;
+  uuids_this_tick: unsigned16;
+
+procedure get_current_time(var timestamp: uuid_time_t);
+var
+  time_now: uuid_time_t;
+begin
+  if not get_current_time_inited then
+  begin
+    get_system_time(time_now);
+    uuids_this_tick := UUIDS_PER_TICK;
+    get_current_time_inited := true;
+  end;
+
+  while true do
+  begin
+    get_system_time(time_now);
+
+    (* if clock reading changed since last UUID generated, *)
+    if time_last <> time_now then
+    begin
+      (* reset count of uuids gen'd with this clock reading *)
+      uuids_this_tick := 0;
+      time_last := time_now;
+      Break;
+    end;
+
+    if uuids_this_tick < UUIDS_PER_TICK then
+    begin
+      uuids_this_tick := uuids_this_tick + 1;
+      Break;
+    end;
+    (* going too fast for our clock; spin *)
+  end;
+
+  (* add the count of uuids to low order bits of the clock reading *)
+  timestamp := time_now + uuids_this_tick;
+end;
+
+
+{ get_system_time }
+
+procedure get_system_time(var timestamp: uuid_time_t);
+var
+  Epoch:TDateTime;
+begin
+  Epoch := EncodeDateTime(1582, 10, 15, 0, 0, 0, 0);
+  timestamp := 10000*MilliSecondsBetween(Epoch, Now);
+end;
+
+
+{ get_system_node_identifier }
+
+var
+  get_system_node_identifier_inited: boolean = false;
+  saved_node: uuid_node_t;
+
+procedure get_system_node_identifier(var node: uuid_node_t);
+begin
+  if not get_system_node_identifier_inited then
+  begin
+    saved_node[0] := Random($100);
+    saved_node[1] := Random($100);
+    saved_node[2] := Random($100);
+    saved_node[3] := Random($100);
+    saved_node[4] := Random($100);
+    saved_node[5] := Random($100);
+
+    get_system_node_identifier_inited := true;
+  end;
+
+  node := saved_node;
+end;
+
+
+{ true_random }
+
+function true_random: unsigned16;
+begin
+  Result := Random($10000);
+end;
+
+end.