Tipp 10.4 - GUID erzeugen (2)

Wie kann ich eine eindeutige GUID erzeugen (eine weitere Variante)?

Mit dieser Funktion können Sie eine eindeutige GUID erzeugen (eine weitere Variante). Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Api-AufrufeVerwendete Win32-Api-Aufrufe und Typen: RpcStringFree, UuidToString, UuidCreate, lstrlen, CopyMemory - GUID

Beispiel:

Option Explicit
 
Const RPC_S_UUID_LOCAL_ONLY As Long = 1824&
Const RPC_S_UUID_NO_ADDRESS As Long = 1739&
Const RPC_S_OK              As Long = 0&
 
Type GUID
     Data1                  As Long
     Data2                  As Integer
     Data3                  As Integer
     Data4(7)               As Byte
End Type
 
Declare Function RpcStringFree Lib "rpcrt4.dll" Alias _
                "RpcStringFreeA" _
                (lpGUIDString As Long) As Long
 
Declare Function UuidToString Lib "rpcrt4.dll" Alias _
                "UuidToStringA" _
                (lpGUID As GUID, _
                 lpGUIDString As Long) As Long
 
Declare Function UuidCreate Lib "rpcrt4.dll" _
                (lpGUID As GUID) As Long
 
Declare Function lstrlen Lib "kernel32.dll" Alias _
                "lstrlenA" _
                (ByVal lpString As Long) As Long
 
Declare Sub CopyMemory Lib "kernel32.dll" Alias _
                           "RtlMoveMemory" _
                           (Destination As Any, _
                            Source As Any, _
                            ByVal Length As Long)
 
Function CreateGUID() As String
'// ========================================================
'// Funktion:       |Erzeugt eine eindeutige GUID
'// --------------------------------------------------------
'// Voraussetzungen:|rpcrt4.dll
'//                 |(Remote Procedure Call Runtime)
'//                 |muss sich im System befinden
'// --------------------------------------------------------
'// Parameter:      |-
'// --------------------------------------------------------
'// Rückgabe:       |eindeutige GUID als String bei Erfolg
'// --------------------------------------------------------
'// Erstellt:       |19.05.2001; Stefan Kulpa
'// --------------------------------------------------------
'// Geändert:       |
'// --------------------------------------------------------
'// Autor:          | Stefan Kulpa
'//                 | EDV Innovation & Consulting - Dormagen
'// --------------------------------------------------------
    Dim uGUID       As GUID
    Dim lpStrGUID   As Long
    Dim lStrLength  As Long
    Dim sGUID       As String
    Dim bNoError    As Boolean
    Dim sBuffer()   As Byte
'// ========================================================
'// GUID erzeugen
'// ========================================================
    If UuidCreate(uGUID) <> RPC_S_UUID_NO_ADDRESS Then
    '// ====================================================
    '// Bei Erfolg, Struktur mit den Daten konvertieren
    '// ====================================================
        If UuidToString(uGUID, lpStrGUID) = RPC_S_OK Then
        '// ================================================
        '// Stringlänge ermitteln
        '// ================================================
            lStrLength = lstrlen(lpStrGUID)
        '// ================================================
        '// Byte-Array entsprechend dimensionieren
        '// ================================================
            ReDim sBuffer(lStrLength - 1) As Byte
        '// ================================================
        '// String in das Byte-Array kopieren
        '// ================================================
            CopyMemory sBuffer(0), _
                       ByVal lpStrGUID, _
                       lStrLength
        '// ================================================
        '// Speicher wieder freigeben
        '// ================================================
            Call RpcStringFree(lpStrGUID)
        '// ================================================
        '// String in Unicode konvertieren
        '// ================================================
            sGUID = StrConv(sBuffer, vbUnicode)
        '// ================================================
        '// Ergebnis zurückgeben
        '// ================================================
            CreateGUID = UCase$(sGUID)
        End If
    End If
 
End Function


Zurück Tipp 10.3 - GUID erzeugen | Inhalt | Tipp 10.5 - Zahl in Wort Weiter