Prikazi cijelu temu 23.02.2015 14:10
roko Van mreze
Clan
Registrovan od:02.02.2009
Lokacija:Rijeka


Predmet:Re: Access trikovi
Kreiranje GUIID
Ako nekome treba GUIID za slanje podataka
PreuzmiIzvorni kôd (Visual Basic):
  1. Option Explicit
  2. DefLng A-Z
  3. Private Type GUID
  4.         Data1 As Long
  5.         Data2 As Integer
  6.         Data3 As Integer
  7.         Data4(0 To 7) As String * 1
  8.     End Type
  9.     Declare Function CoCreateGuid Lib "ole32.dll" (tGUIDStructure As GUID) As Long
  10. 'Za access 64 bita
  11. ' Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (tGUIDStructure As GUID) As Long
  12. Const mciLen As Integer = 4     'svakih part's
  13.  
  14. Public Function CreateGUID() As String
  15.     Dim sGUID   As String       '= result
  16.    Dim TGUID   As GUID         'unutar structure
  17.    If CoCreateGuid(TGUID) = 0 Then ' API uzmi GUID
  18.        With TGUID              'build return string
  19.            sGUID = "{" & PadLeft(Hex(.Data1), mciLen * 2) & "-"
  20.             sGUID = sGUID & PadLeft(Hex(.Data2), mciLen) & "-"
  21.             sGUID = sGUID & PadLeft(Hex(.Data3), mciLen) & "-"
  22.             sGUID = sGUID & FormatGUIDData4(.Data4())
  23.         End With
  24.         sGUID = sGUID & "}"     'end
  25.        CreateGUID = sGUID
  26.     End If
  27. End Function
  28.  
  29. Private Function FormatGUIDData4(aryData4() As String * 1) As String
  30.     Dim i       As Integer      'loop KROZ
  31.    Dim sGUID   As String       'resultat
  32.    Dim sTemp1  As String       '1. part
  33.    Dim sTemp2  As String       '2.part
  34.    For i = LBound(aryData4()) To UBound(aryData4())   'process string array
  35.        If i < 2 Then           '1. part
  36.            sTemp1 = sTemp1 & Hex(Asc(aryData4(i)))
  37.         Else                    '2. part
  38.            sTemp2 = sTemp2 & Hex(Asc(aryData4(i)))
  39.         End If
  40.     Next
  41.     sGUID = PadLeft(sTemp1, mciLen) & "-" & PadLeft(sTemp2, mciLen * 3) 'pad left s nulama
  42.    FormatGUIDData4 = sGUID                     'return gotov
  43. End Function
  44.  
  45. Private Function PadLeft(sString As String, iLen As Integer) As String
  46. '  left zreos ako bude
  47.    Dim sTemp As String
  48.     sTemp = right$(String$(iLen, "0") & sString, iLen)
  49.     PadLeft = sTemp
  50. End Function