UUID Lib hinzugefügt

SYS/lhs_uuid.pbi

@@ -0,0 +1,108 @@
+;**************************************
+;*
+;* lhs_UUID.pbi
+;*
+;* (c) by René Linder
+;* (c) by Linder Hard- und Software
+;*
+;* Lizenz LGPL V2.1
+
+Enumeration WCS_UUID_Version
+  #UUID_V1
+  #UUID_V2
+  #UUID_V3
+  #UUID_V4 ; Standard.
+  #UUID_V5
+EndEnumeration
+
+Global UUID_CryptRandom.i
+
+CompilerIf #PB_Compiler_OS = #PB_OS_Web
+  UUID_CryptRandom = 0
+CompilerElse
+  If OpenCryptRandom()
+    UUID_CryptRandom = 1
+  Else
+    UUID_CryptRandom = 0
+  EndIf
+CompilerEndIf
+
+Procedure.s CreateUUID(Type.i=#UUID_V4, String.s="")
+  ;[T] CreateUUID(Type.i, String.s="")
+  ;[D] Gibt eine UUID des Entsprechenden Types  als String zurück.
+  ;[D] Derzeit nur Version 4 Implementiert.
+  ;[V] 0.0.1
+  ;[M] 0.0.1   
+  Protected P_Type.i = Type.i
+  Protected P_String.s = String.s
+  Protected P_UUID.s = ""
+  Protected Dim P_Numbers.a(16)
+  ;Protected P_Temp.a
+  Protected P_Count.a
+  Protected Key
+ 
+  Structure Struc_UUID
+   
+    low.a
+  EndStructure
+ 
+  Select P_Type
+;     Case #UUID_V1
+;     
+;     Case #UUID_V2
+;     
+;     Case #UUID_V3
+;     
+;     Case #UUID_V5
+    Case 10
+     
+    Default     ;#UUID_V4 RFC 4122 Konform
+                ;xx xx xx xx - xx xx - 4x xx - yx xx - xx xx xx xx xx xx
+      Key = AllocateMemory(16)
+      ;Key = 0
+      CompilerIf #PB_Compiler_OS <> #PB_OS_Web
+        If WCS_UUID_CryptRandom And Key
+          CryptRandomData(Key, 16)
+          For P_Count = 0 To 15
+            P_Numbers(P_Count) = PeekB(Key+P_Count)
+          Next P_Count     
+        Else
+      CompilerElse
+        If WCS_UUID_CryptRandom = 0
+      CompilerEndIf
+        For P_Count = 0 To 15
+          P_Numbers(P_Count) = Random(255)
+        Next P_Count
+      EndIf
+     
+      If Key
+        FreeMemory(Key)
+      EndIf
+     
+      P_Numbers(6) = Val("$4"+Right(RSet(Hex(P_Numbers(6), #PB_Byte), 2, "0"), 1))
+      P_Numbers(8) = Val("%10"+Right(RSet(Bin(P_Numbers(8), #PB_Byte), 8, "0"), 6))
+      P_UUID = ""
+      For P_Count = 0 To 15
+        If P_Count = 4 Or P_Count = 6 Or P_Count = 8 Or P_Count = 10
+          P_UUID + "-"
+        EndIf
+        P_UUID + RSet(Hex(P_Numbers(P_Count), #PB_Byte), 2, "0")
+      Next P_Count
+     
+  EndSelect
+  ProcedureReturn P_UUID
+EndProcedure
+
+Procedure IsUUID(UUID.s , Type.i = #UUID_V4)
+  ;[T] IsUUID(UUID.s , Type.i = #UUID_V4)
+  ;[D] Prüft ob die UUID entsprechend Version 4 und RFC 4122 Konform ist.
+  ;[V] 0.0.1
+  ;[M] 0.0.1     
+  If Mid(UUID.s, 15,1) = Str(Type+1)
+    If Left(Bin(Val("$"+Mid(UUID.s, 15,2)), #PB_Byte),2) = "10"
+      ProcedureReturn #True
+    EndIf
+  EndIf
+ 
+  ProcedureReturn #False
+EndProcedure