12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609 |
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 2010 by Michael Van Canneyt, member of the
- Free Pascal development team
- DBUS component layer on top of the DBUS library.
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit dbuscomp;
- {$mode objfpc}
- {$h+}
- interface
- uses
- Classes, SysUtils, ctypes,dbus;
- Type
- { TDBusMessage }
- TBooleanArray = Array of boolean;
- TByteArray = Array of Byte;
- TSmallIntArray = Array of SmallInt;
- TWordArray = Array of Word;
- TIntegerArray = Array of Integer;
- TCardinalArray = Array of Cardinal;
- TInt64Array = Array of Int64;
- TQWordArray = Array of QWord;
- TDoubleArray = Array of Double;
- TStringArray = Array of String;
- TDBUSDictionary = Class;
- { TDBusMessageIterator }
- TDBusMessageIterator = Class(TObject)
- private
- FIter : DBUSMessageIter;
- protected
- Procedure Error(Const Msg : String);
- Procedure Error(Const Fmt : String; Args : Array of Const);
- Public
- Constructor Create(AIter : DBUSMessageIter);
- Function GetFixedArray(Const AElementType : cint; Var P : Pointer) : cInt;
- Function GetArgumentType: cint;
- Function GetElementType: cint;
- Function Recurse: TDBusMessageIterator;
- Function HasNext : Boolean;
- Procedure Next;
- Procedure Get(AType : cInt; Var Value);
- Procedure GetArgument(Var Arg : Byte);
- Procedure GetArgument(Var Arg : Boolean);
- Procedure GetArgument(Var Arg : SmallInt);
- Procedure GetArgument(Var Arg : Word);
- Procedure GetArgument(Var Arg : Integer);
- Procedure GetArgument(Var Arg : Cardinal);
- Procedure GetArgument(var Arg : Int64);
- Procedure GetArgument(Var Arg : QWord);
- Procedure GetArgument(var Arg : Double);
- Procedure GetArgument(var Arg : String);
- Procedure GetArgument(Var Arg : TByteArray);
- Procedure GetArgument(Var Arg : TBooleanArray);
- Procedure GetArgument(Var Arg : TSmallIntArray);
- Procedure GetArgument(Var Arg : TWordArray);
- Procedure GetArgument(Var Arg : TIntegerArray);
- Procedure GetArgument(Var Arg : TCardinalArray);
- Procedure GetArgument(var Arg : TInt64Array);
- Procedure GetArgument(Var Arg : TQWordArray);
- Procedure GetArgument(var Arg : TDoubleArray);
- Procedure GetArgument(var Arg : TStringArray);
- Procedure GetArgument(var Arg : TStringList);
- Procedure GetArgument(Var Arg : Variant);
- Procedure GetArgument(Const Arg : TDBUSDictionary);
- Procedure Append(AType : cInt; Const Value);
- Procedure AppendArgument(Const Arg : Byte);
- Procedure AppendArgument(Const Arg : Boolean);
- Procedure AppendArgument(Const Arg : SmallInt);
- Procedure AppendArgument(Const Arg : Word);
- Procedure AppendArgument(Const Arg : Integer);
- Procedure AppendArgument(Const Arg : Cardinal);
- Procedure AppendArgument(Const Arg : Int64);
- Procedure AppendArgument(Const Arg : QWord);
- Procedure AppendArgument(Const Arg : Double);
- Procedure AppendArgument(Const Arg : String);
- end;
- TDBUSDictItem = Class(TCollectionItem)
- Protected
- Procedure Load(I : TDBUSMessageIterator); virtual; abstract;
- Procedure Save(I : TDBUSMessageIterator); virtual; abstract;
- end;
- { TDBUSDictionary }
- TDBUSDictionary = Class(TCollection)
- Protected
- Function AddDictItem : TDBUSDictItem;
- end;
- TDBusMessage = Class(TObject)
- private
- FFromSource: Boolean;
- FMessage: PDBUSMessage;
- FAppendCount : Integer;
- FAppendIterator : TDBUSMessageIterator;
- FGetCount : Integer;
- FGetIterator : TDBUSMessageIterator;
- procedure BeginAppend;
- procedure BeginGet;
- function BeginGetFixedArray(const AElementType: cint; var P: Pointer): cInt;
- procedure EndAppend;
- procedure EndGet;
- function GetMessage: PDBUSMessage;
- function GetReplySerial: dbus_uint32_t;
- function GetSerial: dbus_uint32_t;
- procedure SetReplySerial(const AValue: dbus_uint32_t);
- Protected
- Class function MessageType : cint; virtual; abstract;
- Procedure AllocateMessage; virtual; abstract;
- Procedure CheckNotFromSource;
- Procedure CheckNotAllocated;
- Procedure CheckAllocated;
- Function Allocated : boolean;
- Function Copy : TDBUSMessage;
- Procedure Error(Const Msg : String);
- Procedure Error(Const Fmt : String; Args : Array of Const);
- Property Message : PDBUSMessage Read GetMessage;
- Property FromSource : Boolean Read FFromSource;
- Property Serial : dbus_uint32_t Read GetSerial;
- Property ReplySerial : dbus_uint32_t Read GetReplySerial Write SetReplySerial;
- Public
- Constructor Create(ASource : PDBusMessage); virtual;
- Destructor Destroy; override;
- Procedure Append(AType : cInt; Const Value);
- Procedure AppendArgument(Const Arg : Byte);
- Procedure AppendArgument(Const Arg : Boolean);
- Procedure AppendArgument(Const Arg : SmallInt);
- Procedure AppendArgument(Const Arg : Word);
- Procedure AppendArgument(Const Arg : Integer);
- Procedure AppendArgument(Const Arg : Cardinal);
- Procedure AppendArgument(Const Arg : Int64);
- Procedure AppendArgument(Const Arg : QWord);
- Procedure AppendArgument(Const Arg : Double);
- Procedure AppendArgument(Const Arg : String);
- Procedure Get(AType : cInt; Var Value);
- Procedure GetArgument(Var Arg : Byte);
- Procedure GetArgument(Var Arg : Boolean);
- Procedure GetArgument(Var Arg : SmallInt);
- Procedure GetArgument(Var Arg : Word);
- Procedure GetArgument(Var Arg : Integer);
- Procedure GetArgument(Var Arg : Cardinal);
- Procedure GetArgument(var Arg : Int64);
- Procedure GetArgument(Var Arg : QWord);
- Procedure GetArgument(var Arg : Double);
- Procedure GetArgument(var Arg : String);
- Procedure GetArgument(Var Arg : TByteArray);
- Procedure GetArgument(Var Arg : TBooleanArray);
- Procedure GetArgument(Var Arg : TSmallIntArray);
- Procedure GetArgument(Var Arg : TWordArray);
- Procedure GetArgument(Var Arg : TIntegerArray);
- Procedure GetArgument(Var Arg : TCardinalArray);
- Procedure GetArgument(var Arg : TInt64Array);
- Procedure GetArgument(Var Arg : TQWordArray);
- Procedure GetArgument(var Arg : TDoubleArray);
- Procedure GetArgument(var Arg : TStringArray);
- Procedure GetArgument(var Arg : TStringList);
- Procedure GetArgument(Var Arg : Variant);
- Procedure GetArgument(Const Arg : TDBUSDictionary);
- Function GetNextArgumentType : cInt;
- Function GetArrayElementType : cInt;
- Function HasPath(Const APath : String) : boolean; virtual;
- Function HasSender(Const ASender : String) : boolean; virtual;
- Function HasSignature(Const ASignature : String) : boolean; virtual;
- Function IsError(Const AError : string) : Boolean; virtual;
- end;
- TDBUSGUID = Array[1..32] of Byte;
- { TDBUSInvalidMessage }
- TDBUSInvalidMessage = Class(TDBusMessage)
- Class function MessageType : cint; override;
- Procedure AllocateMessage; override;
- end;
- TDBUSInterfaceMessage = Class(TDBusMessage)
- Private
- FInterface: String;
- FPath: String;
- procedure SetInterface(const AValue: String);
- function GetInterface: String;
- procedure SetPath(const AValue: String);
- Public
- Function HasPath(Const APath : String) : boolean; override;
- Property ObjectPath : String Read FPath Write SetPath;
- Property InterfaceName : String Read GetInterface Write SetInterface;
- end;
- { TDBusMethodCallMessage }
- TDBusMethodCallMessage = Class(TDBUSInterfaceMessage)
- private
- FDestination: String;
- FMethod: String;
- procedure SetDestination(const AValue: String);
- procedure SetMethod(const AValue: String);
- Protected
- Class function MessageType : cint; override;
- Procedure AllocateMessage; override;
- Public
- Constructor Create(Const ADestination,AObjectPath,AInterface,AMethod : String); virtual; overload;
- Property Destination : String Read FDestination Write SetDestination;
- Property MethodName : String Read FMethod Write SetMethod;
- end;
- { TDBusSignalMessage }
- TDBusSignalMessage = Class(TDBusInterfaceMessage)
- private
- FName: String;
- procedure SetName(const AValue: String);
- Protected
- Class function MessageType : cint; override;
- Procedure AllocateMessage; override;
- Public
- Constructor Create(Const AObjectPath,AInterface,AName : String); virtual; overload;
- Property Name : String Read FName Write SetName;
- end;
- { TDBusReplyToMessage }
- TDBusReplyToMessage = Class(TDBUSMessage)
- Private
- FReplyTo: TDBUSMessage;
- procedure SetReplyto(const AValue: TDBUSMessage);
- Public
- Constructor Create(Const AReplyTo : TDBUSMessage); overload;
- Property ReplyTo : TDBUSMessage Read FReplyTo Write SetReplyto;
- end;
- { TDBusErrorMessage }
- TDBusErrorMessage = Class(TDBusReplyToMessage)
- private
- FErrorMessage: String;
- FErrorName: String;
- FName: String;
- procedure SetErrorMessage(const AValue: String);
- procedure SetErrorName(const AValue: String);
- Protected
- Class function MessageType : cint; override;
- Procedure AllocateMessage; override;
- Public
- Constructor Create(Const AReplyTo : TDBUSMessage; Const AErrorName,AErrorMessage : String); overload;
- Constructor Create(Const AReplyTo : TDBUSMessage; Const AErrorName,AFormat : String; Args : Array of const); overload;
- Property ErrorName : String Read FErrorName Write SetErrorName;
- Property ErrorMessage : String Read FErrorMessage Write SetErrorMessage;
- end;
- { TDBusMethodReturnMessage }
- TDBusMethodReturnMessage = Class(TDBusReplyToMessage)
- Protected
- Class function MessageType : cint; override;
- Procedure AllocateMessage; override;
- end;
- { TDBusPendingCall }
- TDBusPendingCall = Class(TObject)
- Protected
- FSource : PDBusPendingCall;
- Public
- Constructor Create(Const ASource : PDBusPendingCall);
- Destructor Destroy; override;
- end;
- TCustomDBUSConnection = Class;
- TDBUSFilterItem = Class;
- TDBusMessageHandler = Procedure (Sender : TObject; Msg : TDBUSMessage; Var AResult : DBusHandlerResult) of Object;
- { TDBUSMessageItem }
- TDBUSMessageItem = Class(TCollectionItem)
- private
- FRegistered: Boolean;
- FENabled: Boolean;
- FOnMessage: TDBusMessageHandler;
- function HaveHandle: Boolean;
- Private
- procedure SetEnabled(const AValue: Boolean);
- procedure SetOnMessage(const AValue: TDBusMessageHandler);
- Protected
- procedure MaybeRegister;
- Function ConnHandle : PDBUSConnection;
- function AllowRegister : Boolean; virtual;
- Procedure Register; virtual; abstract;
- Procedure Unregister; virtual; abstract;
- Public
- Procedure Assign(Source : TPersistent); override;
- Property Registered : Boolean Read FRegistered;
- Published
- Property Enabled : Boolean Read FENabled Write SetEnabled;
- Property OnMessage : TDBusMessageHandler Read FOnMessage Write SetOnMessage;
- end;
- TDBUSMessageItemClass = Class of TDBUSMessageItem;
- { TDBUSMessages }
- TDBUSMessages = Class(TCollection)
- private
- FConnection: TCustomDBUSConnection;
- Public
- Constructor Create(Const AConnection : TCustomDBUSConnection; AItemClass : TDBUSMessageItemClass);
- Property Connection : TCustomDBUSConnection Read FConnection;
- end;
- { TDBUSFilterItem }
- TDBUSFilterItem = Class(TDbusMessageItem)
- Public
- Procedure Register; override;
- Procedure Unregister; override;
- end;
- TDBUSFilterItemClass = Class of TDBUSFilterItem;
- { TDBUSFilters }
- TDBUSFilters = Class(TDBUSMessages)
- Private
- function GetF(AIndex : Integer): TDBUSFilterItem;
- procedure SetF(AIndex : Integer; const AValue: TDBUSFilterItem);
- Public
- Constructor Create(Const AConnection : TCustomDBUSConnection);
- Property Filters[AIndex : Integer] : TDBUSFilterItem Read GetF Write SetF; default;
- end;
- { TDBUSObjectItem }
- TDBUSObjectItem = Class(TDbusMessageItem)
- private
- FFallBack: Boolean;
- FPath: String;
- procedure SetFallback(const AValue: Boolean);
- procedure SetPath(const AValue: String);
- Public
- Procedure Register; override;
- Procedure Unregister; override;
- function AllowRegister : Boolean; override;
- Published
- Property Path : String Read FPath Write SetPath;
- Property FallBack : Boolean Read FFallBack Write SetFallback;
- end;
- TDBUSObjectItemClass = Class of TDBUSObjectItem;
- { TDBUSObjectItem }
- { TDBUSObjects }
- TDBUSObjects = Class(TDBUSMessages)
- Private
- function GetO(AIndex : Integer): TDBUSObjectItem;
- procedure SetO(AIndex : Integer; const AValue: TDBUSObjectItem);
- Public
- Constructor Create(Const AConnection : TCustomDBUSConnection);
- Property Objects[AIndex : Integer] : TDBUSObjectItem Read GetO Write SetO; default;
- end;
- { TCustomDBUSConnection }
- TConnectionKind = (ckCustom,ckSystem,ckSession,ckStarter);
- TCustomDBUSConnection = Class(TComponent)
- private
- FConn : PDBusConnection;
- FErr : DBusError;
- FFilters: TDBUSFilters;
- FKind: TConnectionKind;
- FLoadConnected : Boolean;
- FMaxReceivedSize : clong;
- FMaxMessageSize: clong;
- FObjects: TDBUSObjects;
- FPath: String;
- FShared: Boolean;
- function GetAnonymous: boolean;
- function GetAuthenticated: boolean;
- function GetConnected: Boolean;
- function GetDispatchStatus: DBusDispatchStatus;
- function GetMaxMessageSize: clong;
- function GetMaxReceivedSize: clong;
- function GetOutgoingSize: clong;
- function GetServerID: String;
- procedure SetConnected(const AValue: Boolean);
- procedure SetFilters(const AValue: TDBUSFilters);
- procedure SetKind(const AValue: TConnectionKind);
- procedure SetMaxMessageSize(const AValue: clong);
- procedure SetMaxReceivedSize(const AValue: clong);
- procedure SetObjects(const AValue: TDBUSObjects);
- procedure SetPath(const AValue: String);
- procedure SetShared(const AValue: Boolean);
- Protected
- Procedure CheckError;
- procedure CheckDisconnected;
- procedure CheckConnected;
- procedure Loaded; override;
- Function FilterClass : TDBUSFilterItemClass;
- Function ObjectClass : TDBUSObjectItemClass;
- Public
- Constructor Create(AOwner : TComponent); override;
- Destructor Destroy; override;
- Procedure Error(Const Msg : String);
- Procedure ResetError;
- procedure Connect;
- procedure Disconnect;
- procedure RegisterFilters;
- procedure UnRegisterFilters;
- procedure RegisterObjects;
- procedure UnRegisterObjects;
- Function PreAllocateSend : PDBusPreallocatedSend;
- Procedure FreePreAllocatedSend(Allocated : PDBusPreallocatedSend);
- Procedure SendPreallocated(Allocated : PDBusPreallocatedSend; AMessage : TDBusMessage; out ASerial : dbus_uint32_t);
- Procedure SendPreallocated(Allocated : PDBusPreallocatedSend; AMessage : TDBusMessage);
- function Send(AMessage : TDBusMessage; out ASerial : dbus_uint32_t) : boolean;
- function Send(AMessage : TDBusMessage) : boolean;
- Function SendWithReply(AMessage : TDBusMessage; Out PendingCall : TDBUSPendingCall; Const TimeOut : cInt) : boolean;
- Function SendWithReplyAndBlock(AMessage : TDBusMessage; Const TimeOut : cInt) : TDBusMessage;
- Procedure Flush;
- Function ReadWriteDispatch(Const ATimeOut : cInt): Boolean;
- Function ReadWrite(Const ATimeOut : cInt): Boolean;
- Function BorrowMessage : TDBUSMessage;
- Function GetUnixFileDescriptor(Var fd : cInt) : Boolean;
- Function GetUnixProcessID(Var ID : CUlong) : Boolean;
- Function GetUnixUser(Var UID : CUlong) : Boolean;
- Function GetWindowsUser(Var SID : String) : Boolean;
- Function GetSocket(Var SD : cint) : Boolean;
- Function GetObjectPathData(Const Path : String; DoCheck : Boolean = False) : TDBUSObjectItem;
- Procedure SetAllowAnonymous(AValue : Boolean);
- Procedure SetRoutePeerMessages(AValue : Boolean);
- Procedure ReturnMessage(var AMessage : TDBUSMessage);
- Procedure StealBorrowedMessage(var AMessage : TDBUSMessage);
- Procedure ListRegistered(Const APath : String; AList : TStrings);
- Class Function AllocateDataSlot(Var slot : dbus_int32_t) : Boolean;
- Class procedure FreeDataSlot(Var slot : dbus_int32_t);
- Function SetData(Const Slot: dbus_int32_t; Const Data : Pointer; Const FreeFunction : DBUSFreeFunction) : Boolean;
- Function GetData(Const Slot: dbus_int32_t) : Pointer;
- Function PopMessage : TDBUSMessage;
- Function Dispatch : DBusDispatchStatus;
- Property DispatchStatus : DBusDispatchStatus Read GetDispatchStatus;
- Protected
- Property Connected : Boolean Read GetConnected Write SetConnected;
- Property Kind : TConnectionKind Read FKind Write SetKind;
- Property Shared : Boolean read FShared Write SetShared default true;
- Property Path : String Read FPath Write SetPath;
- Property MaxMessageSize : clong Read GetMaxMessageSize Write SetMaxMessageSize;
- Property MaxReceiveSize : clong Read GetMaxReceivedSize Write SetMaxReceivedSize;
- Property OutgoingSize : clong Read GetOutgoingSize;
- Property Authenticated : boolean Read GetAuthenticated;
- Property Anonymous : boolean Read GetAnonymous;
- Property ServerID : String Read GetServerID;
- Property Filters : TDBUSFilters Read FFilters Write SetFilters;
- Property Objects : TDBUSObjects Read FObjects Write SetObjects;
- end;
- TDBUSConnection = Class(TCustomDBUSConnection)
- Public
- Property OutgoingSize;
- Property Authenticated;
- Property Anonymous;
- Property ServerID;
- Published
- Property Connected;
- Property Kind;
- Property Shared;
- Property Path;
- Property MaxMessageSize;
- Property MaxReceiveSize;
- Property Filters;
- Property Objects;
- end;
- { EDBus }
- EDBus = Class(Exception)
- private
- FName: String;
- Public
- Property Name : String Read FName;
- end;
- Function CreateMessageFromSource(M : PDbusMessage) : TDBusMessage;
- Procedure RaiseDBUSError(Const AName,AMsg : String);
- Procedure RaiseDBUSError(Const AName,Fmt : String; Args : Array of const);
- implementation
- resourcestring
- SErrInvalidOperationWhileConnected = 'Cannot perform this operation when connected to the bus.';
- SErrInvalidOperationWhileDisconnected = 'Cannot perform this operation when disconnected from the bus.';
- SErrNoDBUSPath = 'No DBUS Address to connect to.';
- SErrEmptymessage = 'Source message is Nil';
- SerrWrongMessageType = 'Wrong message type. Expected %d, got %d';
- SErrUnknownMessageType = 'Unknown message type: %d';
- SErrInvalidMessageType = 'Cannot create unknown message type';
- SErrInvalidOperationFromSource = 'This operation cannot be performed on a message coming from the DBUS';
- SErrInvalidOperationWhenAllocated = 'This operation cannot be performed when a message was allocated';
- SErrInvalidOperationWhenNotAllocated = 'This operation cannot be performed when the is not allocated';
- SErrEmptyPath = 'Cannot allocate method call message: no path specified';
- SErrEmptyMethod = 'Cannot allocate method call message: no method specified';
- SErrEmptyName = 'Cannot allocate signal message: no signal name specified';
- SErrNoErrorName = 'Cannot allocate error message: no error name specified';
- SErrNoReplyTo = 'Cannot allocate error message: no reply to message specified';
- SErrObjectWithoutPath = 'Cannot (un)register an object without path';
- SErrCouldNotSetReplySerial = 'Could not set reply serial';
- SErrInitIter = 'Could not initialize iterator';
- SErrAppendFailed = 'Append of argument to message failed';
- SErrNoMoreArguments = 'No more arguments available';
- SErrInvalidArgumentType = 'Invalid argument type. Expected %s, got %s.';
- SErrInvalidArrayElementType = 'Invalid array element type. Expected %s got %s';
- SErrInvalidVariantType = 'Invalid VARIANT type';
- Function CreateMessageFromSource(M : PDbusMessage) : TDBusMessage;
- begin
- If M=Nil then
- Result:=Nil
- else
- case dbus_message_get_type(M) of
- DBUS_MESSAGE_TYPE_INVALID : Result:=TDBUSInvalidMessage.Create(M);
- DBUS_MESSAGE_TYPE_METHOD_CALL : Result:=TDBUSMethodCallmessage.Create(M);
- DBUS_MESSAGE_TYPE_METHOD_RETURN : Result:=TDBUSMethodReturnMessage.Create(M);
- DBUS_MESSAGE_TYPE_ERROR : Result:=TDBUSErrorMessage.Create(M);
- DBUS_MESSAGE_TYPE_SIGNAL : Result:=TDBUSSignalMessage.Create(M);
- else
- Raise EDBUS.CreateFmt(SErrUnknownMessageType,[dbus_message_get_type(M)]);
- end
- end;
- procedure RaiseDBUSError(const AName, AMsg: String);
- Var
- E : EDBUS;
- begin
- E:=EDBUS.Create(Amsg);
- E.FName:=AName;
- Raise E;
- end;
- procedure RaiseDBUSError(const AName, Fmt: String; Args: array of const);
- begin
- RaiseDBUSError(AName,Format(Fmt,Args));
- end;
- { TCustomDBUSConnection }
- function TCustomDBUSConnection.GetConnected: Boolean;
- begin
- Result:=(FConn<>Nil);
- If Result then
- begin
- result:=dbus_connection_get_is_connected(FConn)<>0;
- If not Result then
- Disconnect;
- end;
- end;
- function TCustomDBUSConnection.GetAnonymous: boolean;
- begin
- CheckConnected;
- Result:=False;
- result:=(0<>dbus_connection_get_is_anonymous(FConn));
- end;
- function TCustomDBUSConnection.GetAuthenticated: boolean;
- begin
- CheckConnected;
- result:=(0<>dbus_connection_get_is_authenticated(FConn));
- end;
- function TCustomDBUSConnection.GetMaxMessageSize: clong;
- begin
- if Connected then
- Result:=dbus_connection_get_max_message_size(FConn)
- else
- Result:=FMaxMessageSize;
- end;
- function TCustomDBUSConnection.GetMaxReceivedSize: clong;
- begin
- if Connected then
- Result:=dbus_connection_get_max_received_size(FConn)
- else
- Result:=FMaxReceivedSize;
- end;
- function TCustomDBUSConnection.GetOutgoingSize: clong;
- begin
- CheckConnected;
- Result:=dbus_connection_get_outgoing_size(fconn);
- end;
- function TCustomDBUSConnection.GetServerID: String;
- Var
- p : pchar;
- begin
- CheckConnected;
- p:=nil;
- p:=dbus_connection_get_server_id(Fconn);
- If p<>nil then
- Result:=strpas(p);
- end;
- procedure TCustomDBUSConnection.SetConnected(const AValue: Boolean);
- begin
- If (AValue=GetConnected) then exit;
- If (csLoading in ComponentState) then
- FLoadConnected:=AValue
- else
- If AValue then
- Connect
- else
- DisConnect;
- end;
- procedure TCustomDBUSConnection.SetFilters(const AValue: TDBUSFilters);
- begin
- if (FFilters=AValue) then exit;
- FFilters.Assign(AValue);
- end;
- procedure TCustomDBUSConnection.SetKind(const AValue: TConnectionKind);
- begin
- if (Kind<>AValue) then
- CheckDisconnected;
- FKind:=AValue;
- end;
- procedure TCustomDBUSConnection.SetMaxMessageSize(const AValue: clong);
- begin
- FMaxMessageSize:=AValue;
- If Connected and (AValue<>0) then
- dbus_connection_set_max_message_size(fconn,AValue);
- end;
- procedure TCustomDBUSConnection.SetMaxReceivedSize(const AValue: clong);
- begin
- FMaxMessageSize:=AValue;
- If Connected and (AValue<>0) then
- dbus_connection_set_max_received_size(fconn,AValue);
- end;
- procedure TCustomDBUSConnection.SetObjects(const AValue: TDBUSObjects);
- begin
- if FObjects=AValue then exit;
- FObjects.Assign(AValue);
- end;
- procedure TCustomDBUSConnection.SetPath(const AValue: String);
- begin
- if FPath=AValue then exit;
- CheckDisconnected;
- FPath:=AValue;
- end;
- procedure TCustomDBUSConnection.SetShared(const AValue: Boolean);
- begin
- if (AValue=FShared) then exit;
- CheckDisconnected;
- FShared:=AValue;
- end;
- procedure TCustomDBUSConnection.CheckError;
- Var
- E : EDBUS;
- begin
- If (dbus_error_is_set(@FErr)<>0) then
- begin
- E:=EDBUS.Create(strpas(FErr.Message));
- E.FName:=StrPas(FErr.Name);
- ResetError;
- Raise E;
- end;
- end;
- procedure TCustomDBUSConnection.CheckDisconnected;
- begin
- If Connected then
- Error(SErrInvalidOperationWhileConnected);
- end;
- procedure TCustomDBUSConnection.CheckConnected;
- begin
- If not Connected then
- Error(SErrInvalidOperationWhileDisconnected);
- end;
- procedure TCustomDBUSConnection.Loaded;
- begin
- If FLoadConnected then
- Connect;
- end;
- function TCustomDBUSConnection.FilterClass: TDBUSFilterItemClass;
- begin
- Result:=TDBUSFilterItem;
- end;
- function TCustomDBUSConnection.ObjectClass: TDBUSObjectItemClass;
- begin
- Result:=TDBUSObjectItem;
- end;
- constructor TCustomDBUSConnection.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- dbus_error_init(@FErr);
- FShared:=True;
- FFilters:=TDBUSFilters.Create(Self);
- FObjects:=TDBUSObjects.Create(Self);
- end;
- destructor TCustomDBUSConnection.Destroy;
- begin
- Disconnect;
- FreeAndNil(FFilters);
- FreeAndNil(FObjects);
- inherited Destroy;
- end;
- procedure TCustomDBUSConnection.Error(Const Msg: String);
- Var
- E : EDBUS;
- begin
- E:=EDBUS.Create(Msg);
- E.FName:=Self.Name;
- Raise E;
- end;
- procedure TCustomDBUSConnection.ResetError;
- begin
- dbus_error_free(@FErr);
- end;
- procedure TCustomDBUSConnection.Connect;
- Const
- CFlags : Array[TConnectionKind] of DBUSBusType
- = (DBUS_BUS_SYSTEM,DBUS_BUS_SYSTEM,DBUS_BUS_SESSION,DBUS_BUS_STARTER);
- begin
- if GetConnected then exit;
- case kind of
- ckCustom :
- begin
- If (FPath='') then
- Error(SErrNoDBUSPath);
- if Shared then
- fconn:=dbus_connection_open(pchar(FPath),@Ferr)
- else
- fconn:=dbus_connection_open_private(pchar(FPath),@Ferr);
- CheckError;
- end;
- ckSystem,
- ckSession,
- ckStarter :
- begin
- If Shared then
- FConn:=dbus_bus_get(CFlags[kind],@Ferr)
- else
- FConn:=dbus_bus_get_private(CFlags[kind],@Ferr);
- CheckError;
- if Shared then
- dbus_connection_set_exit_on_disconnect(FConn,Ord(False));
- end;
- end;
- If (FMaxMessageSize<>0) then
- dbus_connection_set_max_message_size(fconn,FMaxMessageSize);
- RegisterFilters;
- end;
- procedure TCustomDBUSConnection.Disconnect;
- begin
- UnregisterFilters;
- UnregisterObjects;
- if Not Shared then
- dbus_connection_close(FConn)
- else
- dbus_connection_unref(FConn);
- FConn:=Nil;
- end;
- procedure TCustomDBUSConnection.RegisterFilters;
- Var
- i : integer;
- begin
- For I:=0 to FFilters.Count-1 do
- FFilters[i].MaybeRegister;
- end;
- procedure TCustomDBUSConnection.UnRegisterFilters;
- Var
- i : integer;
- begin
- For I:=0 to FFilters.Count-1 do
- If FFilters[i].Registered then
- FFilters[i].UnRegister;
- end;
- procedure TCustomDBUSConnection.RegisterObjects;
- Var
- i : integer;
- begin
- For I:=0 to FObjects.Count-1 do
- FObjects[i].MaybeRegister;
- end;
- procedure TCustomDBUSConnection.UnRegisterObjects;
- Var
- i : integer;
- begin
- For I:=0 to FObjects.Count-1 do
- If FObjects[i].Registered then
- FObjects[i].UnRegister;
- end;
- function TCustomDBUSConnection.PreallocateSend: PDBusPreallocatedSend;
- begin
- CheckConnected;
- Result:=dbus_connection_preallocate_send(FConn);
- end;
- procedure TCustomDBUSConnection.FreePreAllocatedSend(
- Allocated: PDBusPreallocatedSend);
- begin
- CheckConnected;
- dbus_connection_free_preallocated_send(FConn,Allocated);
- end;
- procedure TCustomDBUSConnection.SendPreallocated(
- Allocated: PDBusPreallocatedSend; AMessage: TDBusMessage;
- out ASerial: dbus_uint32_t);
- begin
- CheckConnected;
- dbus_connection_send_preallocated(FConn,Allocated,AMessage.Message,@ASerial);
- end;
- procedure TCustomDBUSConnection.SendPreallocated(
- Allocated: PDBusPreallocatedSend; AMessage: TDBusMessage);
- Var
- s : dbus_uint32_t;
- begin
- SendPreallocated(Allocated,AMessage,S);
- end;
- function TCustomDBUSConnection.Send(AMessage: TDBusMessage; out
- ASerial: dbus_uint32_t): boolean;
- begin
- CheckConnected;
- Result:=dbus_connection_send(FConn,AMessage.Message,@ASerial)<>0;
- end;
- function TCustomDBUSConnection.Send(AMessage: TDBusMessage): boolean;
- Var
- s : dbus_uint32_t;
- begin
- Result:=Send(AMessage,S);
- end;
- function TCustomDBUSConnection.SendWithReply(AMessage: TDBusMessage; out
- PendingCall: TDBUSPendingCall; const TimeOut: cInt): boolean;
- Var
- P : PDBusPendingCall;
- begin
- CheckConnected;
- PendingCall:=Nil;
- Result:=dbus_connection_send_with_reply(FConn,AMessage.Message,@P,TimeOut)<>0;
- if Result then
- if (P<>Nil) then
- PendingCall:=TDBUSPendingCall.Create(P);
- end;
- function TCustomDBUSConnection.SendWithReplyAndBlock(AMessage: TDBusMessage;
- const TimeOut: cInt): TDBusMessage;
- Var
- M : PDBusMessage;
- begin
- CheckConnected;
- M:=dbus_connection_send_with_reply_and_block(FConn,AMessage.Message,TimeOut,@FErr);
- CheckError;
- Result:=CreateMessageFromSource(M);
- end;
- procedure TCustomDBUSConnection.Flush;
- begin
- CheckConnected;
- dbus_connection_flush(FConn);
- end;
- function TCustomDBUSConnection.ReadWriteDispatch(Const ATimeOut : cInt): Boolean;
- begin
- CheckConnected;
- Result:=dbus_connection_read_write_dispatch(FConn,ATimeOut)<>0;
- end;
- function TCustomDBUSConnection.ReadWrite(const ATimeOut: cInt): Boolean;
- begin
- CheckConnected;
- Result:=dbus_connection_read_write(FConn,ATimeOut)<>0;
- end;
- function TCustomDBUSConnection.BorrowMessage: TDBUSMessage;
- begin
- CheckConnected;
- Result:=CreateMessageFromSource(dbus_connection_borrow_message(FConn));
- end;
- function TCustomDBUSConnection.GetUnixFileDescriptor(Var fd: cInt) : Boolean;
- begin
- CheckConnected;
- Result:=dbus_connection_get_unix_fd(FConn,@fd)<>0;
- end;
- function TCustomDBUSConnection.GetUnixProcessID(var ID: CUlong): Boolean;
- begin
- checkconnected;
- Result:=dbus_connection_get_unix_process_id(FConn,@ID)<>0;
- end;
- function TCustomDBUSConnection.GetUnixUser(var UID: CUlong): Boolean;
- begin
- checkconnected;
- Result:=dbus_connection_get_unix_user(FConn,@UID)<>0;
- end;
- function TCustomDBUSConnection.GetWindowsUser(var SID: String): Boolean;
- Var
- P : PChar;
- begin
- checkconnected;
- Result:=dbus_connection_get_windows_user(FConn,@P)<>0;
- If Result and (P<>Nil) then
- SID:=StrPas(P)
- else
- Sid:='';
- end;
- function TCustomDBUSConnection.GetSocket(var SD: cint): Boolean;
- begin
- checkconnected;
- Result:=dbus_connection_get_socket(FConn,@SD)<>0;
- end;
- function TCustomDBUSConnection.GetObjectPathData(const Path : String; DoCheck : Boolean = False): TDBUSObjectItem;
- Var
- P : Pointer;
- I : integer;
- begin
- CheckConnected;
- dbus_connection_get_object_path_data(FConn,Pchar(Path),@P);
- Result:=Nil;
- If (P<>Nil) then
- if DoCheck then
- begin
- I:=FObjects.Count-1;
- While (Result=Nil) and (I>=0) do
- begin
- If (Pointer(FObjects[i])=P) then
- Result:=TDBUSObjectItem(P);
- Dec(I);
- end;
- end
- else
- Result:=TDBUSObjectItem(P);
- end;
- procedure TCustomDBUSConnection.SetAllowAnonymous(AValue: Boolean);
- begin
- CheckConnected;
- dbus_connection_set_allow_anonymous(FConn,Ord(AValue));
- end;
- procedure TCustomDBUSConnection.SetRoutePeerMessages(AValue: Boolean);
- begin
- CheckConnected;
- dbus_connection_set_route_peer_messages(FConn,Ord(AValue));
- end;
- procedure TCustomDBUSConnection.ReturnMessage(var AMessage: TDBUSMessage);
- begin
- CheckConnected;
- dbus_connection_return_message(FConn,AMessage.Message);
- AMessage.FMessage:=Nil;
- FreeAndNil(AMessage);
- end;
- procedure TCustomDBUSConnection.StealBorrowedMessage(var AMessage: TDBUSMessage
- );
- begin
- CheckConnected;
- dbus_connection_steal_borrowed_message(FConn,AMessage.Message);
- end;
- procedure TCustomDBUSConnection.ListRegistered(const APath: String;
- AList: TStrings);
- Var
- P : PPchar;
- begin
- CheckConnected;
- AList.Clear;
- if (dbus_connection_list_registered(FConn,PChar(APath),@P)<>0) then
- If (P<>Nil) then
- begin
- While (P^<>Nil) do
- begin
- AList.Add(StrPas(P^));
- Inc(P);
- end;
- dbus_free_string_array(P);
- end;
- end;
- class function TCustomDBUSConnection.AllocateDataSlot(var slot: dbus_int32_t
- ): Boolean;
- begin
- Result:=dbus_connection_allocate_data_slot(@slot)<>0;
- end;
- class procedure TCustomDBUSConnection.FreeDataSlot(var slot: dbus_int32_t);
- begin
- dbus_connection_free_data_slot(@slot);
- end;
- function TCustomDBUSConnection.SetData(const Slot: dbus_int32_t;
- const Data: Pointer; const FreeFunction: DBUSFreeFunction): Boolean;
- begin
- CheckConnected;
- Result:=0<>dbus_connection_set_Data(FConn,Slot,Data,FreeFunction);
- end;
- function TCustomDBUSConnection.GetData(const Slot: dbus_int32_t): Pointer;
- begin
- CheckConnected;
- Result:=dbus_connection_get_Data(FConn,Slot);
- end;
- function TCustomDBUSConnection.PopMessage: TDBUSMessage;
- begin
- CheckConnected;
- Result:=CreateMessageFromSource(dbus_connection_pop_message(FConn));
- end;
- function TCustomDBUSConnection.Dispatch: DBusDispatchStatus;
- begin
- CheckConnected;
- Result:=dbus_connection_dispatch(FConn);
- end;
- function TCustomDBUSConnection.GetDispatchStatus: DBusDispatchStatus;
- begin
- CheckConnected;
- Result:=dbus_connection_get_dispatch_status(FConn);
- end;
- { TDBusMessage }
- function TDBusMessage.GetMessage: PDBUSMessage;
- begin
- If (FMessage=Nil) then
- AllocateMessage;
- Result:=FMessage;
- end;
- function TDBusMessage.GetReplySerial: dbus_uint32_t;
- begin
- CheckAllocated;
- result:=dbus_message_get_reply_serial(message);
- end;
- function TDBusMessage.GetSerial: dbus_uint32_t;
- begin
- CheckAllocated;
- result:=dbus_message_get_serial(message);
- end;
- procedure TDBusMessage.SetReplySerial(const AValue: dbus_uint32_t);
- begin
- CheckAllocated;
- if dbus_message_set_reply_serial(message,AVAlue)<>0 then
- Raise EDBUS.Create(SErrCouldNotSetReplySerial);
- end;
- procedure TDBusMessage.CheckNotFromSource;
- begin
- If FFromSource then
- Error(SErrInvalidOperationFromSource);
- end;
- procedure TDBusMessage.CheckNotAllocated;
- begin
- If Allocated then
- Error(SErrInvalidOperationWhenAllocated);
- end;
- procedure TDBusMessage.CheckAllocated;
- begin
- If Allocated then
- Error(SErrInvalidOperationWhenNotAllocated);
- end;
- procedure TDBusMessage.BeginAppend;
- Var
- A : DBUSMessageIter;
- begin
- If (FAppendCount=0) then
- begin
- dbus_message_iter_init_append(message,@A);
- FAppendIterator:=TDBUSmessageIterator.Create(A);
- end;
- Inc(FAppendCount);
- end;
- procedure TDBusMessage.Append(AType: cInt; const Value);
- begin
- BeginAppend;
- try
- FAppendIterator.Append(Atype,Value);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.EndAppend;
- begin
- Dec(FAppendCount);
- end;
- function TDBusMessage.Allocated: boolean;
- begin
- Result:=(FMessage<>Nil);
- end;
- function TDBusMessage.Copy: TDBUSMessage;
- begin
- CheckAllocated;
- Result:=CreateMessageFromSource(dbus_message_copy(message));
- end;
- procedure TDBusMessage.Error(const Msg: String);
- begin
- RaiseDBusError(ClassName,Msg);
- end;
- procedure TDBusMessage.Error(const Fmt: String; Args: array of const);
- begin
- RaiseDBUSError(ClassName,Fmt,Args);
- end;
- constructor TDBusMessage.Create(ASource: PDBusMessage);
- Var
- t : cint;
- begin
- If (ASource=Nil) then
- Error(SErrEmptymessage);
- t:=dbus_message_get_type(ASource);
- If (t<>MessageType) then
- Error(SerrWrongMessageType,[MessageType,T]);
- FMessage:=ASource;
- FFromSource:=True;
- end;
- destructor TDBusMessage.Destroy;
- begin
- if Allocated then
- dbus_message_unref(FMessage);
- inherited Destroy;
- end;
- procedure TDBusMessage.AppendArgument(const Arg: Byte);
- begin
- BeginAppend;
- try
- FAppendIterator.AppendArgument(Arg);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.AppendArgument(Const Arg: Boolean);
- begin
- BeginAppend;
- try
- FAppendIterator.AppendArgument(Arg);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.AppendArgument(const Arg: SmallInt);
- begin
- BeginAppend;
- try
- FAppendIterator.AppendArgument(Arg);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.AppendArgument(const Arg: Word);
- begin
- BeginAppend;
- try
- FAppendIterator.AppendArgument(Arg);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.AppendArgument(Const Arg: Integer);
- begin
- BeginAppend;
- try
- FAppendIterator.AppendArgument(Arg);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.AppendArgument(const Arg: Cardinal);
- begin
- BeginAppend;
- try
- FAppendIterator.AppendArgument(Arg);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.AppendArgument(const Arg: Int64);
- begin
- BeginAppend;
- try
- FAppendIterator.AppendArgument(Arg);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.AppendArgument(const Arg: QWord);
- begin
- BeginAppend;
- try
- FAppendIterator.AppendArgument(Arg);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.AppendArgument(const Arg: Double);
- begin
- BeginAppend;
- try
- FAppendIterator.AppendArgument(Arg);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.AppendArgument(Const Arg: String);
- begin
- BeginAppend;
- try
- FAppendIterator.AppendArgument(Arg);
- finally
- EndAppend;
- end;
- end;
- procedure TDBusMessage.BeginGet;
- Var
- AIter : DBUSMessageIter;
- begin
- If (FGetCount=0) then
- begin
- if (0=dbus_message_iter_init(message,@AIter)) then
- Error(SErrInitIter);
- FGetIterator:=TDBUSMessageIterator.Create(AIter);
- end;
- Inc(FGetCount);
- end;
- procedure TDBusMessage.EndGet;
- begin
- Dec(FGetCount);
- end;
- Function TDBusMessage.GetNextArgumentType: cInt;
- begin
- BeginGet;
- try
- Result:=FGetIterator.GetArgumentType;
- finally
- EndGet;
- end;
- end;
- function TDBusMessage.GetArrayElementType: cInt;
- begin
- BeginGet;
- try
- Result:=FGetIterator.GetArgumentType;
- If (Result<>DBUS_TYPE_ARRAY) then
- Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_ARRAY),Char(Result)]);
- Result:=FGetIterator.GetElementType;
- finally
- EndGet;
- end;
- end;
- procedure TDBusMessage.Get(AType: cInt; var Value);
- begin
- BeginGet;
- try
- FGetIterator.Get(AType,Value);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: Byte);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: Boolean);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: SmallInt);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: Word);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: Integer);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: Cardinal);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: Int64);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: QWord);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: Double);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: String);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- Function TDBusMessage.BeginGetFixedArray(Const AElementType : cint; Var P : Pointer) : cInt;
- begin
- BeginGet;
- try
- Result:=FGetIterator.GetFixedArray(AElementType,P);
- finally
- Endget
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TByteArray);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TBooleanArray);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TSmallIntArray);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TWordArray);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TIntegerArray);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TCardinalArray);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TInt64array);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TQWordArray);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TDoubleArray);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TStringArray);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: TStringList);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(var Arg: Variant);
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- Endget;
- end;
- end;
- procedure TDBusMessage.GetArgument(Const Arg: TDBUSDictionary);
- Var
- I : Integer;
- begin
- BeginGet;
- try
- FGetIterator.GetArgument(Arg);
- finally
- EndGet;
- end;
- end;
- function TDBusMessage.HasPath(const APath: String): boolean;
- begin
- Result:=Allocated;
- if Result then
- Result:=dbus_message_has_path(Message,PChar(APath))<>0;
- end;
- function TDBusMessage.HasSender(const ASender: String): boolean;
- begin
- Result:=Allocated;
- if Result then
- Result:=dbus_message_has_sender(message,PChar(ASender))<>0;
- end;
- function TDBusMessage.HasSignature(const ASignature: String): boolean;
- begin
- Result:=Allocated;
- If Result then
- Result:=dbus_message_has_signature(Message,Pchar(ASignature))<>0;
- end;
- function TDBusMessage.IsError(const AError : string): Boolean;
- begin
- Result:=Allocated;
- if Result then
- Result:=dbus_message_is_error(message,Pchar(AError))<>0;
- end;
- { TDBusMethodCallMessage }
- procedure TDBusMethodCallMessage.SetDestination(const AValue: String);
- begin
- if FDestination=AValue then exit;
- CheckNotAllocated;
- FDestination:=AValue;
- end;
- function TDBusInterfaceMessage.GetInterface: String;
- Var
- p : pchar;
- begin
- If not Allocated then
- Result:=FInterface
- else
- begin
- p:=dbus_message_get_interface(message);
- if (P<>Nil) then
- Result:=strpas(p);
- end;
- end;
- procedure TDBusInterfaceMessage.SetInterface(const AValue: String);
- begin
- if FInterface=AValue then exit;
- CheckNotAllocated;
- FInterface:=AValue;
- end;
- procedure TDBusMethodCallMessage.SetMethod(const AValue: String);
- begin
- if FMethod=AValue then exit;
- CheckNotAllocated;
- FMethod:=AValue;
- end;
- procedure TDBusInterfaceMessage.SetPath(const AValue: String);
- begin
- if FPath=AValue then exit;
- CheckNotAllocated;
- FPath:=AValue;
- end;
- constructor TDBusMethodCallMessage.Create(const ADestination, AObjectPath,
- AInterface, AMethod: String);
- begin
- FDestination:=ADestination;
- FPath:=AObjectPath;
- FInterface:=AInterface;
- FMethod:=AMethod;
- end;
- class function TDBusMethodCallMessage.MessageType: cint;
- begin
- Result:=DBUS_MESSAGE_TYPE_METHOD_CALL;
- end;
- procedure TDBusMethodCallMessage.AllocateMessage;
- Var
- d,i : pchar;
- begin
- CheckNotAllocated;
- d:=nil;
- i:=nil;
- if (FDestination<>'') then
- d:=PChar(FDestination);
- if (FInterface<>'') then
- i:=PChar(FInterface);
- if (FPath='') then
- Error(SErrEmptyPath);
- if (FMethod='') then
- Error(SErrEmptyMethod);
- FMessage:=dbus_message_new_method_call(d,pchar(FPath),i,pchar(FMethod));
- end;
- function TDBusInterfaceMessage.HasPath(const APath: String): boolean;
- begin
- If Allocated then
- Result:=Inherited HasPath(APath)
- else
- Result:=(FPath=APath)
- end;
- { TDBusPendingCall }
- constructor TDBusPendingCall.Create(const ASource: PDBusPendingCall);
- begin
- FSource:=ASource;
- end;
- destructor TDBusPendingCall.Destroy;
- begin
- dbus_pending_call_unref(FSource);
- inherited Destroy;
- end;
- { TDBUSMessageItem }
- procedure TDBUSMessageItem.SetOnMessage(const AValue: TDBusMessageHandler);
- begin
- if FOnMessage=AValue then exit;
- FOnMessage:=AValue;
- end;
- function TDBUSMessageItem.ConnHandle: PDBUSConnection;
- begin
- if HaveHandle then
- Result:=TDBUSFilters(Collection).Connection.FConn
- else
- Result:=Nil
- end;
- function TDBUSMessageItem.AllowRegister: Boolean;
- begin
- Result:=(FEnabled and Assigned(FOnMessage))
- end;
- procedure TDBUSMessageItem.MaybeRegister;
- begin
- If AllowRegister and not Registered then
- Register
- else
- UnRegister;
- end;
- procedure TDBUSMessageItem.SetEnabled(const AValue: Boolean);
- begin
- If AValue=FEnabled then exit;
- FEnabled:=AValue;
- MaybeRegister
- end;
- Function TDBUSMessageItem.HaveHandle : Boolean;
- begin
- Result:=Assigned(Collection)
- and (Collection is TDBUSMessages)
- and (Assigned(TDBUSMessages(Collection).Connection))
- and (TDBUSMessages(Collection).Connection.Connected);
- end;
- procedure TDBUSMessageItem.Assign(Source: TPersistent);
- Var
- F : TDBUSMessageItem;
- begin
- if (Source is TDBUSMessageItem) then
- begin
- F:=Source as TDBUSMessageItem;
- OnMessage:=F.OnMessage;
- Enabled:=F.Enabled;
- end;
- inherited Assign(Source);
- end;
- { TDBUSFilterItem }
- function FilterHandler(connection: PDBusConnection;
- message_: PDBusMessage;
- user_data: Pointer): DBusHandlerResult;cdecl;
- Var
- F : TDBUSFilterItem;
- M : TDBUSMessage;
- begin
- F:=TDBUSFilterItem(user_data);
- If (Connection<>F.ConnHandle) then
- result:=DBUS_HANDLER_RESULT_NOT_YET_HANDLED
- else
- begin
- M:=CreateMessageFromSource(Message_);
- try
- F.OnMessage(F,M,Result);
- except
- result:=DBUS_HANDLER_RESULT_NOT_YET_HANDLED
- end;
- M.Free;
- end;
- end;
- procedure TDBUSFilterItem.Register;
- begin
- if HaveHandle then
- FRegistered:=0<>dbus_connection_add_filter(ConnHandle,
- @FilterHandler,Self,Nil);
- end;
- procedure TDBUSFilterItem.Unregister;
- begin
- if HaveHandle then
- dbus_connection_remove_filter(ConnHandle,@FilterHandler,Self);
- FRegistered:=False;
- end;
- { TDBUSFilters }
- function TDBUSFilters.GetF(AIndex : Integer): TDBUSFilterItem;
- begin
- Result:=TDBUSFilterItem(Items[AIndex])
- end;
- procedure TDBUSFilters.SetF(AIndex : Integer; const AValue: TDBUSFilterItem);
- begin
- Items[AIndex]:=AValue;
- end;
- Constructor TDBUSFilters.Create(Const AConnection: TCustomDBUSConnection);
- Var
- C : TDBUSMessageItemClass;
- begin
- C:=TDBUSFilterItem;
- If Assigned(AConnection) then
- C:=AConnection.FilterClass;
- Inherited Create(AConnection,C);
- end;
- { TDBUSMessages }
- constructor TDBUSMessages.Create(const AConnection: TCustomDBUSConnection;
- AItemClass: TDBUSMessageItemClass);
- begin
- Inherited Create(AItemClass);
- FConnection:=AConnection;
- end;
- { TDBUSObjectItem }
- // in fact, the same handler could be used as in filter...
- function ObjectHandler(connection: PDBusConnection;
- message_: PDBusMessage;
- user_data: Pointer): DBusHandlerResult;cdecl;
- Var
- O : TDBUSObjectItem;
- M : TDBUSMessage;
- begin
- O:=TDBUSObjectItem(user_data);
- If (Connection<>O.ConnHandle) then
- result:=DBUS_HANDLER_RESULT_NOT_YET_HANDLED
- else
- begin
- M:=CreateMessageFromSource(Message_);
- try
- O.OnMessage(O,M,Result);
- except
- result:=DBUS_HANDLER_RESULT_NOT_YET_HANDLED
- end;
- M.Free;
- end;
- end;
- var
- ObjectVTable : DBusObjectPathVTable = (
- unregister_function: Nil;
- message_function: @ObjectHandler;
- dbus_internal_pad1:Nil;
- dbus_internal_pad2:Nil;
- dbus_internal_pad3:Nil;
- dbus_internal_pad4:Nil
- );
- procedure TDBUSObjectItem.SetPath(const AValue: String);
- begin
- If (FPath=AValue) then exit;
- FPath:=AValue;
- If (FPath<>'') then
- MaybeRegister;
- end;
- procedure TDBUSObjectItem.SetFallback(const AValue: Boolean);
- begin
- if FFallBack=AValue then exit;
- FFallBack:=AValue;
- If Registered then
- Unregister;
- MaybeRegister;
- end;
- procedure TDBUSObjectItem.Register;
- begin
- If Path='' then
- Raise Exception.Create(SErrObjectWithoutPath);
- If HaveHandle then
- if FallBack then
- FRegistered:=0<>dbus_connection_register_fallback(ConnHandle,Pchar(Path),@ObjectVTable,Self)
- else
- FRegistered:=0<>dbus_connection_register_object_path(ConnHandle,Pchar(Path),@ObjectVTable,Self);
- end;
- procedure TDBUSObjectItem.Unregister;
- begin
- If Path='' then
- Raise Exception.Create(SErrObjectWithoutPath);
- if HaveHandle then
- FRegistered:=0=dbus_connection_unregister_object_path(ConnHandle,Pchar(Path));
- end;
- function TDBUSObjectItem.AllowRegister: Boolean;
- begin
- Result:=inherited AllowRegister and (Path<>'');
- end;
- { TDBUSObjects }
- function TDBUSObjects.GetO(AIndex: Integer): TDBUSObjectItem;
- begin
- Result:=TDBUSObjectItem(Items[AIndex]);
- end;
- procedure TDBUSObjects.SetO(AIndex: Integer; const AValue: TDBUSObjectItem);
- begin
- Items[AIndex]:=AValue;
- end;
- constructor TDBUSObjects.Create(const AConnection: TCustomDBUSConnection);
- Var
- C : TDBUSMessageItemClass;
- begin
- C:=TDBUSObjectItem;
- If Assigned(AConnection) then
- C:=AConnection.ObjectClass;
- Inherited Create(AConnection,C);
- end;
- { TDBusSignalMessage }
- procedure TDBusSignalMessage.SetName(const AValue: String);
- begin
- if FName=AValue then exit;
- CheckNotAllocated;
- FName:=AValue;
- end;
- class function TDBusSignalMessage.MessageType: cint;
- begin
- Result:= DBUS_MESSAGE_TYPE_SIGNAL;
- end;
- procedure TDBusSignalMessage.AllocateMessage;
- Var
- i : pchar;
- begin
- CheckNotAllocated;
- i:=nil;
- if (FInterface<>'') then
- i:=PChar(FInterface);
- if (FPath='') then
- Error(SErrEmptyPath);
- if (FName='') then
- Error(SErrEmptyName);
- FMessage:=dbus_message_new_signal(PChar(FPath),I,Pchar(Name));
- end;
- constructor TDBusSignalMessage.Create(const AObjectPath, AInterface,
- AName: String);
- begin
- FPath:=AObjectPath;
- FInterface:=AInterface;
- FName:=AName;
- end;
- { TDBusErrorMessage }
- procedure TDBusErrorMessage.SetErrorMessage(const AValue: String);
- begin
- if FErrorMessage=AValue then exit;
- CheckNotAllocated;
- FErrorMessage:=AValue;
- end;
- procedure TDBusErrorMessage.SetErrorName(const AValue: String);
- begin
- if FErrorName=AValue then exit;
- CheckNotAllocated;
- FErrorName:=AValue;
- end;
- procedure TDBusReplyToMessage.SetReplyto(const AValue: TDBUSMessage);
- begin
- if FReplyTo=AValue then exit;
- CheckNotAllocated;
- FReplyTo:=AValue;
- end;
- constructor TDBusReplyToMessage.Create(const AReplyTo: TDBUSMessage);
- begin
- FReplyTo:=AReplyTo;
- end;
- class function TDBusErrorMessage.MessageType: cint;
- begin
- Result:=DBUS_MESSAGE_TYPE_ERROR;
- end;
- procedure TDBusErrorMessage.AllocateMessage;
- Var
- P : PChar;
- begin
- If (ErrorName='') then
- Error(SErrNoErrorName);
- If (ReplyTo=Nil) then
- Error(SErrNoReplyTo);
- P:=Nil;
- If (ErrorMessage<>'') then
- P:=Pchar(ErrorMessage);
- FMessage:=dbus_message_new_error(ReplyTo.Message,Pchar(FErrorName),P);
- end;
- constructor TDBusErrorMessage.Create(const AReplyTo: TDBUSMessage;
- const AErrorName, AErrorMessage: String);
- begin
- Inherited Create(AReplyto);
- FErrorName:=AErrorName;
- FErrorMessage:=AErrorMessage;
- end;
- constructor TDBusErrorMessage.Create(const AReplyTo: TDBUSMessage;
- const AErrorName, AFormat: String; Args: array of const);
- begin
- Inherited Create(AReplyTo);
- FErrorName:=AErrorName;
- FErrorMessage:=Format(AFormat,Args);
- end;
- { TDBusMethodReturnMessage }
- class function TDBusMethodReturnMessage.MessageType: cint;
- begin
- Result:=DBUS_MESSAGE_TYPE_METHOD_RETURN;
- end;
- procedure TDBusMethodReturnMessage.AllocateMessage;
- begin
- If (FReplyTo=Nil) then
- Error(SErrNoReplyTo);
- FMessage:=dbus_message_new_method_return(FReplyTo.Message);
- end;
- { TDBUSInvalidMessage }
- class function TDBUSInvalidMessage.MessageType: cint;
- begin
- Result:=DBUS_MESSAGE_TYPE_INVALID;
- end;
- procedure TDBUSInvalidMessage.AllocateMessage;
- begin
- Error(SErrInvalidMessageType);
- end;
- { TDBusMessageIterator }
- procedure TDBusMessageIterator.Error(const Msg: String);
- begin
- RaiseDBusError(ClassName,Msg);
- end;
- procedure TDBusMessageIterator.Error(const Fmt: String; Args: array of const);
- begin
- RaiseDBUSError(ClassName,Fmt,Args);
- end;
- constructor TDBusMessageIterator.Create(AIter: DBUSMessageIter);
- begin
- FIter:=AIter;
- end;
- function TDBusMessageIterator.GetFixedArray(const AElementType: cint;
- var P: Pointer): cInt;
- Var
- A : cInt;
- AI : DBUSMessageIter;
- begin
- A:=dbus_message_iter_get_arg_type(@FIter);
- If (A<>DBUS_TYPE_ARRAY) then
- Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_ARRAY),Char(A)]);
- A:=dbus_message_iter_get_element_type(@FIter);
- If (A<>AElementType) then
- Error(SErrInvalidArrayElementType,[Char(AElementType),Char(A)]);
- dbus_message_iter_recurse(@FIter, @AI);
- dbus_message_iter_get_fixed_array(@AI,@P,@Result);
- end;
- function TDBusMessageIterator.GetArgumentType: cint;
- begin
- Result:=dbus_message_iter_get_arg_type(@FIter);
- end;
- function TDBusMessageIterator.GetElementType: cint;
- begin
- Result:=dbus_message_iter_get_element_type(@FIter);
- end;
- function TDBusMessageIterator.Recurse: TDBusMessageIterator;
- Var
- AI : DBUSMessageIter;
- begin
- dbus_message_iter_recurse(@Fiter, @AI);
- Result:=TDBusMessageIterator.Create(AI);
- end;
- function TDBusMessageIterator.HasNext: Boolean;
- begin
- Result:=dbus_message_iter_has_next(@Fiter)<>0;
- end;
- procedure TDBusMessageIterator.Next;
- begin
- dbus_message_iter_next(@FIter);
- end;
- procedure TDBusMessageIterator.Get(AType: cInt; var Value);
- Var
- A : cInt;
- begin
- A:=dbus_message_iter_get_arg_type(@fIter);
- if (A=DBUS_TYPE_INVALID) then
- Error(SErrNoMoreArguments);
- if (A<>AType) then
- Error(SErrInvalidArgumentType,[Char(AType),Char(A)]);
- dbus_message_iter_get_basic(@FIter,@value);
- next;
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: Byte);
- begin
- Get(DBUS_TYPE_BYTE,Arg);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: Boolean);
- Var
- B : DBUS_BOOL_T;
- begin
- Get(DBUS_TYPE_BOOLEAN,B);
- Arg:=(B<>0);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: SmallInt);
- begin
- Get(DBUS_TYPE_INT16,Arg);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: Word);
- begin
- Get(DBUS_TYPE_UINT16,Arg);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: Integer);
- begin
- Get(DBUS_TYPE_INT32,Arg);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: Cardinal);
- begin
- Get(DBUS_TYPE_UINT32,Arg);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: Int64);
- begin
- Get(DBUS_TYPE_INT64,Arg);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: QWord);
- begin
- Get(DBUS_TYPE_UINT64,Arg);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: Double);
- begin
- Get(DBUS_TYPE_DOUBLE,Arg);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: String);
- Var
- P : Pchar;
- begin
- p:=Nil;
- Get(DBUS_TYPE_STRING,P);
- if (P=Nil) then
- Arg:=''
- else
- Arg:=StrPas(P);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TByteArray);
- Var
- P : Pointer;
- N : cInt;
- It : DBUSMessageIter;
- begin
- n:=GetFixedArray(DBUS_TYPE_BYTE,p);
- SetLength(Arg,n);
- If (N>0) then
- Move(P^,Arg[0],N*sizeOf(Byte));
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TBooleanArray);
- Var
- P : ^DBUS_BOOL_T;
- N : cInt;
- begin
- n:=GetFixedArray(DBUS_TYPE_BOOLEAN,P);
- SetLength(Arg,n);
- While (N>0) do
- begin
- Dec(N);
- Arg[N]:=(P[N]<>0);
- end;
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TSmallIntArray);
- Var
- P : Pointer;
- N : cInt;
- begin
- n:=GetFixedArray(DBUS_TYPE_int16,P);
- SetLength(Arg,n);
- If (N>0) then
- Move(P^,Arg[0],N*sizeOf(SmallInt));
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TWordArray);
- Var
- P : Pointer;
- N : cInt;
- begin
- n:=GetFixedArray(DBUS_TYPE_Uint16,P);
- SetLength(Arg,n);
- If (N>0) then
- Move(P^,Arg[0],N*sizeOf(Word));
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TIntegerArray);
- Var
- P : Pointer;
- N : cInt;
- begin
- n:=GetFixedArray(DBUS_TYPE_int32,P);
- SetLength(Arg,n);
- If (N>0) then
- Move(P^,Arg[0],N*sizeOf(Integer));
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TCardinalArray);
- Var
- P : Pointer;
- N : cInt;
- begin
- n:=GetFixedArray(DBUS_TYPE_Uint32,P);
- SetLength(Arg,n);
- If (N>0) then
- Move(P^,Arg[0],N*sizeOf(Cardinal));
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TInt64Array);
- Var
- P : Pointer;
- N : cInt;
- begin
- n:=GetFixedArray(DBUS_TYPE_int64,P);
- SetLength(Arg,n);
- If (N>0) then
- Move(P^,Arg[0],N*sizeOf(Int64));
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TQWordArray);
- Var
- P : Pointer;
- N : cInt;
- begin
- n:=GetFixedArray(DBUS_TYPE_Uint64,P);
- SetLength(Arg,n);
- If (N>0) then
- Move(P^,Arg[0],N*sizeOf(QWord));
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TDoubleArray);
- Var
- P : Pointer;
- N : cInt;
- begin
- n:=GetFixedArray(DBUS_TYPE_DOUBLE,P);
- SetLength(Arg,n);
- If (N>0) then
- Move(P^,Arg[0],N*sizeOf(Double));
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TStringArray);
- Var
- A : cInt;
- AI : DBUSMessageIter;
- l : integer;
- p : Pchar;
- begin
- A:=dbus_message_iter_get_arg_type(@fIter);
- If (A<>DBUS_TYPE_ARRAY) then
- Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_ARRAY),Char(A)]);
- A:=dbus_message_iter_get_element_type(@fIter);
- If (A<>DBUS_TYPE_STRING) then
- Error(SErrInvalidArrayElementType,[Char(DBUS_TYPE_STRING),Char(A)]);
- dbus_message_iter_recurse(@Fiter, @AI);
- setlength(Arg,0);
- l:=0;
- while (dbus_message_iter_get_arg_type(@AI)<>DBUS_TYPE_INVALID) do
- begin
- Inc(l);
- If Length(Arg)<L then
- SetLength(Arg,L+10);
- dbus_message_iter_get_basic(@AI,@p);
- If P<>Nil then
- Arg[l-1]:=StrPas(P)
- else
- Arg[l-1]:='';
- dbus_message_iter_next(@ai)
- end;
- dbus_message_iter_next (@FIter);
- If Length(Arg)<>L then
- SetLength(Arg,L);
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: TStringList);
- Var
- A : cInt;
- AI : DBUSMessageIter;
- p : Pchar;
- begin
- A:=GetArgumentType;
- If (A<>DBUS_TYPE_ARRAY) then
- Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_ARRAY),Char(A)]);
- A:=GetElementType;
- If (A<>DBUS_TYPE_STRING) then
- Error(SErrInvalidArrayElementType,[Char(DBUS_TYPE_STRING),Char(A)]);
- dbus_message_iter_recurse(@FIter, @AI);
- Arg.Clear;
- while (dbus_message_iter_get_arg_type(@AI)<>DBUS_TYPE_INVALID) do
- begin
- dbus_message_iter_get_basic(@AI,@p);
- If P<>Nil then
- Arg.Add(StrPas(P))
- else
- Arg.Add('');
- dbus_message_iter_next(@ai);
- end;
- Next;
- end;
- procedure TDBusMessageIterator.GetArgument(var Arg: Variant);
- Var
- A : cInt;
- AI : DBUSMessageIter;
- p : Pchar;
- By : Byte;
- Boo : Boolean;
- S : smallint;
- W : word;
- I : Integer;
- C : Cardinal;
- I64 : Int64;
- Q : QWord;
- D : Double;
- St : String;
- IR : TDBusMessageIterator;
- begin
- A:=GetArgumentType;
- If (A<>DBUS_TYPE_VARIANT) then
- Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_VARIANT),Char(A)]);
- IR:=Recurse;
- try
- A:=IR.GetArgumentType;
- case A of
- DBUS_TYPE_BYTE :
- begin
- IR.GetArgument(By);
- Arg:=by;
- end;
- DBUS_TYPE_BOOLEAN :
- begin
- IR.GetArgument(Boo);
- Arg:=Boo;
- end;
- DBUS_TYPE_INT16 :
- begin
- IR.GetArgument(S);
- Arg:=S;
- end;
- DBUS_TYPE_UINT16 :
- begin
- IR.GetArgument(W);
- Arg:=W;
- end;
- DBUS_TYPE_INT32 :
- begin
- IR.GetArgument(I);
- Arg:=I;
- end;
- DBUS_TYPE_UINT32 :
- begin
- IR.GetArgument(C);
- Arg:=C;
- end;
- DBUS_TYPE_INT64 :
- begin
- IR.GetArgument(I64);
- Arg:=I64;
- end;
- DBUS_TYPE_UINT64 :
- begin
- IR.GetArgument(Q);
- Arg:=Q;
- end;
- DBUS_TYPE_DOUBLE :
- begin
- IR.GetArgument(D);
- Arg:=D;
- end;
- DBUS_TYPE_STRING :
- begin
- IR.GetArgument(St);
- Arg:=St;
- end;
- else
- Error(SErrInvalidVariantType,[Char(DBUS_TYPE_VARIANT),Char(A)]);
- end;
- finally
- IR.free;
- end;
- Next;
- end;
- procedure TDBusMessageIterator.GetArgument(Const Arg: TDBUSDictionary);
- Var
- A : cInt;
- I : TDBusMessageIterator;
- begin
- A:=GetArgumentType;
- If (A<>DBUS_TYPE_ARRAY) then
- Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_ARRAY),Char(A)]);
- A:=GetElementType;
- If (A<>DBUS_TYPE_DICT_ENTRY) then
- Error(SErrInvalidArrayElementType,[Char(DBUS_TYPE_DICT_ENTRY),Char(A)]);
- I:=Recurse;
- try
- While I.HasNext do
- Arg.AddDictItem.Load(I);
- finally
- I.Free;
- end;
- end;
- procedure TDBusMessageIterator.Append(AType: cInt; const Value);
- begin
- if (0=dbus_message_iter_append_basic(@FIter,AType,@Value)) then
- RaiseDbusError(ClassName,SErrAppendFailed);
- end;
- procedure TDBusMessageIterator.AppendArgument(const Arg: Byte);
- begin
- Append(DBUS_TYPE_BYTE,Arg);
- end;
- procedure TDBusMessageIterator.AppendArgument(Const Arg: Boolean);
- Var
- B : dbus_bool_t;
- begin
- B:=Ord(Arg);
- Append(dbus.DBUS_TYPE_BOOLEAN,B);
- end;
- procedure TDBusMessageIterator.AppendArgument(const Arg: SmallInt);
- begin
- Append(DBUS_TYPE_INT16,Arg);
- end;
- procedure TDBusMessageIterator.AppendArgument(const Arg: Word);
- begin
- Append(DBUS_TYPE_UINT16,Arg);
- end;
- procedure TDBusMessageIterator.AppendArgument(Const Arg: Integer);
- begin
- Append(DBUS_TYPE_INT32,Arg);
- end;
- procedure TDBusMessageIterator.AppendArgument(const Arg: Cardinal);
- begin
- Append(DBUS_TYPE_UINT32,Arg);
- end;
- procedure TDBusMessageIterator.AppendArgument(const Arg: Int64);
- begin
- Append(DBUS_TYPE_INT64,Arg);
- end;
- procedure TDBusMessageIterator.AppendArgument(const Arg: QWord);
- begin
- Append(DBUS_TYPE_UINT64,Arg);
- end;
- procedure TDBusMessageIterator.AppendArgument(const Arg: Double);
- begin
- Append(DBUS_TYPE_DOUBLE,Arg);
- end;
- procedure TDBusMessageIterator.AppendArgument(Const Arg: String);
- Var
- P : PChar;
- begin
- P:=Pchar(Arg);
- Append(DBUS_TYPE_STRING,P);
- end;
- { TDBUSDictionary }
- function TDBUSDictionary.AddDictItem: TDBUSDictItem;
- begin
- Result:=Add as TDBUSDictItem;
- end;
- end.
|