Platforms to show: All Mac Windows Linux Cross-Platform

/Util/Machine ID


Required plugins for this example: MBS Util Plugin

You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Util/Machine ID

This example is the version from Fri, 15th Nov 2018.

Project "Machine ID.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
EventHandler Sub Open() pref.init dim r as CheckMachineResult = Pref.CheckMachineID Select case r case CheckMachineResult.Accepted // okay case CheckMachineResult.NewMachine MsgBox "This is a new computer. Please enter license key again." // when new computer, ask customer for license key or activation // than reset table with pref.ResetMachineID // and call pref.CheckMachineID again case CheckMachineResult.Error // "Database error?" case CheckMachineResult.FirstLaunch MsgBox "Welcome to my great app!" end Select dim n as integer = pref.value("LaunchCounter") pref.Value("LaunchCounter") = n + 1 End EventHandler
End Class
MenuBar MainMenuBar
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem EditSeparator1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem EditSeparator2 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Module Pref
Const PrefFilename = "MachineIDTestApp.db"
Const PrefPassword = ""
Enum CheckMachineResult Unknown = 0 FirstLaunch Accepted NewMachine Error = -1 End Enum
Protected Function CheckMachineID() As CheckMachineResult // we use those 10 values dim MacAddress as string = SystemInformationMBS.MACAddressString dim MacModel as string = SystemInformationMBS.MacModel dim HardDiscSerial as string = SystemInformationMBS.HardDiscSerial dim MacUUID as string = SystemInformationMBS.MacUUID dim WinProductKey as string = SystemInformationMBS.WinProductKey dim ComputerName as string = SystemInformationMBS.ComputerName.trim dim CPUBrandString as String = SystemInformationMBS.CPUBrandString dim Platform as string = GetPlatform dim ProcessorCount as integer = SystemInformationMBS.ProcessorCount(SystemInformationMBS.kProcessorCountPhysical) dim PhysicalRAM as Int64 = round(SystemInformationMBS.PhysicalRAM) dim r as RecordSet = db.sqlSelect("SELECT * FROM Machines") if db.Error then dim e as string = db.ErrorMessage break // check in debugger MsgBox e return CheckMachineResult.Error end if dim result as CheckMachineResult dim add as Boolean = false if r = nil or r.EOF then // nothing in table, so add on first run add = true result = CheckMachineResult.FirstLaunch else // have records, so compare result = CheckMachineResult.NewMachine while not r.EOF dim rMacAddress as string = r.Field("MacAddress").StringValue dim rMacModel as string = r.Field("MacModel").StringValue dim rHardDiscSerial as string = r.Field("HardDiscSerial").StringValue dim rMacUUID as string = r.Field("MacUUID").StringValue dim rWinProductKey as string = r.Field("WinProductKey").StringValue dim rComputerName as string = r.Field("ComputerName").StringValue dim rCPUBrandString as String = r.Field("CPUBrandString").StringValue dim rPlatform as string = r.Field("Platform").StringValue dim rProcessorCount as integer = r.Field("ProcessorCount").IntegerValue dim rPhysicalRAM as Int64 = r.Field("PhysicalRAM").Int64Value dim MatchCount as integer if rMacAddress = MacAddress then MatchCount = MatchCount + 1 end if if rMacModel = MacModel then MatchCount = MatchCount + 1 end if if rHardDiscSerial = HardDiscSerial then MatchCount = MatchCount + 1 end if if rMacUUID = MacUUID then MatchCount = MatchCount + 1 end if if rWinProductKey = WinProductKey then MatchCount = MatchCount + 1 end if if rComputerName = ComputerName then MatchCount = MatchCount + 1 end if if rCPUBrandString = CPUBrandString then MatchCount = MatchCount + 1 end if if rPlatform = Platform then MatchCount = MatchCount + 1 end if if rProcessorCount = ProcessorCount then MatchCount = MatchCount + 1 end if if rPhysicalRAM = PhysicalRAM then MatchCount = MatchCount + 1 end if if MatchCount = 10 then // all matched, so it's okay. return CheckMachineResult.Accepted elseif MatchCount = 9 then // one changed, so lets update database, unless we find perfect match add = true result = CheckMachineResult.Accepted end if r.MoveNext wend end if if add then // add new configuration dim d as new DatabaseRecord d.Column("MacAddress") = MacAddress d.Column("MacModel") = MacModel d.Column("HardDiscSerial") = HardDiscSerial d.Column("MacUUID") = MacUUID d.Column("WinProductKey") = WinProductKey d.Column("CPUBrandString") = CPUBrandString d.Column("ComputerName") = ComputerName d.Column("MacUUID") = MacUUID d.IntegerColumn("ProcessorCount") = ProcessorCount d.Int64Column("PhysicalRAM") = PhysicalRAM d.Column("Platform") = Platform db.InsertRecord("Machines", d) if db.Error then dim e as string = db.ErrorMessage break // check in debugger MsgBox e return CheckMachineResult.Error end if end if return result End Function
Protected Function GetPlatform() As string #if TargetWindows then return "Windows" #elseif TargetMacOS then return "MacOS" #elseif TargetIOS then return "iOS" #elseif TargetLinux then return "Linux" #else ? #endif End Function
Sub Init() dic = new Dictionary // define in PrefFilename the name of the preferences file dim file as FolderItem = SpecialFolder.Preferences.Child(PrefFileName) #if RBVersion < 2013 then // in Real Studio dim d as new REALSQLDatabase #else // in Xojo dim d as new SQLiteDatabase #endif if PrefPassword.len > 0 then // you can put in PrefPassword a password for pref file d.EncryptionKey = PrefPassword end if d.DatabaseFile = file if file.Exists then if d.Connect then Pref.db = d ReadTable else dim e as string = D.ErrorMessage break end if else if d.CreateDatabaseFile then // table for preferences d.SQLExecute "CREATE TABLE Pref (Key VARCHAR UNIQUE, Value VARCHAR)" if d.Error then dim e as string = D.ErrorMessage Break end if d.SQLExecute "CREATE TABLE Machines (ID INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT UNIQUE, "+_ "MACAddress VARCHAR, MacModel VARCHAR, HardDiscSerial VARCHAR, MacUUID VARCHAR, "+_ "WinProductKey VARCHAR, ComputerName VARCHAR, CPUBrandString VARCHAR, Platform VARCHAR, "+_ "PhysicalRAM INTEGER, ProcessorCount INTEGER)" if d.Error then dim e as string = D.ErrorMessage Break end if d.Commit Pref.db = d else dim e as string = D.ErrorMessage break end if end if End Sub
Private Sub ReadTable() // values are cached in dictionary in memory for quick read access dim r as RecordSet = db.SQLSelect("SELECT Key,Value FROM Pref") if db.Error then dim e as string = db.ErrorMessage Break // check in debugger #Pragma Unused e Return end if while not r.EOF dim Key as string = r.IdxField(1).StringValue dim Value as string = r.IdxField(2).StringValue dic.Value(key) = value r.MoveNext wend End Sub
Protected Sub ResetMachineID() // when new computer, ask customer for license key or activation // than reset table here // and call CheckMachineID again db.SQLExecute "DELETE FROM Machines" if db.Error then dim e as string = db.ErrorMessage break // check in debugger MsgBox e end if End Sub
Function Value(key as string) As Variant // you can query values here Return dic.Lookup(key, nil) End Function
Sub Value(key as string, assigns value as variant) // you can set value here dim sql as string = "INSERT OR REPLACE INTO Pref (Key, Value) VALUES (?,?)" dim p as PreparedSQLStatement = db.Prepare(sql) p.BindType(0, SQLitePreparedStatement.SQLITE_TEXT) p.BindType(1, SQLitePreparedStatement.SQLITE_TEXT) p.Bind(0, key) p.Bind(1, value) p.SQLExecute if db.Error then dim e as string = db.ErrorMessage Break // check in debugger #Pragma Unused e Return end if dic.Value(key) = value End Sub
Note "About"
Machine ID v1.0 This example is to show you how to make preferences based on a SQLite database. And to show how to do machine id for licsensing. We check 10 values for a machine. We do allow one to change between runs without doing license key or activation again. e.g. if user upgrades RAM or switches hard disk, we will still recognize the configuration You may want to fine tune this to your needs. © 2018 by Christian Schmitz
Property Protected db As SQLiteDatabase
Property Private dic As Dictionary
End Module
Class MainWindow Inherits Window
Control List Inherits Listbox
ControlInstance List Inherits Listbox
End Control
EventHandler Sub Open() Update self.title = str(pref.value("LaunchCounter"))+"nth launch." End EventHandler
Private Sub Update() // show entries from table dim db as SQLiteDatabase dim r as RecordSet = pref.db.sqlSelect("SELECT * FROM Machines") if pref.db.Error then dim e as string = pref.db.ErrorMessage break MsgBox e return end if dim c as integer = r.FieldCount list.ColumnCount = c for i as integer = 1 to c List.Heading(i-1) = r.IdxField(i).name next while not r.EOF List.AddRow "" for i as integer = 1 to c List.cell(list.LastIndex, i-1) = r.IdxField(i).StringValue next r.MoveNext wend End Sub
End Class
End Project

The items on this page are in the following plugins: MBS Util Plugin.


The biggest plugin in space...