diff --git a/SYS/lhs_uuid.pbi b/SYS/lhs_uuid.pbi new file mode 100644 index 0000000..50f72a6 --- /dev/null +++ b/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 \ No newline at end of file