Xojo Conferences
XDCMay2019MiamiUSA

Platforms to show: All Mac Windows Linux Cross-Platform

/Win/Windows Registry Test
Function:
Required plugins for this example: MBS Win Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Win/Windows Registry Test
This example is the version from Thu, 7th Oct 2015.
Project "Windows Registry Test.rbp"
Class MainWindow Inherits Window
Control Liste Inherits ListBox
ControlInstance Liste Inherits ListBox
EventHandler Sub Change() dim s as string dim r as RegistryKeyMBS selectedkey=nil if liste.listindex>0 then r=liste.CellTag(liste.listindex,0) if r<>Nil then selectedkey=r filllist r s=str(R.ItemCount)+" Subkeys and "+str(r.valuecount)+" values for this key." end if end if keyinfo.text=s CreateKeyButton.enabled=selectedkey<>nil CreateValueButton.enabled=selectedkey<>nil End EventHandler
EventHandler Sub ExpandRow(row As Integer) dim key as RegistryKeyMBS dim subkey as RegistryKeyMBS dim i,count as integer key=me.CellTag(row,0) if key<>Nil then count=key.ItemCount-1 for i=0 to count subkey=key.Item(i) if subkey<>nil then addkey subkey else // no right to look into that key Liste.AddRow key.ItemName(i) Liste.CellItalic(Liste.LastIndex,0)=true end if next else beep end if End EventHandler
End Control
Control vlist Inherits ListBox
ControlInstance vlist Inherits ListBox
EventHandler Sub Change() dim v as RegistryValueMBS dim s as string if me.listindex>=0 then v=me.celltag(me.listindex,0) if v<>Nil then regname.text=v.Name s=str(v.Type) if v.isBinary then s=s+", binary" end if if v.isLong32 then s=s+", 32 bit long" end if if v.isLong64 then s=s+", 64 bit long" end if if v.isString then s=s+", string" end if regtype.text=s+"." regsize.text=format(v.size,"0") if v.isString then regvalue.text=v.asString savevalue=v SaveButton.enabled=true elseif v.isbinary then regvalue.text=v.asbinaryString elseif v.islong32 then regvalue.text=format(v.asLong32,"0") elseif v.islong64 then regvalue.text=format(v.asLong64,"0") else regvalue.text="" end if return end if end if regname.text="" regtype.text="" regsize.text="" regvalue.text="" savevalue=nil SaveButton.enabled=false End EventHandler
End Control
Control StaticTexts Inherits Label
ControlInstance StaticTexts(0) Inherits Label
ControlInstance StaticTexts(1) Inherits Label
ControlInstance StaticTexts(2) Inherits Label
ControlInstance StaticTexts(3) Inherits Label
End Control
Control regname Inherits Label
ControlInstance regname Inherits Label
End Control
Control regsize Inherits Label
ControlInstance regsize Inherits Label
End Control
Control regtype Inherits Label
ControlInstance regtype Inherits Label
End Control
Control keyinfo Inherits Label
ControlInstance keyinfo Inherits Label
End Control
Control regvalue Inherits TextField
ControlInstance regvalue Inherits TextField
End Control
Control SaveButton Inherits PushButton
ControlInstance SaveButton Inherits PushButton
EventHandler Sub Action() savevalue.asString=regvalue.text msgBox "Saved. Reread: "+savevalue.asString End EventHandler
End Control
Control keyname Inherits TextField
ControlInstance keyname Inherits TextField
End Control
Control CreateKeyButton Inherits PushButton
ControlInstance CreateKeyButton Inherits PushButton
EventHandler Sub Action() dim r as RegistryKeyMBS r=selectedkey.CreateKey(keyname.text) if r<>nil then msgBox "Key created. Please update the listbox using the triangle switch." end if End EventHandler
End Control
Control valuename Inherits TextField
ControlInstance valuename Inherits TextField
End Control
Control CreateValueButton Inherits PushButton
ControlInstance CreateValueButton Inherits PushButton
EventHandler Sub Action() dim r as RegistryValueMBS r=selectedkey.Value(valuename.text) if r<>nil then r.asString = regvalue.Text msgBox "Value created!" + EndOfLine + _ valuename.Text + "=" + regvalue.Text liste.listindex = liste.listindex // refresh end if End EventHandler
End Control
EventHandler Sub Open() const win95path="HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion" const winNTpath="HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion" dim r as RegistryMBS dim s as string if targetmacOS then msgBox "There is no registry on Mac OS."+EndOfLine+"What a luck!" else r=new RegistryMBS addkey r.ClassesRoot addkey r.CurrentConfig addkey r.CurrentUser addkey r.LocalMachine addkey r.Users s=r.getStringValue(winNTpath, "ProductName") msgBox "This OS is: "+s end if End EventHandler
Sub AddKey(k as RegistryKeyMBS) if k<>nil then if k.ItemCount=0 then liste.addrow k.name else liste.addfolder k.name end if liste.CellTag(liste.lastIndex,0)=k end if End Sub
Sub filllist(r as registrykeyMBS) dim i,c as integer dim v as RegistryValueMBS vlist.deleteAllRows if r<>nil then c=r.ValueCount-1 if rnd<0.5 then // let's pick a way here in the example by random. // with value by index for i=0 to c v=r.Value(i) vlist.addrow v.Name vlist.cell(vlist.lastIndex,1)=format(v.Size,"0") vlist.cell(vlist.lastIndex,2)=format(v.type,"0") vlist.CellTag(vlist.lastIndex,0)=v next else // with values by name for i=0 to c dim name as string = r.ValueName(i) v = r.Value(name) vlist.addrow v.Name vlist.cell(vlist.lastIndex,1)=format(v.Size,"0") vlist.cell(vlist.lastIndex,2)=format(v.type,"0") vlist.CellTag(vlist.lastIndex,0)=v next end if end if End Sub
Property savevalue As registryvalueMBS
Property selectedkey As registrykeyMBS
End Class
MenuBar Menü
MenuItem UntitledMenu3 = ""
MenuItem UntitledMenu2 = "Ablage"
MenuItem FileQuit = "Beenden"
MenuItem UntitledMenu0 = "Bearbeiten"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Ausschneiden"
MenuItem EditCopy = "Kopieren"
MenuItem EditPaste = "Einfügen"
MenuItem EditClear = "Löschen"
End MenuBar
Class App Inherits Application
EventHandler Function UnhandledException(error As RuntimeException) As Boolean MsgBox "Unhandled "+Introspection.GetType(error).name+": "+error.Message+EndOfLine+EndOfLine+join(error.Stack, EndOfLine) Return true End EventHandler
End Class
End Project

See also:

Feedback, Comments & Corrections

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




Links
MBS FileMaker blog