2008/01/26

產生新GUID use VB

VB Call API 寫法'
--------- API 宣告 ---------------------------
Private Declare Function WinCoCreateGuid Lib "OLE32.DLL" Alias "CoCreateGuid" (g As GUIDType) As Long '
-------- 自訂型態 --------
Private Type GUIDType
D1 As Long
D2 As Integer
D3 As Integer
D4(8) As Byte
End Type

' 取得新的 GUID
Public Function GetGUID() As String
Dim gt As GUIDType
Dim sBuf As String
Call WinCoCreateGuid(gt)
sBuf = PadZeros(Hex$(g.D1), 8, True) & _
PadZeros(Hex$(g.D2), 4, True) & _
PadZeros(Hex$(g.D3), 4, True) & _
PadZeros(Hex$(g.D4(0)), 2) & _
PadZeros(Hex$(g.D4(1)), 2) & _
PadZeros(Hex$(g.D4(2)), 2) & _
PadZeros(Hex$(g.D4(3)), 2) & _
PadZeros(Hex$(g.D4(4)), 2) & _
PadZeros(Hex$(g.D4(5)), 2) & _
PadZeros(Hex$(g.D4(6)), 2) & _
PadZeros(Hex$(g.D4(7)), 2)
GetGUID = sBuf
End Function

' 補 0
Public Function PadZeros(ByVal sBit As String, _
ByVal iStrLen As Integer, _
Optional bHyphen As Boolean) As String
If iStrLen > Len(sBit) Then
sBit = Right(String((iStrLen - Len(sBit)), "0") & sBit, iStrLen)
End If
If bHyphen Then sBit = sBit & "-"
PadZeros = sBit
End Function

0 Comments:

張貼留言

<< Home