Pages

Tuesday, 22 April 2014

Generate UIDs with Mapbasic

This is an example mbx that demonstrates how to generate unique strings.
This example uses a range of variables from computer CPU, Mouse Pointer location, Current Time in milliseconds, Windows API "ole32.dll" GUID generation and the internal mapbasic  Rnd() function. This code has been tested with a 5 Character string continually returning unique strings in groups of 10,000.

Warning: I cannot guarantee that this code will always produce an unique ID. The greater the string length the higher the probability the value will be unique

Please feel free to use or modify this code for use in your application. This code is offered under the described GNU below. It would be
appreciated if this code is used that there is a reference back to www.mapbasichelp.com
Kind regards

James Moloney


GNU GENERAL PUBLIC LICENSE
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License along
with this program. I f not see, http://www.gnu.org/licenses/   
 
Include "Mapbasic.def"


Declare Sub Main
Declare Sub
GenerateUID

Declare Function GetStringUID(ByVal iStrLength as Integer) as String
Declare Function GetReallyRandomNumber() as Float

Type POINTAPI
   x As Integer
   y As Integer
End Type

Declare Function
GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Integer
Dim CursorLocation As POINTAPI
Declare Function GetCPUusage() as Integer
Declare Function GetSystemTimes Lib "kernel32.dll" (idleTime As Integer, kernelTime As Integer, userTime As Integer) As Logical

Type GUID
   Data1 As Integer  
   Data2 As Integer
   Data3 As Integer
   Data4 As Integer
End Type
Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Integer

Dim iRange as Integer
Dim iProgress as Integer
Dim sIdle, sKernel, sUser As Integer
Dim bRandom1 as Logical
Dim bRandom2 as Logical
Dim bUseCPU as Logical

Declare Sub WaitInMilliseconds(byVal iMilliseconds as Integer)
'----------------------------------------------------------------
Sub Main   Print Chr$(12)
   Randomize 'Make sure your code always randomises the rnd seed
   iProgress = 1
   iRange = 10000

   Dim bResult as Logical
   bResult = GetSystemTimes (sIdle, sKernel, sUser)

   ProgressBar "Generating 10,000 UIDs..."
      Calling GenerateUIDRange iRange

   If CommandInfo(CMD_INFO_STATUS) Then
      Note "10,000 UIDs Generated!"
   Else
      Note "Operation interrupted! Less than 10,000 UIDs created!"
   End If
End Sub
'----------------------------------------------------------------
Sub GenerateUID

   Dim strUID as String
   'strUID = GetUID(8) & "-" & GetUID(4) & "-" & GetUID(4) & "-" & GetUID(8) 'example of GUID
   strUID = GetStringUID(15)
   Print strUID

   iProgress = iProgress + 1
   If iProgress > iRange then
      ProgressBar = -1
   Else
      ProgressBar = iProgress
   End If
End Sub
'----------------------------------------------------------------
Function GetStringUID(ByVal iStrLength as Integer) as String
OnError Goto CatchEx

   Dim i as Integer
   Dim iRandNum as Float

   Dim strUID as String

   Do while i < iStrLength
      iRandNum = Round(GetReallyRandomNumber(),1)

      If iRandNum > 47 and iRandNum < 58 then
         strUID = strUID & Chr$(iRandNum)
         i = i + 1
      End If
      If iRandNum > 64 and iRandNum < 91 then
         strUID = strUID & Chr$(iRandNum)
         i = i + 1
      End If
   Loop

   GetStringUID = strUID
Done:
   Exit Function
CatchEx:
   Resume Done

End Function
'----------------------------------------------------------------
Function GetReallyRandomNumber() as Float
OnError Goto CatchEx

   Dim i as Integer
   Dim iResult as Integer
   Dim iCPU as Float
   Dim uID as GUID
   Dim iRandomNumber as Float

   iResult = CoCreateGuid(uID)
   iResult = GetCursorPos(CursorLocation)
  
   If CursorLocation.x = 0 then
      CursorLocation.x = 0.5
   End If
   If Cursorlocation.y = 0 then
      Cursorlocation.y = 0.5
   End If
   If bUseCPU then
      iCPU = GetCPUusage()
      bUseCPU = false
    Else
      iCPU = Rnd(Val(FormatTime$(CurTime(), "fff")))
      bUseCPU = true
   End If
   If iCPU = 0 Then
      iCPU = Val(FormatTime$(CurTime(), "fff"))
   End If
   If bRandom1 then
      iRandomNumber = (Rnd(iCPU) * uID.Data1) * Val(FormatTime$(CurTime(), "fff"))/100
      bRandom1 = false
   Else
      iRandomNumber = (CursorLocation.x / Cursorlocation.y) * iCPU * rnd(uID.Data2)
      bRandom1 = true
   End If
   If NOT bRandom2 then
      iRandomNumber = (Rnd(iRandomNumber) * iCPU) * Val(FormatTime$(CurTime(), "fff"))/100
      bRandom1 = true
   Else
      iRandomNumber = Rnd(iRandomNumber)* uID.Data3
      bRandom2 = false
   End If
   If iRandomNumber < 0.01 then
      iRandomNumber = iRandomNumber * 1000
   End If
   If iRandomNumber < 1 then
      iRandomNumber = iRandomNumber * 100
   ElseIf iRandomNumber > 100 then
      iRandomNumber = iRandomNumber / 100
   ElseIf iRandomNumber > 1000 then
      iRandomNumber = iRandomNumber / 1000
   End If
   If iRandomNumber < 1 then
      iRandomNumber = iRandomNumber * 100
   End If
   If iRandomNumber = 0 then
      Dim bResult as Logical
      bResult = GetSystemTimes (sIdle, sKernel, sUser)
      iRandomNumber = Rnd(Val(FormatTime$(CurTime(), "fff"))) * 100 * uID.Data4
   End If
  
   GetReallyRandomNumber = iRandomNumber

Done:
   Exit Function
CatchEx:
   GetReallyRandomNumber = 1

   Resume Done
End Function
'----------------------------------------------------------------
Function GetCPUusage() as IntegerOnError Goto CatchEx

   Dim eIdle, eKernel, eUser As Integer
   Dim cIdle, cKernel, cUser As Integer
   Dim systemTime As Integer
   Dim totalCpuUsage As Integer

   Dim bResult as Logical
   bResult = GetSystemTimes(eIdle, eKernel, eUser)
  
   cIdle = (eIdle - sIdle)
   cKernel = (eKernel - sKernel)
   cUser = (eUser - sUser)
   
   systemTime = (cKernel + cUser)
  
   totalCpuUsage = (systemTime - cIdle) * (100) / (systemTime)
  
   GetCPUusage = totalCpuUsage

Done:
   Exit Function
CatchEx:
   Resume Done

End Function
'----------------------------------------------------------------
Sub WaitInMilliseconds(byVal iMilliseconds as Integer)
OnError Goto CatchEx
   Dim iEndTime as Integer
   iEndTime = Val(FormatTime$(CurTime(), "hhmmssfff")) + iMilliseconds

   Do while Val(FormatTime$(CurTime(), "hhmmssfff")) < iEndTime
      'Nothing
   Loop
Done:
   Exit Sub

CatchEx:
   Resume Done

End Sub

No comments:

Post a Comment