├── cli ├── dbus2pas.ico ├── dbus2pas.lpi └── dbus2pas.lpr ├── gui ├── fpdbusview.ico ├── frmmain.rsj ├── fpdbusview.lpr ├── frmcodeoptions.rsj ├── frmcode.pp ├── fpdbusview.lpi ├── frmcodeoptions.lfm ├── frmcodeoptions.pp ├── frmmain.pp ├── frmcode.lfm └── frmmain.lfm ├── LICENSE ├── src ├── dbusintro.rsj ├── dbusproxy.pp ├── dbusprop.pp ├── dbuscomp.rsj ├── dbusintf.pp └── dbusintro.pp ├── README.md └── COPYING /cli/dbus2pas.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/fpdbus-tools/HEAD/cli/dbus2pas.ico -------------------------------------------------------------------------------- /gui/fpdbusview.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/gcarreno/fpdbus-tools/HEAD/gui/fpdbusview.ico -------------------------------------------------------------------------------- /gui/frmmain.rsj: -------------------------------------------------------------------------------- 1 | {"version":1,"strings":[ 2 | {"hash":141603106,"name":"frmmain.sserviceinterfaces","sourcebytes":[73,110,116,101,114,102,97,99,101,115,32,102,111,114,32,115,101,114,118,105,99,101,32,34,37,115,34],"value":"Interfaces for service \"%s\""} 3 | ]} 4 | -------------------------------------------------------------------------------- /gui/fpdbusview.lpr: -------------------------------------------------------------------------------- 1 | program fpdbusview; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX}{$IFDEF UseCThreads} 7 | cthreads, 8 | {$ENDIF}{$ENDIF} 9 | Interfaces, // this includes the LCL widgetset 10 | Forms, frmmain, frmcodeoptions, frmcode 11 | { you can add units after this }; 12 | 13 | {$R *.res} 14 | 15 | begin 16 | Application.Title:='DBUS Viewer and code generation application'; 17 | Application.Initialize; 18 | Application.CreateForm(TMainForm, MainForm); 19 | Application.CreateForm(TCodeOptionsForm, CodeOptionsForm); 20 | Application.Run; 21 | end. 22 | 23 | -------------------------------------------------------------------------------- /gui/frmcodeoptions.rsj: -------------------------------------------------------------------------------- 1 | {"version":1,"strings":[ 2 | {"hash":73602837,"name":"frmcodeoptions.sinterfacename","sourcebytes":[80,97,115,99,97,108,32,110,97,109,101,32,102,111,114,32,105,110,116,101,114,102,97,99,101],"value":"Pascal name for interface"}, 3 | {"hash":231217458,"name":"frmcodeoptions.sgetinterfacename","sourcebytes":[69,110,116,101,114,32,97,32,110,101,119,32,110,97,109,101,32,102,111,114,32,105,110,116,101,114,102,97,99,101,32,34,37,115,34,46,32,84,104,105,115,32,109,117,115,116,32,98,101,32,97,32,80,97,115,99,97,108,32,105,100,101,110,116,105,102,105,101,114],"value":"Enter a new name for interface \"%s\". This must be a Pascal identifier"} 4 | ]} 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This is the file COPYING.FPC, it applies to the Free Pascal Run-Time Library 2 | (RTL) and packages (packages) distributed by members of the Free Pascal 3 | Development Team. 4 | 5 | The source code of the Free Pascal Runtime Libraries and packages are 6 | distributed under the Library GNU General Public License 7 | (see the file COPYING) with the following modification: 8 | 9 | As a special exception, the copyright holders of this library give you 10 | permission to link this library with independent modules to produce an 11 | executable, regardless of the license terms of these independent modules, 12 | and to copy and distribute the resulting executable under terms of your choice, 13 | provided that you also meet, for each linked independent module, the terms 14 | and conditions of the license of that module. An independent module is a module 15 | which is not derived from or based on this library. If you modify this 16 | library, you may extend this exception to your version of the library, but you are 17 | not obligated to do so. If you do not wish to do so, delete this exception 18 | statement from your version. 19 | 20 | If you didn't receive a copy of the file COPYING, contact: 21 | Free Software Foundation 22 | 675 Mass Ave 23 | Cambridge, MA 02139 24 | USA 25 | 26 | -------------------------------------------------------------------------------- /gui/frmcode.pp: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the Free Pascal run time library. 3 | Copyright (c) 2010 by Michael Van Canneyt, member of the 4 | Free Pascal development team 5 | 6 | DBUS Introspection generated code preview 7 | 8 | See the file COPYING.FPC, included in this distribution, 9 | for details about the copyright. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 | 15 | **********************************************************************} 16 | 17 | unit frmcode; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ButtonPanel, 25 | SynMemo, SynHighlighterPas; 26 | 27 | type 28 | 29 | { TCodeForm } 30 | 31 | TCodeForm = class(TForm) 32 | ButtonPanel1: TButtonPanel; 33 | SynFreePascalSyn1: TSynFreePascalSyn; 34 | SynMemo1: TSynMemo; 35 | private 36 | function GetC: TStrings; 37 | procedure SetC(const AValue: TStrings); 38 | { private declarations } 39 | public 40 | { public declarations } 41 | Property Code : TStrings Read GetC Write SetC; 42 | end; 43 | 44 | var 45 | CodeForm: TCodeForm; 46 | 47 | implementation 48 | 49 | {$R *.lfm} 50 | 51 | { TCodeForm } 52 | 53 | function TCodeForm.GetC: TStrings; 54 | begin 55 | Result:=SynMemo1.Lines; 56 | end; 57 | 58 | procedure TCodeForm.SetC(const AValue: TStrings); 59 | begin 60 | SynMemo1.Lines.Assign(AValue); 61 | end; 62 | 63 | end. 64 | 65 | -------------------------------------------------------------------------------- /src/dbusintro.rsj: -------------------------------------------------------------------------------- 1 | {"version":1,"strings":[ 2 | {"hash":235232947,"name":"dbusintro.serrunknown","sourcebytes":[85,110,107,110,111,119,110,32,37,115,32,58,32,37,115],"value":"Unknown %s : %s"}, 3 | {"hash":149700308,"name":"dbusintro.sargument","sourcebytes":[97,114,103,117,109,101,110,116],"value":"argument"}, 4 | {"hash":121417556,"name":"dbusintro.smethod","sourcebytes":[109,101,116,104,111,100],"value":"method"}, 5 | {"hash":127919228,"name":"dbusintro.ssignal","sourcebytes":[115,105,103,110,97,108],"value":"signal"}, 6 | {"hash":180926405,"name":"dbusintro.sinterface","sourcebytes":[105,110,116,101,114,102,97,99,101],"value":"interface"}, 7 | {"hash":157732553,"name":"dbusintro.sproperty","sourcebytes":[112,114,111,112,101,114,116,121],"value":"property"}, 8 | {"hash":143622373,"name":"dbusintro.svariable","sourcebytes":[118,97,114,105,97,98,108,101],"value":"variable"}, 9 | {"hash":480677,"name":"dbusintro.snode","sourcebytes":[110,111,100,101],"value":"node"}, 10 | {"hash":14814062,"name":"dbusintro.serrnorootnode","sourcebytes":[82,111,111,116,32,110,111,100,101,32,34,110,111,100,101,34,32,110,111,116,32,102,111,117,110,100,46],"value":"Root node \"node\" not found."}, 11 | {"hash":89883815,"name":"dbusintro.swarnunknownelement","sourcebytes":[85,110,107,110,111,119,110,32,101,108,101,109,101,110,116,32,34,37,115,34,32,105,110,32,100,101,102,105,110,105,116,105,111,110,32,111,102,32,37,115,32,34,37,115,34,46,32,73,103,110,111,114,105,110,103],"value":"Unknown element \"%s\" in definition of %s \"%s\". Ignoring"}, 12 | {"hash":233284275,"name":"dbusintro.swarnunknowntypesignature","sourcebytes":[85,110,107,110,111,119,110,32,116,121,112,101,32,115,105,103,110,97,116,117,114,101,32,58,32,37,115],"value":"Unknown type signature : %s"}, 13 | {"hash":219384867,"name":"dbusintro.swarnwrongdicttype","sourcebytes":[87,114,111,110,103,32,100,105,99,116,32,116,121,112,101,32,100,101,102,105,110,105,116,105,111,110,32,58,32,37,115],"value":"Wrong dict type definition : %s"} 14 | ]} 15 | -------------------------------------------------------------------------------- /cli/dbus2pas.lpi: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | <ResourceType Value="res"/> 15 | <UseXPManifest Value="True"/> 16 | <Icon Value="0"/> 17 | </General> 18 | <i18n> 19 | <EnableI18N LFM="False"/> 20 | </i18n> 21 | <VersionInfo> 22 | <Language Value=""/> 23 | <CharSet Value=""/> 24 | <StringTable ProductVersion=""/> 25 | </VersionInfo> 26 | <BuildModes Count="1"> 27 | <Item1 Name="default" Default="True"/> 28 | </BuildModes> 29 | <PublishOptions> 30 | <Version Value="2"/> 31 | <IgnoreBinaries Value="False"/> 32 | <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> 33 | <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> 34 | </PublishOptions> 35 | <RunParams> 36 | <local> 37 | <FormatVersion Value="1"/> 38 | </local> 39 | </RunParams> 40 | <Units Count="1"> 41 | <Unit0> 42 | <Filename Value="dbus2pas.lpr"/> 43 | <IsPartOfProject Value="True"/> 44 | </Unit0> 45 | </Units> 46 | </ProjectOptions> 47 | <CompilerOptions> 48 | <Version Value="11"/> 49 | <Target> 50 | <Filename Value="../bin/dbus2pas"/> 51 | </Target> 52 | <SearchPaths> 53 | <IncludeFiles Value="$(ProjOutDir)"/> 54 | <OtherUnitFiles Value="../src"/> 55 | <UnitOutputDirectory Value="../bin"/> 56 | </SearchPaths> 57 | <Parsing> 58 | <SyntaxOptions> 59 | <UseAnsiStrings Value="False"/> 60 | </SyntaxOptions> 61 | </Parsing> 62 | </CompilerOptions> 63 | <Debugging> 64 | <Exceptions Count="3"> 65 | <Item1> 66 | <Name Value="EAbort"/> 67 | </Item1> 68 | <Item2> 69 | <Name Value="ECodetoolError"/> 70 | </Item2> 71 | <Item3> 72 | <Name Value="EFOpenError"/> 73 | </Item3> 74 | </Exceptions> 75 | </Debugging> 76 | </CONFIG> 77 | -------------------------------------------------------------------------------- /src/dbusproxy.pp: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the Free Pascal run time library. 3 | Copyright (c) 2010 by Michael Van Canneyt, member of the 4 | Free Pascal development team 5 | 6 | DBUS proxy component 7 | 8 | See the file COPYING.FPC, included in this distribution, 9 | for details about the copyright. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 | 15 | **********************************************************************} 16 | {$mode objfpc} 17 | {$h+} 18 | unit dbusproxy; 19 | 20 | interface 21 | 22 | uses sysutils, classes, dbus, dbuscomp; 23 | 24 | Type 25 | 26 | { TDBUSProxy } 27 | 28 | TDBUSProxy = Class(TComponent) 29 | private 30 | FConnection: TCustomDBUSConnection; 31 | FDestination: String; 32 | FObjectPath: String; 33 | FTimeout: Integer; 34 | procedure SetConnection(const AValue: TCustomDBUSConnection); 35 | procedure SetDestination(const AValue: String); 36 | procedure SetObjectPath(const AValue: String); 37 | Protected 38 | Procedure UnhandledArgument(Const AName,AType : String); 39 | Function GetMethodCallMessage(Const AInterface, AMethodName : String) : TDBusMethodCallMessage; 40 | Function GetMessageReply(M : TDBUSMethodCallMessage) : TDBUSMessage; 41 | Public 42 | Constructor Create(AOwner : TComponent); override; 43 | Property Connection : TCustomDBUSConnection Read FConnection Write SetConnection; 44 | Property ObjectPath : String Read FObjectPath Write SetObjectPath; 45 | Property Destination : String Read FDestination Write SetDestination; 46 | Property Timeout : Integer Read FTimeout Write FTimeOut; 47 | end; 48 | 49 | Implementation 50 | 51 | { TDBUSProxy } 52 | 53 | procedure TDBUSProxy.SetConnection(const AValue: TCustomDBUSConnection); 54 | begin 55 | if FConnection=AValue then exit; 56 | FConnection:=AValue; 57 | end; 58 | 59 | procedure TDBUSProxy.SetDestination(const AValue: String); 60 | begin 61 | if FDestination=AValue then exit; 62 | FDestination:=AValue; 63 | end; 64 | 65 | procedure TDBUSProxy.SetObjectPath(const AValue: String); 66 | begin 67 | if FObjectPath=AValue then exit; 68 | FObjectPath:=AValue; 69 | end; 70 | 71 | procedure TDBUSProxy.UnhandledArgument(const AName, AType: String); 72 | begin 73 | Raise Exception.CreateFmt('Type of argument "%s" cannot be handled yet : %s is unimplemented.',[AName,AType]); 74 | end; 75 | 76 | function TDBUSProxy.GetMethodCallMessage(const AInterface, AMethodName: String 77 | ): TDBusMethodCallMessage; 78 | begin 79 | Result:=TDBusMethodCallMessage.Create(FDestination,FObjectPath,AInterface,AMethodName); 80 | end; 81 | 82 | function TDBUSProxy.GetMessageReply(M: TDBUSMethodCallMessage): TDBUSMessage; 83 | begin 84 | Result:=Connection.SendWithReplyAndBlock(M,FTimeout); 85 | If (Result=Nil) then 86 | Raise Exception.CreateFmt('No reply on message',[]); 87 | end; 88 | 89 | constructor TDBUSProxy.Create(AOwner: TComponent); 90 | begin 91 | inherited Create(AOwner); 92 | FTimeout:=5000; 93 | end; 94 | 95 | end. 96 | -------------------------------------------------------------------------------- /gui/fpdbusview.lpi: -------------------------------------------------------------------------------- 1 | <?xml version="1.0" encoding="UTF-8"?> 2 | <CONFIG> 3 | <ProjectOptions> 4 | <Version Value="9"/> 5 | <General> 6 | <Flags> 7 | <SaveOnlyProjectUnits Value="True"/> 8 | </Flags> 9 | <SessionStorage Value="InProjectDir"/> 10 | <MainUnit Value="0"/> 11 | <Title Value="DBUS Viewer and code generation application"/> 12 | <ResourceType Value="res"/> 13 | <UseXPManifest Value="True"/> 14 | <Icon Value="0"/> 15 | </General> 16 | <i18n> 17 | <EnableI18N LFM="False"/> 18 | </i18n> 19 | <VersionInfo> 20 | <Language Value=""/> 21 | <CharSet Value=""/> 22 | <StringTable ProductVersion=""/> 23 | </VersionInfo> 24 | <BuildModes Count="1"> 25 | <Item1 Name="default" Default="True"/> 26 | </BuildModes> 27 | <PublishOptions> 28 | <Version Value="2"/> 29 | <IgnoreBinaries Value="False"/> 30 | <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> 31 | <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> 32 | </PublishOptions> 33 | <RunParams> 34 | <local> 35 | <FormatVersion Value="1"/> 36 | </local> 37 | </RunParams> 38 | <RequiredPackages Count="2"> 39 | <Item1> 40 | <PackageName Value="SynEdit"/> 41 | </Item1> 42 | <Item2> 43 | <PackageName Value="LCL"/> 44 | </Item2> 45 | </RequiredPackages> 46 | <Units Count="4"> 47 | <Unit0> 48 | <Filename Value="fpdbusview.lpr"/> 49 | <IsPartOfProject Value="True"/> 50 | </Unit0> 51 | <Unit1> 52 | <Filename Value="frmmain.pp"/> 53 | <IsPartOfProject Value="True"/> 54 | <ComponentName Value="MainForm"/> 55 | <HasResources Value="True"/> 56 | <ResourceBaseClass Value="Form"/> 57 | </Unit1> 58 | <Unit2> 59 | <Filename Value="frmcodeoptions.pp"/> 60 | <IsPartOfProject Value="True"/> 61 | <ComponentName Value="CodeOptionsForm"/> 62 | <HasResources Value="True"/> 63 | <ResourceBaseClass Value="Form"/> 64 | </Unit2> 65 | <Unit3> 66 | <Filename Value="frmcode.pp"/> 67 | <IsPartOfProject Value="True"/> 68 | <ComponentName Value="CodeForm"/> 69 | <HasResources Value="True"/> 70 | <ResourceBaseClass Value="Form"/> 71 | </Unit3> 72 | </Units> 73 | </ProjectOptions> 74 | <CompilerOptions> 75 | <Version Value="11"/> 76 | <Target> 77 | <Filename Value="../bin/fpdbusview"/> 78 | </Target> 79 | <SearchPaths> 80 | <IncludeFiles Value="$(ProjOutDir)"/> 81 | <OtherUnitFiles Value="../src"/> 82 | <UnitOutputDirectory Value="../bin"/> 83 | </SearchPaths> 84 | <Parsing> 85 | <SyntaxOptions> 86 | <UseAnsiStrings Value="False"/> 87 | </SyntaxOptions> 88 | </Parsing> 89 | </CompilerOptions> 90 | <Debugging> 91 | <Exceptions Count="3"> 92 | <Item1> 93 | <Name Value="EAbort"/> 94 | </Item1> 95 | <Item2> 96 | <Name Value="ECodetoolError"/> 97 | </Item2> 98 | <Item3> 99 | <Name Value="EFOpenError"/> 100 | </Item3> 101 | </Exceptions> 102 | </Debugging> 103 | </CONFIG> 104 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # fpdbus-tools 2 | 3 | ## Free Pascal DBus Wrapper and Code Generation Tools 4 | 5 | The author of this code is [Michaël Van Canneyt](mailto:michael@freepascal.org). 6 | 7 | You can find the code and the article he wrote about it [here](https://www.freepascal.org/~michael/articles/#dbus2). 8 | 9 | That page contains a real treasure trove of information and source code. 10 | 11 | I'm just re-arranging the code and adding some niceaties. 12 | 13 | ## What does it contain? 14 | 15 | The code is comprised of a set of pascal units that implement a Component wrapper around [DBus](https://dbus.freedesktop.org/): 16 | 17 | - `src/dbuscomp.pp` DBUS component layer on top of the DBUS library. 18 | - `src/dbusintf.pp` DBUS standard interfaces: Introspectable, DBUS daemon and Properties. 19 | - `src/dbusintro.pp` DBUS Introspection and code generation components. 20 | - `src/dbusproxy.pp` DBUS proxy component. 21 | 22 | The code also includes a set of code generation tools, both in GUI and CLI format: 23 | 24 | - `gui/fpdbusview` GUI tool for exploring and exporting code for both System and Session services. 25 | - `cli/dbus2pas` CLI tools for exporting code for both System and Session services. 26 | 27 | ## fpdbusview 28 | 29 | This gui tool depends on: 30 | - LCL 31 | - SynEdit (For the preview of the generated code) 32 | 33 | (needs explanation of what is, what it does and how it does it) 34 | 35 | ## dbus2pas 36 | 37 | This cli util has no dependencies in terms of packages. 38 | 39 | This is a command line utility that you can use in scripting. 40 | It does not have the visual aid to browse your exposed DBus services. 41 | You will have done so with a DBus debug tool like the above mentioned `fpdbusview` or [D-Feet](https://wiki.gnome.org/Apps/DFeet). 42 | Once you have the necessary information, you can use `dbus2pas` to generate ObjectPascal code to wrap around the service and ease it's use via a more OOP way. 43 | 44 | Here are the options to use dbus2pas. 45 | 46 | ```man 47 | Usage: dbus2pas options 48 | 49 | -h | --help print this help message 50 | -s | --system connect to system bus 51 | -p | --objectpath=O object to introspect in service (default is /) 52 | -o | --output=N filename to write to (defaults to unitname) 53 | -d | --destination=D destination service to connect to 54 | -f | --file=N file to read XML from 55 | -u | --unitname=N unitname (equals output if not set) 56 | -c | --codeoptions=N Set code generation options. Comma-separated list of: 57 | GenerateInterface Generate interface declaration 58 | GenerateProxy Generate proxy declaration 59 | ProxyHasInterface Proxy implements interface 60 | ProxyUsesProtected Proxy methods are protected 61 | UseFunction Use functions for methods with OUT parameter 62 | IncludeSystemInterfaces Include system interfaces 63 | LastPartInterfaceName InterfaceName is constructed from last part of DBUS name if none specified 64 | -k | --keywordprefix=p Prefix for pascal identifier names 65 | -x | --xmlfile=N Write introspection XML to file (only with -d) 66 | ``` 67 | 68 | ### Examples 69 | 70 | ```shell 71 | dbus2pas -p /org/freedesktop/Notifications \ 72 | -o org_freedesktop_Notifications.pas \ 73 | -d org.freedesktop.Notifications \ 74 | -u org_freedesktop_Notifications \ 75 | -c GenerateInterface,GenerateProxy,UseFunction,LastPartInterfaceName 76 | ``` 77 | This will create a file called `org_freedesktop_Notifications.pas` containing code with an Interface and a Proxy to the org.freedesktop.Notifications service. 78 | 79 | You will need to include `org_freedesktop_Notifications.pas` and `dbusproxy.pp` in your project. 80 | -------------------------------------------------------------------------------- /gui/frmcodeoptions.lfm: -------------------------------------------------------------------------------- 1 | object CodeOptionsForm: TCodeOptionsForm 2 | Left = 342 3 | Height = 374 4 | Top = 324 5 | Width = 620 6 | ActiveControl = EUnit 7 | Caption = 'DBUS Code generation options' 8 | ClientHeight = 374 9 | ClientWidth = 620 10 | Visible = False 11 | object CLBInterfaces: TCheckListBox 12 | Left = 353 13 | Height = 200 14 | Top = 24 15 | Width = 236 16 | Anchors = [akTop, akLeft, akRight] 17 | ItemHeight = 0 18 | OnDblClick = CLBInterfacesDblClick 19 | TabOrder = 0 20 | TopIndex = -1 21 | end 22 | object BPreview: TButton 23 | Left = 514 24 | Height = 25 25 | Top = 292 26 | Width = 75 27 | Anchors = [akTop, akRight] 28 | Caption = '&Preview' 29 | OnClick = BPreviewClick 30 | TabOrder = 1 31 | end 32 | object EUnit: TEdit 33 | Left = 104 34 | Height = 27 35 | Top = 16 36 | Width = 136 37 | OnExit = EUnitExit 38 | TabOrder = 2 39 | end 40 | object LUnitName: TLabel 41 | Left = 8 42 | Height = 17 43 | Top = 17 44 | Width = 70 45 | Caption = '&Unit name' 46 | FocusControl = EUnit 47 | ParentColor = False 48 | end 49 | object LPrefix: TLabel 50 | Left = 8 51 | Height = 17 52 | Top = 48 53 | Width = 104 54 | Caption = '&Keyword Prefix' 55 | FocusControl = EPRefix 56 | ParentColor = False 57 | end 58 | object EPRefix: TEdit 59 | Left = 104 60 | Height = 27 61 | Top = 46 62 | Width = 80 63 | TabOrder = 3 64 | end 65 | object CGOptions: TCheckGroup 66 | Left = 8 67 | Height = 184 68 | Top = 80 69 | Width = 313 70 | AutoFill = True 71 | Caption = '&Code options' 72 | ChildSizing.LeftRightSpacing = 6 73 | ChildSizing.TopBottomSpacing = 6 74 | ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 75 | ChildSizing.EnlargeVertical = crsHomogenousChildResize 76 | ChildSizing.ShrinkHorizontal = crsScaleChilds 77 | ChildSizing.ShrinkVertical = crsScaleChilds 78 | ChildSizing.Layout = cclLeftToRightThenTopToBottom 79 | ChildSizing.ControlsPerLine = 1 80 | ClientHeight = 165 81 | ClientWidth = 309 82 | Items.Strings = ( 83 | 'Generate interface declaration' 84 | 'Generate proxy declaration' 85 | 'Proxy implements interface.' 86 | 'Proxy methods are protected' 87 | 'Use functions for methods with OUT parameter' 88 | 'Include system interfaces' 89 | 'Use last part of DBUS name as interface name.' 90 | ) 91 | TabOrder = 4 92 | Data = { 93 | 0700000002020202020202 94 | } 95 | end 96 | object FEUnit: TFileNameEdit 97 | Left = 8 98 | Height = 27 99 | Top = 295 100 | Width = 465 101 | DialogKind = dkSave 102 | DialogTitle = 'Enter pascal source file name' 103 | DialogOptions = [ofPathMustExist] 104 | Filter = 'Pascal files|*.pp;*.pas|All files|*.*' 105 | FilterIndex = 0 106 | HideDirectories = False 107 | ButtonWidth = 23 108 | NumGlyphs = 1 109 | Anchors = [akTop, akLeft, akRight] 110 | MaxLength = 0 111 | TabOrder = 5 112 | end 113 | object Label1: TLabel 114 | Left = 8 115 | Height = 17 116 | Top = 272 117 | Width = 114 118 | Caption = 'Ou&tput filename' 119 | FocusControl = FEUnit 120 | ParentColor = False 121 | end 122 | object Interfaces: TLabel 123 | Left = 353 124 | Height = 23 125 | Top = 1 126 | Width = 218 127 | Alignment = taCenter 128 | AutoSize = False 129 | Caption = '&Interfaces' 130 | FocusControl = CLBInterfaces 131 | Layout = tlCenter 132 | ParentColor = False 133 | end 134 | object ButtonPanel1: TButtonPanel 135 | Left = 6 136 | Height = 37 137 | Top = 331 138 | Width = 608 139 | OKButton.Name = 'OKButton' 140 | OKButton.DefaultCaption = True 141 | OKButton.OnClick = ButtonPanel1Click 142 | HelpButton.Name = 'HelpButton' 143 | HelpButton.DefaultCaption = True 144 | HelpButton.Enabled = False 145 | CloseButton.Name = 'CloseButton' 146 | CloseButton.DefaultCaption = True 147 | CloseButton.Enabled = False 148 | CancelButton.Name = 'CancelButton' 149 | CancelButton.DefaultCaption = True 150 | TabOrder = 6 151 | ShowButtons = [pbOK, pbCancel] 152 | end 153 | object Label2: TLabel 154 | Left = 353 155 | Height = 15 156 | Top = 229 157 | Width = 236 158 | Alignment = taCenter 159 | Anchors = [akTop, akLeft, akRight] 160 | AutoSize = False 161 | Caption = '(double-click to rename interface)' 162 | ParentColor = False 163 | end 164 | end 165 | -------------------------------------------------------------------------------- /gui/frmcodeoptions.pp: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the Free Pascal run time library. 3 | Copyright (c) 2010 by Michael Van Canneyt, member of the 4 | Free Pascal development team 5 | 6 | DBUS Introspection code generation options 7 | 8 | See the file COPYING.FPC, included in this distribution, 9 | for details about the copyright. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 | 15 | **********************************************************************} 16 | unit frmcodeoptions; 17 | 18 | {$mode objfpc}{$h+} 19 | 20 | interface 21 | 22 | uses 23 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, CheckLst, 24 | StdCtrls, ExtCtrls, EditBtn, ButtonPanel, dbusintro; 25 | 26 | type 27 | 28 | { TCodeOptionsForm } 29 | 30 | TCodeOptionsForm = class(TForm) 31 | BPreview: TButton; 32 | ButtonPanel1: TButtonPanel; 33 | Interfaces: TLabel; 34 | CGOptions: TCheckGroup; 35 | CLBInterfaces: TCheckListBox; 36 | EUnit: TEdit; 37 | EPRefix: TEdit; 38 | FEUnit: TFileNameEdit; 39 | Label1: TLabel; 40 | Label2: TLabel; 41 | LPrefix: TLabel; 42 | LUnitName: TLabel; 43 | procedure BPreviewClick(Sender: TObject); 44 | procedure ButtonPanel1Click(Sender: TObject); 45 | procedure CLBInterfacesDblClick(Sender: TObject); 46 | procedure EUnitExit(Sender: TObject); 47 | private 48 | FCodegen: TDBUSCodeGenerator; 49 | FIntro: TDBUSIntrospection; 50 | procedure FormToCodegen; 51 | procedure SetCodeGen(const AValue: TDBUSCodeGenerator); 52 | { private declarations } 53 | public 54 | { public declarations } 55 | Property Intro : TDBUSIntrospection Read FIntro Write Fintro; 56 | Property CodeGen : TDBUSCodeGenerator Read FCodegen Write SetCodeGen; 57 | end; 58 | 59 | var 60 | CodeOptionsForm: TCodeOptionsForm; 61 | 62 | implementation 63 | 64 | uses frmcode; 65 | 66 | resourcestring 67 | SInterfaceName = 'Pascal name for interface'; 68 | SGetInterfaceName = 'Enter a new name for interface "%s". This must be a Pascal identifier'; 69 | 70 | {$R *.lfm} 71 | 72 | { TCodeOptionsForm } 73 | 74 | procedure TCodeOptionsForm.EUnitExit(Sender: TObject); 75 | begin 76 | FEunit.FileName:=ExtractFilePath(FEunit.FileName)+EUnit.Text+'.pp'; 77 | end; 78 | 79 | procedure TCodeOptionsForm.BPreviewClick(Sender: TObject); 80 | begin 81 | FormToCodeGen; 82 | With TCodeForm.Create(Self) do 83 | try 84 | FCodeGen.GenerateUnit(Fintro.Interfaces,Code); 85 | ShowModal; 86 | Finally 87 | Free; 88 | end; 89 | end; 90 | 91 | procedure TCodeOptionsForm.ButtonPanel1Click(Sender: TObject); 92 | begin 93 | FormToCodeGen; 94 | FCodeGen.SaveUnitToFile(Fintro.Interfaces,FEUNit.FileName); 95 | end; 96 | 97 | procedure TCodeOptionsForm.CLBInterfacesDblClick(Sender: TObject); 98 | 99 | Var 100 | I : Integer; 101 | O : TDBUSInterfaceCodeOptionItem; 102 | S : String; 103 | 104 | begin 105 | I:=CLBInterfaces.ItemIndex; 106 | If I=-1 then exit; 107 | O:=CLBInterfaces.Items.Objects[I] as TDBUSInterfaceCodeOptionItem; 108 | S:=O.PascalName; 109 | If (S='') then 110 | S:=O.Name; 111 | if InputQuery(SInterfaceName,Format(SGetInterfaceName,[O.Name]),S) then 112 | begin 113 | O.PascalName:=S; 114 | CLBInterfaces.Items[i]:=O.Name+' -> '+S; 115 | end; 116 | 117 | end; 118 | 119 | procedure TCodeOptionsForm.FormToCodegen; 120 | 121 | var 122 | O : TDBUSCodeOption; 123 | S : TDBUSCodeOptionS; 124 | I : Integer; 125 | 126 | begin 127 | FCodeGen.UnitName := EUNit.Text; 128 | FCodegen.KeyWordPrefix := EPrefix.Text; 129 | S:=[]; 130 | For O:=Low(TDBUSCodeOption) to High(TDBUSCodeOption) do 131 | if CGOptions.Checked[Ord(O)] then 132 | Include(S,O); 133 | FCodeGen.Options:=S; 134 | For I:=0 to FCodeGen.Interfaceoptions.Count-1 do 135 | begin 136 | // CLBInterfaces.Items.AddObject(FCodeGen.Interfaceoptions[i].Name,FCodeGen.Interfaceoptions); 137 | FCodeGen.Interfaceoptions[i].Skip:=Not CLBInterfaces.Checked[i]; 138 | end; 139 | end; 140 | 141 | procedure TCodeOptionsForm.SetCodeGen(const AValue: TDBUSCodeGenerator); 142 | 143 | Var 144 | O : TDBUSCodeOption; 145 | I : Integer; 146 | S : String; 147 | 148 | begin 149 | FCodeGen:=AValue; 150 | EUNit.Text:=FCodeGen.UnitName; 151 | EPrefix.Text:=FCodegen.KeyWordPrefix; 152 | For O :=Low(TDBUSCodeOption) to High(TDBUSCodeOption) do 153 | CGOptions.Checked[Ord(O)]:=(O in FCodeGen.Options); 154 | For I:=0 to FCodeGen.Interfaceoptions.Count-1 do 155 | begin 156 | S:=FCodeGen.Interfaceoptions[i].PascalName; 157 | If S='' then 158 | S:=FCodeGen.Interfaceoptions[i].Name 159 | else 160 | S:=FCodeGen.Interfaceoptions[i].Name+' -> '+S; 161 | CLBInterfaces.Items.AddObject(S,FCodeGen.Interfaceoptions[i]); 162 | CLBInterfaces.Checked[i]:=Not FCodeGen.Interfaceoptions[i].Skip; 163 | end; 164 | FEunit.FileName:=EUnit.Text; 165 | end; 166 | 167 | end. 168 | 169 | -------------------------------------------------------------------------------- /src/dbusprop.pp: -------------------------------------------------------------------------------- 1 | unit dbusprop; 2 | 3 | {$mode objfpc} 4 | {$h+} 5 | 6 | interface 7 | 8 | uses SysUtils, Classes, dbuscomp, dbusproxy; 9 | 10 | Const 11 | Sorg_freedesktop_DBus_Properties_Name = 'org.freedesktop.DBus.Properties'; 12 | 13 | Type 14 | 15 | { org.freedesktop.DBus.Properties -> org_freedesktop_DBus_Properties } 16 | 17 | 18 | TPropertiesGetAllResultItem = Class(TDBUSDictItem) 19 | Private 20 | FKey : String; 21 | FValue : Variant; 22 | Public 23 | Procedure Assign (Source: TPersistent); override; 24 | Procedure Load(I : TDBUSMessageIterator); override; 25 | Procedure Save(I : TDBUSMessageIterator); override; 26 | Property Key : String Read FKey Write FKey; 27 | Property Value : Variant Read FValue Write FValue; 28 | end; 29 | 30 | TPropertiesGetAllResult = Class(TDBUSDictionary) 31 | Private 32 | Function GetE(AIndex : Integer) : TPropertiesGetAllResultItem; 33 | Procedure SetE(AIndex : Integer; AValue : TPropertiesGetAllResultItem); 34 | Public 35 | Constructor CreateDict; 36 | Function AddElement : TPropertiesGetAllResultItem; 37 | Function IndexOfKey(AKey : String) : Integer; 38 | Function FindElement(AKey : String) : TPropertiesGetAllResultItem; 39 | Function ValueByKey(AKey : String) : Variant; 40 | Property Elements[AIndex : Integer] : TPropertiesGetAllResultItem Read GetE Write SetE;Default; 41 | end; 42 | 43 | IProperties = Interface 44 | Function Get (interface_name : String;property_name : String) : Variant; 45 | Procedure aSet (interface_name : String;property_name : String;value : Variant); 46 | Function GetAll (interface_name : String) : TPropertiesGetAllResult; 47 | end; 48 | 49 | TProperties_proxy = Class(TDBUSProxy) 50 | Public 51 | Function Get (interface_name : String;property_name : String) : Variant; 52 | Procedure aSet (interface_name : String;property_name : String;value : Variant); 53 | Function GetAll (interface_name : String) : TPropertiesGetAllResult; 54 | end; 55 | { org.freedesktop.DBus.Introspectable -> org_freedesktop_DBus_Introspectable } 56 | 57 | 58 | implementation 59 | 60 | Procedure TPropertiesGetAllResultItem.Assign (Source: TPersistent); 61 | 62 | var 63 | I : TPropertiesGetAllResultItem; 64 | 65 | begin 66 | if (Source is TPropertiesGetAllResultItem) then 67 | begin 68 | I:=Source as TPropertiesGetAllResultItem; 69 | Fkey:=I.Key; 70 | FValue:=I.Value; 71 | end 72 | else 73 | Inherited; 74 | end; 75 | 76 | 77 | Procedure TPropertiesGetAllResultItem.Load(I : TDBUSMessageIterator); 78 | 79 | begin 80 | I.GetArgument(FKey); 81 | I.GetArgument(FValue); 82 | end; 83 | 84 | 85 | Procedure TPropertiesGetAllResultItem.Save(I : TDBUSMessageIterator); 86 | 87 | begin 88 | I.AppendArgument(FKey); 89 | I.AppendArgument(FValue); 90 | end; 91 | 92 | 93 | Constructor TPropertiesGetAllResult.CreateDict; 94 | 95 | begin 96 | inherited Create(TPropertiesGetAllResultItem); 97 | end; 98 | 99 | 100 | Function TPropertiesGetAllResult.GetE(AIndex : Integer) : TPropertiesGetAllResultItem; 101 | 102 | begin 103 | Result:=Items[AIndex] as TPropertiesGetAllResultItem; 104 | end; 105 | 106 | 107 | Procedure TPropertiesGetAllResult.SetE(AIndex : Integer; AValue : TPropertiesGetAllResultItem); 108 | 109 | begin 110 | Items[AIndex]:=AValue; 111 | end; 112 | 113 | 114 | Function TPropertiesGetAllResult.AddElement : TPropertiesGetAllResultItem; 115 | 116 | begin 117 | Result:=Add as TPropertiesGetAllResultItem; 118 | end; 119 | 120 | 121 | Function TPropertiesGetAllResult.IndexOfKey(AKey : String) : Integer; 122 | 123 | begin 124 | Result:=Count-1; 125 | While (Result>=0) and (GetE(Result).Key<>AKey) do 126 | Dec(Result); 127 | end; 128 | 129 | 130 | Function TPropertiesGetAllResult.FindElement(AKey : String) : TPropertiesGetAllResultItem; 131 | 132 | var 133 | I : Integer; 134 | 135 | begin 136 | I:=IndexOfKey(AKey); 137 | If (I=-1) then 138 | Result:=Nil 139 | else 140 | Result:=GetE(I); 141 | end; 142 | 143 | 144 | Function TPropertiesGetAllResult.ValueByKey(AKey : String) : Variant; 145 | 146 | var 147 | I : Integer; 148 | 149 | begin 150 | I:=IndexOfKey(AKey); 151 | If (I=-1) then 152 | RaiseDBUSError(ClassName,'No value found for key') 153 | else 154 | Result:=GetE(I).Value; 155 | end; 156 | 157 | 158 | 159 | { org.freedesktop.DBus.Properties -> Properties } 160 | 161 | Function TProperties_proxy.Get (interface_name : String;property_name : String) : Variant; 162 | 163 | var 164 | M : TDBUSMethodCallMessage; 165 | R : TDBUSMessage; 166 | begin 167 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Properties_Name, 'Get'); 168 | try 169 | M.AppendArgument(interface_name); 170 | M.AppendArgument(property_name); 171 | R:=GetMessageReply(M); 172 | try 173 | R.GetArgument(Result); 174 | finally 175 | R.Free; 176 | end; 177 | finally 178 | M.Free; 179 | end; 180 | end; 181 | 182 | 183 | Procedure TProperties_proxy.aSet (interface_name : String;property_name : String;value : Variant); 184 | 185 | var 186 | M : TDBUSMethodCallMessage; 187 | R : TDBUSMessage; 188 | begin 189 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Properties_Name, 'aSet'); 190 | try 191 | M.AppendArgument(interface_name); 192 | M.AppendArgument(property_name); 193 | M.AppendArgument(value); 194 | R:=GetMessageReply(M); 195 | try 196 | finally 197 | R.Free; 198 | end; 199 | finally 200 | M.Free; 201 | end; 202 | end; 203 | 204 | 205 | Function TProperties_proxy.GetAll (interface_name : String) : TPropertiesGetAllResult; 206 | 207 | var 208 | M : TDBUSMethodCallMessage; 209 | R : TDBUSMessage; 210 | I : TDBUSMessageIterator; 211 | begin 212 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Properties_Name, 'GetAll'); 213 | try 214 | M.AppendArgument(interface_name); 215 | R:=GetMessageReply(M); 216 | try 217 | Result:=TPropertiesGetAllResult.CreateDict; 218 | R.GetArgument(Result); 219 | finally 220 | R.Free; 221 | end; 222 | finally 223 | M.Free; 224 | end; 225 | end; 226 | 227 | 228 | 229 | end. 230 | -------------------------------------------------------------------------------- /src/dbuscomp.rsj: -------------------------------------------------------------------------------- 1 | {"version":1,"strings":[ 2 | {"hash":17031694,"name":"dbuscomp.serrinvalidoperationwhileconnected","sourcebytes":[67,97,110,110,111,116,32,112,101,114,102,111,114,109,32,116,104,105,115,32,111,112,101,114,97,116,105,111,110,32,119,104,101,110,32,99,111,110,110,101,99,116,101,100,32,116,111,32,116,104,101,32,98,117,115,46],"value":"Cannot perform this operation when connected to the bus."}, 3 | {"hash":251118846,"name":"dbuscomp.serrinvalidoperationwhiledisconnected","sourcebytes":[67,97,110,110,111,116,32,112,101,114,102,111,114,109,32,116,104,105,115,32,111,112,101,114,97,116,105,111,110,32,119,104,101,110,32,100,105,115,99,111,110,110,101,99,116,101,100,32,102,114,111,109,32,116,104,101,32,98,117,115,46],"value":"Cannot perform this operation when disconnected from the bus."}, 4 | {"hash":218183982,"name":"dbuscomp.serrnodbuspath","sourcebytes":[78,111,32,68,66,85,83,32,65,100,100,114,101,115,115,32,116,111,32,99,111,110,110,101,99,116,32,116,111,46],"value":"No DBUS Address to connect to."}, 5 | {"hash":119874780,"name":"dbuscomp.serremptymessage","sourcebytes":[83,111,117,114,99,101,32,109,101,115,115,97,103,101,32,105,115,32,78,105,108],"value":"Source message is Nil"}, 6 | {"hash":162174100,"name":"dbuscomp.serrwrongmessagetype","sourcebytes":[87,114,111,110,103,32,109,101,115,115,97,103,101,32,116,121,112,101,46,32,69,120,112,101,99,116,101,100,32,37,100,44,32,103,111,116,32,37,100],"value":"Wrong message type. Expected %d, got %d"}, 7 | {"hash":13741108,"name":"dbuscomp.serrunknownmessagetype","sourcebytes":[85,110,107,110,111,119,110,32,109,101,115,115,97,103,101,32,116,121,112,101,58,32,37,100],"value":"Unknown message type: %d"}, 8 | {"hash":105316453,"name":"dbuscomp.serrinvalidmessagetype","sourcebytes":[67,97,110,110,111,116,32,99,114,101,97,116,101,32,117,110,107,110,111,119,110,32,109,101,115,115,97,103,101,32,116,121,112,101],"value":"Cannot create unknown message type"}, 9 | {"hash":141429843,"name":"dbuscomp.serrinvalidoperationfromsource","sourcebytes":[84,104,105,115,32,111,112,101,114,97,116,105,111,110,32,99,97,110,110,111,116,32,98,101,32,112,101,114,102,111,114,109,101,100,32,111,110,32,97,32,109,101,115,115,97,103,101,32,99,111,109,105,110,103,32,102,114,111,109,32,116,104,101,32,68,66,85,83],"value":"This operation cannot be performed on a message coming from the DBUS"}, 10 | {"hash":201271252,"name":"dbuscomp.serrinvalidoperationwhenallocated","sourcebytes":[84,104,105,115,32,111,112,101,114,97,116,105,111,110,32,99,97,110,110,111,116,32,98,101,32,112,101,114,102,111,114,109,101,100,32,119,104,101,110,32,97,32,109,101,115,115,97,103,101,32,119,97,115,32,97,108,108,111,99,97,116,101,100],"value":"This operation cannot be performed when a message was allocated"}, 11 | {"hash":11800756,"name":"dbuscomp.serrinvalidoperationwhennotallocated","sourcebytes":[84,104,105,115,32,111,112,101,114,97,116,105,111,110,32,99,97,110,110,111,116,32,98,101,32,112,101,114,102,111,114,109,101,100,32,119,104,101,110,32,116,104,101,32,105,115,32,110,111,116,32,97,108,108,111,99,97,116,101,100],"value":"This operation cannot be performed when the is not allocated"}, 12 | {"hash":210669412,"name":"dbuscomp.serremptypath","sourcebytes":[67,97,110,110,111,116,32,97,108,108,111,99,97,116,101,32,109,101,116,104,111,100,32,99,97,108,108,32,109,101,115,115,97,103,101,58,32,110,111,32,112,97,116,104,32,115,112,101,99,105,102,105,101,100],"value":"Cannot allocate method call message: no path specified"}, 13 | {"hash":234182340,"name":"dbuscomp.serremptymethod","sourcebytes":[67,97,110,110,111,116,32,97,108,108,111,99,97,116,101,32,109,101,116,104,111,100,32,99,97,108,108,32,109,101,115,115,97,103,101,58,32,110,111,32,109,101,116,104,111,100,32,115,112,101,99,105,102,105,101,100],"value":"Cannot allocate method call message: no method specified"}, 14 | {"hash":42477316,"name":"dbuscomp.serremptyname","sourcebytes":[67,97,110,110,111,116,32,97,108,108,111,99,97,116,101,32,115,105,103,110,97,108,32,109,101,115,115,97,103,101,58,32,110,111,32,115,105,103,110,97,108,32,110,97,109,101,32,115,112,101,99,105,102,105,101,100],"value":"Cannot allocate signal message: no signal name specified"}, 15 | {"hash":98312212,"name":"dbuscomp.serrnoerrorname","sourcebytes":[67,97,110,110,111,116,32,97,108,108,111,99,97,116,101,32,101,114,114,111,114,32,109,101,115,115,97,103,101,58,32,110,111,32,101,114,114,111,114,32,110,97,109,101,32,115,112,101,99,105,102,105,101,100],"value":"Cannot allocate error message: no error name specified"}, 16 | {"hash":55188276,"name":"dbuscomp.serrnoreplyto","sourcebytes":[67,97,110,110,111,116,32,97,108,108,111,99,97,116,101,32,101,114,114,111,114,32,109,101,115,115,97,103,101,58,32,110,111,32,114,101,112,108,121,32,116,111,32,109,101,115,115,97,103,101,32,115,112,101,99,105,102,105,101,100],"value":"Cannot allocate error message: no reply to message specified"}, 17 | {"hash":142270744,"name":"dbuscomp.serrobjectwithoutpath","sourcebytes":[67,97,110,110,111,116,32,40,117,110,41,114,101,103,105,115,116,101,114,32,97,110,32,111,98,106,101,99,116,32,119,105,116,104,111,117,116,32,112,97,116,104],"value":"Cannot (un)register an object without path"}, 18 | {"hash":11871068,"name":"dbuscomp.serrcouldnotsetreplyserial","sourcebytes":[67,111,117,108,100,32,110,111,116,32,115,101,116,32,114,101,112,108,121,32,115,101,114,105,97,108],"value":"Could not set reply serial"}, 19 | {"hash":56057634,"name":"dbuscomp.serrinititer","sourcebytes":[67,111,117,108,100,32,110,111,116,32,105,110,105,116,105,97,108,105,122,101,32,105,116,101,114,97,116,111,114],"value":"Could not initialize iterator"}, 20 | {"hash":101669476,"name":"dbuscomp.serrappendfailed","sourcebytes":[65,112,112,101,110,100,32,111,102,32,97,114,103,117,109,101,110,116,32,116,111,32,109,101,115,115,97,103,101,32,102,97,105,108,101,100],"value":"Append of argument to message failed"}, 21 | {"hash":167144181,"name":"dbuscomp.serrnomorearguments","sourcebytes":[78,111,32,109,111,114,101,32,97,114,103,117,109,101,110,116,115,32,97,118,97,105,108,97,105,98,108,101],"value":"No more arguments availaible"}, 22 | {"hash":47626222,"name":"dbuscomp.serrinvalidargumenttype","sourcebytes":[73,110,118,97,108,105,100,32,97,114,103,117,109,101,110,116,32,116,121,112,101,46,32,69,120,112,101,99,116,101,100,32,37,115,44,32,103,111,116,32,37,115,46],"value":"Invalid argument type. Expected %s, got %s."}, 23 | {"hash":203305043,"name":"dbuscomp.serrinvalidarrayelementtype","sourcebytes":[73,110,118,97,108,105,100,32,97,114,114,97,121,32,101,108,101,109,101,110,116,32,116,121,112,101,46,32,69,120,112,101,99,116,101,100,32,37,115,32,103,111,116,32,37,115],"value":"Invalid array element type. Expected %s got %s"}, 24 | {"hash":50988837,"name":"dbuscomp.serrinvalidvarianttype","sourcebytes":[73,110,118,97,108,105,100,32,86,65,82,73,65,78,84,32,116,121,112,101],"value":"Invalid VARIANT type"} 25 | ]} 26 | -------------------------------------------------------------------------------- /cli/dbus2pas.lpr: -------------------------------------------------------------------------------- 1 | program dbus2pas; 2 | 3 | {$mode objfpc}{$H+} 4 | 5 | uses 6 | {$IFDEF UNIX} 7 | cwstring, 8 | {$ENDIF} 9 | Classes, SysUtils, CustApp, xmlread,typinfo, 10 | dom, dbuscomp, dbusintro, dbusintf; 11 | 12 | type 13 | 14 | { TDBUSIntfApplication } 15 | 16 | TDBUSIntfApplication = class(TCustomApplication) 17 | private 18 | procedure GenerateCode(Intro: TDBUSIntrospection); 19 | function GetCodeOptions: TDBUSCodeOptions; 20 | function GetXML(out XML: TXMLDocument): Boolean; 21 | protected 22 | procedure DoRun; override; 23 | public 24 | constructor Create(TheOwner: TComponent); override; 25 | destructor Destroy; override; 26 | procedure WriteHelp; virtual; 27 | end; 28 | 29 | { TDBUSIntfApplication } 30 | 31 | Function TDBUSIntfApplication.GetXML(Out XML : TXMLDocument) : Boolean; 32 | 33 | Var 34 | S : TStringStream; 35 | Conn : TDBUSConnection; 36 | P : Torg_freedesktop_DBus_Introspectable_proxy; 37 | 38 | begin 39 | If HasOption('f','file') then 40 | begin 41 | ReadXMlFile(XML,GetOptionValue('f','file')); 42 | Result:=true; 43 | end 44 | else if not HasOption('d','destination') then 45 | begin 46 | WriteHelp; 47 | Result:=False; 48 | end 49 | else 50 | begin 51 | Conn:=TDBUSConnection.Create(Self); 52 | try 53 | if HasOption('s','system') then 54 | Conn.Kind:=ckSystem 55 | else 56 | Conn.Kind:=ckSession; 57 | Conn.Connect; 58 | P:=Torg_freedesktop_DBus_Introspectable_proxy.create(Self); 59 | try 60 | P.Connection:=Conn; 61 | If HasOption('p','objectpath') then 62 | P.ObjectPath:=GetOptionValue('p','objectpath') 63 | else 64 | P.ObjectPath:='/'; 65 | P.Destination:=GetOptionValue('d','destination'); 66 | S:=TStringStream.Create(P.Introspect); 67 | try 68 | If HasOption('x','xmlfile') then 69 | With TFileStream.Create(GetOPtionvalue('x','xmlfile'),fmCreate) do 70 | Try 71 | CopyFrom(S,0); 72 | S.Position:=0; 73 | finally 74 | Free; 75 | end; 76 | ReadXMLFile(Xml,S); 77 | Result:=True; 78 | finally 79 | S.Free; 80 | end; 81 | finally 82 | P.Free; 83 | end; 84 | finally 85 | Conn.Free; 86 | end; 87 | end; 88 | end; 89 | 90 | procedure TDBUSIntfApplication.DoRun; 91 | var 92 | ErrorMsg: String; 93 | XMl : TXMLDocument; 94 | Intro : TDBUSintrospection; 95 | 96 | begin 97 | ErrorMsg:=CheckOptions('hpsdfuockx','help objectpath system destination file unitname output codeoptions keywordprefix xmlfile'); 98 | if ErrorMsg<>'' then begin 99 | ShowException(Exception.Create(ErrorMsg)); 100 | Terminate; 101 | Exit; 102 | end; 103 | if HasOption('h','help') then begin 104 | WriteHelp; 105 | Terminate; 106 | Exit; 107 | end; 108 | If GetXml(Xml) then 109 | begin 110 | try 111 | Intro:=TDBUSIntrospection.Create(Self); 112 | try 113 | Intro.LoadFromXML(XML); 114 | GenerateCode(Intro); 115 | finally 116 | Intro.Free; 117 | end; 118 | finally 119 | XML.Free; 120 | end; 121 | end; 122 | Terminate; 123 | end; 124 | 125 | Function TDBUSIntfApplication.GetCodeOptions : TDBUSCodeOptions; 126 | 127 | Var 128 | p : Integer; 129 | S,O : String; 130 | 131 | begin 132 | if not HasOption('c','codeoptions') then 133 | Result:=DefaultCodeOptions 134 | else 135 | begin 136 | Result:=[]; 137 | S:=GetOptionValue('c','codeoptions'); 138 | While (S<>'') do 139 | begin 140 | P:=Pos(',',S); 141 | If P=0 then 142 | P:=Length(S)+1; 143 | O:=Trim(Copy(S,1,P-1)); 144 | Delete(S,1,P); 145 | P:=GetEnumValue(TypeInfo(TDBUSCodeOption),'dco'+O); 146 | If (P=-1) then 147 | Writeln('Unknown code option : ',O) 148 | else 149 | Include(Result,TDBUSCodeOption(P)); 150 | end; 151 | end; 152 | end; 153 | Procedure TDBUSIntfApplication.GenerateCode(Intro : TDBUSIntrospection); 154 | 155 | Var 156 | Code : TDBUSCodegenerator; 157 | Fn,UN : String; 158 | 159 | begin 160 | If HasOption('u','unitname') then 161 | UN:=GetOptionValue('u','unitname'); 162 | If HasOption('o','output') then 163 | FN:=GetOptionValue('o','output') 164 | else if (UN<>'') then 165 | FN:=UN+'.pp' 166 | else 167 | FN:='unit1.pp'; 168 | if (UN='') then 169 | if (FN<>'') then 170 | UN:=changefileext(ExtractFileName(FN),''); 171 | Code:=TDBUSCodegenerator.Create(Self); 172 | try 173 | Code.UnitName:=UN; 174 | Code.Options:=GetCodeOptions; 175 | if HasOption('k','keywordprefix') then 176 | Code.KeyWordPrefix:=GetoptionValue('k','keywordprefix'); 177 | 178 | Code.SaveUnitToFile(Intro.Interfaces,FN); 179 | finally 180 | Code.Free; 181 | end; 182 | end; 183 | 184 | constructor TDBUSIntfApplication.Create(TheOwner: TComponent); 185 | begin 186 | inherited Create(TheOwner); 187 | StopOnException:=True; 188 | end; 189 | 190 | destructor TDBUSIntfApplication.Destroy; 191 | begin 192 | inherited Destroy; 193 | end; 194 | 195 | procedure TDBUSIntfApplication.WriteHelp; 196 | begin 197 | { add your help code here } 198 | writeln('Usage: ',ExeName,' options '); 199 | writeln('With options one of:'); 200 | Writeln('-h | --help print this help message'); 201 | Writeln('-s | --system connect to system bus'); 202 | Writeln('-p | --objectpath=O object to introspect in service (default is /)'); 203 | Writeln('-o | --output=N filename to write to (defaults to unitname)'); 204 | Writeln('-d | --destination=D destination service to connect to'); 205 | Writeln('-f | --file=N file to read XML from'); 206 | Writeln('-u | --unitname=N unitname (equals output if not set)'); 207 | Writeln('-c | --codeoptions=N Set code generation options. Comma-separated list of'); 208 | Writeln(' GenerateInterface Generate interface declaration'); 209 | Writeln(' GenerateProxy Generate proxy declaration'); 210 | Writeln(' ProxyHasInterface Proxy implements interface'); 211 | Writeln(' ProxyUsesProtected Proxy methods are protected'); 212 | Writeln(' UseFunction Use functions for methods with OUT parameter'); 213 | Writeln(' IncludeSystemInterfaces Include system interfaces'); 214 | Writeln(' LastPartInterfaceName InterfaceName is constructed from last part of DBUS name if none specified'); 215 | Writeln('-k | --keywordprefix=p Prefix for pascal identifier names'); 216 | Writeln('-x | --xmlfile=N Write introspection XML to file (only with -d)'); 217 | end; 218 | 219 | var 220 | Application: TDBUSIntfApplication; 221 | 222 | {$R *.res} 223 | 224 | begin 225 | Application:=TDBUSIntfApplication.Create(nil); 226 | Application.Title:='DBUS code pascal code generator'; 227 | Application.Run; 228 | Application.Free; 229 | end. 230 | 231 | -------------------------------------------------------------------------------- /src/dbusintf.pp: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the Free Pascal run time library. 3 | Copyright (c) 2010 by Michael Van Canneyt, member of the 4 | Free Pascal development team 5 | 6 | DBUS standard interfaces: Introspectable, DBUS daemon and Properties 7 | 8 | See the file COPYING.FPC, included in this distribution, 9 | for details about the copyright. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 | 15 | **********************************************************************} 16 | 17 | unit dbusintf; 18 | 19 | {$mode objfpc} 20 | {$h+} 21 | 22 | interface 23 | 24 | uses SysUtils, Classes, dbuscomp, dbusproxy; 25 | 26 | Const 27 | Sorg_freedesktop_DBus_Introspectable_Name = 'org.freedesktop.DBus.Introspectable'; 28 | Sorg_freedesktop_DBus_Name = 'org.freedesktop.DBus'; 29 | Sorg_freedesktop_DBus_Properties_Name = 'org.freedesktop.DBus.Properties'; 30 | 31 | Type 32 | 33 | { org.freedesktop.DBus.Introspectable -> org_freedesktop_DBus_Introspectable } 34 | 35 | Iorg_freedesktop_DBus_Introspectable = Interface 36 | Function Introspect : String; 37 | end; 38 | 39 | Torg_freedesktop_DBus_Introspectable_proxy = Class(TDBUSProxy) 40 | Public 41 | Function Introspect : String; 42 | end; 43 | { org.freedesktop.DBus -> org_freedesktop_DBus } 44 | 45 | Iorg_freedesktop_DBus = Interface 46 | Function Hello : String; 47 | Function RequestName (Arg1 : String;Arg2 : Cardinal) : Cardinal; 48 | Function ReleaseName (Arg1 : String) : Cardinal; 49 | Function StartServiceByName (Arg1 : String;Arg2 : Cardinal) : Cardinal; 50 | Procedure UpdateActivationEnvironment (Arg1 : TDBUSDictionary); 51 | Function NameHasOwner (Arg1 : String) : Boolean; 52 | Function ListNames : TStringArray; 53 | Function ListActivatableNames : TStringArray; 54 | Procedure AddMatch (Arg1 : String); 55 | Procedure RemoveMatch (Arg1 : String); 56 | Function GetNameOwner (Arg1 : String) : String; 57 | Function ListQueuedOwners (Arg1 : String) : TStringArray; 58 | Function GetConnectionUnixUser (Arg1 : String) : Cardinal; 59 | Function GetConnectionUnixProcessID (Arg1 : String) : Cardinal; 60 | Function GetAdtAuditSessionData (Arg1 : String) : TByteArray; 61 | Function GetConnectionSELinuxSecurityContext (Arg1 : String) : TByteArray; 62 | Procedure ReloadConfig; 63 | Function GetId : String; 64 | end; 65 | 66 | Torg_freedesktop_DBus_proxy = Class(TDBUSProxy) 67 | Public 68 | Function Hello : String; 69 | Function RequestName (Arg1 : String;Arg2 : Cardinal) : Cardinal; 70 | Function ReleaseName (Arg1 : String) : Cardinal; 71 | Function StartServiceByName (Arg1 : String;Arg2 : Cardinal) : Cardinal; 72 | Procedure UpdateActivationEnvironment (Arg1 : TDBUSDictionary); 73 | Function NameHasOwner (Arg1 : String) : Boolean; 74 | Function ListNames : TStringArray; 75 | Function ListActivatableNames : TStringArray; 76 | Procedure AddMatch (Arg1 : String); 77 | Procedure RemoveMatch (Arg1 : String); 78 | Function GetNameOwner (Arg1 : String) : String; 79 | Function ListQueuedOwners (Arg1 : String) : TStringArray; 80 | Function GetConnectionUnixUser (Arg1 : String) : Cardinal; 81 | Function GetConnectionUnixProcessID (Arg1 : String) : Cardinal; 82 | Function GetAdtAuditSessionData (Arg1 : String) : TByteArray; 83 | Function GetConnectionSELinuxSecurityContext (Arg1 : String) : TByteArray; 84 | Procedure ReloadConfig; 85 | Function GetId : String; 86 | end; 87 | 88 | { org.freedesktop.DBus.Properties -> org_freedesktop_DBus_Properties } 89 | 90 | Iorg_freedesktop_DBus_Properties = Interface 91 | Function Get (interface_name : String;property_name : String) : Variant; 92 | Procedure aSet (interface_name : String;property_name : String;value : Variant); 93 | Function GetAll (interface_name : String) : TDBUSDictionary; 94 | end; 95 | 96 | Torg_freedesktop_DBus_Properties_proxy = Class(TDBUSProxy, Iorg_freedesktop_DBus_Properties) 97 | Public 98 | Function Get (interface_name : String;property_name : String) : Variant; 99 | Procedure aSet (interface_name : String;property_name : String;value : Variant); 100 | Function GetAll (interface_name : String) : TDBUSDictionary; 101 | end; 102 | 103 | implementation 104 | 105 | 106 | { org.freedesktop.DBus.Introspectable -> org_freedesktop_DBus_Introspectable } 107 | 108 | Function Torg_freedesktop_DBus_Introspectable_proxy.Introspect : String; 109 | 110 | Var 111 | M : TDBUSMethodCallMessage; 112 | R : TDBUSMessage; 113 | begin 114 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Introspectable_Name, 'Introspect'); 115 | try 116 | R:=GetMessageReply(M); 117 | try 118 | R.GetArgument(Result); 119 | finally 120 | R.Free; 121 | end; 122 | finally 123 | M.Free; 124 | end; 125 | end; 126 | 127 | 128 | { org.freedesktop.DBus -> org_freedesktop_DBus } 129 | 130 | Function Torg_freedesktop_DBus_proxy.Hello : String; 131 | 132 | Var 133 | M : TDBUSMethodCallMessage; 134 | R : TDBUSMessage; 135 | begin 136 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'Hello'); 137 | try 138 | R:=GetMessageReply(M); 139 | try 140 | R.GetArgument(Result); 141 | finally 142 | R.Free; 143 | end; 144 | finally 145 | M.Free; 146 | end; 147 | end; 148 | 149 | 150 | Function Torg_freedesktop_DBus_proxy.RequestName (Arg1 : String;Arg2 : Cardinal) : Cardinal; 151 | 152 | Var 153 | M : TDBUSMethodCallMessage; 154 | R : TDBUSMessage; 155 | begin 156 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'RequestName'); 157 | try 158 | M.AppendArgument(Arg1); 159 | M.AppendArgument(Arg2); 160 | R:=GetMessageReply(M); 161 | try 162 | R.GetArgument(Result); 163 | finally 164 | R.Free; 165 | end; 166 | finally 167 | M.Free; 168 | end; 169 | end; 170 | 171 | 172 | Function Torg_freedesktop_DBus_proxy.ReleaseName (Arg1 : String) : Cardinal; 173 | 174 | Var 175 | M : TDBUSMethodCallMessage; 176 | R : TDBUSMessage; 177 | begin 178 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'ReleaseName'); 179 | try 180 | M.AppendArgument(Arg1); 181 | R:=GetMessageReply(M); 182 | try 183 | R.GetArgument(Result); 184 | finally 185 | R.Free; 186 | end; 187 | finally 188 | M.Free; 189 | end; 190 | end; 191 | 192 | 193 | Function Torg_freedesktop_DBus_proxy.StartServiceByName (Arg1 : String;Arg2 : Cardinal) : Cardinal; 194 | 195 | Var 196 | M : TDBUSMethodCallMessage; 197 | R : TDBUSMessage; 198 | begin 199 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'StartServiceByName'); 200 | try 201 | M.AppendArgument(Arg1); 202 | M.AppendArgument(Arg2); 203 | R:=GetMessageReply(M); 204 | try 205 | R.GetArgument(Result); 206 | finally 207 | R.Free; 208 | end; 209 | finally 210 | M.Free; 211 | end; 212 | end; 213 | 214 | 215 | Procedure Torg_freedesktop_DBus_proxy.UpdateActivationEnvironment (Arg1 : TDBUSDictionary); 216 | 217 | Var 218 | M : TDBUSMethodCallMessage; 219 | R : TDBUSMessage; 220 | begin 221 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'UpdateActivationEnvironment'); 222 | try 223 | UnhandledArgument('Arg1','Array'); 224 | R:=GetMessageReply(M); 225 | try 226 | finally 227 | R.Free; 228 | end; 229 | finally 230 | M.Free; 231 | end; 232 | end; 233 | 234 | 235 | Function Torg_freedesktop_DBus_proxy.NameHasOwner (Arg1 : String) : Boolean; 236 | 237 | Var 238 | M : TDBUSMethodCallMessage; 239 | R : TDBUSMessage; 240 | begin 241 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'NameHasOwner'); 242 | try 243 | M.AppendArgument(Arg1); 244 | R:=GetMessageReply(M); 245 | try 246 | R.GetArgument(Result); 247 | finally 248 | R.Free; 249 | end; 250 | finally 251 | M.Free; 252 | end; 253 | end; 254 | 255 | 256 | Function Torg_freedesktop_DBus_proxy.ListNames : TStringArray; 257 | 258 | Var 259 | M : TDBUSMethodCallMessage; 260 | R : TDBUSMessage; 261 | begin 262 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'ListNames'); 263 | try 264 | R:=GetMessageReply(M); 265 | try 266 | R.GetArgument(Result); 267 | finally 268 | R.Free; 269 | end; 270 | finally 271 | M.Free; 272 | end; 273 | end; 274 | 275 | 276 | Function Torg_freedesktop_DBus_proxy.ListActivatableNames : TStringArray; 277 | 278 | Var 279 | M : TDBUSMethodCallMessage; 280 | R : TDBUSMessage; 281 | begin 282 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'ListActivatableNames'); 283 | try 284 | R:=GetMessageReply(M); 285 | try 286 | R.GetArgument(Result); 287 | finally 288 | R.Free; 289 | end; 290 | finally 291 | M.Free; 292 | end; 293 | end; 294 | 295 | 296 | Procedure Torg_freedesktop_DBus_proxy.AddMatch (Arg1 : String); 297 | 298 | Var 299 | M : TDBUSMethodCallMessage; 300 | R : TDBUSMessage; 301 | begin 302 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'AddMatch'); 303 | try 304 | M.AppendArgument(Arg1); 305 | R:=GetMessageReply(M); 306 | try 307 | finally 308 | R.Free; 309 | end; 310 | finally 311 | M.Free; 312 | end; 313 | end; 314 | 315 | 316 | Procedure Torg_freedesktop_DBus_proxy.RemoveMatch (Arg1 : String); 317 | 318 | Var 319 | M : TDBUSMethodCallMessage; 320 | R : TDBUSMessage; 321 | begin 322 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'RemoveMatch'); 323 | try 324 | M.AppendArgument(Arg1); 325 | R:=GetMessageReply(M); 326 | try 327 | finally 328 | R.Free; 329 | end; 330 | finally 331 | M.Free; 332 | end; 333 | end; 334 | 335 | 336 | Function Torg_freedesktop_DBus_proxy.GetNameOwner (Arg1 : String) : String; 337 | 338 | Var 339 | M : TDBUSMethodCallMessage; 340 | R : TDBUSMessage; 341 | begin 342 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'GetNameOwner'); 343 | try 344 | M.AppendArgument(Arg1); 345 | R:=GetMessageReply(M); 346 | try 347 | R.GetArgument(Result); 348 | finally 349 | R.Free; 350 | end; 351 | finally 352 | M.Free; 353 | end; 354 | end; 355 | 356 | 357 | Function Torg_freedesktop_DBus_proxy.ListQueuedOwners (Arg1 : String) : TStringArray; 358 | 359 | Var 360 | M : TDBUSMethodCallMessage; 361 | R : TDBUSMessage; 362 | begin 363 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'ListQueuedOwners'); 364 | try 365 | M.AppendArgument(Arg1); 366 | R:=GetMessageReply(M); 367 | try 368 | R.GetArgument(Result); 369 | finally 370 | R.Free; 371 | end; 372 | finally 373 | M.Free; 374 | end; 375 | end; 376 | 377 | 378 | Function Torg_freedesktop_DBus_proxy.GetConnectionUnixUser (Arg1 : String) : Cardinal; 379 | 380 | Var 381 | M : TDBUSMethodCallMessage; 382 | R : TDBUSMessage; 383 | begin 384 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'GetConnectionUnixUser'); 385 | try 386 | M.AppendArgument(Arg1); 387 | R:=GetMessageReply(M); 388 | try 389 | R.GetArgument(Result); 390 | finally 391 | R.Free; 392 | end; 393 | finally 394 | M.Free; 395 | end; 396 | end; 397 | 398 | 399 | Function Torg_freedesktop_DBus_proxy.GetConnectionUnixProcessID (Arg1 : String) : Cardinal; 400 | 401 | Var 402 | M : TDBUSMethodCallMessage; 403 | R : TDBUSMessage; 404 | begin 405 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'GetConnectionUnixProcessID'); 406 | try 407 | M.AppendArgument(Arg1); 408 | R:=GetMessageReply(M); 409 | try 410 | R.GetArgument(Result); 411 | finally 412 | R.Free; 413 | end; 414 | finally 415 | M.Free; 416 | end; 417 | end; 418 | 419 | 420 | Function Torg_freedesktop_DBus_proxy.GetAdtAuditSessionData (Arg1 : String) : TByteArray; 421 | 422 | Var 423 | M : TDBUSMethodCallMessage; 424 | R : TDBUSMessage; 425 | begin 426 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'GetAdtAuditSessionData'); 427 | try 428 | M.AppendArgument(Arg1); 429 | R:=GetMessageReply(M); 430 | try 431 | R.GetArgument(Result); 432 | finally 433 | R.Free; 434 | end; 435 | finally 436 | M.Free; 437 | end; 438 | end; 439 | 440 | 441 | Function Torg_freedesktop_DBus_proxy.GetConnectionSELinuxSecurityContext (Arg1 : String) : TByteArray; 442 | 443 | Var 444 | M : TDBUSMethodCallMessage; 445 | R : TDBUSMessage; 446 | begin 447 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'GetConnectionSELinuxSecurityContext'); 448 | try 449 | M.AppendArgument(Arg1); 450 | R:=GetMessageReply(M); 451 | try 452 | R.GetArgument(Result); 453 | finally 454 | R.Free; 455 | end; 456 | finally 457 | M.Free; 458 | end; 459 | end; 460 | 461 | 462 | Procedure Torg_freedesktop_DBus_proxy.ReloadConfig; 463 | 464 | Var 465 | M : TDBUSMethodCallMessage; 466 | R : TDBUSMessage; 467 | begin 468 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'ReloadConfig'); 469 | try 470 | R:=GetMessageReply(M); 471 | try 472 | finally 473 | R.Free; 474 | end; 475 | finally 476 | M.Free; 477 | end; 478 | end; 479 | 480 | 481 | Function Torg_freedesktop_DBus_proxy.GetId : String; 482 | 483 | Var 484 | M : TDBUSMethodCallMessage; 485 | R : TDBUSMessage; 486 | begin 487 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Name, 'GetId'); 488 | try 489 | R:=GetMessageReply(M); 490 | try 491 | R.GetArgument(Result); 492 | finally 493 | R.Free; 494 | end; 495 | finally 496 | M.Free; 497 | end; 498 | end; 499 | 500 | 501 | { org.freedesktop.DBus.Properties -> org_freedesktop_DBus_Properties } 502 | 503 | Function Torg_freedesktop_DBus_Properties_proxy.Get (interface_name : String;property_name : String) : Variant; 504 | 505 | Var 506 | M : TDBUSMethodCallMessage; 507 | R : TDBUSMessage; 508 | begin 509 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Properties_Name, 'Get'); 510 | try 511 | M.AppendArgument(interface_name); 512 | M.AppendArgument(property_name); 513 | R:=GetMessageReply(M); 514 | try 515 | // R.GetArgument(Result); 516 | finally 517 | R.Free; 518 | end; 519 | finally 520 | M.Free; 521 | end; 522 | end; 523 | 524 | 525 | Procedure Torg_freedesktop_DBus_Properties_proxy.aSet (interface_name : String;property_name : String;value : Variant); 526 | 527 | Var 528 | M : TDBUSMethodCallMessage; 529 | R : TDBUSMessage; 530 | begin 531 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Properties_Name, 'aSet'); 532 | try 533 | M.AppendArgument(interface_name); 534 | M.AppendArgument(property_name); 535 | M.AppendArgument(value); 536 | R:=GetMessageReply(M); 537 | try 538 | finally 539 | R.Free; 540 | end; 541 | finally 542 | M.Free; 543 | end; 544 | end; 545 | 546 | 547 | Function Torg_freedesktop_DBus_Properties_proxy.GetAll (interface_name : String) : TDBUSDictionary; 548 | 549 | Var 550 | M : TDBUSMethodCallMessage; 551 | R : TDBUSMessage; 552 | begin 553 | M:=GetMethodCallMessage(Sorg_freedesktop_DBus_Properties_Name, 'GetAll'); 554 | try 555 | M.AppendArgument(interface_name); 556 | R:=GetMessageReply(M); 557 | try 558 | UnhandledArgument('values','Array'); 559 | finally 560 | R.Free; 561 | end; 562 | finally 563 | M.Free; 564 | end; 565 | end; 566 | 567 | 568 | end. 569 | -------------------------------------------------------------------------------- /gui/frmmain.pp: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the Free Pascal run time library. 3 | Copyright (c) 2010 by Michael Van Canneyt, member of the 4 | Free Pascal development team 5 | 6 | DBUS Introspection viewer and code generation. 7 | 8 | See the file COPYING.FPC, included in this distribution, 9 | for details about the copyright. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 | 15 | **********************************************************************} 16 | unit frmmain; 17 | 18 | {$mode objfpc}{$H+} 19 | 20 | interface 21 | 22 | uses 23 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, 24 | ActnList, ExtCtrls, StdCtrls, ComCtrls, dbuscomp, dbusintro; 25 | 26 | type 27 | 28 | { TMainForm } 29 | 30 | TMainForm = class(TForm) 31 | AGetprop: TAction; 32 | AGenCode: TAction; 33 | AQuit: TAction; 34 | ASession: TAction; 35 | ASystem: TAction; 36 | ActionList1: TActionList; 37 | ILDBUS: TImageList; 38 | Label1: TLabel; 39 | LServiceInterfaces: TLabel; 40 | LBServices: TListBox; 41 | MainMenu1: TMainMenu; 42 | MDBUS: TMenuItem; 43 | MenuItem2: TMenuItem; 44 | MIGetprop: TMenuItem; 45 | MICode: TMenuItem; 46 | MLog: TMemo; 47 | MenuItem1: TMenuItem; 48 | MIQuit: TMenuItem; 49 | MISession: TMenuItem; 50 | MISystem: TMenuItem; 51 | Panel1: TPanel; 52 | PNames: TPanel; 53 | Panel2: TPanel; 54 | PMTree: TPopupMenu; 55 | Splitter1: TSplitter; 56 | Splitter2: TSplitter; 57 | TVDBUS: TTreeView; 58 | procedure AGenCodeExecute(Sender: TObject); 59 | procedure AGetpropExecute(Sender: TObject); 60 | procedure AGetpropUpdate(Sender: TObject); 61 | procedure AQuitExecute(Sender: TObject); 62 | procedure ASessionExecute(Sender: TObject); 63 | procedure ASystemExecute(Sender: TObject); 64 | procedure FormShow(Sender: TObject); 65 | procedure LBServicesClick(Sender: TObject); 66 | procedure TVDBUSDblClick(Sender: TObject); 67 | private 68 | { private declarations } 69 | FConn : TDBUSConnection; 70 | FServiceName : String; 71 | procedure DisplayAnnotation(ANode: TTreeNode; AItem: TDBUSNamedItem); 72 | procedure DisplayDBUSNode(DBUSNode: TDBUSNodeItem; AParent: TTreeNode); 73 | procedure DisplayNames; 74 | procedure DisplayServiceInfo(const AServiceName, AObjectPath: String; AParent : TTreeNode); 75 | procedure DisplayInterfaces(Intf: TDBUSInterfaces; AParent : TTreeNode); 76 | procedure DisplayInterface(ANode: TTreeNode; Intf: TDBUSInterfaceDef); 77 | procedure DisplayMethod(ANode: TTreeNode; AMethod: TDBUSMethodDef); 78 | procedure DisplayProperty(ANode: TTreeNode; AProperty: TDBUSPropertyDef); 79 | procedure DisplaySignal(ANode: TTreeNode; ASignal: TDBUSSignalDef); 80 | function ExtractPropertyName(ANode: TTreeNode): string; 81 | function FindPropertiesInterFace(ANode: TTreeNode): TTreeNode; 82 | procedure GenerateCodeForIntrospection(AIntro: TDBUSIntroSpection; AInterfaceName,AUnitName: String); 83 | function GetInterfaceNode(ANode: TTreeNode): TTreeNode; 84 | function GetIntrospection(const AServiceName, AObjectPath: String ): TDBUSIntrospection; 85 | function GetNodeNode(ANode: TTreeNode): TTreeNode; 86 | function GetNodeWithType(ANode: TTreeNode; AType: Integer): TTreeNode; 87 | procedure ShowPropertyValue(ANode : TTreeNode); 88 | function ObjectpathFromNode(N: TTreeNode): String; 89 | procedure ShowError(E: Exception); 90 | public 91 | { public declarations } 92 | Procedure ConnectToBus(AKind : TConnectionKind); 93 | end; 94 | 95 | var 96 | MainForm: TMainForm; 97 | 98 | implementation 99 | 100 | uses dbusintf, dom, xmlread, frmcodeoptions, dbusprop; 101 | 102 | {$R *.lfm} 103 | 104 | Const 105 | SystemDest = 'org.freedesktop.DBus'; 106 | 107 | II_Interfaces = 0; 108 | II_Interface = 1; 109 | II_Node = 2; 110 | II_Method = 3; 111 | II_Property = 4; 112 | II_Signal = 5; 113 | II_ArgIn = 6; 114 | II_ArgOut = 7; 115 | II_Annotation = 8; 116 | 117 | ResourceString 118 | SServiceInterfaces = 'Interfaces for service "%s"'; 119 | 120 | { TMainForm } 121 | 122 | procedure TMainForm.ASystemExecute(Sender: TObject); 123 | begin 124 | ConnectToBus(ckSystem); 125 | end; 126 | 127 | procedure TMainForm.FormShow(Sender: TObject); 128 | begin 129 | ConnectToBus(ckSession); 130 | end; 131 | 132 | procedure TMainForm.LBServicesClick(Sender: TObject); 133 | begin 134 | With LBServices do 135 | if ItemIndex>=0 then 136 | begin 137 | TVDBUS.Items.Clear; 138 | DisplayServiceInfo(Items[ItemIndex],'/',Nil); 139 | end; 140 | end; 141 | 142 | procedure TMainForm.TVDBUSDblClick(Sender: TObject); 143 | 144 | Var 145 | N,N2 : TTreeNode; 146 | OP : String; 147 | 148 | begin 149 | N:=TVDBUS.Selected; 150 | If (N=Nil) then 151 | exit; 152 | If (N.ImageIndex=II_NODE) and (N.Count=0) then 153 | begin 154 | OP:=ObjectPathFromNode(N); 155 | DisplayServiceInfo(FServiceName,OP,N); 156 | end; 157 | end; 158 | 159 | procedure TMainForm.DisplayNames; 160 | 161 | Var 162 | P : Torg_freedesktop_DBus_proxy; 163 | NS : TStringArray; 164 | I : Integer; 165 | 166 | begin 167 | LBServices.Items.beginUpdate; 168 | try 169 | LBServices.Items.Clear; 170 | P:=Torg_freedesktop_DBus_proxy.Create(Self); 171 | try 172 | P.Connection:=FConn; 173 | P.Destination:=SystemDest; 174 | P.ObjectPath:='/'; 175 | NS:=P.ListNames; 176 | For I:=0 to Length(NS)-1 do 177 | LBServices.Items.Add(NS[i]); 178 | I:=LBServices.Items.IndexOf(SystemDest); 179 | If (I<>-1) then 180 | begin 181 | LBServices.ItemIndex:=I; 182 | TVDBUS.Items.Clear; 183 | DisplayServiceInfo(SystemDest,'/',Nil); 184 | end; 185 | SetLength(NS,0); 186 | finally 187 | P.Free; 188 | end; 189 | finally 190 | LBServices.Items.EndUpdate; 191 | end; 192 | end; 193 | 194 | Function TMainForm.GetIntrospection(Const AServiceName, AObjectPath : String) : TDBUSIntrospection; 195 | 196 | Var 197 | T : TStringStream; 198 | XML : TXMLDocument; 199 | P : TOrg_freedesktop_DBus_Introspectable_proxy; 200 | S : String; 201 | I : Integer; 202 | 203 | begin 204 | P:=Torg_freedesktop_DBus_Introspectable_proxy.create(Self); 205 | try 206 | P.Connection:=FConn; 207 | P.ObjectPath:=AObjectPath; 208 | P.Destination:=AServiceName; 209 | S:=P.Introspect; 210 | finally 211 | P.Free; 212 | end; 213 | T:=TStringStream.Create(S); 214 | try 215 | ReadXMLFile(XML,T); 216 | try 217 | Result:=TDBUSIntrospection.Create(Self); 218 | try 219 | Result.LoadFromXML(Xml); 220 | For I:=0 to Result.Warnings.Count-1 do 221 | MLog.Lines.add(Result.Warnings[i]); 222 | except 223 | FreeAndNil(Result); 224 | Raise; 225 | end; 226 | finally 227 | XML.Free; 228 | end; 229 | finally 230 | T.free; 231 | end; 232 | end; 233 | 234 | Function TMainForm.ExtractPropertyName(ANode : TTreeNode) : string; 235 | 236 | Var 237 | P : integer; 238 | 239 | begin 240 | Result:=ANode.Text; 241 | P:=Pos(': ',Result); 242 | Delete(Result,1,P+1); 243 | P:=Pos(' ',Result); 244 | Result:=Trim(Copy(Result,1,P-1)); 245 | end; 246 | 247 | Function TMainForm.GetNodeWithType(ANode : TTreeNode; AType : Integer) : TTreeNode; 248 | 249 | begin 250 | Result:=ANode; 251 | While (Result<>Nil) and (Result.ImageIndex<>AType) do 252 | Result:=Result.Parent; 253 | end; 254 | 255 | Function TMainForm.GetNodeNode(ANode : TTreeNode) : TTreeNode; 256 | 257 | begin 258 | Result:=GetNodeWithType(ANode,II_NODE); 259 | end; 260 | 261 | Function TMainForm.GetInterfaceNode(ANode : TTreeNode) : TTreeNode; 262 | 263 | begin 264 | Result:=GetNodeWithType(ANode,II_INTERFACE); 265 | end; 266 | 267 | Function TMainForm.FindPropertiesInterFace(ANode : TTreeNode) : TTreeNode; 268 | 269 | begin 270 | If Assigned(Anode) then 271 | Result:=ANode.GetFirstChild 272 | else if TVDBUS.Items.Count>0 then 273 | Result:=TVDBUS.Items[0] 274 | else 275 | Result:=nil; 276 | While (Result<>Nil) and ((Result.ImageIndex<>II_Interface) or (Result.Text<>Sorg_freedesktop_DBus_Properties_Name)) do 277 | Result:=Result.GetNextSibling; 278 | end; 279 | 280 | procedure TMainForm.ShowPropertyValue(ANode: TTreeNode); 281 | 282 | Var 283 | N,NI,NO : TTreeNode; 284 | P : TProperties_proxy; 285 | V : Variant; 286 | intfN,S,OP : String; 287 | 288 | begin 289 | Ni:=GetInterFaceNode(ANode); 290 | If Assigned(Ni) then 291 | No:=GetNodeNode(Ni.Parent) 292 | else 293 | begin 294 | ShowMessage('No interface node found.'); 295 | Exit; 296 | end; 297 | N:=FindPropertiesInterFace(No); 298 | If not Assigned(N) then 299 | begin 300 | ShowMessage('No properties interface found.'); 301 | Exit; 302 | end; 303 | OP:=ObjectPathFromNode(No); 304 | P:=TProperties_Proxy.Create(Self); 305 | try 306 | P.Connection:=FConn; 307 | P.ObjectPath:=OP; 308 | P.Destination:=FServiceName; 309 | S:=ExtractPropertyName(ANode); 310 | intfn:=Ni.Text; 311 | V:=P.Get(Intfn,S); 312 | try 313 | OP:=V; 314 | except 315 | OP:='Variant value cannot be displayed'; 316 | end; 317 | Mlog.Lines.Add('Property '+S+' = '+OP); 318 | finally 319 | P.Free; 320 | end; 321 | end; 322 | 323 | procedure TMainForm.DisplayServiceInfo(Const AServiceName, AObjectPath : String; AParent : TTreeNode); 324 | 325 | Var 326 | Intro : TDBUSIntrospection; 327 | 328 | begin 329 | LServiceInterfaces.Caption:=Format(SServiceInterfaces,[AServiceName]); 330 | FServiceName:=AServiceName; 331 | try 332 | Intro:=GetIntroSpection(AServiceName,AObjectPath); 333 | try 334 | DisplayDBUSNode(Intro.RootNode,AParent); 335 | finally 336 | Intro.Free; 337 | end; 338 | except 339 | On E : Exception do 340 | ShowError(E); 341 | end; 342 | end; 343 | 344 | Procedure TMainForm.DisplayDBUSNode(DBUSNode : TDBUSNodeItem;AParent : TTreeNode); 345 | 346 | Var 347 | N : TTreeNode; 348 | I : integer; 349 | 350 | begin 351 | With TVDBUS do 352 | begin 353 | Items.BeginUpdate; 354 | try 355 | If AParent=Nil then 356 | Items.Clear; 357 | DisplayInterfaces(DBUSNode.Interfaces,AParent); 358 | For I:=0 to DBUSNode.Nodes.Count-1 do 359 | begin 360 | N:=TVDBUS.Items.AddChild(AParent,DBUSNode.Nodes[i].Name+'/'); 361 | N.ImageIndex:=II_Node; 362 | N.SelectedIndex:=II_Node; 363 | DisplayDBUSNode(DBUSNode.Nodes[i],N); 364 | end; 365 | finally 366 | Items.EndUpdate; 367 | end; 368 | end; 369 | end; 370 | 371 | procedure TMainForm.ShowError(E : Exception); 372 | 373 | begin 374 | MLog.Lines.Add('Error : '+E.Message); 375 | end; 376 | 377 | procedure TMainForm.ConnectToBus(AKind: TConnectionKind); 378 | 379 | Const 380 | Buses : Array [TConnectionKind] of string 381 | = ('Custom','System','Session','Starter'); 382 | 383 | begin 384 | try 385 | If Not Assigned(FConn) then 386 | FCOnn:=TDBUSConnection.Create(Self) 387 | else 388 | FConn.Disconnect; 389 | FConn.Kind:=AKind; 390 | FConn.Connect; 391 | Caption:=Format('DBUS Inspector : %s bus',[Buses[AKind]]); 392 | Mlog.Lines.Add(Format('Connected to %s bus',[Buses[AKind]])); 393 | DisplayNames; 394 | except 395 | On E : Exception do 396 | ShowError(E); 397 | end; 398 | end; 399 | 400 | procedure TMainForm.ASessionExecute(Sender: TObject); 401 | begin 402 | ConnectToBus(ckSession); 403 | end; 404 | 405 | procedure TMainForm.AQuitExecute(Sender: TObject); 406 | begin 407 | Close; 408 | end; 409 | 410 | Function TMainForm.ObjectpathFromNode(N : TTreeNode) : String; 411 | 412 | begin 413 | Result:=''; 414 | While (N<>Nil) do 415 | begin 416 | Result:=N.Text+Result; 417 | N:=N.Parent; 418 | end; 419 | Result:='/'+Copy(Result,1,Length(Result)-1); 420 | end; 421 | 422 | procedure TMainForm.GenerateCodeForIntrospection(AIntro : TDBUSIntroSpection; AInterfaceName,AUnitName : String); 423 | 424 | Var 425 | CG : TDBUSCodeGenerator; 426 | F : TCodeOptionsForm; 427 | I : Integer; 428 | IO : TDBUSInterfaceCodeOptionItem; 429 | Intf : TDBUSInterfaceDef; 430 | S : String; 431 | begin 432 | CG:=TDBUSCodeGenerator.Create(Self); 433 | try 434 | if (UnitName<>'') then 435 | CG.UnitName:=AUnitName 436 | else 437 | begin 438 | S:=ExtractFileExt(AInterfaceName); 439 | Delete(S,1,1); 440 | CG.UnitName:=S 441 | end; 442 | For I:=0 to AIntro.Interfaces.Count-1 do 443 | begin 444 | Intf:=AIntro.interfaces[i]; 445 | IO:=CG.InterfaceOptions.Addoption(Intf.Name); 446 | IO.Skip:=Not ((AInterfaceName='') or (AInterfaceName=Intf.Name)); 447 | end; 448 | With TCodeOptionsForm.Create(Self) do 449 | try 450 | CodeGen:=CG; 451 | Intro:=AIntro; 452 | ShowModal; 453 | finally 454 | Free; 455 | end; 456 | finally 457 | CG.Free; 458 | end; 459 | end; 460 | 461 | procedure TMainForm.AGenCodeExecute(Sender: TObject); 462 | 463 | Var 464 | N,Ni : TTreeNode; 465 | Op,UN : String; 466 | Intro : TDBUSIntroSpection; 467 | 468 | 469 | begin 470 | Ni:=Nil; 471 | N:=TVDBUS.Selected; 472 | While (N<>Nil) and (N.ImageIndex<>II_NODE) do 473 | begin 474 | If (N.ImageIndex=II_Interface) then 475 | NI:=N; 476 | N:=N.Parent; 477 | end; 478 | OP:=ObjectPathFromNode(N); 479 | Un:=ExtractFileName(OP); 480 | Intro:=GetIntrospection(FServiceName,OP); 481 | try 482 | If (Ni<>Nil) then 483 | OP:=Ni.Text 484 | else 485 | OP:=''; 486 | GenerateCodeForIntrospection(Intro,OP,Un); 487 | finally 488 | Intro.free; 489 | end; 490 | end; 491 | 492 | procedure TMainForm.AGetpropExecute(Sender: TObject); 493 | 494 | begin 495 | ShowPropertyValue(TVDBUS.Selected); 496 | end; 497 | 498 | procedure TMainForm.AGetpropUpdate(Sender: TObject); 499 | 500 | Var 501 | N : TTreeNode; 502 | 503 | begin 504 | 505 | N:=GetNodeNode(TVDBUS.Selected); 506 | (Sender as TAction).Enabled:=(FindPropertiesInterFace(N)<>Nil) and (TVDBUS.Selected.ImageIndex=II_Property); 507 | 508 | end; 509 | 510 | procedure TMainForm.DisplayInterfaces(Intf : TDBUSInterfaces; AParent : TTreeNode); 511 | 512 | Var 513 | N : TTreeNode; 514 | I : Integer; 515 | 516 | begin 517 | For I:=0 to Intf.Count-1 do 518 | begin 519 | N:=TVDBUS.Items.AddChild(AParent,Intf[i].Name); 520 | N.ImageIndex:=II_Interface; 521 | N.SelectedIndex:=II_Interface; 522 | DisplayInterface(N,Intf[i]); 523 | end; 524 | end; 525 | 526 | procedure TMainForm.DisplayInterface(ANode : TTreeNode;Intf : TDBUSInterfaceDef); 527 | 528 | Var 529 | I : Integer; 530 | N : TTreeNode; 531 | 532 | begin 533 | For I:=0 to Intf.Methods.Count-1 do 534 | begin 535 | N:=TVDBUS.Items.AddChild(ANode,'Method : '+Intf.Methods[i].Name); 536 | N.ImageIndex:=II_Method; 537 | N.SelectedIndex:=II_Method; 538 | DisplayMethod(N,Intf.Methods[i]); 539 | end; 540 | For I:=0 to Intf.Signals.Count-1 do 541 | begin 542 | N:=TVDBUS.Items.AddChild(ANode,'Signal : '+Intf.Signals[i].Name); 543 | N.ImageIndex:=II_Signal; 544 | N.SelectedIndex:=II_Signal; 545 | DisplaySignal(N,Intf.Signals[i]); 546 | end; 547 | For I:=0 to Intf.Properties.Count-1 do 548 | begin 549 | N:=TVDBUS.Items.AddChild(ANode,'Property : '+Intf.Properties[i].Name); 550 | N.ImageIndex:=II_Property; 551 | N.SelectedIndex:=II_Property; 552 | DisplayProperty(N,Intf.Properties[i]); 553 | end; 554 | DisplayAnnotation(ANode,Intf); 555 | end; 556 | 557 | procedure TMainForm.DisplayAnnotation(ANode : TTreeNode; AItem : TDBUSNamedItem); 558 | 559 | Var 560 | N : TTreeNode; 561 | I : Integer; 562 | AN,AV : String; 563 | 564 | begin 565 | If Not AItem.HasAnnotations then 566 | Exit; 567 | For i:=0 to AItem.Annotations.Count-1 do 568 | begin 569 | AItem.Annotations.GetNameValue(I,AN,AV); 570 | N:=TVDBUS.Items.AddChild(ANode,Format('Annotation "%s" : %s',[AN,AV])); 571 | N.ImageIndex:=II_Annotation; 572 | N.SelectedIndex:=II_Annotation; 573 | end; 574 | 575 | end; 576 | 577 | 578 | procedure TMainForm.DisplayMethod(ANode : TTreeNode; AMethod : TDBUSMethodDef); 579 | 580 | Var 581 | I : Integer; 582 | S,D : String; 583 | A : TDBUSArgumentDef; 584 | N : TTreeNode; 585 | 586 | begin 587 | For I:=0 to AMethod.Arguments.Count-1 do 588 | begin 589 | A:=AMethod.Arguments[i]; 590 | S:=A.ArgName; 591 | Case AMethod.Arguments[i].Direction of 592 | adnone : S:='? '+S; 593 | adOut : S:='out '+S; 594 | adIn : S:='in '+S; 595 | end; 596 | D:=DBUSPascalTypeNames[A.DataType]; 597 | If (D<>'') then 598 | S:=S+' : '+D; 599 | If (A.DataType=ddtArray) then 600 | S:=S+' of '+DBUSPascalTypeNames[A.ElementType]; 601 | N:=TVDBUS.Items.AddChild(ANode,S); 602 | N.Data:=A; 603 | Case AMethod.Arguments[i].Direction of 604 | adOut : N.ImageIndex:=II_ArgOut; 605 | adIn : N.ImageIndex:=II_ArgIn; 606 | end; 607 | N.SelectedIndex:=N.ImageIndex; 608 | end; 609 | DisplayAnnotation(ANode,AMethod); 610 | end; 611 | 612 | procedure TMainForm.DisplaySignal(ANode : TTreeNode; ASignal : TDBUSSignalDef); 613 | 614 | Var 615 | I : Integer; 616 | S,D : String; 617 | N : TTreeNode; 618 | V : TDBUSvarDef; 619 | begin 620 | For I:=0 to ASignal.Variables.Count-1 do 621 | begin 622 | S:=ASignal.Variables[i].Name; 623 | If (S='') then 624 | S:='var'+inttostr(i); 625 | V:=ASignal.Variables[I]; 626 | D:=DBUSPascalTypeNames[V.DataType]; 627 | If (D<>'') then 628 | S:=S+' : '+D; 629 | If (V.DataType=ddtArray) then 630 | S:=S+DBUSPascalTypeNames[V.ElementType]; 631 | N:=TVDBUS.Items.AddChild(ANode,S); 632 | N.Data:=V; 633 | end; 634 | DisplayAnnotation(ANode,ASignal); 635 | end; 636 | 637 | procedure TMainForm.DisplayProperty(ANode : TTreeNode; AProperty : TDBUSPropertyDef); 638 | 639 | Var 640 | I : Integer; 641 | S,D : String; 642 | N : TTreeNode; 643 | begin 644 | S:=DBUSPascalTypeNames[AProperty.DataType]; 645 | If (AProperty.DataType=ddtArray) then 646 | S:=S+' of '+DBUSPascalTypeNames[AProperty.ElementType]; 647 | Case AProperty.Access of 648 | dpaRead : S:=S+' (read-only)'; 649 | dpaWrite : S:=S+' (write-only)'; 650 | dpaReadWrite : S:=S+' (wead/write)'; 651 | end; 652 | ANode.Text:=ANode.Text+' : '+S; 653 | DisplayAnnotation(ANode,AProperty); 654 | end; 655 | 656 | end. 657 | 658 | -------------------------------------------------------------------------------- /gui/frmcode.lfm: -------------------------------------------------------------------------------- 1 | object CodeForm: TCodeForm 2 | Left = 250 3 | Height = 366 4 | Top = 250 5 | Width = 520 6 | ActiveControl = SynMemo1 7 | Caption = 'Preview generated code' 8 | ClientHeight = 366 9 | ClientWidth = 520 10 | LCLVersion = '0.9.29' 11 | inline SynMemo1: TSynMemo 12 | Cursor = crIBeam 13 | Left = 0 14 | Height = 320 15 | Top = 0 16 | Width = 520 17 | Align = alClient 18 | Font.Height = 9 19 | Font.Name = '-misc-dejavu sans mono-*-*-*-*-*-*-*-*-*-*-iso10646-1' 20 | Font.Pitch = fpFixed 21 | Font.Quality = fqNonAntialiased 22 | ParentColor = False 23 | ParentFont = False 24 | TabOrder = 0 25 | BorderStyle = bsSingle 26 | Gutter.Width = 53 27 | Gutter.MouseActions = < 28 | item 29 | Shift = [] 30 | ShiftMask = [] 31 | Button = mbLeft 32 | ClickCount = ccAny 33 | ClickDir = cdDown 34 | Command = 13 35 | MoveCaret = False 36 | Option = 0 37 | Priority = 0 38 | end 39 | item 40 | Shift = [] 41 | ShiftMask = [] 42 | Button = mbRight 43 | ClickCount = ccSingle 44 | ClickDir = cdUp 45 | Command = 12 46 | MoveCaret = False 47 | Option = 0 48 | Priority = 0 49 | end> 50 | Highlighter = SynFreePascalSyn1 51 | Keystrokes = < 52 | item 53 | Command = ecUp 54 | ShortCut = 38 55 | end 56 | item 57 | Command = ecSelUp 58 | ShortCut = 8230 59 | end 60 | item 61 | Command = ecScrollUp 62 | ShortCut = 16422 63 | end 64 | item 65 | Command = ecDown 66 | ShortCut = 40 67 | end 68 | item 69 | Command = ecSelDown 70 | ShortCut = 8232 71 | end 72 | item 73 | Command = ecScrollDown 74 | ShortCut = 16424 75 | end 76 | item 77 | Command = ecLeft 78 | ShortCut = 37 79 | end 80 | item 81 | Command = ecSelLeft 82 | ShortCut = 8229 83 | end 84 | item 85 | Command = ecWordLeft 86 | ShortCut = 16421 87 | end 88 | item 89 | Command = ecSelWordLeft 90 | ShortCut = 24613 91 | end 92 | item 93 | Command = ecRight 94 | ShortCut = 39 95 | end 96 | item 97 | Command = ecSelRight 98 | ShortCut = 8231 99 | end 100 | item 101 | Command = ecWordRight 102 | ShortCut = 16423 103 | end 104 | item 105 | Command = ecSelWordRight 106 | ShortCut = 24615 107 | end 108 | item 109 | Command = ecPageDown 110 | ShortCut = 34 111 | end 112 | item 113 | Command = ecSelPageDown 114 | ShortCut = 8226 115 | end 116 | item 117 | Command = ecPageBottom 118 | ShortCut = 16418 119 | end 120 | item 121 | Command = ecSelPageBottom 122 | ShortCut = 24610 123 | end 124 | item 125 | Command = ecPageUp 126 | ShortCut = 33 127 | end 128 | item 129 | Command = ecSelPageUp 130 | ShortCut = 8225 131 | end 132 | item 133 | Command = ecPageTop 134 | ShortCut = 16417 135 | end 136 | item 137 | Command = ecSelPageTop 138 | ShortCut = 24609 139 | end 140 | item 141 | Command = ecLineStart 142 | ShortCut = 36 143 | end 144 | item 145 | Command = ecSelLineStart 146 | ShortCut = 8228 147 | end 148 | item 149 | Command = ecEditorTop 150 | ShortCut = 16420 151 | end 152 | item 153 | Command = ecSelEditorTop 154 | ShortCut = 24612 155 | end 156 | item 157 | Command = ecLineEnd 158 | ShortCut = 35 159 | end 160 | item 161 | Command = ecSelLineEnd 162 | ShortCut = 8227 163 | end 164 | item 165 | Command = ecEditorBottom 166 | ShortCut = 16419 167 | end 168 | item 169 | Command = ecSelEditorBottom 170 | ShortCut = 24611 171 | end 172 | item 173 | Command = ecToggleMode 174 | ShortCut = 45 175 | end 176 | item 177 | Command = ecCopy 178 | ShortCut = 16429 179 | end 180 | item 181 | Command = ecPaste 182 | ShortCut = 8237 183 | end 184 | item 185 | Command = ecDeleteChar 186 | ShortCut = 46 187 | end 188 | item 189 | Command = ecCut 190 | ShortCut = 8238 191 | end 192 | item 193 | Command = ecDeleteLastChar 194 | ShortCut = 8 195 | end 196 | item 197 | Command = ecDeleteLastChar 198 | ShortCut = 8200 199 | end 200 | item 201 | Command = ecDeleteLastWord 202 | ShortCut = 16392 203 | end 204 | item 205 | Command = ecUndo 206 | ShortCut = 32776 207 | end 208 | item 209 | Command = ecRedo 210 | ShortCut = 40968 211 | end 212 | item 213 | Command = ecLineBreak 214 | ShortCut = 13 215 | end 216 | item 217 | Command = ecSelectAll 218 | ShortCut = 16449 219 | end 220 | item 221 | Command = ecCopy 222 | ShortCut = 16451 223 | end 224 | item 225 | Command = ecBlockIndent 226 | ShortCut = 24649 227 | end 228 | item 229 | Command = ecLineBreak 230 | ShortCut = 16461 231 | end 232 | item 233 | Command = ecInsertLine 234 | ShortCut = 16462 235 | end 236 | item 237 | Command = ecDeleteWord 238 | ShortCut = 16468 239 | end 240 | item 241 | Command = ecBlockUnindent 242 | ShortCut = 24661 243 | end 244 | item 245 | Command = ecPaste 246 | ShortCut = 16470 247 | end 248 | item 249 | Command = ecCut 250 | ShortCut = 16472 251 | end 252 | item 253 | Command = ecDeleteLine 254 | ShortCut = 16473 255 | end 256 | item 257 | Command = ecDeleteEOL 258 | ShortCut = 24665 259 | end 260 | item 261 | Command = ecUndo 262 | ShortCut = 16474 263 | end 264 | item 265 | Command = ecRedo 266 | ShortCut = 24666 267 | end 268 | item 269 | Command = ecGotoMarker0 270 | ShortCut = 16432 271 | end 272 | item 273 | Command = ecGotoMarker1 274 | ShortCut = 16433 275 | end 276 | item 277 | Command = ecGotoMarker2 278 | ShortCut = 16434 279 | end 280 | item 281 | Command = ecGotoMarker3 282 | ShortCut = 16435 283 | end 284 | item 285 | Command = ecGotoMarker4 286 | ShortCut = 16436 287 | end 288 | item 289 | Command = ecGotoMarker5 290 | ShortCut = 16437 291 | end 292 | item 293 | Command = ecGotoMarker6 294 | ShortCut = 16438 295 | end 296 | item 297 | Command = ecGotoMarker7 298 | ShortCut = 16439 299 | end 300 | item 301 | Command = ecGotoMarker8 302 | ShortCut = 16440 303 | end 304 | item 305 | Command = ecGotoMarker9 306 | ShortCut = 16441 307 | end 308 | item 309 | Command = ecSetMarker0 310 | ShortCut = 24624 311 | end 312 | item 313 | Command = ecSetMarker1 314 | ShortCut = 24625 315 | end 316 | item 317 | Command = ecSetMarker2 318 | ShortCut = 24626 319 | end 320 | item 321 | Command = ecSetMarker3 322 | ShortCut = 24627 323 | end 324 | item 325 | Command = ecSetMarker4 326 | ShortCut = 24628 327 | end 328 | item 329 | Command = ecSetMarker5 330 | ShortCut = 24629 331 | end 332 | item 333 | Command = ecSetMarker6 334 | ShortCut = 24630 335 | end 336 | item 337 | Command = ecSetMarker7 338 | ShortCut = 24631 339 | end 340 | item 341 | Command = ecSetMarker8 342 | ShortCut = 24632 343 | end 344 | item 345 | Command = ecSetMarker9 346 | ShortCut = 24633 347 | end 348 | item 349 | Command = EcFoldLevel1 350 | ShortCut = 41009 351 | end 352 | item 353 | Command = EcFoldLevel2 354 | ShortCut = 41010 355 | end 356 | item 357 | Command = EcFoldLevel1 358 | ShortCut = 41011 359 | end 360 | item 361 | Command = EcFoldLevel1 362 | ShortCut = 41012 363 | end 364 | item 365 | Command = EcFoldLevel1 366 | ShortCut = 41013 367 | end 368 | item 369 | Command = EcFoldLevel6 370 | ShortCut = 41014 371 | end 372 | item 373 | Command = EcFoldLevel7 374 | ShortCut = 41015 375 | end 376 | item 377 | Command = EcFoldLevel8 378 | ShortCut = 41016 379 | end 380 | item 381 | Command = EcFoldLevel9 382 | ShortCut = 41017 383 | end 384 | item 385 | Command = EcFoldLevel0 386 | ShortCut = 41008 387 | end 388 | item 389 | Command = EcFoldCurrent 390 | ShortCut = 41005 391 | end 392 | item 393 | Command = EcUnFoldCurrent 394 | ShortCut = 41003 395 | end 396 | item 397 | Command = EcToggleMarkupWord 398 | ShortCut = 32845 399 | end 400 | item 401 | Command = ecNormalSelect 402 | ShortCut = 24654 403 | end 404 | item 405 | Command = ecColumnSelect 406 | ShortCut = 24643 407 | end 408 | item 409 | Command = ecLineSelect 410 | ShortCut = 24652 411 | end 412 | item 413 | Command = ecTab 414 | ShortCut = 9 415 | end 416 | item 417 | Command = ecShiftTab 418 | ShortCut = 8201 419 | end 420 | item 421 | Command = ecMatchBracket 422 | ShortCut = 24642 423 | end 424 | item 425 | Command = ecColSelUp 426 | ShortCut = 40998 427 | end 428 | item 429 | Command = ecColSelDown 430 | ShortCut = 41000 431 | end 432 | item 433 | Command = ecColSelLeft 434 | ShortCut = 40997 435 | end 436 | item 437 | Command = ecColSelRight 438 | ShortCut = 40999 439 | end 440 | item 441 | Command = ecColSelPageDown 442 | ShortCut = 40994 443 | end 444 | item 445 | Command = ecColSelPageBottom 446 | ShortCut = 57378 447 | end 448 | item 449 | Command = ecColSelPageUp 450 | ShortCut = 40993 451 | end 452 | item 453 | Command = ecColSelPageTop 454 | ShortCut = 57377 455 | end 456 | item 457 | Command = ecColSelLineStart 458 | ShortCut = 40996 459 | end 460 | item 461 | Command = ecColSelLineEnd 462 | ShortCut = 40995 463 | end 464 | item 465 | Command = ecColSelEditorTop 466 | ShortCut = 57380 467 | end 468 | item 469 | Command = ecColSelEditorBottom 470 | ShortCut = 57379 471 | end> 472 | MouseActions = < 473 | item 474 | Shift = [] 475 | ShiftMask = [ssShift, ssAlt] 476 | Button = mbLeft 477 | ClickCount = ccSingle 478 | ClickDir = cdDown 479 | Command = 1 480 | MoveCaret = True 481 | Option = 0 482 | Priority = 0 483 | end 484 | item 485 | Shift = [ssShift] 486 | ShiftMask = [ssShift, ssAlt] 487 | Button = mbLeft 488 | ClickCount = ccSingle 489 | ClickDir = cdDown 490 | Command = 1 491 | MoveCaret = True 492 | Option = 1 493 | Priority = 0 494 | end 495 | item 496 | Shift = [ssAlt] 497 | ShiftMask = [ssShift, ssAlt] 498 | Button = mbLeft 499 | ClickCount = ccSingle 500 | ClickDir = cdDown 501 | Command = 3 502 | MoveCaret = True 503 | Option = 0 504 | Priority = 0 505 | end 506 | item 507 | Shift = [ssShift, ssAlt] 508 | ShiftMask = [ssShift, ssAlt] 509 | Button = mbLeft 510 | ClickCount = ccSingle 511 | ClickDir = cdDown 512 | Command = 3 513 | MoveCaret = True 514 | Option = 1 515 | Priority = 0 516 | end 517 | item 518 | Shift = [] 519 | ShiftMask = [] 520 | Button = mbRight 521 | ClickCount = ccSingle 522 | ClickDir = cdUp 523 | Command = 12 524 | MoveCaret = False 525 | Option = 0 526 | Priority = 0 527 | end 528 | item 529 | Shift = [] 530 | ShiftMask = [] 531 | Button = mbLeft 532 | ClickCount = ccDouble 533 | ClickDir = cdDown 534 | Command = 6 535 | MoveCaret = True 536 | Option = 0 537 | Priority = 0 538 | end 539 | item 540 | Shift = [] 541 | ShiftMask = [] 542 | Button = mbLeft 543 | ClickCount = ccTriple 544 | ClickDir = cdDown 545 | Command = 7 546 | MoveCaret = True 547 | Option = 0 548 | Priority = 0 549 | end 550 | item 551 | Shift = [] 552 | ShiftMask = [] 553 | Button = mbLeft 554 | ClickCount = ccQuad 555 | ClickDir = cdDown 556 | Command = 8 557 | MoveCaret = True 558 | Option = 0 559 | Priority = 0 560 | end 561 | item 562 | Shift = [] 563 | ShiftMask = [] 564 | Button = mbMiddle 565 | ClickCount = ccSingle 566 | ClickDir = cdDown 567 | Command = 10 568 | MoveCaret = True 569 | Option = 0 570 | Priority = 0 571 | end 572 | item 573 | Shift = [ssCtrl] 574 | ShiftMask = [ssShift, ssAlt, ssCtrl] 575 | Button = mbLeft 576 | ClickCount = ccSingle 577 | ClickDir = cdUp 578 | Command = 11 579 | MoveCaret = False 580 | Option = 0 581 | Priority = 0 582 | end> 583 | MouseSelActions = < 584 | item 585 | Shift = [] 586 | ShiftMask = [] 587 | Button = mbLeft 588 | ClickCount = ccSingle 589 | ClickDir = cdDown 590 | Command = 9 591 | MoveCaret = False 592 | Option = 0 593 | Priority = 0 594 | end> 595 | inline SynGutterPartList1: TSynGutterPartList 596 | object SynGutterMarks1: TSynGutterMarks 597 | Width = 23 598 | end 599 | object SynGutterLineNumber1: TSynGutterLineNumber 600 | Width = 13 601 | MouseActions = <> 602 | MarkupInfo.Background = clBtnFace 603 | MarkupInfo.Foreground = clNone 604 | DigitCount = 2 605 | ShowOnlyLineNumbersMultiplesOf = 1 606 | ZeroStart = False 607 | LeadingZeros = False 608 | end 609 | object SynGutterChanges1: TSynGutterChanges 610 | Width = 4 611 | ModifiedColor = 59900 612 | SavedColor = clGreen 613 | end 614 | object SynGutterSeparator1: TSynGutterSeparator 615 | Width = 2 616 | end 617 | object SynGutterCodeFolding1: TSynGutterCodeFolding 618 | MouseActions = < 619 | item 620 | Shift = [] 621 | ShiftMask = [] 622 | Button = mbRight 623 | ClickCount = ccSingle 624 | ClickDir = cdUp 625 | Command = 16 626 | MoveCaret = False 627 | Option = 0 628 | Priority = 0 629 | end 630 | item 631 | Shift = [] 632 | ShiftMask = [ssShift] 633 | Button = mbMiddle 634 | ClickCount = ccAny 635 | ClickDir = cdDown 636 | Command = 14 637 | MoveCaret = False 638 | Option = 0 639 | Priority = 0 640 | end 641 | item 642 | Shift = [ssShift] 643 | ShiftMask = [ssShift] 644 | Button = mbMiddle 645 | ClickCount = ccAny 646 | ClickDir = cdDown 647 | Command = 14 648 | MoveCaret = False 649 | Option = 1 650 | Priority = 0 651 | end 652 | item 653 | Shift = [] 654 | ShiftMask = [] 655 | Button = mbLeft 656 | ClickCount = ccAny 657 | ClickDir = cdDown 658 | Command = 0 659 | MoveCaret = False 660 | Option = 0 661 | Priority = 0 662 | end> 663 | MarkupInfo.Background = clNone 664 | MarkupInfo.Foreground = clGray 665 | MouseActionsExpanded = < 666 | item 667 | Shift = [] 668 | ShiftMask = [] 669 | Button = mbLeft 670 | ClickCount = ccAny 671 | ClickDir = cdDown 672 | Command = 14 673 | MoveCaret = False 674 | Option = 0 675 | Priority = 0 676 | end> 677 | MouseActionsCollapsed = < 678 | item 679 | Shift = [ssCtrl] 680 | ShiftMask = [ssCtrl] 681 | Button = mbLeft 682 | ClickCount = ccAny 683 | ClickDir = cdDown 684 | Command = 15 685 | MoveCaret = False 686 | Option = 0 687 | Priority = 0 688 | end 689 | item 690 | Shift = [] 691 | ShiftMask = [ssCtrl] 692 | Button = mbLeft 693 | ClickCount = ccAny 694 | ClickDir = cdDown 695 | Command = 15 696 | MoveCaret = False 697 | Option = 1 698 | Priority = 0 699 | end> 700 | end 701 | end 702 | end 703 | object ButtonPanel1: TButtonPanel 704 | Left = 6 705 | Height = 34 706 | Top = 326 707 | Width = 508 708 | OKButton.Name = 'OKButton' 709 | OKButton.Caption = '&OK' 710 | OKButton.Enabled = False 711 | HelpButton.Name = 'HelpButton' 712 | HelpButton.Caption = '&Help' 713 | HelpButton.Enabled = False 714 | CloseButton.Name = 'CloseButton' 715 | CloseButton.Caption = '&Close' 716 | CancelButton.Name = 'CancelButton' 717 | CancelButton.Caption = 'Cancel' 718 | CancelButton.Enabled = False 719 | TabOrder = 1 720 | ShowButtons = [pbClose] 721 | end 722 | object SynFreePascalSyn1: TSynFreePascalSyn 723 | Enabled = False 724 | CompilerMode = pcmObjFPC 725 | NestedComments = True 726 | left = 273 727 | top = 69 728 | end 729 | end 730 | -------------------------------------------------------------------------------- /gui/frmmain.lfm: -------------------------------------------------------------------------------- 1 | object MainForm: TMainForm 2 | Left = 552 3 | Height = 455 4 | Top = 304 5 | Width = 561 6 | ActiveControl = PNames 7 | Caption = 'DBUS inspector' 8 | ClientHeight = 455 9 | ClientWidth = 561 10 | Menu = MainMenu1 11 | OnShow = FormShow 12 | Visible = False 13 | object PNames: TPanel 14 | Left = 0 15 | Height = 267 16 | Top = 0 17 | Width = 170 18 | Align = alLeft 19 | Caption = 'PNames' 20 | ClientHeight = 267 21 | ClientWidth = 170 22 | TabOrder = 0 23 | object LBServices: TListBox 24 | Left = 1 25 | Height = 234 26 | Top = 32 27 | Width = 168 28 | Align = alClient 29 | ItemHeight = 0 30 | OnClick = LBServicesClick 31 | ScrollWidth = 166 32 | TabOrder = 0 33 | TopIndex = -1 34 | end 35 | object Label1: TLabel 36 | Left = 1 37 | Height = 31 38 | Top = 1 39 | Width = 168 40 | Align = alTop 41 | Alignment = taCenter 42 | AutoSize = False 43 | Caption = '&Services' 44 | Layout = tlCenter 45 | ParentColor = False 46 | end 47 | end 48 | object Panel2: TPanel 49 | Left = 0 50 | Height = 183 51 | Top = 272 52 | Width = 561 53 | Align = alBottom 54 | Caption = 'Panel2' 55 | ClientHeight = 183 56 | ClientWidth = 561 57 | TabOrder = 1 58 | object MLog: TMemo 59 | Left = 1 60 | Height = 181 61 | Top = 1 62 | Width = 559 63 | Align = alClient 64 | Lines.Strings = ( 65 | '' 66 | ) 67 | TabOrder = 0 68 | end 69 | end 70 | object Splitter1: TSplitter 71 | Left = 170 72 | Height = 267 73 | Top = 0 74 | Width = 5 75 | Beveled = True 76 | end 77 | object Splitter2: TSplitter 78 | Cursor = crVSplit 79 | Left = 0 80 | Height = 5 81 | Top = 267 82 | Width = 561 83 | Align = alBottom 84 | Beveled = True 85 | ResizeAnchor = akBottom 86 | end 87 | object Panel1: TPanel 88 | Left = 175 89 | Height = 267 90 | Top = 0 91 | Width = 386 92 | Align = alClient 93 | Caption = 'Panel1' 94 | ClientHeight = 267 95 | ClientWidth = 386 96 | TabOrder = 4 97 | object LServiceInterfaces: TLabel 98 | Left = 1 99 | Height = 31 100 | Top = 1 101 | Width = 384 102 | Align = alTop 103 | Alignment = taCenter 104 | AutoSize = False 105 | Caption = 'Interfaces for service' 106 | Layout = tlCenter 107 | ParentColor = False 108 | end 109 | object TVDBUS: TTreeView 110 | Left = 1 111 | Height = 234 112 | Top = 32 113 | Width = 384 114 | Align = alClient 115 | Images = ILDBUS 116 | PopupMenu = PMTree 117 | ReadOnly = True 118 | TabOrder = 0 119 | OnDblClick = TVDBUSDblClick 120 | Options = [tvoAutoItemHeight, tvoHideSelection, tvoKeepCollapsedNodes, tvoReadOnly, tvoShowButtons, tvoShowLines, tvoShowRoot, tvoToolTips, tvoThemedDraw] 121 | end 122 | end 123 | object MainMenu1: TMainMenu 124 | left = 62 125 | top = 19 126 | object MDBUS: TMenuItem 127 | Caption = 'DBUS' 128 | object MISystem: TMenuItem 129 | Action = ASystem 130 | end 131 | object MISession: TMenuItem 132 | Action = ASession 133 | end 134 | object MenuItem1: TMenuItem 135 | Caption = '-' 136 | end 137 | object MIQuit: TMenuItem 138 | Action = AQuit 139 | end 140 | end 141 | object MICode: TMenuItem 142 | Caption = 'Code generator' 143 | object MenuItem2: TMenuItem 144 | Action = AGenCode 145 | Caption = 'Generate code for interfaces' 146 | end 147 | end 148 | end 149 | object ActionList1: TActionList 150 | left = 120 151 | top = 83 152 | object ASystem: TAction 153 | Caption = 'S&ystem Bus' 154 | OnExecute = ASystemExecute 155 | ShortCut = 16473 156 | end 157 | object ASession: TAction 158 | Caption = 'S&ession bus' 159 | OnExecute = ASessionExecute 160 | ShortCut = 16453 161 | end 162 | object AQuit: TAction 163 | Caption = '&Quit' 164 | OnExecute = AQuitExecute 165 | ShortCut = 16465 166 | end 167 | object AGenCode: TAction 168 | Caption = 'Generate code for interface' 169 | OnExecute = AGenCodeExecute 170 | end 171 | object AGetprop: TAction 172 | Caption = 'Get property value' 173 | OnExecute = AGetpropExecute 174 | OnUpdate = AGetpropUpdate 175 | end 176 | end 177 | object ILDBUS: TImageList 178 | left = 240 179 | top = 159 180 | Bitmap = { 181 | 4C69090000001000000010000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 182 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 183 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF008088 184 | CA0A747CC13B6D74BD5B6163E3FF5157E2FF5157E2FF5F62E3FF6C74BC5E747B 185 | C13B8088CA0AFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF007378 186 | CEC86E6FECFF6668EBFF5F62E9FF7878F0FF7474F0FF5F62E9FF696BEBFF6F71 187 | ECFF7277CCC8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00545A 188 | DBFE7C7CF2FF9793F7FF6468E9FF5258E3FF5258E3FF6468E9FF9793F7FF7C7C 189 | F2FF4D56D9FE6D75BB26FFFFFF007E9F800A7395753B6C8F6F5B6EA877FF4C52 190 | E0FFA2A2F4FF6A6CECFF6163EAFF9793F7FF9793F7FF6468E9FF6566EAFF5C61 191 | E7FF4F57E2FF6D75BB30FFFFFF00759E7AC87CB485FF76AF7EFF6FAB78FF4E54 192 | E1FFB4B1F9FF9596F5FF666AEBFF6F71ECFF6E72ECFF5A5CE5FF5C61E7FF5F62 193 | E9FF5158E2FF6D75BB30FFFFFF0064A06BFE86BA8FFF99C6A2FF74AD7CFF4F57 194 | E2FFB4B1F9FF9796F4FF9393F4FF8C8DF0FF5C60E8FF5C61E7FF5D61E8FF5F62 195 | E9FF4F57E2FF6D75BB30FFFFFF005D9F65FFB9D6BEFF87BA8FFF71AC78FF5359 196 | DCFF666AEBFF9896F4FF9191F3FF898AF0FF5B5FE7FF5F62E9FF5D61E8FF5158 197 | E4FF4954D8FE967E7643A68C770A60A068FFC5DEC9FFB4D4B9FFA4C9AAFF81AB 198 | 9AFF616DC3FF5058E0FF6668EBFF9393F4FF6163EAFF585BE4FF4952DCFF6063 199 | BEFFA6897FFFC19A71FFA5856BC862A169FFC0DAC5FFADD0B3FFABCEB1FF9EC8 200 | A6FF6DAA76FF957B7EFF5A61C8FF5058E3FF4F56E0FF585FC8FF907884FFBB90 201 | 66FFD1B38FFFC6A27BFFA9784FFE639F6BFEA9CDAFFFA6CCACFFA2C9A9FF99C5 202 | 9FFF6BA974FFAE7C4FFFDCC8B0FFBF9F81FFB88D65FFD1B38FFFD1B38FFFBB90 203 | 66FFBC9168FFB78A60FFB17E52FF6E8F723D68966CE766A36CFF93C099FF9EC7 204 | A4FF71AC78FFAF7E51FFE3D0BCFFDAC3ABFFD3B89EFFC7A37DFFC1986FFFB689 205 | 5CFFB78A60FFBA8E62FFB18054FFFFFFFF00F7F7F7016D906F63619565F463A2 206 | 6AFF61A169FFB17E52FFE1CDB8FFD8C0A5FFD8C0A7FFD4BA9DFFB88C60FFB78A 207 | 60FFB88D61FFBA8E62FFB17E52FFFFFFFF00FFFFFF00FFFFFF00FFFFFF006C8E 208 | 6E146C8F6E08AD7F56FED5BB9FFFD6BB9EFFD3B89CFFD1B394FFB7895DFFBA8E 209 | 62FFB88D61FFB28156FFA8754DFEFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 210 | FF00FFFFFF00977C663DA07B5BE7B28158FFCBAB89FFD1B495FFBB8E63FFB587 211 | 5AFFAB774DFF9B7556EB93766146FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 212 | FF00FFFFFF00FFFFFF00F7F7F7019A7D6864A17857F4B28056FFAF7E52FFA175 213 | 53F695776073FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 214 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 215 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00C99B6433C99B6433C99B6433C698 216 | 6233C3955F33C0925C33FFFFFF00FFFFFF00B3855033AE804C33A97B4733A376 217 | 42339E703D33986B3833FFFFFF00C99B6433C99B64FFD3AE82FFD0AC80FFCEA9 218 | 7DFFCBA67BFFC6A074FFB789532DB2844F2DBB956AFFB8946AFFB49066FFAF8B 219 | 62FFAB875EFF926432FF996C3933C69963FFC89A63FFFAFAFAFFFAFAFAFFFAFA 220 | FAFFF8F8F8FFD9C6B1FFB1834EE6AC7E4AE6D7C4AFFFF9F9F9FFF9F9F9FFF9F9 221 | F9FFF9F9F9FF8B5D2CFF976938FFC69963FFC59760FFFAFAFAFFCDCDCDFFCACA 222 | CAFFC6C6C6FFF2F2F2FFDDD8D2FFEBE5DFFFFCFCFCFFCCCCCCFFC9C9C9FFBDBD 223 | BDFFF9F9F9FF845726FF916333FFC69963FFC1935CFFFAFAFAFFF2F2F2FFEFEF 224 | EFFFEAEAEAFFD5D5D5FFB5B5B5FFDFDFDFFFF5F5F5FFF1F1F1FFECECECFFDEDE 225 | DEFFF9F9F9FF7D5020FF8A5E2DFFC69862FFBC8E58FFFAFAFAFFCCCCCCFFCACA 226 | CAFFC5C5C5FFD4D4D4FFA7A7A7FFD8D8D8FFF5F5F5FFCBCBCBFFC7C7C7FFBBBB 227 | BBFFF8F8F8FF774A1AFF845828FFC29560FFB78953FFFAFAFAFFF1F1F1FFEDED 228 | EDFFE9E9E9FFD4D4D4FFA6A6A6FFD8D8D8FFF5F5F5FFEFEFEFFFEBEBEBFFDCDC 229 | DCFFF8F8F8FF714415FF7F5323FFBE915CFFB1834EFFF9F9F9FFCCCCCCFFC9C9 230 | C9FFC5C5C5FFD3D3D3FFA6A6A6FFD8D8D8FFF4F4F4FFCACACAFFC6C6C6FFBABA 231 | BAFFF8F8F8FF6B3E10FF7A4D1EFFBA8D58FFAB7D49FFF9F9F9FFF1F1F1FFEDED 232 | EDFFE7E7E7FFD3D3D3FFA5A5A5FFD7D7D7FFF4F4F4FFEEEEEEFFEAEAEAFFDCDC 233 | DCFFF8F8F8FF66390BFF74481AFFB68854FFA57743FFF9F9F9FFF9F9F9FFF9F9 234 | F9FFF8F8F8FFF1F1F1FFE3E3E3FFF3F3F3FFF8F8F8FFF9F9F9FFF8F8F8FFE9E9 235 | E9FFF8F8F8FF623507FF704416FFB0834FFF9E703DFF986B38FF936533FF8D60 236 | 2EFF875A29FF825424FFAB9074FFAA8F73FF724516FF6D4011FF693C0DFF6538 237 | 0AFF613406FF5E3103FF6C3F12FFAB7E4AFFB38B5DFFB38B5DFFB38B5DFFB38B 238 | 5DFFB38B5DFFB38B5DFF7D5121FF794C1DFFB38B5DFFB38B5DFFB38B5DFFB38B 239 | 5DFFB38B5DFFB38B5DFF683C0EFFA37642FF9E703DFF986B38FF936533FF8D60 240 | 2EFF875A29FF825424FF936839FF906536FF724516FF6D4011FF693C0DFF6538 241 | 0AFF613406FF5E3103FF5B2E01FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 242 | FF00FFFFFF008254249F764919E1714415E1825424BAFFFFFF00FFFFFF00FFFF 243 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 244 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 245 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 246 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 247 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 248 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 249 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 250 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 251 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0034B4D9D05EC2E1FA60C3E2FA60C3 252 | E2FA60C3E2FA5FC3E2FA3CB6DBDD2CB2D8162CB2D80F2CB2D80F2CB2D80F2CB2 253 | D80F2CB3D80F2CB3D804FFFFFF00FFFFFF0036B3DAF8FDFEFEFFFEFFFFFFFEFE 254 | FFFFFDFEFFFFFEFFFFFFEAF7FBFF6BC7E4F96BC7E3F86BC7E3F86BC7E3F879CD 255 | E6F774CAE5E132B1D956FFFFFF00FFFFFF0035AFDAF0F7FCFEFF8EE4F8FF91DE 256 | F5FF9FE0F5FFACE1F6FFEFFBFEFFF4FDFEFFF3FCFEFFF1FCFEFFEFFBFEFFEEFB 257 | FEFFFAFDFFF936AFDAD4FFFFFF00FFFFFF0036AADAF2F1FAFDFF94DEF5FF93DC 258 | F4FF81D5F2FF6ACAEDFF6CCBEAFF85D3EFFF80D2EFFF7AD0EFFF76CFEEFF72CF 259 | EEFFE9F7FBFF34AEDAF3FFFFFF00FFFFFF0035ABDAFAE8F6FBFF94D4EFFF88CE 260 | EEFF73C1E9FFC9E9F6FFF2FCFEFFF3FCFEFFF2FCFEFFF0FCFEFFEFFBFEFFEEFB 261 | FEFFFEFFFFFF36ABDAF7FFFFFF00FFFFFF0037A6DAFAFEFFFFFFF8FDFFFFF6FD 262 | FFFFF5FCFFFFF3FCFEFFD8F6FCFF94E6F8FF85E3F7FF76DFF6FF68DBF5FF5CD8 263 | F4FFD7F4FCFF35A4DAF7FFFFFF00FFFFFF0036A1DAF9F6FCFEFFC8F2FCFFB9EF 264 | FBFFACECFAFF9CE8F9FF8BE3F7FF7CE0F6FF6CDCF6FF5DD9F5FF4FD6F4FF44D3 265 | F3FFD0F3FCFF359FDAF7FFFFFF00FFFFFF00369ADAF8F2FAFDFFB3EDFAFFA4E9 266 | F9FF95E6F8FF85E2F7FF76DEF6FF65DBF5FF57D7F4FF49D4F3FF3BD1F2FF30CE 267 | F1FFCCF2FBFF3598DAF7FFFFFF00FFFFFF003594DAF7EFFAFEFFA1E9F9FF91E5 268 | F8FF81E1F7FF72DEF6FF63DAF5FF54D7F4FF47D3F3FF39D0F2FF2ECDF1FF26CB 269 | F0FFCAF2FBFF3594DAF7FFFFFF00FFFFFF00338ED9E6DCF0FAF0A7DDF4FD9EDB 270 | F4FF96DAF3FF8ED8F3FF86D7F3FF7FD4F2FF79D3F2FF72D2F1FF6CD0F1FF69CF 271 | F1FFC2EAF8FE338ED9F0FFFFFF00FFFFFF002C86D8702D88D8A62D87D8EA2D88 272 | D8F72D88D8F72D88D8F72D88D8F72D88D8F72D88D8F72D88D8F72D88D8F72D87 273 | D8F72D88D8F12C86D893FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 274 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 275 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 276 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 277 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 278 | FF00FFFFFF00C0C0C0FFB7B7B7FFB6B6B6FFBCBCBCFFFFFFFF00FFFFFF00FFFF 279 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00DEDEDEFFDEDEDEFFF2F2 280 | F200FFFFFF00C1C1C1FFE5E5E5FFE4E4E4FFA9A9A9FFFEFEFE00F1F1F100D9D9 281 | D9FFD9D9D9FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00BABABAFFCDCDCDFFC2C2 282 | C2FFE7E7E7FFC8C8C8FFDEDEDEFFDDDDDDFFBABABAFFE5E5E5FFA9A9A9FFA7A7 283 | A7FFA5A5A5FFFFFFFF00FFFFFF00FFFFFF00BCBCBCFFDCDCDCFFEDEDEDFFDBDB 284 | DBFFC4C4C4FFBDBDBDFFD6D6D6FFD4D4D4FFAFAFAFFFB0B0B0FFCBCBCBFFE7E7 285 | E7FFB7B7B7FFA3A3A3FFFFFFFF00FFFFFF00BABABAFFC3C3C3FFDCDCDCFFD4D4 286 | D4FFD9D9D9FFDBDBDBFFD6D6D6FFD4D4D4FFD9D9D9FFD2D2D2FFCBCBCBFFC8C8 287 | C8FF797979FF999999FFFFFFFF00FFFFFF00FFFFFF00B7B7B7FFD4D4D4FFCCCC 288 | CCFFC9C9C9FFBABABAFF9C9C9CFFA1A1A1FFC2C2C2FFC6C6C6FFC1C1C1FFB7B7 289 | B7FF9F9F9FFFFFFFFF00FFFFFF00BBBBBBFFBBBBBBFFC4C4C4FFD8D8D8FFCDCD 290 | CDFFBCBCBCFF8C8C8CFFDBDBDBCDDDDDDDCD959595FFC3C3C3FFC2C2C2FFCDCD 291 | CDFF979797FF8B8B8BFF8B8B8BFFC2C2C2FFE9E9E9FFD6D6D6FFC9C9C9FFCECE 292 | CEFFA5A5A5FFDEDEDECDFFFFFF00FFFFFF00E4E4E4CDACACACFFC4C4C4FFBABA 293 | BAFFC6C6C6FFDDDDDDFF6B6B6BFFBEBEBEFFE2E2E2FFD2D2D2FFC6C6C6FFCDCD 294 | CDFFB1B1B1FFE2E2E2CDFFFFFF00FFFFFF00E3E3E3CDA8A8A8FFC2C2C2FFB7B7 295 | B7FFC0C0C0FFD2D2D2FF616161FFA1A1A1FF919191FFA8A8A8FFCFCFCFFFC6C6 296 | C6FFCCCCCCFF9E9E9EFFE4E4E4CDE2E2E2CD959595FFC1C1C1FFBCBCBCFFB9B9 297 | B9FF737373FF656565FF6B6B6BFFFFFFFF00FFFFFF00ADADADFFC5C5C5FFC1C1 298 | C1FFC5C5C5FFC7C7C7FFAAAAAAFFA7A7A7FFC1C1C1FFBEBEBEFFB5B5B5FFAAAA 299 | AAFF939393FFFFFFFF00FFFFFF00FFFFFF00AEAEAEFFA5A5A5FFD5D5D5FFC5C5 300 | C5FFCBCBCBFFD1D1D1FFC9C9C9FFC7C7C7FFCCCCCCFFC5C5C5FFBDBDBDFFCBCB 301 | CBFF6E6E6EFF959595FFFFFFFF00FFFFFF00ACACACFFBCBCBCFFDEDEDEFFA6A6 302 | A6FF898989FF858585FFC4C4C4FFC2C2C2FF6E6E6EFF767676FFA6A6A6FFD2D2 303 | D2FF808080FF8F8F8FFFFFFFFF00FFFFFF00FFFFFF00959595FF707070FF6E6E 304 | 6EFFE1E1E1FF949494FFCBCBCBFFC7C7C7FF787878FFDEDEDEFF646464FF4F4F 305 | 4FFF7B7B7BFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00D0D0D0FFD0D0D0FFEDED 306 | ED66FEFEFE00848484FFBDBDBDFFB2B2B2FF656565FFFEFEFE00ECECEC88CCCC 307 | CCFFCCCCCCFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 308 | FF00FFFFFF00A4A4A4FF747474FF707070FF9C9C9CFFFFFFFF00FFFFFF00FFFF 309 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 310 | FF00D7D7D8FF005CCEFF005CCEFF005CCEFFBDC0C5FFFFFFFF00FFFFFF00FFFF 311 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D7D7 312 | D8FF005CCEFFC1DEF4FFB4D9F3FFB4D9F3FF005CCEFFD2D3D4FFFFFFFF00FFFF 313 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D7D7D8FF005C 314 | CEFFB7DAF4FF65B3E8FF1E90DEFF1E90DEFF96CBEFFF005CCEFFD2D3D4FFFFFF 315 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D7D7D8FF005CCEFF9CCC 316 | EFFF44A4E5FF66B5EAFF178EDFFF178EDFFF148DDFFF97CCF1FF005CCEFFD2D3 317 | D4FFFFFFFF00FFFFFF00FFFFFF00FFFFFF00D7D7D8FF005CCEFF9BCCEFFF168F 318 | E1FF4FAAE9FF7EC1EFFF2898E5FF2898E5FF1991E3FF1890E2FF97CDF1FF005C 319 | CEFFD2D3D4FFFFFFFF00FFFFFF00C1C4C8FF005CCEFF9ACCF0FF1991E2FF1B93 320 | E4FF6FBBEEFF47A8EBFF2197E6FF2197E6FF4CABEBFF6DBAEEFF65B6EDFFAED8 321 | F4FF005CCEFFBDC0C5FFFFFFFF00005CCEFF9DCDEFFF1991E3FF1D94E5FF38A2 322 | EAFF89C8F3FF5CB3EFFF69BAF1FF69BAF1FF8FCBF4FF91CCF4FF90CBF3FF8ECA 323 | F2FFD5EAF9FF005CCEFFBDC0C500005CCEFFB5D4EBFF2598E6FF3AA3EAFF8DCA 324 | F4FF4DAEEFFF5CB5F1FF94CEF6FF94CEF6FF94CEF6FF93CEF5FF92CDF4FF91CC 325 | F3FFBBD8EFFF005CCEFF005CCE00005CCEFFB5D4EBFF2598E6FF3AA3EAFF8DCA 326 | F4FF4DAEEFFF5CB5F1FF94CEF6FF94CEF6FF94CEF6FF93CEF5FF92CDF4FF91CC 327 | F3FFBBD8EFFF005CCEFF005CCE00D7D7D8FF005CCEFFA9CCE8FF8FCCF4FF45AA 328 | EFFF4FAFF2FF7BC4F6FF97D1F8FF97D1F8FF96D0F7FF95D0F7FF95CEF6FFBBD8 329 | EFFF005CCEFFC1C4C8FF005CCE00FFFFFF00D7D7D8FF005CCEFFB2D1EBFF31A2 330 | EFFF32A3F1FF8BCCF8FF99D3F9FF99D3F9FF99D2F9FF98D1F8FFBCDAF1FF005C 331 | CEFFD7D7D8FF005CCE00C1C4C800FFFFFF00FFFFFF00D7D7D8FF005CCEFF9BC4 332 | E6FF43ADF5FF8BCDFAFF9CD5FBFF9CD5FBFF9CD4FBFFBCDAF1FF005CCEFFD7D7 333 | D8FF005CCE00D7D7D800FFFFFF00FFFFFF00FFFFFF00FFFFFF00CDCECFFF005C 334 | CEFF9BC5E6FF79C5FAFF9FD7FDFF9FD7FDFFCFE5F6FF005CCEFFD7D7D8FF005C 335 | CE00D7D7D800FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00D7D7 336 | D8FF005CCEFFB7D3ECFFBCDBF4FFBCDBF4FF005CCEFFD7D7D8FF005CCE00D7D7 337 | D800FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 338 | FF00C1C4C8FF005CCEFF005CCEFF005CCEFFD7D7D8FF005CCE00D7D7D800FFFF 339 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 340 | FF00FFFFFF00C1C4C800005CCE00005CCE00005CCE00D7D7D800FFFFFF00FFFF 341 | FF00FFFFFF00FFFFFF00FFFFFF00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFD 342 | FD00BAE0E0FF0C7070FF0C7070FF0C7070FFBAE0E0FFFCFDFD00FCFDFD00FCFD 343 | FD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00BAE0 344 | E0FF0C7070FF8FCACAFF8FCACAFF8FCACAFF0C7070FFBAE0E0FFFCFDFD00FCFD 345 | FD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00BAE0E0FF0C70 346 | 70FF8FCACAFF228686FF208484FF2C8D8DFF8FCACAFF0C7070FFBAE0E0FFFCFD 347 | FD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00BAE0E0FF0C7070FF8FCA 348 | CAFF248787FF228686FF268989FF2D8E8EFF399797FF8FCACAFF0C7070FFBAE0 349 | E0FFFCFDFD00FCFDFD00FCFDFD00FCFDFD00BAE0E0FF0C7070FF8FCACAFF2487 350 | 87FF228686FF288A8AFF2E8F8FFF349494FF3A9898FF47A0A0FF8FCACAFF0C70 351 | 70FFBAE0E0FFFCFDFD00FCFDFD00BAE0E0FF0C7070FF8FCACAFF248787FF2487 352 | 87FF298B8BFF2E8F8FFF349494FF3C9999FF429D9DFF4AA2A2FF54A9A9FF8FCA 353 | CAFF0C7070FFBAE0E0FFFCFDFD000C7070FF8FCACAFF248787FF7ABFBFFFC9E7 354 | E7FFC9E7E7FF7ABFBFFF4AA2A2FF429D9DFF4AA2A2FF52A8A8FFC9E7E7FF68B5 355 | B5FF8FCACAFF0C7070FFFCFDFD000C7070FF8FCACAFF268989FFC9E7E7FF86C6 356 | C6FF93CCCCFFC9E7E7FFC9E7E7FFB1DBDBFF7EC1C1FF88C7C7FFC9E7E7FF68B5 357 | B5FF8FCACAFF0C7070FFFCFDFD000C7070FF8FCACAFF379696FFC9E7E7FF3796 358 | 96FF3F9B9BFF47A0A0FF6CB7B7FFC9E7E7FFC9E7E7FFC9E7E7FF7EC1C1FF74BC 359 | BCFF8FCACAFF0C7070FFFCFDFD00BAE0E0FF0C7070FF8FCACAFF3F9B9BFF409C 360 | 9CFF47A0A0FF4DA5A5FF54A9A9FF5BADADFF63B2B2FF6CB7B7FF76BDBDFF8FCA 361 | CAFF0C7070FFBAE0E0FFFCFDFD00FCFDFD00BAE0E0FF0C7070FF8FCACAFF4CA4 362 | A4FF4FA6A6FF56AAAAFF5DAEAEFF64B3B3FF6CB7B7FF78BEBEFF8FCACAFF0C70 363 | 70FFBAE0E0FFFCFDFD00FCFDFD00FCFDFD00FCFDFD00BAE0E0FF0C7070FF8FCA 364 | CAFF5BADADFF5FAFAFFF66B4B4FF6CB7B7FF7ABFBFFF8FCACAFF0C7070FFBAE0 365 | E0FFFCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00BAE0E0FF0C70 366 | 70FF8FCACAFF6CB7B7FF70B9B9FF7ABFBFFF8FCACAFF0C7070FFBAE0E0FFFCFD 367 | FD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00BAE0 368 | E0FF0C7070FF8FCACAFF8FCACAFF8FCACAFF0C7070FFBAE0E0FFFCFDFD00FCFD 369 | FD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFD 370 | FD00BAE0E0FF0C7070FF0C7070FF0C7070FFBAE0E0FFFCFDFD00FCFDFD00FCFD 371 | FD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFD 372 | FD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFDFD00FCFD 373 | FD00FCFDFD00FCFDFD00FCFDFD00FFFFFF000000000000000000000000000000 374 | 00000000000000000000000000000000000000A0C4FF00000000000000000000 375 | 0000000000000000000000000000FFFFFF000000000000000000000000000000 376 | 00000000000000000000000000000000000000A0C4FF00A0C4FF009DBF140000 377 | 0000000000000000000000000000FFFFFF000000000000000000000000000000 378 | 00000000000000000000000000000000000000A0C4FFADF3FBFF00A0C4FF0579 379 | 7D11000000000000000000000000FFFFFF00000000000000000000000000067A 380 | 7C0B1BA1BBA4159FBBCF13A1BEE700A0C4FF00A0C4FF25E4FBFFADF3FBFF00A0 381 | C4FF05797D110000000000000000FFFFFF00000000000000000005797D1C14A3 382 | C1D514A1BCD46CE8F7F86EE8F7FF6FEBFAFF73ECFAFF20E3FAFF31E1F6FFADF3 383 | FBFF00A0C4FF05797D1100000000FFFFFF000000000005797D3213A3C1E441CE 384 | E3FE69E7F6FF36D9ECFF16CDE3FF29DBF1FF2FE0F5FF29DBF1FF32E2F7FF2FE0 385 | F6FFADF3FBFF00A0C4FF05797D0AFFFFFF0005797D0A16A1BDCA40CDE1FF36D9 386 | ECFF1DD2E8FF1DD2E8FF1DD2E8FF29DBF1FF2FE0F5FF32E2F7FF32E2F7FF32E2 387 | F8FF2FE0F6FFADF3FBFF00A0C4FFFFFFFF0015A0BCCB1BABC5F86AE5F3FF0BC8 388 | DFFF1DD2E8FF1DD2E8FF1DD2E8FF04C0D6FF04C0D6FF04C0D6FF2CDFF4FF32E2 389 | F8FF79EDFBFF00A0C4FF05797E11FFFFFF001BA3BFF46FDCEBFF07C2D8FF0AC8 390 | DFFF05DDF7FF69EAF9FF69EAF9FF69EAF9FF69EAF9FF76EDFBFF04C3DAFF76ED 391 | FBFF00A0C4FF05797D1100000000FFFFFF001AA4C0F869E4F2FF0FC9DFFF6EE1 392 | EEFF01A9C4FF00A0C4FF00A0C4FF00A0C4FF00A0C4FF76EDFBFF76EDFBFF00A0 393 | C4FF05797D110000000000000000FFFFFF0019A3C1FF76E2EFFF6DE6F5FF00A0 394 | C4C90099B95000A0C430000000000000000000A0C4FF76EDFBFF00A0C4FF0579 395 | 7D11000000000000000000000000FFFFFF0011A2C2FF88E7F2FE02ACC8FF009E 396 | C11A0000000000000000000000000000000000A0C4FF00A0C4FF000000000000 397 | 0000000000000000000000000000FFFFFF0023A6C0EF5DDAE9FE0EAACBFE0000 398 | 00000000000000000000000000000000000000A0C4FF00000000000000000000 399 | 0000000000000000000000000000FFFFFF0023A6C07F43C5D8FE43C4DBFC00A0 400 | C422000000000000000000000000000000000000000000000000000000000000 401 | 0000000000000000000000000000FFFFFF000000000011A6C2AE66DBEAB200A0 402 | C45D000000000000000000000000000000000000000000000000000000000000 403 | 0000000000000000000000000000FFFFFF000000000000A0C4181AA7C46918A6 404 | C369000000000000000000000000000000000000000000000000000000000000 405 | 0000000000000000000000000000FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 406 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C954FFF1C954FFF1C954FFF1C95 407 | 4FFF1C954FFF1C954FFF1C954FFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 408 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF001C954FFF27D170FF5CE095FF5CE0 409 | 95FF5CE095FF5CE095FF1C954FFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 410 | FF00CDCDCDFFB9B9B9FFB7B7B7FFC7C7C7FFFFFFFF001C954FFF27D170FF5CE0 411 | 95FF5CE095FF5CE095FF1C954FFFFFFFFF00FFFFFF00CFCFCFFFE2E2E2FFFFFF 412 | FF00D0D0D0FFDEDEDEFFD8D8D8FFBEBEBEFFFFFFFF00E2E2E2FF1C954FFF27D1 413 | 70FF5CE095FF5CE095FF1C954FFFFFFFFF00E2E2E2FFC8C8C8FFCECECEFFD1D1 414 | D1FFC6C6C6FFD5D5D5FFD2D2D2FFBABABAFFE2E2E2FF1C954FFF5CE095FF1C95 415 | 4FFF27D170FF5CE095FF1C954FFFFFFFFF00B1B1B1FFDFDFDFFFE5E5E5FFD0D0 416 | D0FFC9C9C9FFDBDBDBFFD8D8D8FFE2E2E2FF1C954FFF5CE095FF1C954FFFE2E2 417 | E2FF1C954FFF27D170FF1C954FFFFFFFFF00DFDFDF00BCBCBCFFD3D3D3FFCFCF 418 | CFFFD2D2D2FFAEAEAEFFE2E2E2FF1C954FFF5CE095FF1C954FFFE2E2E2FFD0D0 419 | D000FFFFFF001C954FFF1C954FFFCACACAFFC9C9C9FFC6C6C6FFD4D4D4FFC6C6 420 | C6FF959595FFE2E2E2FF1C954FFF5CE095FF1C954FFFE2E2E2FFA8A8A8FFA4A4 421 | A4FFA8A8A8FFFFFFFF00FFFFFF00C4C4C4FFE0E0E0FFCFCFCFFFD0D0D0FFB1B1 422 | B1FFC8C8C8FFFFFFFF001C954FFF1C954FFFE2E2E2FFC3C3C3FFBDBDBDFFD0D0 423 | D0FF6A6A6AFFFFFFFF00FFFFFF00B9B9B9FFD1D1D1FFC9C9C9FFCCCCCCFFBABA 424 | BAFFD0D0D0FFFFFFFF00FFFFFF00E2E2E2FFAFAFAFFFBFBFBFFFB3B3B3FFBEBE 425 | BEFF5B5B5BFFFFFFFF00FFFFFF00B3B3B3FFA9A9A9FFB3B3B3FFC9C9C9FFC8C8 426 | C8FFA7A7A7FFCFCFCFFFCCCCCCFF9D9D9DFFBFBFBFFFB9B9B9FF8A8A8AFF8585 427 | 85FF8F8F8FFFFFFFFF00FFFFFF00FFFFFF00DCDCDC00ABABABFFC7C7C7FFC8C8 428 | C8FFD8D8D8FFB3B3B3FFB1B1B1FFD4D4D4FFC1C1C1FFB8B8B8FF8C8C8CFFD2D2 429 | D200FFFFFF00FFFFFF00FFFFFF00FFFFFF009A9A9AFFCACACAFFDADADAFFA4A4 430 | A4FFA1A1A1FFC7C7C7FFC4C4C4FF919191FF9A9A9AFFDDDDDDFF999999FF6A6A 431 | 6AFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00D9D9D9FF979797FF767676FFA2A2 432 | A2FF989898FFBFBFBFFFB7B7B7FF7F7F7FFF9F9F9FFF646464FF6F6F6FFFCBCB 433 | CBFFFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00B4B4B4FFBFBFBFFFFFFF 434 | FF00A4A4A4FFB6B6B6FFA7A7A7FF8C8C8CFFFFFFFF00B6B6B6FFACACACFFFFFF 435 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 436 | FF00BABABAFF737373FF6E6E6EFFB3B3B3FFFFFFFF00FFFFFF00FFFFFF00FFFF 437 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 438 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 439 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 440 | FF000101E23D0101E3AC0101E23DFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 441 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0001B3CC813CC1DCFF36BDDBFF34BC 442 | DAFF1F39DAFF6666F7FF1D38DAFF2CB7D9FF2AB6D9FF27B5D9FF24B3D8FF21B2 443 | D7FF1FB1D7FF01B3CC81FFFFFF00FFFFFF0001B1CAAD74E1F2FF6FDDEEFF6FDD 444 | EEFF539ADBFF1F1FB8FF5D73A4FF71D2E0FF6FDDEEFF6FDDEEFF6FDDEEFF6FDD 445 | EEFF74E1F2FF01B1CAADFFFFFF00FFFFFF0001AFC8AE73DFF0FF69D7E8FF69D7 446 | E8FF67D1E2FF62C7D7FF61B5C3FF6E979DFF69D7E8FF69D7E8FF69D7E8FF69D7 447 | E8FF73DFF0FF01AFC8AEFFFFFF00FFFFFF0001ADC6AF78E1F1FF6CD9EAFF6CD9 448 | EAFF6AD3E4FF65C9D9FF62C3D2FF62C3D2FF6CD9EAFF6CD9EAFF6CD9EAFF6CD9 449 | EAFF78E1F1FF01ADC6AFFFFFFF00FFFFFF0001AAC3B17EE3F3FF70DCEDFF70DC 450 | EDFF70DCEDFF70DCEDFF70DCEDFF70DCEDFF70DCEDFF70DCEDFF70DCEDFF70DC 451 | EDFF7EE3F3FF01AAC3B1FFFFFF00FFFFFF0001A7C0B384E6F5FF74DFF0FF74DF 452 | F0FF74DFF0FF74DFF0FF74DFF0FF74DFF0FF74DFF0FF74DFF0FF74DFF0FF74DF 453 | F0FF84E6F5FF01A7C0B3FFFFFF00FFFFFF0001A4BCB58AE8F7FF78E2F3FF78E2 454 | F3FF78E2F3FF78E2F3FF78E2F3FF78E2F3FF78E2F3FF78E2F3FF78E2F3FF78E2 455 | F3FF8AE8F7FF01A4BCB5FFFFFF00FFFFFF0001A1B9B790EBFAFF7CE5F6FF7CE5 456 | F6FF7CE5F6FF7CE5F6FF7CE5F6FF7CE5F6FF7CE5F6FF7CE5F6FF7CE5F6FF7CE5 457 | F6FF90EBFAFF01A1B9B7FFFFFF00FFFFFF00019EB5B996EEFCFF80E8F9FF80E8 458 | F9FF80E8F9FF80E8F9FF80E8F9FF80E8F9FF80E8F9FF80E8F9FF80E8F9FF80E8 459 | F9FF96EEFCFF019EB5B9FFFFFF00FFFFFF00019AB2BB9BF0FDFF84EBFCFF84EB 460 | FCFF84EBFCFF84EBFCFF84EBFCFF84EBFCFF84EBFCFF84EBFCFF84EBFCFF84EB 461 | FCFF9BF0FDFF019AB2BBFFFFFF00FFFFFF000091A8C1ACF4FFFFA0F1FEFFA0F1 462 | FEFFA0F1FEFFA0F1FEFFA0F1FEFFA0F1FEFFA0F1FEFFA0F1FEFFA0F1FEFFA0F1 463 | FEFFACF4FFFF0091A8C1FFFFFF00FFFFFF0000869D96108BACFF0E8AACFF0D89 464 | ABFF0B88ABFF0686AAFF0686AAFF0686ABFF0585ABFF0384ABFF0284AAFF0083 465 | AAFF0082AAFF00869D96FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 466 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 467 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 468 | FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF 469 | FF00FFFFFF00FFFFFF00FFFFFF00 470 | } 471 | end 472 | object PMTree: TPopupMenu 473 | left = 311 474 | top = 97 475 | object MIGetprop: TMenuItem 476 | Action = AGetprop 477 | end 478 | end 479 | end 480 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU LESSER GENERAL PUBLIC LICENSE 2 | Version 2.1, February 1999 3 | 4 | Copyright (C) 1991, 1999 Free Software Foundation, Inc. 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | [This is the first released version of the Lesser GPL. It also counts 10 | as the successor of the GNU Library Public License, version 2, hence 11 | the version number 2.1.] 12 | 13 | Preamble 14 | 15 | The licenses for most software are designed to take away your 16 | freedom to share and change it. By contrast, the GNU General Public 17 | Licenses are intended to guarantee your freedom to share and change 18 | free software--to make sure the software is free for all its users. 19 | 20 | This license, the Lesser General Public License, applies to some 21 | specially designated software packages--typically libraries--of the 22 | Free Software Foundation and other authors who decide to use it. You 23 | can use it too, but we suggest you first think carefully about whether 24 | this license or the ordinary General Public License is the better 25 | strategy to use in any particular case, based on the explanations below. 26 | 27 | When we speak of free software, we are referring to freedom of use, 28 | not price. Our General Public Licenses are designed to make sure that 29 | you have the freedom to distribute copies of free software (and charge 30 | for this service if you wish); that you receive source code or can get 31 | it if you want it; that you can change the software and use pieces of 32 | it in new free programs; and that you are informed that you can do 33 | these things. 34 | 35 | To protect your rights, we need to make restrictions that forbid 36 | distributors to deny you these rights or to ask you to surrender these 37 | rights. These restrictions translate to certain responsibilities for 38 | you if you distribute copies of the library or if you modify it. 39 | 40 | For example, if you distribute copies of the library, whether gratis 41 | or for a fee, you must give the recipients all the rights that we gave 42 | you. You must make sure that they, too, receive or can get the source 43 | code. If you link other code with the library, you must provide 44 | complete object files to the recipients, so that they can relink them 45 | with the library after making changes to the library and recompiling 46 | it. And you must show them these terms so they know their rights. 47 | 48 | We protect your rights with a two-step method: (1) we copyright the 49 | library, and (2) we offer you this license, which gives you legal 50 | permission to copy, distribute and/or modify the library. 51 | 52 | To protect each distributor, we want to make it very clear that 53 | there is no warranty for the free library. Also, if the library is 54 | modified by someone else and passed on, the recipients should know 55 | that what they have is not the original version, so that the original 56 | author's reputation will not be affected by problems that might be 57 | introduced by others. 58 | 59 | Finally, software patents pose a constant threat to the existence of 60 | any free program. We wish to make sure that a company cannot 61 | effectively restrict the users of a free program by obtaining a 62 | restrictive license from a patent holder. Therefore, we insist that 63 | any patent license obtained for a version of the library must be 64 | consistent with the full freedom of use specified in this license. 65 | 66 | Most GNU software, including some libraries, is covered by the 67 | ordinary GNU General Public License. This license, the GNU Lesser 68 | General Public License, applies to certain designated libraries, and 69 | is quite different from the ordinary General Public License. We use 70 | this license for certain libraries in order to permit linking those 71 | libraries into non-free programs. 72 | 73 | When a program is linked with a library, whether statically or using 74 | a shared library, the combination of the two is legally speaking a 75 | combined work, a derivative of the original library. The ordinary 76 | General Public License therefore permits such linking only if the 77 | entire combination fits its criteria of freedom. The Lesser General 78 | Public License permits more lax criteria for linking other code with 79 | the library. 80 | 81 | We call this license the "Lesser" General Public License because it 82 | does Less to protect the user's freedom than the ordinary General 83 | Public License. It also provides other free software developers Less 84 | of an advantage over competing non-free programs. These disadvantages 85 | are the reason we use the ordinary General Public License for many 86 | libraries. However, the Lesser license provides advantages in certain 87 | special circumstances. 88 | 89 | For example, on rare occasions, there may be a special need to 90 | encourage the widest possible use of a certain library, so that it becomes 91 | a de-facto standard. To achieve this, non-free programs must be 92 | allowed to use the library. A more frequent case is that a free 93 | library does the same job as widely used non-free libraries. In this 94 | case, there is little to gain by limiting the free library to free 95 | software only, so we use the Lesser General Public License. 96 | 97 | In other cases, permission to use a particular library in non-free 98 | programs enables a greater number of people to use a large body of 99 | free software. For example, permission to use the GNU C Library in 100 | non-free programs enables many more people to use the whole GNU 101 | operating system, as well as its variant, the GNU/Linux operating 102 | system. 103 | 104 | Although the Lesser General Public License is Less protective of the 105 | users' freedom, it does ensure that the user of a program that is 106 | linked with the Library has the freedom and the wherewithal to run 107 | that program using a modified version of the Library. 108 | 109 | The precise terms and conditions for copying, distribution and 110 | modification follow. Pay close attention to the difference between a 111 | "work based on the library" and a "work that uses the library". The 112 | former contains code derived from the library, whereas the latter must 113 | be combined with the library in order to run. 114 | 115 | GNU LESSER GENERAL PUBLIC LICENSE 116 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 117 | 118 | 0. This License Agreement applies to any software library or other 119 | program which contains a notice placed by the copyright holder or 120 | other authorized party saying it may be distributed under the terms of 121 | this Lesser General Public License (also called "this License"). 122 | Each licensee is addressed as "you". 123 | 124 | A "library" means a collection of software functions and/or data 125 | prepared so as to be conveniently linked with application programs 126 | (which use some of those functions and data) to form executables. 127 | 128 | The "Library", below, refers to any such software library or work 129 | which has been distributed under these terms. A "work based on the 130 | Library" means either the Library or any derivative work under 131 | copyright law: that is to say, a work containing the Library or a 132 | portion of it, either verbatim or with modifications and/or translated 133 | straightforwardly into another language. (Hereinafter, translation is 134 | included without limitation in the term "modification".) 135 | 136 | "Source code" for a work means the preferred form of the work for 137 | making modifications to it. For a library, complete source code means 138 | all the source code for all modules it contains, plus any associated 139 | interface definition files, plus the scripts used to control compilation 140 | and installation of the library. 141 | 142 | Activities other than copying, distribution and modification are not 143 | covered by this License; they are outside its scope. The act of 144 | running a program using the Library is not restricted, and output from 145 | such a program is covered only if its contents constitute a work based 146 | on the Library (independent of the use of the Library in a tool for 147 | writing it). Whether that is true depends on what the Library does 148 | and what the program that uses the Library does. 149 | 150 | 1. You may copy and distribute verbatim copies of the Library's 151 | complete source code as you receive it, in any medium, provided that 152 | you conspicuously and appropriately publish on each copy an 153 | appropriate copyright notice and disclaimer of warranty; keep intact 154 | all the notices that refer to this License and to the absence of any 155 | warranty; and distribute a copy of this License along with the 156 | Library. 157 | 158 | You may charge a fee for the physical act of transferring a copy, 159 | and you may at your option offer warranty protection in exchange for a 160 | fee. 161 | 162 | 2. You may modify your copy or copies of the Library or any portion 163 | of it, thus forming a work based on the Library, and copy and 164 | distribute such modifications or work under the terms of Section 1 165 | above, provided that you also meet all of these conditions: 166 | 167 | a) The modified work must itself be a software library. 168 | 169 | b) You must cause the files modified to carry prominent notices 170 | stating that you changed the files and the date of any change. 171 | 172 | c) You must cause the whole of the work to be licensed at no 173 | charge to all third parties under the terms of this License. 174 | 175 | d) If a facility in the modified Library refers to a function or a 176 | table of data to be supplied by an application program that uses 177 | the facility, other than as an argument passed when the facility 178 | is invoked, then you must make a good faith effort to ensure that, 179 | in the event an application does not supply such function or 180 | table, the facility still operates, and performs whatever part of 181 | its purpose remains meaningful. 182 | 183 | (For example, a function in a library to compute square roots has 184 | a purpose that is entirely well-defined independent of the 185 | application. Therefore, Subsection 2d requires that any 186 | application-supplied function or table used by this function must 187 | be optional: if the application does not supply it, the square 188 | root function must still compute square roots.) 189 | 190 | These requirements apply to the modified work as a whole. If 191 | identifiable sections of that work are not derived from the Library, 192 | and can be reasonably considered independent and separate works in 193 | themselves, then this License, and its terms, do not apply to those 194 | sections when you distribute them as separate works. But when you 195 | distribute the same sections as part of a whole which is a work based 196 | on the Library, the distribution of the whole must be on the terms of 197 | this License, whose permissions for other licensees extend to the 198 | entire whole, and thus to each and every part regardless of who wrote 199 | it. 200 | 201 | Thus, it is not the intent of this section to claim rights or contest 202 | your rights to work written entirely by you; rather, the intent is to 203 | exercise the right to control the distribution of derivative or 204 | collective works based on the Library. 205 | 206 | In addition, mere aggregation of another work not based on the Library 207 | with the Library (or with a work based on the Library) on a volume of 208 | a storage or distribution medium does not bring the other work under 209 | the scope of this License. 210 | 211 | 3. You may opt to apply the terms of the ordinary GNU General Public 212 | License instead of this License to a given copy of the Library. To do 213 | this, you must alter all the notices that refer to this License, so 214 | that they refer to the ordinary GNU General Public License, version 2, 215 | instead of to this License. (If a newer version than version 2 of the 216 | ordinary GNU General Public License has appeared, then you can specify 217 | that version instead if you wish.) Do not make any other change in 218 | these notices. 219 | 220 | Once this change is made in a given copy, it is irreversible for 221 | that copy, so the ordinary GNU General Public License applies to all 222 | subsequent copies and derivative works made from that copy. 223 | 224 | This option is useful when you wish to copy part of the code of 225 | the Library into a program that is not a library. 226 | 227 | 4. You may copy and distribute the Library (or a portion or 228 | derivative of it, under Section 2) in object code or executable form 229 | under the terms of Sections 1 and 2 above provided that you accompany 230 | it with the complete corresponding machine-readable source code, which 231 | must be distributed under the terms of Sections 1 and 2 above on a 232 | medium customarily used for software interchange. 233 | 234 | If distribution of object code is made by offering access to copy 235 | from a designated place, then offering equivalent access to copy the 236 | source code from the same place satisfies the requirement to 237 | distribute the source code, even though third parties are not 238 | compelled to copy the source along with the object code. 239 | 240 | 5. A program that contains no derivative of any portion of the 241 | Library, but is designed to work with the Library by being compiled or 242 | linked with it, is called a "work that uses the Library". Such a 243 | work, in isolation, is not a derivative work of the Library, and 244 | therefore falls outside the scope of this License. 245 | 246 | However, linking a "work that uses the Library" with the Library 247 | creates an executable that is a derivative of the Library (because it 248 | contains portions of the Library), rather than a "work that uses the 249 | library". The executable is therefore covered by this License. 250 | Section 6 states terms for distribution of such executables. 251 | 252 | When a "work that uses the Library" uses material from a header file 253 | that is part of the Library, the object code for the work may be a 254 | derivative work of the Library even though the source code is not. 255 | Whether this is true is especially significant if the work can be 256 | linked without the Library, or if the work is itself a library. The 257 | threshold for this to be true is not precisely defined by law. 258 | 259 | If such an object file uses only numerical parameters, data 260 | structure layouts and accessors, and small macros and small inline 261 | functions (ten lines or less in length), then the use of the object 262 | file is unrestricted, regardless of whether it is legally a derivative 263 | work. (Executables containing this object code plus portions of the 264 | Library will still fall under Section 6.) 265 | 266 | Otherwise, if the work is a derivative of the Library, you may 267 | distribute the object code for the work under the terms of Section 6. 268 | Any executables containing that work also fall under Section 6, 269 | whether or not they are linked directly with the Library itself. 270 | 271 | 6. As an exception to the Sections above, you may also combine or 272 | link a "work that uses the Library" with the Library to produce a 273 | work containing portions of the Library, and distribute that work 274 | under terms of your choice, provided that the terms permit 275 | modification of the work for the customer's own use and reverse 276 | engineering for debugging such modifications. 277 | 278 | You must give prominent notice with each copy of the work that the 279 | Library is used in it and that the Library and its use are covered by 280 | this License. You must supply a copy of this License. If the work 281 | during execution displays copyright notices, you must include the 282 | copyright notice for the Library among them, as well as a reference 283 | directing the user to the copy of this License. Also, you must do one 284 | of these things: 285 | 286 | a) Accompany the work with the complete corresponding 287 | machine-readable source code for the Library including whatever 288 | changes were used in the work (which must be distributed under 289 | Sections 1 and 2 above); and, if the work is an executable linked 290 | with the Library, with the complete machine-readable "work that 291 | uses the Library", as object code and/or source code, so that the 292 | user can modify the Library and then relink to produce a modified 293 | executable containing the modified Library. (It is understood 294 | that the user who changes the contents of definitions files in the 295 | Library will not necessarily be able to recompile the application 296 | to use the modified definitions.) 297 | 298 | b) Use a suitable shared library mechanism for linking with the 299 | Library. A suitable mechanism is one that (1) uses at run time a 300 | copy of the library already present on the user's computer system, 301 | rather than copying library functions into the executable, and (2) 302 | will operate properly with a modified version of the library, if 303 | the user installs one, as long as the modified version is 304 | interface-compatible with the version that the work was made with. 305 | 306 | c) Accompany the work with a written offer, valid for at 307 | least three years, to give the same user the materials 308 | specified in Subsection 6a, above, for a charge no more 309 | than the cost of performing this distribution. 310 | 311 | d) If distribution of the work is made by offering access to copy 312 | from a designated place, offer equivalent access to copy the above 313 | specified materials from the same place. 314 | 315 | e) Verify that the user has already received a copy of these 316 | materials or that you have already sent this user a copy. 317 | 318 | For an executable, the required form of the "work that uses the 319 | Library" must include any data and utility programs needed for 320 | reproducing the executable from it. However, as a special exception, 321 | the materials to be distributed need not include anything that is 322 | normally distributed (in either source or binary form) with the major 323 | components (compiler, kernel, and so on) of the operating system on 324 | which the executable runs, unless that component itself accompanies 325 | the executable. 326 | 327 | It may happen that this requirement contradicts the license 328 | restrictions of other proprietary libraries that do not normally 329 | accompany the operating system. Such a contradiction means you cannot 330 | use both them and the Library together in an executable that you 331 | distribute. 332 | 333 | 7. You may place library facilities that are a work based on the 334 | Library side-by-side in a single library together with other library 335 | facilities not covered by this License, and distribute such a combined 336 | library, provided that the separate distribution of the work based on 337 | the Library and of the other library facilities is otherwise 338 | permitted, and provided that you do these two things: 339 | 340 | a) Accompany the combined library with a copy of the same work 341 | based on the Library, uncombined with any other library 342 | facilities. This must be distributed under the terms of the 343 | Sections above. 344 | 345 | b) Give prominent notice with the combined library of the fact 346 | that part of it is a work based on the Library, and explaining 347 | where to find the accompanying uncombined form of the same work. 348 | 349 | 8. You may not copy, modify, sublicense, link with, or distribute 350 | the Library except as expressly provided under this License. Any 351 | attempt otherwise to copy, modify, sublicense, link with, or 352 | distribute the Library is void, and will automatically terminate your 353 | rights under this License. However, parties who have received copies, 354 | or rights, from you under this License will not have their licenses 355 | terminated so long as such parties remain in full compliance. 356 | 357 | 9. You are not required to accept this License, since you have not 358 | signed it. However, nothing else grants you permission to modify or 359 | distribute the Library or its derivative works. These actions are 360 | prohibited by law if you do not accept this License. Therefore, by 361 | modifying or distributing the Library (or any work based on the 362 | Library), you indicate your acceptance of this License to do so, and 363 | all its terms and conditions for copying, distributing or modifying 364 | the Library or works based on it. 365 | 366 | 10. Each time you redistribute the Library (or any work based on the 367 | Library), the recipient automatically receives a license from the 368 | original licensor to copy, distribute, link with or modify the Library 369 | subject to these terms and conditions. You may not impose any further 370 | restrictions on the recipients' exercise of the rights granted herein. 371 | You are not responsible for enforcing compliance by third parties with 372 | this License. 373 | 374 | 11. If, as a consequence of a court judgment or allegation of patent 375 | infringement or for any other reason (not limited to patent issues), 376 | conditions are imposed on you (whether by court order, agreement or 377 | otherwise) that contradict the conditions of this License, they do not 378 | excuse you from the conditions of this License. If you cannot 379 | distribute so as to satisfy simultaneously your obligations under this 380 | License and any other pertinent obligations, then as a consequence you 381 | may not distribute the Library at all. For example, if a patent 382 | license would not permit royalty-free redistribution of the Library by 383 | all those who receive copies directly or indirectly through you, then 384 | the only way you could satisfy both it and this License would be to 385 | refrain entirely from distribution of the Library. 386 | 387 | If any portion of this section is held invalid or unenforceable under any 388 | particular circumstance, the balance of the section is intended to apply, 389 | and the section as a whole is intended to apply in other circumstances. 390 | 391 | It is not the purpose of this section to induce you to infringe any 392 | patents or other property right claims or to contest validity of any 393 | such claims; this section has the sole purpose of protecting the 394 | integrity of the free software distribution system which is 395 | implemented by public license practices. Many people have made 396 | generous contributions to the wide range of software distributed 397 | through that system in reliance on consistent application of that 398 | system; it is up to the author/donor to decide if he or she is willing 399 | to distribute software through any other system and a licensee cannot 400 | impose that choice. 401 | 402 | This section is intended to make thoroughly clear what is believed to 403 | be a consequence of the rest of this License. 404 | 405 | 12. If the distribution and/or use of the Library is restricted in 406 | certain countries either by patents or by copyrighted interfaces, the 407 | original copyright holder who places the Library under this License may add 408 | an explicit geographical distribution limitation excluding those countries, 409 | so that distribution is permitted only in or among countries not thus 410 | excluded. In such case, this License incorporates the limitation as if 411 | written in the body of this License. 412 | 413 | 13. The Free Software Foundation may publish revised and/or new 414 | versions of the Lesser General Public License from time to time. 415 | Such new versions will be similar in spirit to the present version, 416 | but may differ in detail to address new problems or concerns. 417 | 418 | Each version is given a distinguishing version number. If the Library 419 | specifies a version number of this License which applies to it and 420 | "any later version", you have the option of following the terms and 421 | conditions either of that version or of any later version published by 422 | the Free Software Foundation. If the Library does not specify a 423 | license version number, you may choose any version ever published by 424 | the Free Software Foundation. 425 | 426 | 14. If you wish to incorporate parts of the Library into other free 427 | programs whose distribution conditions are incompatible with these, 428 | write to the author to ask for permission. For software which is 429 | copyrighted by the Free Software Foundation, write to the Free 430 | Software Foundation; we sometimes make exceptions for this. Our 431 | decision will be guided by the two goals of preserving the free status 432 | of all derivatives of our free software and of promoting the sharing 433 | and reuse of software generally. 434 | 435 | NO WARRANTY 436 | 437 | 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO 438 | WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. 439 | EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR 440 | OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY 441 | KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE 442 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 443 | PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE 444 | LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME 445 | THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 446 | 447 | 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN 448 | WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY 449 | AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU 450 | FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR 451 | CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE 452 | LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING 453 | RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A 454 | FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF 455 | SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH 456 | DAMAGES. 457 | 458 | END OF TERMS AND CONDITIONS 459 | 460 | How to Apply These Terms to Your New Libraries 461 | 462 | If you develop a new library, and you want it to be of the greatest 463 | possible use to the public, we recommend making it free software that 464 | everyone can redistribute and change. You can do so by permitting 465 | redistribution under these terms (or, alternatively, under the terms of the 466 | ordinary General Public License). 467 | 468 | To apply these terms, attach the following notices to the library. It is 469 | safest to attach them to the start of each source file to most effectively 470 | convey the exclusion of warranty; and each file should have at least the 471 | "copyright" line and a pointer to where the full notice is found. 472 | 473 | <one line to give the library's name and a brief idea of what it does.> 474 | Copyright (C) <year> <name of author> 475 | 476 | This library is free software; you can redistribute it and/or 477 | modify it under the terms of the GNU Lesser General Public 478 | License as published by the Free Software Foundation; either 479 | version 2.1 of the License, or (at your option) any later version. 480 | 481 | This library is distributed in the hope that it will be useful, 482 | but WITHOUT ANY WARRANTY; without even the implied warranty of 483 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 484 | Lesser General Public License for more details. 485 | 486 | You should have received a copy of the GNU Lesser General Public 487 | License along with this library; if not, write to the Free Software 488 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 489 | 490 | Also add information on how to contact you by electronic and paper mail. 491 | 492 | You should also get your employer (if you work as a programmer) or your 493 | school, if any, to sign a "copyright disclaimer" for the library, if 494 | necessary. Here is a sample; alter the names: 495 | 496 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 497 | library `Frob' (a library for tweaking knobs) written by James Random Hacker. 498 | 499 | <signature of Ty Coon>, 1 April 1990 500 | Ty Coon, President of Vice 501 | 502 | That's all there is to it! 503 | 504 | 505 | -------------------------------------------------------------------------------- /src/dbusintro.pp: -------------------------------------------------------------------------------- 1 | { 2 | This file is part of the Free Pascal run time library. 3 | Copyright (c) 2010 by Michael Van Canneyt, member of the 4 | Free Pascal development team 5 | 6 | DBUS Introspection and code generation components. 7 | 8 | See the file COPYING.FPC, included in this distribution, 9 | for details about the copyright. 10 | 11 | This program is distributed in the hope that it will be useful, 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 14 | 15 | **********************************************************************} 16 | 17 | unit dbusintro; 18 | 19 | {$mode objfpc}{$H+} 20 | 21 | interface 22 | 23 | uses 24 | Classes, SysUtils, dom, xmlread; 25 | 26 | Type 27 | TDBUSDataType = (ddtUnknown,ddtByte,ddtBoolean,ddtInt16,ddtUint16,ddtInt32,ddtUint32, 28 | ddtInt64,ddtUint64,ddtDouble,ddtString,ddtObjectPath, 29 | ddtSignature, ddtArray, ddtVariant,ddtStruct,ddtDict,ddFD); 30 | TDBUSDataTypes = Set of TDBUSDataType; 31 | TDBUSDictDef = Array[0..1] of TDBUSDataType; 32 | 33 | Const 34 | DBUSCompoundTypes : TDBUSDataTypes = [ddtArray, ddtDict, ddtStruct]; 35 | DBUSTypeNames : array[TDBUSDataType] of char 36 | = ('?','y','b','n','q','i','u', 37 | 'x','t','d','s','o', 38 | 'g','a','v','r','e','h'); 39 | DBUSPascalTypeNames : Array[TDBUSDataType] of String 40 | = ('','Byte','Boolean','Smallint','Word','Integer','Cardinal', 41 | 'Int64','QWord','Double','String','String', 42 | 'TDBUSGUID','Array','Variant','Record','TDBUSDict','THandle'); 43 | 44 | Type 45 | { TDBUSNamedItem } 46 | 47 | TDBUSNamedItem = Class(TCollectionItem) 48 | private 49 | FAnnotations: TStrings; 50 | FName: String; 51 | function GetAnnotation: TStrings; 52 | procedure SetAnnotation(const AValue: TStrings); 53 | protected 54 | function GetDisplayName: string; override; 55 | Public 56 | Destructor destroy; override; 57 | Function HasAnnotations : Boolean; 58 | Property Name : String Read FName Write FName; 59 | Property Annotations : TStrings Read GetAnnotation Write SetAnnotation; 60 | end; 61 | 62 | TDBUSStructDef = Class; 63 | 64 | { TDBUSStructItem } 65 | 66 | TDBUSStructItem = Class(TCollectionItem) 67 | private 68 | FDataType: TDBUSDataType; 69 | FStruct : TDBUSStructDef; 70 | function GetStruct: TDBUSStructDef; 71 | procedure SetStruct(const AValue: TDBUSStructDef); 72 | Public 73 | Destructor Destroy; override; 74 | Procedure Assign(Source: TPersistent); 75 | Property DataType : TDBUSDataType Read FDataType Write FDataType; 76 | Property Struct : TDBUSStructDef Read GetStruct Write SetStruct; 77 | end; 78 | 79 | { TDBUSStructDef } 80 | 81 | TDBUSStructDef = Class(TCollection) 82 | private 83 | FName: String; 84 | function GetF(AIndex : Integer): TDBUSStructItem; 85 | procedure SetF(AIndex : Integer; const AValue: TDBUSStructItem); 86 | Public 87 | Procedure Assign(Source : TPersistent); override; 88 | Property Name : String Read FName Write FName; 89 | property Fields[AIndex : Integer] : TDBUSStructItem Read GetF Write SetF; default; 90 | end; 91 | 92 | 93 | 94 | { TDBUSNamedCollection } 95 | 96 | TDBUSNamedCollection = Class(TCollection) 97 | private 98 | function GetN(AIndex : Integer): TDBUSNamedItem; 99 | procedure SetN(AIndex : Integer; const AValue: TDBUSNamedItem); 100 | Public 101 | Function IndexOfName(Const AName: String) : Integer; 102 | Property NamedItems[AIndex : Integer] : TDBUSNamedItem Read GetN Write SetN; default; 103 | end; 104 | 105 | TDBUSVariables = Class; 106 | { TDBUSVarDef } 107 | 108 | TDBUSVarDef = Class(TDBUSNamedItem) 109 | private 110 | FDataType: TDBUSDataType; 111 | FDictDef: TDBUSDictDef; 112 | FElementType: TDBUSDataType; 113 | FStruct : TDBUSVariables; 114 | FStructType : String; 115 | function GetStructDef: TDBUSVariables; 116 | procedure SetStructDef(const AValue: TDBUSVariables); 117 | protected 118 | Property StructType : String Read FStructType; 119 | Public 120 | Procedure Assign(Source : TPersistent); override; 121 | Property DataType : TDBUSDataType Read FDataType Write FDataType; 122 | Property ElementType : TDBUSDataType Read FElementType Write FElementType; 123 | Property StructDef : TDBUSVariables Read GetStructDef Write SetStructDef; 124 | Property DictDef : TDBUSDictDef Read FDictDef Write FDictDef; 125 | end; 126 | 127 | { TDBUSVariables } 128 | 129 | TDBUSVariables = Class(TDBUSNamedCollection) 130 | private 131 | function GetV(AIndex : Integer): TDBUSVarDef; 132 | procedure SetV(AIndex : Integer; const AValue: TDBUSVarDef); 133 | Public 134 | Function AddVariable(Const AName : String) : TDBUSVarDef; 135 | Function FindVariableByName(Const AName : String) : TDBUSVarDef; 136 | Function GetVariableByName(Const AName : String) : TDBUSVarDef; 137 | Property Variables[AIndex : Integer] : TDBUSVarDef Read GetV Write SetV; default; 138 | end; 139 | 140 | { TDBUSPropertyDef } 141 | 142 | TDBUSPropertyAccess = (dpaRead,dpaWrite,dpaReadWrite); 143 | TDBUSPropertyDef = Class(TDBUSVarDef) 144 | private 145 | FAccess: TDBUSPropertyAccess; 146 | Public 147 | Procedure Assign(Source : TPersistent); override; 148 | Property Access : TDBUSPropertyAccess Read FAccess Write FAccess; 149 | end; 150 | 151 | 152 | { TDBUSProperties } 153 | 154 | TDBUSProperties = Class(TDBUSNamedCollection) 155 | private 156 | function GetA(AIndex : Integer): TDBUSPropertyDef; 157 | procedure SetA(AIndex : Integer; const AValue: TDBUSPropertyDef); 158 | Public 159 | Function AddProperty(Const AName : String) : TDBUSPropertyDef; 160 | Function FindPropertyByName(Const AName : String) : TDBUSPropertyDef; 161 | Function GetPropertyByName(Const AName : String) : TDBUSPropertyDef; 162 | Property Properties[AIndex : Integer] : TDBUSPropertyDef Read GetA Write SetA; default; 163 | end; 164 | 165 | TArgumentDirection = (adnone,adIn,adOut); 166 | 167 | { TDBusArgumentDef } 168 | 169 | TDBusArgumentDef = Class(TDBUSVarDef) 170 | private 171 | FDirection: TArgumentDirection; 172 | Public 173 | procedure Assign(Source: TPersistent); override; 174 | Function ArgName : String; 175 | Property Direction : TArgumentDirection Read FDirection Write FDirection; 176 | end; 177 | 178 | { TDBUSArguments } 179 | 180 | TDBUSArguments = Class(TDBUSNamedCollection) 181 | private 182 | function GetA(AIndex : Integer): TDBUSArgumentDef; 183 | procedure SetA(AIndex : Integer; const AValue: TDBUSArgumentDef); 184 | Public 185 | Function AddArgument(Const AName : String) : TDBUSArgumentDef; 186 | Function FindArgumentByName(Const AName : String) : TDBUSArgumentDef; 187 | Function GetArgumentByName(Const AName : String) : TDBUSArgumentDef; 188 | Property Arguments[AIndex : Integer] : TDBUSArgumentDef Read GetA Write SetA; default; 189 | end; 190 | 191 | { TDBUSMethodDef } 192 | 193 | TDBUSMethodDef = Class(TDBUSNamedItem) 194 | private 195 | FArguments: TDBUSArguments; 196 | procedure SetArguments(const AValue: TDBUSArguments); 197 | Public 198 | constructor Create(ACollection: TCollection); override; 199 | destructor Destroy; override; 200 | Procedure Assign(Source : TPersistent); override; 201 | Property Arguments : TDBUSArguments Read FArguments Write SetArguments; 202 | end; 203 | 204 | { TDBUSSignalDef } 205 | 206 | TDBUSSignalDef = Class(TDBUSNamedItem) 207 | private 208 | FVariables: TDBUSVariables; 209 | procedure SetVariables(const AValue: TDBUSVariables); 210 | Public 211 | constructor Create(ACollection: TCollection); override; 212 | destructor Destroy; override; 213 | Procedure Assign(Source : TPersistent); override; 214 | Property Variables : TDBUSVariables Read FVariables Write SetVariables; 215 | end; 216 | 217 | { TDBUSMethods } 218 | 219 | TDBUSMethods = Class(TDBUSNamedCollection) 220 | private 221 | function GetM(AIndex : Integer): TDBUSMethodDef; 222 | procedure SetM(AIndex : Integer; const AValue: TDBUSMethodDef); 223 | Public 224 | Function AddMethod(Const AName : String) : TDBUSMethodDef; 225 | Function FindMethodByName(Const AName : String) : TDBUSMethodDef; 226 | Function GetMethodByName(Const AName : String) : TDBUSMethodDef; 227 | Property Methods [AIndex : Integer] : TDBUSMethodDef Read GetM Write SetM; default; 228 | end; 229 | 230 | { TDBUSSignals } 231 | 232 | TDBUSSignals = Class(TDBUSNamedCollection) 233 | private 234 | function GetS(AIndex : Integer): TDBUSSignalDef; 235 | procedure SetS(AIndex : Integer; const AValue: TDBUSSignalDef); 236 | Public 237 | Function AddSignal(Const AName : String) : TDBUSSignalDef; 238 | Function FindSignalByName(Const AName : String) : TDBUSSignalDef; 239 | Function GetSignalByName(Const AName : String) : TDBUSSignalDef; 240 | Property Signals [AIndex : Integer] : TDBUSSignalDef Read GetS Write SetS; default; 241 | end; 242 | 243 | TDBUSInterfaces = Class; 244 | { TDBUSInterfaceDef } 245 | 246 | TDBUSInterfaceDef = Class(TDBUSNamedItem) 247 | private 248 | FMethods: TDBUSMethods; 249 | FProperties: TDBUSProperties; 250 | FSignals: TDBUSSignals; 251 | procedure SetMethods(const AValue: TDBUSMethods); 252 | procedure SetProperties(const AValue: TDBUSProperties); 253 | procedure SetSignals(const AValue: TDBUSSignals); 254 | Public 255 | Constructor Create(ACollection: TCollection); override; 256 | Destructor Destroy; override; 257 | Property Methods : TDBUSMethods Read FMethods Write SetMethods; 258 | Property Signals : TDBUSSignals Read FSignals Write SetSignals; 259 | Property Properties : TDBUSProperties Read FProperties Write SetProperties; 260 | end; 261 | 262 | { TDBUSInterfaces } 263 | 264 | TDBUSInterfaces = Class(TDBUSNamedCollection) 265 | private 266 | function GetI(AIndex : Integer): TDBUSinterfaceDef; 267 | procedure SetI(AIndex : Integer; const AValue: TDBUSinterfaceDef); 268 | Public 269 | Function AddInterface(Const AName : String) : TDBUSInterfaceDef; 270 | Function FindInterfaceByName(Const AName : String) : TDBUSInterfaceDef; 271 | Function GetInterfaceByName(Const AName : String) : TDBUSInterfaceDef; 272 | Property Interfaces[AIndex : Integer] : TDBUSinterfaceDef Read GetI Write SetI; default; 273 | end; 274 | 275 | { TDBUSNodeItem } 276 | TDBUSNodes = Class; 277 | 278 | TDBUSNodeItem = Class(TDBUSNamedItem) 279 | private 280 | FInterfaces: TDBUSInterfaces; 281 | FNodes: TDBUSNodes; 282 | procedure SetInterfaces(const AValue: TDBUSInterfaces); 283 | procedure SetNodes(const AValue: TDBUSNodes); 284 | Public 285 | Constructor Create(ACollection: TCollection); override; 286 | Destructor Destroy; override; 287 | Procedure Clear; 288 | Property Interfaces : TDBUSInterfaces Read FInterfaces Write SetInterfaces; 289 | Property Nodes : TDBUSNodes Read FNodes Write SetNodes; 290 | end; 291 | 292 | { TDBUSNodes } 293 | 294 | TDBUSNodes =Class(TDBUSNamedCollection) 295 | private 296 | function GetN(AIndex : Integer): TDBUSNodeItem; 297 | procedure SetN(AIndex : Integer; const AValue: TDBUSNodeItem); 298 | Public 299 | Function AddNode(Const AName : String) : TDBUSNodeItem; 300 | Function FindNode(Const AName : String) : TDBUSNodeItem; 301 | Function GetNodeByName(Const AName : String) : TDBUSNodeItem; 302 | Property Nodes[AIndex : Integer] : TDBUSNodeItem Read GetN Write SetN; default; 303 | end; 304 | { TDBUSIntrospection } 305 | 306 | TUnknownInterfaceElementEvent = Procedure(Sender : TObject; AInterface : TDBUSInterfaceDef;AElement : TDOMElement); 307 | TUnknownMethodElementEvent = Procedure(Sender : TObject; AMethod : TDBUSMethodDef;AElement : TDOMElement); 308 | TUnknownSignalElementEvent = Procedure(Sender : TObject; ASignal : TDBUSSignalDef;AElement : TDOMElement); 309 | TUnknownPropertyElementEvent = Procedure(Sender : TObject; AProperty : TDBUSPropertyDef;AElement : TDOMElement); 310 | 311 | TDBUSIntrospection = Class(TComponent) 312 | private 313 | FOnUnknownInterfaceElement: TUnknownInterfaceElementEvent; 314 | FOnUnknownMethodElement: TUnknownMethodElementEvent; 315 | FOnUnknownPropertyElement: TUnknownPropertyElementEvent; 316 | FOnUnknownSignalElement: TUnknownSignalElementEvent; 317 | FRootNode: TDBUSNodeItem; 318 | FWarnings: TStrings; 319 | function GetInterfaces: TDBUSInterfaces; 320 | protected 321 | procedure ParseStructDef(var S: String; AVariable: TDBUSVarDef); 322 | procedure ParseDictDef(ADef: String; AVariable: TDBUSVarDef); 323 | procedure ParseVariableDef(var S: String; AVariable: TDBUSVarDef); 324 | procedure ParseNode(DBUSNode : TDBUSNodeItem; ANode: TDOMElement); 325 | procedure ParseVariable(AVariable: TDBUSVarDef; EVariable: TDOMelement); 326 | procedure ParseArgument(AArgument: TDBUSArgumentDef; EArgument: TDOMelement); 327 | procedure ParseInterface(Intf: TDBUSInterfaceDef; EIntf: TDOMelement); 328 | procedure ParseMethod(AMethod : TDBUSMethodDef; EMethod: TDOMelement); 329 | procedure ParseSignal(ASignal : TDBUSSignalDef; ESignal: TDOMelement); 330 | procedure ParseProperty(AProperty: TDBUSPropertyDef; EProperty: TDOMelement); 331 | Procedure Warn(Const Fmt : String; Args : Array of const); 332 | Public 333 | Constructor Create(AOwner : TComponent); override; 334 | Destructor Destroy; override; 335 | Procedure LoadFromFile(Const AFileName : String); 336 | Procedure LoadFromXML(Const XML : TXMLDocument); 337 | Property Interfaces : TDBUSInterfaces Read GetInterfaces; 338 | Property RootNode : TDBUSNodeItem Read FRootNode; 339 | Property OnUnknownInterfaceElement : TUnknownInterfaceElementEvent Read FOnUnknownInterfaceElement Write FOnUnknownInterfaceElement; 340 | Property OnUnknownMethodElement : TUnknownMethodElementEvent Read FOnUnknownMethodElement Write FOnUnknownMethodElement; 341 | Property OnUnknownSignalElement : TUnknownSignalElementEvent Read FOnUnknownSignalElement Write FOnUnknownSignalElement; 342 | Property OnUnknownPropertyElement : TUnknownPropertyElementEvent Read FOnUnknownPropertyElement Write FOnUnknownPropertyElement; 343 | Property Warnings : TStrings Read FWarnings; 344 | end; 345 | 346 | TDBUSCodeOption = (dcoGenerateInterface, // Generate interface declaration 347 | dcoGenerateProxy, // Generate proxy declaration 348 | dcoProxyHasInterface, // Proxy implements interface. 349 | dcoProxyUsesProtected, // Proxy methods are protected 350 | dcoUseFunction, // Use functions for methods with OUT parameter 351 | dcoIncludeSystemInterfaces, // Include system interfaces 352 | dcoLastPartInterfaceName); // InterfaceName is constructed from last part of DBUS name if none specified 353 | TDBUSCodeOptions = Set of TDBUSCodeOption; 354 | 355 | { TDBUSInterfaceCodeOptionItem } 356 | 357 | TDBUSInterfaceCodeOptionItem = Class(TDBUSNameditem) 358 | private 359 | FPascalName: String; 360 | FSkip: Boolean; 361 | public 362 | procedure Assign(Source : TPersistent); 363 | Published 364 | Property PascalName : String Read FPascalName Write FPascalName; 365 | Property Skip : Boolean Read FSkip Write FSkip; 366 | end; 367 | 368 | { TDBUSInterfaceCodeOptions } 369 | 370 | TDBUSInterfaceCodeOptions = Class(TDBUSNamedCollection) 371 | private 372 | function GetO(AIndex : Integer): TDBUSInterfaceCodeOptionItem; 373 | procedure SetO(AIndex : Integer; const AValue: TDBUSInterfaceCodeOptionItem); 374 | Public 375 | Function AddOption(AName : String) : TDBUSInterfaceCodeOptionItem; 376 | Property CodeOptions[AIndex : Integer] : TDBUSInterfaceCodeOptionItem Read GetO Write SetO; default; 377 | end; 378 | 379 | { TDBUSCodeGenerator } 380 | 381 | TDBUSCodeGenerator = Class(TComponent) 382 | private 383 | FInterfaceOptions: TDBUSInterfaceCodeOptions; 384 | FOptions: TDBUSCodeOptions; 385 | FReserved : TStringList; 386 | FKeyWordPrefix: String; 387 | FUnitName: String; 388 | FCurrentIndent : Integer; 389 | Protected 390 | // Source code generation auxiliary routines 391 | function GetIndent : string; 392 | Procedure AddLine(Source : TStrings; Const ALine : String); 393 | Procedure AddIndentLine(Source : TStrings; Const ALine : String); 394 | Procedure DoIndent; 395 | Procedure DoUnIndent; 396 | procedure AddVarDecl(Source: TStrings; AName, AType: String; First: Boolean = False); 397 | procedure Procbegin(Source: Tstrings); 398 | procedure ProcEnd(Source: Tstrings); 399 | Procedure GetKeyWords(List : TStrings); virtual; 400 | // DBUS specifics 401 | Function CreateDeclaration(Intf : TDBUSInterfaceDef) : boolean; 402 | Function GetInterfaceName(Intf : TDBUSInterfaceDef) : String; 403 | procedure CheckDictClassDef(AIntfName: String; Method: TDBUSMethodDef; Source: TStrings); 404 | procedure GenerateDictClassDef(A: TDBUSVarDef; Source: TStrings); 405 | procedure CheckDictClassImpl(AIntfName: String; Method: TDBUSMethodDef; Source: TStrings); 406 | procedure GenerateDictClassImpl(A: TDBUSVarDef; Source: TStrings); 407 | procedure GenerateDictItemClassImpl(A: TDBUSVarDef; Source: TStrings); 408 | procedure SetInterfaceOptions(const AValue: TDBUSInterfaceCodeOptions); 409 | procedure WritePassMethodInParams(const MsgVarName: String; Args: TDBUSArguments; Source: TStrings); 410 | procedure WriteReadMethodOutParams(const MsgVarName: String; Args: TDBUSArguments; Source: TStrings); 411 | function DBUSPropertyGetterName(AProperty: TDBUSPropertyDef): String; 412 | function DBUSPropertySetterName(AProperty: TDBUSPropertyDef): String; 413 | procedure GenerateUnitImplementation(Intf: TDBUSInterfaces; Source: TStrings ); 414 | procedure GenerateUnitInterface(Intf: TDBUSInterfaces; Source: TStrings); 415 | procedure GeneratePropertyGetterProxyImplementation(const AClassName: String; AIntf: TDBUSInterfaceDef; AProp: TDBUSPropertyDef;Source: TStrings); 416 | procedure GeneratePropertySetterProxyImplementation(const AClassName: String; AIntf: TDBUSInterfaceDef; AProp: TDBUSPropertyDef; Source: TStrings); 417 | procedure GenerateProxyMethodImplementation(const AClassName: String; AIntf: TDBUSInterfaceDef; AMethod: TDBUSMethodDef; Source: TStrings); 418 | Public 419 | Constructor Create(AOwner : TComponent); override; 420 | Destructor Destroy; override; 421 | // Create valid pascal identifier 422 | Function CreateCleanIdentifier(Const AName : String) : String; 423 | // Create type definition 424 | Function DBUSTypeDef(Const AType : TDBUSVarDef) : String; 425 | // Create Method argument definition 426 | Function DBUSArgToParamDef(Const Arg : TDBUSArgumentDef; IsResult : Boolean) : String; 427 | // Create method declaration. No ending semicolon. 428 | function GenerateMethodDeclaration(const AClassname: String; AMethod: TDBUSMethodDef): String; virtual; 429 | // Create property getter declaration. No ending semicolon. 430 | function GenerateGetPropertyDeclaration(const AClassName: String; AProperty: TDBUSPropertyDef): String; 431 | // Create property setter declaration. No ending semicolon. 432 | function GenerateSetPropertyDeclaration(const AClassName: String; AProperty: TDBUSPropertyDef): String; 433 | // Create property declaration. No ending semicolon. 434 | function GeneratePropertyDeclaration(const AClassName: String; AProperty: TDBUSPropertyDef): String; 435 | // Add method implementation to source. 436 | Procedure GenerateMethodDefinition(Const AClassname : String; AMethod : TDBUSMethodDef; Source : TStrings); 437 | // Add Interface definition to source. 438 | Procedure GenerateInterfaceDefinition(Intf : TDBUSInterfaceDef; Source : TStrings); 439 | // Add proxy definition to source. 440 | Procedure GenerateProxyDefinition(Intf : TDBUSInterfaceDef; Source : TStrings); 441 | // Add proxy implementation to source. 442 | procedure GenerateProxyImplementation(AIntf: TDBUSInterfaceDef; Source: TStrings); 443 | // Generate complete unit. 444 | Procedure GenerateUnit(Intf : TDBUSInterfaces; Source : TStrings); 445 | // Generate complete unit and save to file. 446 | Procedure SaveUnitToFile(Intf : TDBUSInterfaces; Const AFileName : String); 447 | Published 448 | // Prefix to use when keywords are encountered as names. 449 | Property KeyWordPrefix : String Read FKeyWordPrefix Write FKeyWordPrefix; 450 | // Options controlling the output. 451 | Property Options : TDBUSCodeOptions Read FOptions Write FOptions; 452 | // Unit name for unit generation. 453 | Property UnitName : String Read FUnitName Write FUnitName; 454 | // List of interfaces to treat. If non-empty, a declaration is generated only for those that are listed. 455 | // If Skip=true for one of these in here, then it is also not generated 456 | Property InterfaceOptions : TDBUSInterfaceCodeOptions Read FInterfaceOptions Write SetInterfaceOptions; 457 | end; 458 | 459 | EDBUSIntrospect = Class(Exception); 460 | 461 | Function CharToDBUSDataType(C : Char) : TDBUSDataType; 462 | 463 | Const 464 | DefaultCodeOptions = [dcogenerateInterface,dcogenerateProxy,dcoUseFunction]; 465 | 466 | implementation 467 | 468 | Resourcestring 469 | 470 | SErrUnknown = 'Unknown %s : %s'; 471 | SArgument = 'argument'; 472 | SMethod = 'method'; 473 | SSignal = 'signal'; 474 | SInterface = 'interface'; 475 | SProperty = 'property'; 476 | SVariable = 'variable'; 477 | SNode = 'node'; 478 | 479 | SErrNoRootNode = 'Root node "node" not found.'; 480 | SWarnUnknownElement = 'Unknown element "%s" in definition of %s "%s". Ignoring'; 481 | SWarnUnknownTypeSignature = 'Unknown type signature : %s'; 482 | SWarnWrongDictType = 'Wrong dict type definition : %s'; 483 | 484 | Function CharToDBUSDataType(C : Char) : TDBUSDataType; 485 | 486 | begin 487 | Result:=High(TDBUSDataType); 488 | While (Result>ddtUnknown) and (DBUSTypeNames[Result]<>C) do 489 | Result:=Pred(Result); 490 | end; 491 | 492 | Procedure DBUSError(Msg : String; Args : Array of const); 493 | 494 | begin 495 | Raise EDBUSIntrospect.CreateFmt(Msg,Args); 496 | end; 497 | 498 | { TDBUSNamedCollection } 499 | 500 | function TDBUSNamedCollection.GetN(AIndex : Integer): TDBUSNamedItem; 501 | begin 502 | Result:=TDBUSNamedItem(Items[AIndex]); 503 | end; 504 | 505 | procedure TDBUSNamedCollection.SetN(AIndex : Integer; 506 | const AValue: TDBUSNamedItem); 507 | begin 508 | Items[AIndex]:=AValue; 509 | end; 510 | 511 | function TDBUSNamedCollection.IndexOfName(const AName: String): Integer; 512 | begin 513 | Result:=Count-1; 514 | While (Result>=0) and (CompareText(AName,GetN(Result).Name)<>0) do 515 | Dec(Result); 516 | end; 517 | 518 | { TDBUSArguments } 519 | 520 | function TDBUSArguments.GetA(AIndex : Integer): TDBUSArgumentDef; 521 | begin 522 | Result:=TDBUSArgumentDef(Items[AIndex]); 523 | end; 524 | 525 | procedure TDBUSArguments.SetA(AIndex : Integer; const AValue: TDBUSArgumentDef); 526 | begin 527 | Items[AIndex]:=AValue; 528 | end; 529 | 530 | function TDBUSArguments.AddArgument(const AName: String): TDBUSArgumentDef; 531 | begin 532 | Result:=Add as TDBUSArgumentDef; 533 | Result.FName:=AName; 534 | end; 535 | 536 | function TDBUSArguments.FindArgumentByName(const AName: String 537 | ): TDBUSArgumentDef; 538 | 539 | Var 540 | I : Integer; 541 | 542 | begin 543 | I:=IndexOfName(AName); 544 | If I=-1 then 545 | Result:=Nil 546 | else 547 | Result:=GetA(I); 548 | end; 549 | 550 | function TDBUSArguments.GetArgumentByName(const AName: String 551 | ): TDBUSArgumentDef; 552 | begin 553 | Result:=FindArgumentByName(AName); 554 | If (result=Nil) then 555 | DBUSError(SErrUnknown,[SArgument,AName]); 556 | end; 557 | 558 | { TDBusArgumentDef } 559 | 560 | procedure TDBusArgumentDef.Assign(Source: TPersistent); 561 | Var 562 | A : TDBusArgumentDef; 563 | begin 564 | inherited Assign(Source); 565 | If (Source is TDBusArgumentDef) then 566 | begin 567 | A:=Source as TDBusArgumentDef; 568 | FDirection:=A.Direction; 569 | FStructType:=A.StructType; 570 | If A.HasAnnotations then 571 | Annotations.Assign(A.Annotations); 572 | end 573 | end; 574 | 575 | function TDBusArgumentDef.ArgName: String; 576 | begin 577 | Result:=Name; 578 | If Result='' then 579 | Result:='Arg'+IntToStr(Index+1); 580 | end; 581 | 582 | { TDBUSArgumentsDef } 583 | 584 | procedure TDBUSMethodDef.SetArguments(const AValue: TDBUSArguments); 585 | begin 586 | if FArguments=AValue then exit; 587 | FArguments.Assign(AValue); 588 | end; 589 | 590 | constructor TDBUSMethodDef.Create(ACollection: TCollection); 591 | begin 592 | inherited Create(ACollection); 593 | FArguments:=TDBUSArguments.Create(TDBUSArgumentDef); 594 | end; 595 | 596 | destructor TDBUSMethodDef.Destroy; 597 | begin 598 | FreeAndNil(FArguments); 599 | inherited Destroy; 600 | end; 601 | 602 | procedure TDBUSMethodDef.Assign(Source: TPersistent); 603 | 604 | Var 605 | M : TDBUSMethodDef; 606 | 607 | begin 608 | if (Source is TDBUSMethodDef) then 609 | begin 610 | M:=Source as TDBUSMethodDef; 611 | FName:=M.Name; 612 | If M.HasAnnotations then 613 | Annotations:=M.Annotations; 614 | FArguments.Assign(M.Arguments); 615 | end 616 | else 617 | inherited Assign(Source); 618 | end; 619 | 620 | { TDBUSMethods } 621 | 622 | function TDBUSMethods.GetM(AIndex : Integer): TDBUSMethodDef; 623 | begin 624 | Result:=TDBUSMethodDef(Items[Aindex]); 625 | end; 626 | 627 | procedure TDBUSMethods.SetM(AIndex : Integer; const AValue: TDBUSMethodDef); 628 | begin 629 | Items[AIndex]:=AValue; 630 | end; 631 | 632 | function TDBUSMethods.AddMethod(const AName: String): TDBUSMethodDef; 633 | begin 634 | Result:=add as TDBUSMethodDef; 635 | Result.FName:=AName; 636 | end; 637 | 638 | function TDBUSMethods.FindMethodByName(const AName: String): TDBUSMethodDef; 639 | 640 | Var 641 | I : integer; 642 | 643 | begin 644 | I:=IndexOfName(Aname); 645 | If (I=-1) then 646 | Result:=Nil 647 | else 648 | Result:=GetM(I); 649 | end; 650 | 651 | function TDBUSMethods.GetMethodByName(const AName: String): TDBUSMethodDef; 652 | begin 653 | Result:=FindMethodByName(AName); 654 | If (Result=Nil) then 655 | DBUSError(SErrUnknown,[SMethod,AName]); 656 | end; 657 | 658 | { TDBUSSignals } 659 | 660 | function TDBUSSignals.GetS(AIndex: Integer): TDBUSSignalDef; 661 | begin 662 | Result:=TDBUSSignalDef(Items[AIndex]); 663 | end; 664 | 665 | procedure TDBUSSignals.Sets(AIndex: Integer; const AValue: TDBUSSignalDef); 666 | begin 667 | Items[AIndex]:=AValue; 668 | end; 669 | 670 | function TDBUSSignals.AddSignal(const AName: String): TDBUSSignalDef; 671 | begin 672 | Result:=Add as TDBUSSignalDef; 673 | Result.FName:=AName; 674 | end; 675 | 676 | function TDBUSSignals.FindSignalByName(const AName: String): TDBUSSignalDef; 677 | 678 | Var 679 | I : integer; 680 | 681 | begin 682 | I:=IndexOfName(AName); 683 | If I=-1 then 684 | Result:=Nil 685 | else 686 | Result:=GetS(I); 687 | end; 688 | 689 | function TDBUSSignals.GetSignalByName(const AName: String): TDBUSSignalDef; 690 | begin 691 | Result:=FindSignalByname(AName); 692 | If (Result=Nil) then 693 | DBUSError(SErrUnknown,[SSignal,AName]); 694 | end; 695 | 696 | { TDBUSInterfaceDef } 697 | 698 | procedure TDBUSInterfaceDef.SetMethods(const AValue: TDBUSMethods); 699 | begin 700 | if FMethods=AValue then exit; 701 | FMethods.Assign(AValue); 702 | end; 703 | 704 | procedure TDBUSInterfaceDef.SetProperties(const AValue: TDBUSProperties); 705 | begin 706 | if FProperties=AValue then exit; 707 | FProperties.Assign(AValue); 708 | end; 709 | 710 | procedure TDBUSInterfaceDef.SetSignals(const AValue: TDBUSSignals); 711 | begin 712 | if FSignals=AValue then exit; 713 | FSignals.Assign(AValue); 714 | end; 715 | 716 | constructor TDBUSInterfaceDef.Create(ACollection: TCollection); 717 | begin 718 | inherited Create(ACollection); 719 | FMethods:=TDBUSMethods.Create(TDBUSMethodDef); 720 | FSignals:=TDBUSSignals.Create(TDBUSSignalDef); 721 | FProperties:=TDBUSProperties.Create(TDBUSPropertyDef); 722 | end; 723 | 724 | destructor TDBUSInterfaceDef.Destroy; 725 | begin 726 | FreeAndNil(FProperties); 727 | FreeAndNil(FSignals); 728 | FreeAndNil(FMethods); 729 | inherited Destroy; 730 | end; 731 | 732 | { TDBUSInterfaces } 733 | 734 | function TDBUSInterfaces.GetI(AIndex : Integer): TDBUSinterfaceDef; 735 | begin 736 | Result:=TDBUSinterfaceDef(Items[AIndex]); 737 | end; 738 | 739 | procedure TDBUSInterfaces.SetI(AIndex : Integer; const AValue: TDBUSinterfaceDef 740 | ); 741 | begin 742 | Items[AIndex]:=AValue; 743 | end; 744 | 745 | function TDBUSInterfaces.AddInterface(const AName: String): TDBUSInterfaceDef; 746 | begin 747 | Result:=Add as TDBUSInterfaceDef; 748 | Result.FName:=AName; 749 | end; 750 | 751 | function TDBUSInterfaces.FindInterfaceByName(const AName: String 752 | ): TDBUSInterfaceDef; 753 | Var 754 | I : Integer; 755 | 756 | begin 757 | I:=IndexOfName(AName); 758 | If (I=-1) then 759 | Result:=Nil 760 | else 761 | Result:=GetI(I); 762 | end; 763 | 764 | function TDBUSInterfaces.GetInterfaceByName(const AName: String 765 | ): TDBUSInterfaceDef; 766 | begin 767 | Result:=FindInterfaceByName(AName); 768 | If Result=Nil then 769 | DBUSError(SErrUnknown,[SInterface,AName]) 770 | 771 | end; 772 | 773 | { TDBUSIntrospection } 774 | 775 | constructor TDBUSIntrospection.Create(AOwner: TComponent); 776 | begin 777 | inherited Create(AOwner); 778 | FWarnings:=TStringList.Create; 779 | FRootNode:=TDBUSNodeItem.Create(Nil); 780 | end; 781 | 782 | destructor TDBUSIntrospection.Destroy; 783 | begin 784 | FreeAndNil(FRootNode); 785 | FreeAndNil(FWarnings); 786 | inherited Destroy; 787 | end; 788 | 789 | procedure TDBUSIntrospection.LoadFromFile(const AFileName: String); 790 | 791 | Var 792 | XML : TXMLDocument; 793 | 794 | begin 795 | ReadXMLFile(XML,AFileName); 796 | try 797 | LoadFromXML(XML); 798 | finally 799 | XML.Free 800 | end; 801 | end; 802 | 803 | function TDBUSIntrospection.GetInterfaces: TDBUSInterfaces; 804 | begin 805 | Result:=FRootNode.Interfaces; 806 | end; 807 | 808 | Procedure TDBUSIntrospection.ParseStructDef(Var S : String; AVariable: TDBUSVarDef); 809 | 810 | Var 811 | it : TDBUSVarDef; 812 | 813 | begin 814 | Repeat 815 | IT:=AVariable.Structdef.AddVariable('field'+IntToStr(AVariable.Structdef.Count+1)); 816 | ParseVariableDef(S,it); 817 | Delete(S,1,1); 818 | Until S[1]=')'; 819 | Delete(S,1,1); 820 | end; 821 | 822 | Procedure TDBUSIntrospection.ParseVariableDef(Var S : String; AVariable: TDBUSVarDef); 823 | 824 | Var 825 | C : char; 826 | 827 | begin 828 | If (Length(S)=0) then 829 | AVariable.DataType:=ddtUnknown 830 | else 831 | begin 832 | AVariable.DataType:=CharToDBUSDataType(S[1]); 833 | If (AVariable.DataType=ddtArray) and (Length(S)>1) then 834 | AVariable.ElementType:=CharToDBUSDataType(S[2]); 835 | end; 836 | if (AVariable.DataType=ddtUnknown) 837 | or ((AVariable.DataType=ddtArray) and (AVariable.ElementType=ddtUnknown)) then 838 | begin 839 | if (AVariable.DataType=ddtArray) then 840 | begin 841 | C:=S[2]; 842 | Delete(S,1,2); 843 | end 844 | else 845 | begin 846 | C:=S[1]; 847 | Delete(S,1,1); 848 | end; 849 | Case C of 850 | '(' : begin 851 | if (AVariable.DataType=ddtUnknown) then 852 | AVariable.DataType:=ddtStruct 853 | else 854 | AVariable.ElementType:=ddtStruct; 855 | ParseStructDef(S,AVariable); 856 | end; 857 | '{' : begin 858 | if (AVariable.DataType=ddtUnknown) then 859 | AVariable.DataType:=ddtDict 860 | else 861 | AVariable.ElementType:=ddtDict; 862 | ParseDictDef(S,AVariable); 863 | end; 864 | else 865 | Warn(SWarnUnknownTypeSignature,[C]); 866 | end; 867 | end; 868 | end; 869 | 870 | Procedure TDBUSIntrospection.ParseDictDef(ADef : String; AVariable: TDBUSVarDef); 871 | 872 | Var 873 | C : Char; 874 | DD : TDBUSDictDef; 875 | 876 | begin 877 | If (Length(ADef)<>3) or (ADef[3]<>'}') then 878 | Warn(SWarnWrongDictType,[ADef]); 879 | DD[0]:=CharToDBUSDataType(ADef[1]); 880 | DD[1]:=CharToDBUSDataType(ADef[2]); 881 | AVariable.DictDef:=DD; 882 | if (AVariable.DictDef[1]=ddtUnknown) then 883 | begin 884 | C:=ADef[1]; 885 | Delete(ADef,1,1); 886 | if (C='(') then 887 | ParseStructDef(ADef,AVariable); 888 | end; 889 | end; 890 | 891 | procedure TDBUSIntrospection.ParseVariable(AVariable: TDBUSVarDef; 892 | EVariable: TDOMelement); 893 | 894 | Var 895 | C : Char; 896 | S : String; 897 | 898 | begin 899 | AVariable.Name:=EVariable['name']; 900 | AVariable.ElementType:=ddtUnknown; 901 | S:=EVariable['type']; 902 | ParseVariableDef(S,AVariable); 903 | end; 904 | 905 | procedure TDBUSIntrospection.ParseArgument(AArgument: TDBUSArgumentDef; EArgument: TDOMelement); 906 | 907 | Var 908 | S : String; 909 | 910 | begin 911 | ParseVariable(AArgument,EArgument); 912 | S:=EArgument['direction']; 913 | if s='in' then 914 | AArgument.Direction:=adIn 915 | else if s='out' then 916 | AArgument.Direction:=adOut 917 | else 918 | AArgument.Direction:=adNone; 919 | end; 920 | 921 | procedure TDBUSIntrospection.ParseInterface(Intf: TDBUSInterfaceDef; EIntf : TDOMelement); 922 | 923 | Var 924 | N : TDOMNode; 925 | E : TDOMElement; 926 | M : TDBUSMethodDef; 927 | S : TDBUSSignalDef; 928 | P : TDBUSPropertyDef; 929 | 930 | begin 931 | N:=EIntf.FirstChild; 932 | While (N<>Nil) do 933 | begin 934 | If N.NodeType=ELEMENT_NODE then 935 | begin 936 | E:=TDOMElement(N); 937 | If (E.NodeName='method') then 938 | begin 939 | M:=Intf.Methods.AddMethod(E['name']); 940 | ParseMethod(M,E); 941 | end 942 | else if (E.NodeName='signal') then 943 | begin 944 | S:=Intf.Signals.AddSignal(E['name']); 945 | ParseSignal(S,E); 946 | end 947 | else if (E.NodeName='property') then 948 | begin 949 | P:=Intf.Properties.AddProperty(E['name']); 950 | ParseProperty(P,E); 951 | end 952 | else if (E.NodeName='annotation') then 953 | Intf.Annotations.Add(E['name']+'='+E['value']) 954 | else 955 | If Assigned(FOnUnknownInterfaceElement) then 956 | FOnUnknownInterfaceElement(Self,Intf,E) 957 | else 958 | Warn(SWarnUnknownElement,[E.NodeName,SInterface,Intf.Name]) 959 | end; 960 | N:=N.NextSibling; 961 | end; 962 | end; 963 | 964 | procedure TDBUSIntrospection.ParseMethod(AMethod: TDBUSMethodDef; 965 | EMethod: TDOMelement); 966 | 967 | Var 968 | E : TDOMElement; 969 | N : TDOMNode; 970 | A : TDBUSArgumentDef; 971 | 972 | begin 973 | N:=EMethod.FirstChild; 974 | While (N<>Nil) do 975 | begin 976 | If (N.NodeType=ELEMENT_NODE) then 977 | begin 978 | E:=TDOMElement(N); 979 | if (E.NodeName='arg') then 980 | begin 981 | A:=AMethod.Arguments.AddArgument(E['name']); 982 | ParseArgument(A,E); 983 | end 984 | else if (E.NodeName='annotation') then 985 | AMethod.Annotations.Add(E['name']+'='+E['value']) 986 | else 987 | If Assigned(FOnUnknownMethodElement) then 988 | FOnUnknownMethodElement(Self,AMethod,E) 989 | else 990 | Warn(SWarnUnknownElement,[E.NodeName,SMethod,AMethod.Name]) 991 | end; 992 | N:=N.NextSibling; 993 | end; 994 | end; 995 | 996 | procedure TDBUSIntrospection.ParseProperty(AProperty: TDBUSPropertyDef; 997 | EProperty: TDOMelement); 998 | 999 | Var 1000 | E : TDOMElement; 1001 | N : TDOMNode; 1002 | A : TDBUSArgumentDef; 1003 | S : String; 1004 | begin 1005 | AProperty.ElementType:=ddtUnknown; 1006 | S:=EProperty['type']; 1007 | ParseVariableDef(S,AProperty); 1008 | N:=EProperty.FirstChild; 1009 | While (N<>Nil) do 1010 | begin 1011 | If (N.NodeType=ELEMENT_NODE) then 1012 | begin 1013 | E:=TDOMElement(N); 1014 | if (E.NodeName='annotation') then 1015 | AProperty.Annotations.Add(E['name']+'='+E['value']) 1016 | else 1017 | If Assigned(FOnUnknownPropertyElement) then 1018 | FOnUnknownPropertyElement(Self,AProperty,E) 1019 | else 1020 | Warn(SWarnUnknownElement,[E.NodeName,SProperty,AProperty.Name]) 1021 | end; 1022 | N:=N.NextSibling; 1023 | end; 1024 | end; 1025 | 1026 | procedure TDBUSIntrospection.ParseSignal(ASignal: TDBUSSignalDef; 1027 | ESignal: TDOMelement); 1028 | Var 1029 | E : TDOMElement; 1030 | N : TDOMNode; 1031 | V : TDBUSVarDef; 1032 | 1033 | begin 1034 | N:=ESignal.FirstChild; 1035 | While (N<>Nil) do 1036 | begin 1037 | If (N.NodeType=ELEMENT_NODE) then 1038 | begin 1039 | E:=TDOMElement(N); 1040 | if (E.NodeName='arg') then 1041 | begin 1042 | V:=ASignal.Variables.Addvariable(E['name']); 1043 | ParseVariable(V,E); 1044 | end 1045 | else if (E.NodeName='annotation') then 1046 | ASignal.Annotations.Add(E['name']+'='+E['value']) 1047 | else 1048 | If Assigned(FOnUnknownSignalElement) then 1049 | FOnUnknownSignalElement(Self,ASignal,E) 1050 | else 1051 | Warn(SWarnUnknownElement,[E.NodeName,SSignal,ASignal.Name]) 1052 | end; 1053 | N:=N.NextSibling; 1054 | end; 1055 | end; 1056 | 1057 | 1058 | procedure TDBUSIntrospection.Warn(const Fmt: String; Args: array of const); 1059 | begin 1060 | FWarnings.Add(Format(Fmt,Args)); 1061 | end; 1062 | 1063 | procedure TDBUSIntrospection.ParseNode(DBUSNode : TDBUSNodeItem; ANode : TDOMElement); 1064 | 1065 | Var 1066 | N : TDOMNode; 1067 | I : TDBUSInterfaceDef; 1068 | No : TDBUSNOdeItem; 1069 | E : TDOMElement; 1070 | 1071 | begin 1072 | N:=ANode.FirstChild; 1073 | While (N<>Nil) do 1074 | begin 1075 | If (N.NodeType=ELEMENT_NODE) and (TDomElement(N).NodeName='interface') then 1076 | begin 1077 | E:=TDOMElement(N); 1078 | ParseInterface(DBUSNode.Interfaces.AddInterface(E['name']),E); 1079 | end 1080 | else If (N.NodeType=ELEMENT_NODE) and (TDomElement(N).NodeName='node') then 1081 | begin 1082 | E:=TDOMElement(N); 1083 | No:=DBUSNode.Nodes.AddNode(E['name']); 1084 | ParseNode(No,E); 1085 | end; 1086 | N:=N.NextSibling; 1087 | end; 1088 | end; 1089 | 1090 | procedure TDBUSIntrospection.LoadFromXML(const XML: TXMLDocument); 1091 | 1092 | Var 1093 | E : TDOMElement; 1094 | 1095 | begin 1096 | FRootNode.Clear; 1097 | FWarnings.Clear; 1098 | E:=XML.DocumentElement; 1099 | If (E.NodeName<>'node') then 1100 | DBUSError(SErrNoRootNode,[]); 1101 | ParseNode(FRootNode,E); 1102 | end; 1103 | 1104 | 1105 | { TDBUSVarDef } 1106 | 1107 | function TDBUSVarDef.GetStructDef: TDBUSVariables; 1108 | begin 1109 | If not Assigned(FStruct) then 1110 | FStruct:=TDBUSVariables.Create(TDBUSVarDef); 1111 | Result:=FStruct; 1112 | end; 1113 | 1114 | procedure TDBUSVarDef.SetStructDef(const AValue: TDBUSVariables); 1115 | begin 1116 | StructDef.Assign(Avalue); 1117 | end; 1118 | 1119 | procedure TDBUSVarDef.Assign(Source: TPersistent); 1120 | 1121 | Var 1122 | V : TDBUSVarDef; 1123 | 1124 | begin 1125 | if (Source is TDBUSVarDef) then 1126 | begin 1127 | v:=Source as TDBUSVarDef; 1128 | FName:=V.Name; 1129 | FDataType:=V.DataType; 1130 | FElementType:=V.ElementType; 1131 | FDictDef:=V.FDictDef; 1132 | FStructType:=V.StructType; 1133 | If Assigned(V.FStruct) then 1134 | StructDef:=V.FStruct; 1135 | end 1136 | else 1137 | inherited Assign(Source); 1138 | end; 1139 | 1140 | { TDBUSPropertyDef } 1141 | 1142 | procedure TDBUSPropertyDef.Assign(Source: TPersistent); 1143 | 1144 | Var 1145 | P : TDBUSPropertyDef; 1146 | 1147 | begin 1148 | inherited Assign(Source); 1149 | if (Source is TDBUSPropertyDef) then 1150 | begin 1151 | P:=Source as TDBUSPropertyDef; 1152 | FName:=P.Name; 1153 | If P.HasAnnotations then 1154 | Annotations:=P.Annotations; 1155 | FAccess:=P.Access; 1156 | end; 1157 | end; 1158 | 1159 | { TDBUSProperties } 1160 | 1161 | function TDBUSProperties.GetA(AIndex: Integer): TDBUSPropertyDef; 1162 | begin 1163 | Result:=TDBUSPropertyDef(Items[AIndex]); 1164 | end; 1165 | 1166 | procedure TDBUSProperties.SetA(AIndex: Integer; const AValue: TDBUSPropertyDef); 1167 | begin 1168 | Items[AIndex]:=AValue; 1169 | end; 1170 | 1171 | function TDBUSProperties.AddProperty(const AName: String): TDBUSPropertyDef; 1172 | begin 1173 | Result:=Add as TDBUSPropertyDef; 1174 | Result.Name:=AName; 1175 | end; 1176 | 1177 | function TDBUSProperties.FindPropertyByName(const AName: String): TDBUSPropertyDef; 1178 | 1179 | Var 1180 | I : integer; 1181 | 1182 | begin 1183 | I:=IndexOfName(AName); 1184 | If (I=-1) then 1185 | Result:=Nil 1186 | else 1187 | Result:=GetA(I); 1188 | end; 1189 | 1190 | function TDBUSProperties.GetPropertyByName(const AName: String 1191 | ): TDBUSPropertyDef; 1192 | begin 1193 | Result:=FindPropertyByName(Aname); 1194 | If (Result=Nil) then 1195 | DBUSError(SerrUnknown,[SProperty,AName]); 1196 | end; 1197 | 1198 | { TDBUSVariables } 1199 | 1200 | function TDBUSVariables.GetV(AIndex: Integer): TDBUSVarDef; 1201 | begin 1202 | Result:=TDBUSVarDef(Items[AIndex]); 1203 | end; 1204 | 1205 | procedure TDBUSVariables.SetV(AIndex: Integer; const AValue: TDBUSVarDef); 1206 | begin 1207 | Items[AIndex]:=AValue; 1208 | end; 1209 | 1210 | function TDBUSVariables.AddVariable(const AName: String): TDBUSVarDef; 1211 | begin 1212 | Result:=Add as TDBUSVarDef; 1213 | Result.FName:=Aname; 1214 | end; 1215 | 1216 | function TDBUSVariables.FindVariableByName(const AName: String): TDBUSVarDef; 1217 | 1218 | Var 1219 | I : Integer; 1220 | 1221 | begin 1222 | I:=IndexOfName(AName); 1223 | If (I=-1) then 1224 | Result:=Nil 1225 | else 1226 | Result:=GetV(I); 1227 | end; 1228 | 1229 | function TDBUSVariables.GetVariableByName(const AName: String): TDBUSVarDef; 1230 | 1231 | 1232 | begin 1233 | Result:=FindVariableByName(AName); 1234 | If (Result=Nil) then 1235 | DBUSError(SErrUnknown,[SVariable,AName]) 1236 | end; 1237 | 1238 | { TDBUSSignalDef } 1239 | 1240 | procedure TDBUSSignalDef.SetVariables(const AValue: TDBUSVariables); 1241 | begin 1242 | Fvariables.Assign(AValue); 1243 | end; 1244 | 1245 | constructor TDBUSSignalDef.Create(ACollection: TCollection); 1246 | begin 1247 | inherited Create(ACollection); 1248 | FVariables:=TDBUSVariables.Create(TDBUSVarDef); 1249 | end; 1250 | 1251 | destructor TDBUSSignalDef.Destroy; 1252 | begin 1253 | FreeAndNil(FVariables); 1254 | inherited Destroy; 1255 | end; 1256 | 1257 | procedure TDBUSSignalDef.Assign(Source: TPersistent); 1258 | Var 1259 | S : TDBUSSignalDef; 1260 | begin 1261 | inherited Assign(Source); 1262 | If (source is TDBUSSignalDef) then 1263 | begin 1264 | S:=Source as TDBUSSignalDef; 1265 | FVariables.Assign(S.Variables); 1266 | If S.Hasannotations then 1267 | Annotations:=S.Annotations; 1268 | end; 1269 | end; 1270 | 1271 | { --------------------------------------------------------------------- 1272 | TDBUSCodeGenerator 1273 | ---------------------------------------------------------------------} 1274 | 1275 | function TDBUSCodeGenerator.GetIndent: string; 1276 | begin 1277 | Result:=StringOFchar(' ',FCurrentIndent) 1278 | end; 1279 | 1280 | procedure TDBUSCodeGenerator.AddLine(Source: TStrings; const ALine: String); 1281 | begin 1282 | If (ALine<>'') then 1283 | Source.Add(GetIndent+ALine) 1284 | else 1285 | Source.Add(''); 1286 | end; 1287 | 1288 | procedure TDBUSCodeGenerator.AddIndentLine(Source: TStrings; const ALine: String 1289 | ); 1290 | 1291 | begin 1292 | DoIndent; 1293 | AddLine(Source,Aline); 1294 | DoUnindent; 1295 | end; 1296 | 1297 | procedure TDBUSCodeGenerator.DoIndent; 1298 | begin 1299 | FCurrentIndent:=FCurrentIndent+2; 1300 | end; 1301 | 1302 | procedure TDBUSCodeGenerator.DoUnIndent; 1303 | begin 1304 | If FCurrentIndent>1 then 1305 | FCurrentIndent:=FCurrentIndent-2; 1306 | end; 1307 | 1308 | procedure TDBUSCodeGenerator.GetKeyWords(List: TStrings); 1309 | 1310 | 1311 | Const 1312 | KeyCount = 78; 1313 | Keys : Array[1..KeyCount] of String = ('absolute', 'and', 'array', 1314 | 'asm', 'begin', 'case', 'const','constructor','destructor','div','do', 1315 | 'downto','else','end','file','for','function','goto','if','implementation', 1316 | 'in','inherited','inline','interface','label','mod','nil','not','object', 1317 | 'of','on','operator','or','packed','procedure','program','record', 1318 | 'reintroduce', 'repeat','self','set','shl','shr','string','then','to', 1319 | 'type','unit','until','uses','var','while','with','xor','dispose','exit', 1320 | 'false','new','true','as','class','dispinterface','except','exports', 1321 | 'finalization','finally','initialization','inline','is','library','on', 1322 | 'out','packed','property','raise','resourcestring','threadvar','try'); 1323 | 1324 | Var 1325 | I : Integer; 1326 | 1327 | begin 1328 | For I:=1 to KeyCount do 1329 | List.add(Keys[i]); 1330 | end; 1331 | 1332 | constructor TDBUSCodeGenerator.Create(AOwner: TComponent); 1333 | begin 1334 | inherited Create(AOwner); 1335 | FReserved:=TStringList.Create; 1336 | GetKeyWords(FReserved); 1337 | FReserved.Sorted:=True; 1338 | FkeywordPrefix:='a'; 1339 | Foptions:=DefaultCodeOptions; 1340 | FInterfaceoptions:=TDBUSInterfaceCodeOptions.Create(TDBUSInterfaceCodeOptionItem); 1341 | end; 1342 | 1343 | destructor TDBUSCodeGenerator.Destroy; 1344 | begin 1345 | FreeAndNil(Freserved); 1346 | FreeAndNil(FInterfaceoptions); 1347 | inherited Destroy; 1348 | end; 1349 | 1350 | function TDBUSCodeGenerator.CreateCleanIdentifier(const AName: String): String; 1351 | 1352 | Const 1353 | AllowedChars = ['a'..'z','A'..'Z','0'..'9','_']; 1354 | 1355 | Var 1356 | I : Integer; 1357 | 1358 | begin 1359 | Result:=AName; 1360 | For I:=1 to Length(Result) do 1361 | If Not (Result[i] in AllowedChars) then 1362 | Result[i]:='_'; 1363 | If (Length(Result)>0) and (Result[1] in ['0'..'9']) then 1364 | Result:='_'+Result; 1365 | While (FReserved.IndexOf(Result)<>-1) do 1366 | Result:=FKeyWordPrefix+Result; 1367 | end; 1368 | 1369 | function TDBUSCodeGenerator.DBUSTypeDef(const AType: TDBUSVarDef): String; 1370 | 1371 | Var 1372 | I : Integer; 1373 | 1374 | begin 1375 | If (AType.StructType<>'') then 1376 | Result:=AType.StructType 1377 | else if (AType.DataType<>ddtArray) then 1378 | Result:=DBUSPascalTypeNames[AType.DataType] 1379 | else 1380 | Case AType.ElementType of 1381 | ddtDict : 1382 | begin 1383 | Result:='TDBUSDictionary'; 1384 | end; 1385 | ddtStruct : 1386 | begin 1387 | Result:='Array of Record '; 1388 | For I:=0 to AType.StructDef.Count-1 do 1389 | begin 1390 | Result:=Result+AType.StructDef[I].Name+' : '+DBUSTypeDef(AType.StructDef[I])+'; '; 1391 | end; 1392 | Result:=Result+'End'; 1393 | end; 1394 | else 1395 | Result:='T'+DBUSPascalTypeNames[AType.ElementType]+'Array'; 1396 | end; 1397 | end; 1398 | 1399 | function TDBUSCodeGenerator.DBUSArgToParamDef(const Arg: TDBUSArgumentDef; 1400 | IsResult: Boolean): String; 1401 | begin 1402 | If not IsResult then 1403 | Result:=CreateCleanIdentifier(Arg.ArgName); 1404 | Result:=Result+' : '+DBUSTypeDef(Arg); 1405 | end; 1406 | 1407 | Function TDBUSCodeGenerator.GenerateMethodDeclaration(Const AClassname : String; AMethod: TDBUSMethodDef) : String; 1408 | 1409 | Const 1410 | Prefixes : Array[Boolean] of string = ('Procedure','Function'); 1411 | 1412 | Var 1413 | I,La : Integer; 1414 | IsF : Boolean; 1415 | 1416 | begin 1417 | Isf:=dcoUseFunction in Options; 1418 | LA:=AMethod.Arguments.Count-1; 1419 | If IsF then 1420 | isf:=(La>=0) and (AMethod.Arguments[LA].Direction=adOut); 1421 | Result:=''; 1422 | For I:=0 to AMethod.Arguments.Count-1-Ord(Isf) do 1423 | begin 1424 | If (Result<>'') then 1425 | Result:=Result+';'; 1426 | Result:=Result+DBUSArgToParamDef(AMethod.Arguments[i],False); 1427 | end; 1428 | If (Result<>'') then 1429 | Result:=' ('+Result+')'; 1430 | Result:=CreateCleanIdentifier(AMethod.Name)+Result; 1431 | if IsF then 1432 | Result:=Result+DBUSArgToParamDef(AMethod.Arguments[LA],true); 1433 | If (AClassName<>'') then 1434 | Result:=AClassName+'.'+Result; 1435 | Result:=Prefixes[Isf]+' '+Result; 1436 | end; 1437 | 1438 | Procedure TDBUSCodeGenerator.GenerateMethodDefinition(Const AClassname : String; AMethod: TDBUSMethodDef; 1439 | Source: TStrings); 1440 | begin 1441 | AddLine(Source,GenerateMethodDeclaration(AClassName,AMethod)+';'); 1442 | end; 1443 | 1444 | Function TDBUSCodeGenerator.DBUSPropertyGetterName(AProperty : TDBUSPropertyDef) : String; 1445 | 1446 | begin 1447 | Result:='DBUSPropGet'+CreateCleanIdentifier(AProperty.Name); 1448 | end; 1449 | 1450 | Function TDBUSCodeGenerator.DBUSPropertySetterName(AProperty : TDBUSPropertyDef) : String; 1451 | 1452 | begin 1453 | Result:='DBUSPropSet'+CreateCleanIdentifier(AProperty.Name); 1454 | end; 1455 | 1456 | Function TDBUSCodeGenerator.GeneratePropertyDeclaration(Const AClassName : String; AProperty : TDBUSPropertyDef) : String; 1457 | 1458 | begin 1459 | Result:='property '+CreateCleanIdentifier(AProperty.Name)+' : '; 1460 | Result:=Result+DBUSTypeDef(AProperty); 1461 | If (Aproperty.Access in [dpaRead,dpaReadWrite]) then 1462 | Result:=Result+' read '+DBUSPropertyGetterName(AProperty); 1463 | If (Aproperty.Access in [dpaWrite,dpaReadWrite]) then 1464 | Result:=Result+' read '+DBUSPropertySetterName(AProperty); 1465 | end; 1466 | 1467 | Function TDBUSCodeGenerator.GenerateGetPropertyDeclaration(Const AClassName : String; AProperty : TDBUSPropertyDef) : String; 1468 | 1469 | begin 1470 | Result:=DBUSPropertyGetterName(AProperty); 1471 | If (AClassName<>'') then 1472 | Result:=AClassName+'.'+Result; 1473 | Result:='Function '+Result+' : '+DBUSTypeDef(AProperty); 1474 | end; 1475 | 1476 | Function TDBUSCodeGenerator.GenerateSetPropertyDeclaration(Const AClassName : String; AProperty : TDBUSPropertyDef) : String; 1477 | 1478 | begin 1479 | Result:=DBUSPropertyGetterName(AProperty); 1480 | If (AClassName<>'') then 1481 | Result:=AClassName+'.'+Result; 1482 | Result:='Procedure '+Result+'(AValue : '+DBUSTypeDef(AProperty)+')'; 1483 | end; 1484 | 1485 | procedure TDBUSCodeGenerator.GenerateDictClassDef(A : TDBUSVarDef; Source : TStrings); 1486 | 1487 | Var 1488 | S,DIN,NKT,NVT : String; 1489 | 1490 | begin 1491 | // Item class 1492 | AddLine(Source,''); 1493 | DIN:=A.StructType+'Item'; 1494 | AddLine(Source,Din+' = Class(TDBUSDictItem)'); 1495 | AddLine(Source,'Private'); 1496 | DoIndent; 1497 | NKT:=DBUSPascalTypeNames[A.DictDef[0]]; 1498 | NVT:=DBUSPascalTypeNames[A.DictDef[1]]; 1499 | AddLine(Source,'FKey : '+NKT+';'); 1500 | // Only simple or record types for the moment. 1501 | AddLine(Source,'FValue : '+NVT+';'); 1502 | DoUnindent; 1503 | AddLine(Source,'Public'); 1504 | DoIndent; 1505 | AddLine(Source,'Procedure Assign (Source: TPersistent); override;'); 1506 | AddLine(Source,'Procedure Load(I : TDBUSMessageIterator); override;'); 1507 | AddLine(Source,'Procedure Save(I : TDBUSMessageIterator); override;'); 1508 | AddLine(Source,'Property Key : '+NKT+' Read FKey Write FKey;'); 1509 | AddLine(Source,'Property Value : '+NVT+' Read FValue Write FValue;'); 1510 | DoUnindent; 1511 | AddLine(Source,'end;'); 1512 | AddLine(Source,''); 1513 | AddLine(Source,A.StructType+' = Class(TDBUSDictionary)'); 1514 | AddLine(Source,'Private'); 1515 | DoIndent; 1516 | AddLine(Source,'Function GetE(AIndex : Integer) : '+DIN+';'); 1517 | AddLine(Source,'Procedure SetE(AIndex : Integer; AValue : '+DIN+');'); 1518 | DoUnIndent; 1519 | AddLine(Source,'Public'); 1520 | DoIndent; 1521 | AddLine(Source,'Constructor CreateDict;'); 1522 | AddLine(Source,'Function AddElement : '+Din+';'); 1523 | AddLine(Source,'Function IndexOfKey(AKey : '+NKT+') : Integer;'); 1524 | AddLine(Source,'Function FindElement(AKey : '+NKT+') : '+Din+';'); 1525 | AddLine(Source,'Function ValueByKey(AKey : '+NKT+') : '+NVT+';'); 1526 | AddLine(Source,'Property Elements[AIndex : Integer] : '+DIN+' Read GetE Write SetE;Default;'); 1527 | DoUnIndent; 1528 | AddLine(Source,'end;'); 1529 | AddLine(Source,''); 1530 | end; 1531 | 1532 | procedure TDBUSCodeGenerator.CheckDictClassImpl(AIntfName: String; 1533 | Method: TDBUSMethodDef; Source: TStrings); 1534 | Var 1535 | I : integer; 1536 | A : TDBUSargumentDef; 1537 | 1538 | begin 1539 | For I:=0 to Method.Arguments.Count-1 do 1540 | begin 1541 | A:=Method.Arguments[i]; 1542 | If (A.DataType=ddtArray) and (A.ElementType=ddtDict) then 1543 | begin 1544 | GenerateDictItemClassImpl(A,Source); 1545 | GenerateDictClassImpl(A,Source); 1546 | end; 1547 | end; 1548 | end; 1549 | 1550 | procedure TDBUSCodeGenerator.AddVarDecl(Source : TStrings; AName,AType : String; First : Boolean = False); 1551 | 1552 | begin 1553 | if First then 1554 | begin 1555 | AddLine(Source,''); 1556 | AddLine(Source,'var'); 1557 | end; 1558 | DoIndent; 1559 | AddLine(Source,AName+' : '+AType+';'); 1560 | DoUnIndent; 1561 | end; 1562 | 1563 | procedure TDBUSCodeGenerator.Procbegin(Source : Tstrings); 1564 | 1565 | begin 1566 | AddLine(Source,''); 1567 | AddLine(Source,'begin'); 1568 | DoIndent; 1569 | end; 1570 | procedure TDBUSCodeGenerator.ProcEnd(Source : Tstrings); 1571 | 1572 | begin 1573 | DoUnIndent; 1574 | AddLine(Source,'end;'); 1575 | AddLine(Source,''); 1576 | AddLine(Source,''); 1577 | end; 1578 | 1579 | procedure TDBUSCodeGenerator.GenerateDictItemClassImpl(A: TDBUSVarDef; 1580 | Source: TStrings); 1581 | 1582 | Var 1583 | Din : String; 1584 | 1585 | begin 1586 | DIN:=A.StructType+'Item'; 1587 | AddLine(Source,'Procedure '+Din+'.Assign (Source: TPersistent);'); 1588 | AddVarDecl(Source,'I',Din,true); 1589 | ProcBegin(Source); 1590 | AddLine(Source,'if (Source is '+Din+') then'); 1591 | DoIndent; 1592 | AddLine(Source,'begin'); 1593 | AddLine(Source,'I:=Source as '+Din+';'); 1594 | AddLine(Source,'Fkey:=I.Key;'); 1595 | AddLine(Source,'FValue:=I.Value;'); 1596 | AddLine(Source,'end'); 1597 | DoUnIndent; 1598 | AddLine(Source,'else'); 1599 | DoIndent; 1600 | AddLine(Source,'Inherited;'); 1601 | DoUnIndent; 1602 | ProcEnd(Source); 1603 | AddLine(Source,'Procedure '+Din+'.Load(I : TDBUSMessageIterator);'); 1604 | Procbegin(Source); 1605 | AddLine(Source,'I.GetArgument(FKey);'); 1606 | AddLine(Source,'I.GetArgument(FValue);'); 1607 | ProcEnd(Source); 1608 | AddLine(Source,'Procedure '+Din+'.Save(I : TDBUSMessageIterator);'); 1609 | Procbegin(Source); 1610 | AddLine(Source,'I.AppendArgument(FKey);'); 1611 | AddLine(Source,'I.AppendArgument(FValue);'); 1612 | ProcEnd(Source); 1613 | end; 1614 | 1615 | procedure TDBUSCodeGenerator.GenerateDictClassImpl(A: TDBUSVarDef;Source: TStrings); 1616 | 1617 | Var 1618 | Din,Nvt,NKT : String; 1619 | 1620 | begin 1621 | Din:=A.StructType+'Item'; 1622 | NKT:=DBUSPascalTypeNames[A.DictDef[0]]; 1623 | NVT:=DBUSPascalTypeNames[A.DictDef[1]]; 1624 | AddLine(Source,'Constructor '+A.StructType+'.CreateDict;'); 1625 | procBegin(Source); 1626 | AddLine(Source,'inherited Create('+Din+');'); 1627 | procend(Source); 1628 | AddLine(Source,'Function '+A.StructType+'.GetE(AIndex : Integer) : '+DIN+';'); 1629 | ProcBegin(Source); 1630 | AddLine(Source,'Result:=Items[AIndex] as '+Din+';'); 1631 | ProcEnd(Source); 1632 | AddLine(Source,'Procedure '+A.StructType+'.SetE(AIndex : Integer; AValue : '+DIN+');'); 1633 | ProcBegin(Source); 1634 | AddLine(Source,'Items[AIndex]:=AValue;'); 1635 | ProcEnd(Source); 1636 | AddLine(Source,'Function '+A.StructType+'.AddElement : '+Din+';'); 1637 | ProcBegin(Source); 1638 | AddLine(Source,'Result:=Add as '+DIn+';'); 1639 | ProcEnd(Source); 1640 | AddLine(Source,'Function '+A.StructType+'.IndexOfKey(AKey : '+NKT+') : Integer;'); 1641 | ProcBegin(Source); 1642 | AddLine(Source,'Result:=Count-1;'); 1643 | AddLine(Source,'While (Result>=0) and (GetE(Result).Key<>AKey) do'); 1644 | DoIndent; 1645 | AddLine(Source,'Dec(Result);'); 1646 | DoUnIndent; 1647 | ProcEnd(Source); 1648 | AddLine(Source,'Function '+A.StructType+'.FindElement(AKey : '+NKT+') : '+Din+';'); 1649 | AddVarDecl(Source,'I','Integer',True); 1650 | ProcBegin(Source); 1651 | AddLine(Source,'I:=IndexOfKey(AKey);'); 1652 | AddLine(Source,'If (I=-1) then'); 1653 | DoIndent; 1654 | AddLine(Source,'Result:=Nil'); 1655 | DoUnIndent; 1656 | AddLine(Source,'else'); 1657 | DoIndent; 1658 | AddLine(Source,'Result:=GetE(I);'); 1659 | DoUnIndent; 1660 | ProcEnd(Source); 1661 | AddLine(Source,'Function '+A.StructType+'.ValueByKey(AKey : '+NKT+') : '+NVT+';'); 1662 | AddVarDecl(Source,'I','Integer',True); 1663 | ProcBegin(Source); 1664 | AddLine(Source,'I:=IndexOfKey(AKey);'); 1665 | AddLine(Source,'If (I=-1) then'); 1666 | DoIndent; 1667 | AddLine(Source,'RaiseDBUSError(ClassName,''No value found for key'')'); 1668 | DoUnIndent; 1669 | AddLine(Source,'else'); 1670 | DoIndent; 1671 | AddLine(Source,'Result:=GetE(I).Value;'); 1672 | DoUnIndent; 1673 | ProcEnd(Source); 1674 | end; 1675 | 1676 | 1677 | procedure TDBUSCodeGenerator.CheckDictClassDef(AIntfName : String; Method : TDBUSMethodDef; Source : TStrings); 1678 | 1679 | Var 1680 | I : integer; 1681 | A : TDBUSargumentDef; 1682 | S : String; 1683 | 1684 | begin 1685 | For I:=0 to Method.Arguments.Count-1 do 1686 | begin 1687 | A:=Method.Arguments[i]; 1688 | If (A.DataType=ddtArray) and (A.ElementType=ddtDict) then 1689 | begin 1690 | If (A.Direction=adout) and (I=Method.Arguments.Count-1) then 1691 | S:='Result' 1692 | else 1693 | S:=A.ArgName; 1694 | A.FStructType:='T'+AIntfName+Method.Name+S; 1695 | GenerateDictClassDef(A,Source); 1696 | end; 1697 | end; 1698 | end; 1699 | 1700 | procedure TDBUSCodeGenerator.GenerateInterfaceDefinition( 1701 | Intf: TDBUSInterfaceDef; Source: TStrings); 1702 | 1703 | Var 1704 | S : String; 1705 | I : Integer; 1706 | 1707 | begin 1708 | For I:=0 to Intf.Methods.Count-1 do 1709 | CheckDictClassDef(GetInterfaceName(Intf),Intf.Methods[i],Source); 1710 | S:='I'+GetInterfaceName(Intf)+' = Interface'; 1711 | AddLine(Source,S); 1712 | DoIndent; 1713 | For I:=0 to Intf.Methods.Count-1 do 1714 | AddLine(Source,GenerateMethodDeclaration('',Intf.Methods[i])+';'); 1715 | For I:=0 to Intf.Properties.Count-1 do 1716 | begin 1717 | If (Intf.Properties[i].Access in [dpaRead,dpaReadWrite]) then 1718 | AddLine(Source,GenerateGetPropertyDeclaration('',Intf.Properties[i])+';'); 1719 | If (Intf.Properties[i].Access in [dpaWrite,dpaReadWrite]) then 1720 | AddLine(Source,GenerateSetPropertyDeclaration('',Intf.Properties[i])+';'); 1721 | end; 1722 | For I:=0 to Intf.Properties.Count-1 do 1723 | AddLine(Source,GeneratePropertyDeclaration('',Intf.Properties[i])+';'); 1724 | DoUnindent; 1725 | AddLine(Source,'end;'); 1726 | end; 1727 | 1728 | procedure TDBUSCodeGenerator.GenerateProxyDefinition(Intf: TDBUSInterfaceDef; 1729 | Source: TStrings); 1730 | 1731 | Var 1732 | S,NI : String; 1733 | I : Integer; 1734 | 1735 | begin 1736 | NI:=GetInterfaceName(Intf); 1737 | S:='T'+NI+'Proxy = Class(TDBUSProxy'; 1738 | If dcoProxyHasInterface in Options then 1739 | S:=S+', I'+NI; 1740 | S:=S+')'; 1741 | AddLine(Source,S); 1742 | If Intf.Properties.Count>0 then 1743 | begin 1744 | AddLine(Source,'Protected'); 1745 | DoIndent; 1746 | For I:=0 to Intf.Properties.Count-1 do 1747 | begin 1748 | If (Intf.Properties[i].Access in [dpaRead,dpaReadWrite]) then 1749 | AddLine(Source,GenerateGetPropertyDeclaration('',Intf.Properties[i])+';'); 1750 | If (Intf.Properties[i].Access in [dpaWrite,dpaReadWrite]) then 1751 | AddLine(Source,GenerateSetPropertyDeclaration('',Intf.Properties[i])+';'); 1752 | end; 1753 | DoUnIndent; 1754 | end; 1755 | // Need protected methods ? 1756 | If (dcoProxyHasInterface in Options) and (dcoProxyUsesProtected in Options) then 1757 | begin 1758 | // Not yet in protected section ? 1759 | If (Intf.Properties.Count=0) then 1760 | AddLine(Source,'Protected'); 1761 | end 1762 | else 1763 | AddLine(Source,'Public'); 1764 | DoIndent; 1765 | For I:=0 to Intf.Methods.Count-1 do 1766 | AddLine(Source,GenerateMethodDeclaration('',Intf.Methods[i])+';'); 1767 | For I:=0 to Intf.Properties.Count-1 do 1768 | AddLine(Source,GeneratePropertyDeclaration('',Intf.Properties[i])+';'); 1769 | DoUnIndent; 1770 | AddLine(Source,'end;'); 1771 | end; 1772 | 1773 | procedure TDBUSCodeGenerator.GenerateUnit(Intf: TDBUSInterfaces; 1774 | Source: TStrings); 1775 | begin 1776 | FCurrentIndent:=0; 1777 | AddLine(Source,'unit '+Unitname+';'); 1778 | AddLine(Source,''); 1779 | AddLine(Source,'{$mode objfpc}'); 1780 | AddLine(Source,'{$h+}'); 1781 | AddLine(Source,''); 1782 | AddLine(Source,'interface'); 1783 | AddLine(Source,''); 1784 | AddLine(Source,'uses SysUtils, Classes, dbuscomp, dbusproxy;'); 1785 | AddLine(Source,''); 1786 | GenerateUnitInterface(Intf,Source); 1787 | AddLine(Source,''); 1788 | AddLine(Source,'implementation'); 1789 | AddLine(Source,''); 1790 | GenerateUnitImplementation(Intf,Source); 1791 | AddLine(Source,''); 1792 | AddLine(Source,'end.'); 1793 | end; 1794 | 1795 | procedure TDBUSCodeGenerator.SaveUnitToFile(Intf: TDBUSInterfaces; 1796 | const AFileName: String); 1797 | 1798 | Var 1799 | Src : TStrings; 1800 | 1801 | begin 1802 | Src:=TStringList.Create; 1803 | try 1804 | GenerateUnit(intf,Src); 1805 | Src.SaveToFile(AFileName); 1806 | finally 1807 | Src.Free; 1808 | end; 1809 | end; 1810 | 1811 | procedure TDBUSCodeGenerator.GenerateUnitInterface(Intf: TDBUSInterfaces; Source: TStrings); 1812 | 1813 | Var 1814 | I : Integer; 1815 | 1816 | begin 1817 | AddLine(Source,'Const'); 1818 | DoIndent; 1819 | For I:=0 to Intf.Count-1 do 1820 | if CreateDeclaration(Intf[i]) then 1821 | AddLine(Source,'S'+GetInterfaceName(Intf[i])+'Name = '''+Intf[i].Name+''';'); 1822 | DoUnIndent; 1823 | AddLine(Source,''); 1824 | AddLine(Source,'Type'); 1825 | AddLine(Source,''); 1826 | DoIndent; 1827 | For I:=0 to Intf.Count-1 do 1828 | if CreateDeclaration(Intf[i]) then 1829 | begin 1830 | AddLine(Source,'{ '+intf[i].Name+' -> '+CreateCleanIdentifier(intf[i].Name)+' } '); 1831 | If DCOGenerateinterface in options then 1832 | begin 1833 | AddLine(Source,''); 1834 | GenerateInterfaceDefinition(Intf[i],Source); 1835 | end; 1836 | If DCOGenerateProxy in options then 1837 | begin 1838 | AddLine(Source,''); 1839 | GenerateProxyDefinition(Intf[i],Source); 1840 | end; 1841 | end; 1842 | DoUnIndent; 1843 | end; 1844 | 1845 | procedure TDBUSCodeGenerator.GenerateUnitImplementation(Intf: TDBUSInterfaces; Source: TStrings); 1846 | 1847 | Var 1848 | I,J : Integer; 1849 | AIntf : TDBUSInterfaceDef; 1850 | 1851 | begin 1852 | For I:=0 to Intf.Count-1 do 1853 | begin 1854 | AIntf:=Intf[i]; 1855 | if CreateDeclaration(AIntf) then 1856 | begin 1857 | For J:=0 to AIntf.Methods.Count-1 do 1858 | CheckDictClassImpl(GetInterfaceName(AIntf),AIntf.Methods[J],Source); 1859 | end; 1860 | end; 1861 | if dcoGenerateProxy in Options then 1862 | begin 1863 | AddLine(Source,''); 1864 | For I:=0 to Intf.Count-1 do 1865 | if CreateDeclaration(Intf[i]) then 1866 | begin 1867 | AIntf:=Intf[i]; 1868 | AddLine(Source,'{ '+Aintf.Name+' -> '+GetInterfaceName(Aintf)+' } '); 1869 | AddLine(Source,''); 1870 | GenerateProxyImplementation(AIntf,Source); 1871 | end; 1872 | end; 1873 | end; 1874 | 1875 | Procedure TDBUSCodeGenerator.GenerateProxyImplementation(AIntf : TDBUSInterfaceDef; Source : TStrings); 1876 | 1877 | Var 1878 | I : integer; 1879 | CN : String; 1880 | 1881 | begin 1882 | CN:='T'+GetInterfaceName(AIntf)+'Proxy'; 1883 | For I:=0 to AIntf.Properties.Count-1 do 1884 | begin 1885 | GeneratePropertyGetterProxyImplementation(CN,AIntf,AIntf.Properties[i],Source); 1886 | AddLine(Source,''); 1887 | AddLine(Source,''); 1888 | GeneratePropertySetterProxyImplementation(CN,AIntf,AIntf.Properties[i],Source); 1889 | AddLine(Source,''); 1890 | AddLine(Source,''); 1891 | end; 1892 | For I:=0 to AIntf.Methods.Count-1 do 1893 | begin 1894 | GenerateProxyMethodImplementation(CN,AIntf,AIntf.Methods[i],Source); 1895 | AddLine(Source,''); 1896 | AddLine(Source,''); 1897 | end; 1898 | end; 1899 | 1900 | 1901 | Procedure TDBUSCodeGenerator.GeneratePropertyGetterProxyImplementation(Const AClassName : String; 1902 | AIntf : TDBUSInterfaceDef; 1903 | AProp : TDBUSPropertyDef; 1904 | Source : TStrings); 1905 | 1906 | begin 1907 | AddLine(Source,GenerateGetPropertyDeclaration(AClassName,AProp)+';'); 1908 | AddLine(Source,''); 1909 | AddLine(Source,'begin'); 1910 | AddLine(Source,'end;'); 1911 | end; 1912 | 1913 | Procedure TDBUSCodeGenerator.GeneratePropertySetterProxyImplementation(Const AClassName : String; 1914 | AIntf : TDBUSInterfaceDef; 1915 | AProp : TDBUSPropertyDef; 1916 | Source : TStrings); 1917 | 1918 | begin 1919 | AddLine(Source,GenerateSetPropertyDeclaration(AClassName,AProp)+';'); 1920 | AddLine(Source,''); 1921 | AddLine(Source,'begin'); 1922 | AddLine(Source,'end;'); 1923 | end; 1924 | 1925 | procedure TDBUSCodeGenerator.WritePassMethodInParams(Const MsgVarName : String; Args : TDBUSArguments; Source : TStrings); 1926 | 1927 | Var 1928 | I : Integer; 1929 | A : TDBUSArgumentDef; 1930 | 1931 | begin 1932 | For I:=0 to Args.Count-1 do 1933 | begin 1934 | A:=Args[i]; 1935 | If (A.Direction=adIn) then 1936 | begin 1937 | If ((A.DataType in [ddtStruct,ddtDict]) 1938 | or ((A.DataType=ddtArray) and (A.ElementType in [ddtDict,ddtStruct]))) 1939 | then 1940 | AddLine(Source,'UnhandledArgument('''+A.ArgName+''','''+DBUSPascalTypeNames[A.DataType]+''');') 1941 | else 1942 | AddLine(Source,MsgVarName+'.AppendArgument('+A.ArgName+');'); 1943 | end; 1944 | end; 1945 | end; 1946 | 1947 | procedure TDBUSCodeGenerator.SetInterfaceOptions( 1948 | const AValue: TDBUSInterfaceCodeOptions); 1949 | begin 1950 | if FInterfaceOptions=AValue then exit; 1951 | FInterfaceOptions.Assign(AValue); 1952 | end; 1953 | 1954 | procedure TDBUSCodeGenerator.WriteReadMethodOutParams(Const MsgVarName : String; Args : TDBUSArguments; Source : TStrings); 1955 | 1956 | Var 1957 | I,La : Integer; 1958 | IsF,ISDD : Boolean; 1959 | A : TDBUSArgumentDef; 1960 | S : String; 1961 | 1962 | begin 1963 | Isf:=dcoUseFunction in Options; 1964 | LA:=Args.Count-1; 1965 | If IsF then 1966 | isf:=(La>=0) and (Args[LA].Direction=adOut); 1967 | For I:=0 to Args.Count-1 do 1968 | begin 1969 | A:=Args[i]; 1970 | IsDD:=(A.DataType=ddtArray) and (A.ElementType=ddtDict); 1971 | If (A.Direction=adOut) then 1972 | begin 1973 | If ((A.DataType=ddtStruct) or ((A.DataType=ddtArray) and (A.ElementType=ddtStruct))) 1974 | then 1975 | AddLine(Source,'UnhandledArgument('''+A.ArgName+''','''+DBUSPascalTypeNames[A.DataType]+''');') 1976 | else 1977 | begin 1978 | if Isf and (I=La) then 1979 | S:='Result' 1980 | else 1981 | S:=A.ArgName; 1982 | If isDD then 1983 | AddLine(Source,S+':='+A.StructType+'.CreateDict;'); 1984 | AddLine(Source,MsgVarName+'.GetArgument('+S+');'); 1985 | end; 1986 | end; 1987 | end; 1988 | end; 1989 | 1990 | function TDBUSCodeGenerator.CreateDeclaration(Intf: TDBUSInterfaceDef): boolean; 1991 | 1992 | Const 1993 | SysIntf1 = 'org.freedesktop.DBus'; 1994 | SysIntf2 = 'org.freedesktop.DBus.Introspectable'; 1995 | SysIntf3 = 'org.freedesktop.DBus.Properties'; 1996 | 1997 | Var 1998 | N : String; 1999 | i : Integer; 2000 | 2001 | begin 2002 | n:=Intf.Name; 2003 | If (N=Sysintf1) or (N=SysIntf2) or (N=SysIntf3) then 2004 | result:=dcoIncludeSystemInterfaces in Options 2005 | else 2006 | begin 2007 | Result:=(FInterfaceoptions.Count=0); 2008 | If Not Result then 2009 | begin 2010 | I:=FInterfaceoptions.IndexOfName(N); 2011 | Result:=I<>-1; 2012 | If Result then 2013 | Result:=Not FInterfaceoptions[I].Skip; 2014 | end; 2015 | end; 2016 | end; 2017 | 2018 | function TDBUSCodeGenerator.GetInterfaceName(Intf: TDBUSInterfaceDef): String; 2019 | 2020 | Var 2021 | I : Integer; 2022 | 2023 | begin 2024 | Result:=Intf.Name; 2025 | I:=InterfaceOptions.IndexOfName(Result); 2026 | If (I=-1) or (InterfaceOptions[i].PascalName='') then 2027 | begin 2028 | if (dcoLastPartInterfaceName in Options) and (pos('.',Result)<>0) then 2029 | begin 2030 | Result:=ExtractFileExt(Result); 2031 | Delete(Result,1,1); 2032 | end; 2033 | end 2034 | else 2035 | Result:=InterfaceOptions[i].PascalName; 2036 | Result:=CreateCleanIdentifier(Result); 2037 | end; 2038 | 2039 | procedure TDBUSCodeGenerator.GenerateProxyMethodImplementation( 2040 | const AClassName: String; AIntf: TDBUSInterfaceDef; AMethod: TDBUSMethodDef; 2041 | Source: TStrings); 2042 | 2043 | var 2044 | S : string; 2045 | Ok : Boolean; 2046 | I : integer; 2047 | 2048 | 2049 | begin 2050 | // M:=TDBUSMethodCallMessage.Create('org.freedesktop.DBus','/','org.freedesktop.DBus','ListNames'); 2051 | AddLine(Source,GenerateMethodDeclaration(AClassName,AMethod)+';'); 2052 | AddVarDecl(Source,'M','TDBUSMethodCallMessage',True); 2053 | AddVarDecl(Source,'R','TDBUSMessage'); 2054 | Ok:=False; 2055 | For I:=0 to AMethod.Arguments.Count-1 do 2056 | if (AMethod.Arguments[i].DataType=ddtArray) and (AMethod.Arguments[i].ElementType=ddtDict) then 2057 | Ok:=true; 2058 | if Ok Then 2059 | AddVarDecl(Source,'I','TDBUSMessageIterator'); 2060 | AddLine(Source,'begin'); 2061 | DoIndent; 2062 | S:='S'+GetInterfaceName(AIntf)+'Name, '''+CreateCleanIdentifier(AMethod.Name)+''''; 2063 | AddLine(Source,'M:=GetMethodCallMessage('+S+');'); 2064 | AddLine(Source,'try'); 2065 | DoIndent; 2066 | WritePassMethodInParams('M',AMethod.Arguments,Source); 2067 | AddLine(Source,'R:=GetMessageReply(M);'); 2068 | AddLine(Source,'try'); 2069 | DoIndent; 2070 | WriteReadMethodOutParams('R',AMethod.Arguments,Source); 2071 | DoUnindent; 2072 | AddLine(Source,'finally'); 2073 | AddIndentLine(Source,'R.Free;'); 2074 | AddLine(Source,'end;'); 2075 | DoUnindent; 2076 | AddLine(Source,'finally'); 2077 | AddIndentLine(Source,'M.Free;'); 2078 | AddLine(Source,'end;'); 2079 | DoUnindent; 2080 | AddLine(Source,'end;'); 2081 | end; 2082 | 2083 | { TDBUSStructDef } 2084 | 2085 | function TDBUSStructDef.GetF(AIndex : Integer): TDBUSStructItem; 2086 | begin 2087 | Result:=TDBUSStructItem(Items[AIndex]); 2088 | end; 2089 | 2090 | procedure TDBUSStructDef.SetF(AIndex : Integer; const AValue: TDBUSStructItem); 2091 | begin 2092 | Items[AIndex]:=Avalue; 2093 | end; 2094 | 2095 | procedure TDBUSStructDef.Assign(Source: TPersistent); 2096 | 2097 | Var 2098 | S : TDBUSStructDef; 2099 | 2100 | begin 2101 | If (Source is TDBUSStructDef) then 2102 | begin 2103 | S:=TDBUSStructDef(Source); 2104 | FName:=S.Name; 2105 | end; 2106 | inherited Assign(Source); 2107 | end; 2108 | 2109 | { TDBUSStructItem } 2110 | 2111 | function TDBUSStructItem.GetStruct: TDBUSStructDef; 2112 | begin 2113 | If not Assigned(FStruct) then 2114 | FStruct:=TDBUSStructDef.Create(TDBUSStructItem); 2115 | Result:=FStruct; 2116 | end; 2117 | 2118 | procedure TDBUSStructItem.SetStruct(const AValue: TDBUSStructDef); 2119 | begin 2120 | If not Assigned(FStruct) then 2121 | FStruct:=TDBUSStructDef.Create(TDBUSStructItem); 2122 | FStruct.Assign(AValue); 2123 | end; 2124 | 2125 | destructor TDBUSStructItem.Destroy; 2126 | begin 2127 | FreeAndNil(FStruct); 2128 | inherited Destroy; 2129 | end; 2130 | 2131 | procedure TDBUSStructItem.Assign(Source: TPersistent); 2132 | 2133 | Var 2134 | S : TDBUSStructItem; 2135 | 2136 | 2137 | begin 2138 | If (Source is TDBUSStructItem) then 2139 | begin 2140 | S:=TDBUSStructItem(Source); 2141 | FDataType:=S.DataType; 2142 | If Assigned(S.FStruct) then 2143 | Struct:=S.FStruct; 2144 | end 2145 | else 2146 | Inherited; 2147 | end; 2148 | 2149 | { TDBUSNamedItem } 2150 | 2151 | function TDBUSNamedItem.GetAnnotation: TStrings; 2152 | begin 2153 | If FAnnotations=Nil then 2154 | FAnnotations:=TstringList.Create; 2155 | Result:=FAnnotations; 2156 | end; 2157 | 2158 | procedure TDBUSNamedItem.SetAnnotation(const AValue: TStrings); 2159 | begin 2160 | Annotations.Assign(AValue); 2161 | end; 2162 | 2163 | function TDBUSNamedItem.GetDisplayName: string; 2164 | begin 2165 | If (FName<>'') then 2166 | Result:=FName 2167 | else 2168 | Result:=inherited GetDisplayName; 2169 | end; 2170 | 2171 | destructor TDBUSNamedItem.destroy; 2172 | begin 2173 | FreeAndNil(FAnnotations); 2174 | inherited destroy; 2175 | end; 2176 | 2177 | function TDBUSNamedItem.HasAnnotations: Boolean; 2178 | begin 2179 | Result:=Assigned(FAnnotations); 2180 | end; 2181 | 2182 | { TDBUSInterfaceCodeOptionItem } 2183 | 2184 | procedure TDBUSInterfaceCodeOptionItem.Assign(Source: TPersistent); 2185 | 2186 | Var 2187 | O : TDBUSInterfaceCodeOptionItem; 2188 | 2189 | begin 2190 | If Source is TDBUSInterfaceCodeOptionItem then 2191 | begin 2192 | O:=TDBUSInterfaceCodeOptionItem(Source); 2193 | FName:=O.Name; 2194 | If O.HasAnnotations then 2195 | FAnnotations:=O.Annotations; 2196 | FPascalName:=O.Pascalname; 2197 | FSkip:=O.Skip; 2198 | end 2199 | else 2200 | Inherited; 2201 | end; 2202 | 2203 | { TDBUSInterfaceCodeOptions } 2204 | 2205 | function TDBUSInterfaceCodeOptions.GetO(AIndex : Integer 2206 | ): TDBUSInterfaceCodeOptionItem; 2207 | begin 2208 | Result:=Items[AIndex] as TDBUSInterfaceCodeOptionItem 2209 | end; 2210 | 2211 | procedure TDBUSInterfaceCodeOptions.SetO(AIndex : Integer; 2212 | const AValue: TDBUSInterfaceCodeOptionItem); 2213 | begin 2214 | Items[AIndex]:=Avalue; 2215 | end; 2216 | 2217 | function TDBUSInterfaceCodeOptions.AddOption(AName: String 2218 | ): TDBUSInterfaceCodeOptionItem; 2219 | begin 2220 | Result:=Add as TDBUSInterfaceCodeOptionItem; 2221 | Result.FName:=Aname; 2222 | end; 2223 | 2224 | 2225 | { TDBUSNodes } 2226 | 2227 | function TDBUSNodes.GetN(AIndex : Integer): TDBUSNodeItem; 2228 | begin 2229 | Result:=Items[Aindex] as TDBUSNodeItem; 2230 | end; 2231 | 2232 | procedure TDBUSNodes.SetN(AIndex : Integer; const AValue: TDBUSNodeItem); 2233 | begin 2234 | Items[Aindex]:=AValue; 2235 | end; 2236 | 2237 | function TDBUSNodes.AddNode(const AName: String): TDBUSNodeItem; 2238 | begin 2239 | Result:=Add as TDBUSNodeItem; 2240 | Result.Fname:=AName; 2241 | end; 2242 | 2243 | function TDBUSNodes.FindNode(const AName: String): TDBUSNodeItem; 2244 | 2245 | Var 2246 | I : Integer; 2247 | 2248 | begin 2249 | I:=IndexOfName(Aname); 2250 | If (I=-1) then 2251 | Result:=Nil 2252 | else 2253 | Result:=GetN(I) 2254 | end; 2255 | 2256 | function TDBUSNodes.GetNodeByName(const AName: String): TDBUSNodeItem; 2257 | begin 2258 | Result:=FindNode(Aname); 2259 | If Result=Nil then 2260 | DBUSError(SErrUnknown,[SNode,AName]); 2261 | end; 2262 | 2263 | { TDBUSNodeItem } 2264 | 2265 | procedure TDBUSNodeItem.SetInterfaces(const AValue: TDBUSInterfaces); 2266 | begin 2267 | If (FInterfaces=AValue) then 2268 | Exit; 2269 | FInterfaces.Assign(AValue); 2270 | end; 2271 | 2272 | procedure TDBUSNodeItem.SetNodes(const AValue: TDBUSNodes); 2273 | begin 2274 | if FNodes=AValue then exit; 2275 | FNodes:=AValue; 2276 | end; 2277 | 2278 | constructor TDBUSNodeItem.Create(ACollection: TCollection); 2279 | begin 2280 | inherited Create(ACollection); 2281 | FNodes:=TDBUSNodes.Create(TDBUSNodeItem); 2282 | FInterFaces:=TDBUSInterfaces.Create(TDBUSInterfaceDef); 2283 | end; 2284 | 2285 | destructor TDBUSNodeItem.Destroy; 2286 | begin 2287 | FreeAndNil(FNodes); 2288 | FreeAndNil(FInterFaces); 2289 | inherited Destroy; 2290 | end; 2291 | 2292 | procedure TDBUSNodeItem.Clear; 2293 | begin 2294 | FNodes.Clear; 2295 | FInterfaces.Clear; 2296 | end; 2297 | 2298 | end. 2299 | 2300 | --------------------------------------------------------------------------------