Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0271: Eine GUID generieren lassen

VB 5/6-Tipp 0271: Eine GUID generieren lassen

 von Herfried K. Wagner

Schwierigkeitsgrad:

Verwendete API-Aufrufe: RtlMoveMemory (CopyMemory), RpcStringFreeA (RpcStringFree), UuidCreate, UuidToStringA (UuidToString), lstrlenA (lstrlen)

Download: Download des Beispielprojektes [2,29 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"

Option Explicit

Private Declare Function UuidCreate Lib "rpcrt4" (lpGUID _
        As GUID) As Long
        
Private Declare Function UuidToString Lib "rpcrt4" Alias _
        "UuidToStringA" (lpGUID As GUID, lpGUIDString As _
        Long) As Long

Private Declare Function lstrlen Lib "kernel32" Alias _
        "lstrlenA" (ByVal lpString As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias _
        "RtlMoveMemory" (lpDest As Any, lpSource As Any, _
        ByVal cBytes As Long)

Private Declare Function RpcStringFree Lib "rpcrt4" Alias _
        "RpcStringFreeA" (lpGUIDString As Long) As Long

Const RPC_S_OK = &H0
Const RPC_S_UUID_LOCAL_ONLY = &H720
Const RPC_S_UUID_NO_ADDRESS = &H6CB

Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(7) As Byte
End Type

Private Sub Command1_Click()
  Text1.Text = CreateGUID()
End Sub

Private Function CreateGUID() As String
  Dim G As GUID, GuidByt&, l&, GuidStr$, Buffer() As Byte

    If UuidCreate(G) <> RPC_S_UUID_NO_ADDRESS Then
      If UuidToString(G, GuidByt) = RPC_S_OK Then
  
        l = lstrlen(GuidByt)
        ReDim Buffer(l - 1) As Byte

        Call CopyMemory(Buffer(0), ByVal GuidByt, l)
        Call RpcStringFree(GuidByt)
        GuidStr = StrConv(Buffer, vbUnicode)
        CreateGUID = UCase$(GuidStr)
      End If
    End If
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 4 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.