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