dbuscomp.pp 61 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609
  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. DBUS component layer on top of the DBUS library.
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. unit dbuscomp;
  13. {$mode objfpc}
  14. {$h+}
  15. interface
  16. uses
  17. Classes, SysUtils, ctypes,dbus;
  18. Type
  19. { TDBusMessage }
  20. TBooleanArray = Array of boolean;
  21. TByteArray = Array of Byte;
  22. TSmallIntArray = Array of SmallInt;
  23. TWordArray = Array of Word;
  24. TIntegerArray = Array of Integer;
  25. TCardinalArray = Array of Cardinal;
  26. TInt64Array = Array of Int64;
  27. TQWordArray = Array of QWord;
  28. TDoubleArray = Array of Double;
  29. TStringArray = Array of String;
  30. TDBUSDictionary = Class;
  31. { TDBusMessageIterator }
  32. TDBusMessageIterator = Class(TObject)
  33. private
  34. FIter : DBUSMessageIter;
  35. protected
  36. Procedure Error(Const Msg : String);
  37. Procedure Error(Const Fmt : String; Args : Array of Const);
  38. Public
  39. Constructor Create(AIter : DBUSMessageIter);
  40. Function GetFixedArray(Const AElementType : cint; Var P : Pointer) : cInt;
  41. Function GetArgumentType: cint;
  42. Function GetElementType: cint;
  43. Function Recurse: TDBusMessageIterator;
  44. Function HasNext : Boolean;
  45. Procedure Next;
  46. Procedure Get(AType : cInt; Var Value);
  47. Procedure GetArgument(Var Arg : Byte);
  48. Procedure GetArgument(Var Arg : Boolean);
  49. Procedure GetArgument(Var Arg : SmallInt);
  50. Procedure GetArgument(Var Arg : Word);
  51. Procedure GetArgument(Var Arg : Integer);
  52. Procedure GetArgument(Var Arg : Cardinal);
  53. Procedure GetArgument(var Arg : Int64);
  54. Procedure GetArgument(Var Arg : QWord);
  55. Procedure GetArgument(var Arg : Double);
  56. Procedure GetArgument(var Arg : String);
  57. Procedure GetArgument(Var Arg : TByteArray);
  58. Procedure GetArgument(Var Arg : TBooleanArray);
  59. Procedure GetArgument(Var Arg : TSmallIntArray);
  60. Procedure GetArgument(Var Arg : TWordArray);
  61. Procedure GetArgument(Var Arg : TIntegerArray);
  62. Procedure GetArgument(Var Arg : TCardinalArray);
  63. Procedure GetArgument(var Arg : TInt64Array);
  64. Procedure GetArgument(Var Arg : TQWordArray);
  65. Procedure GetArgument(var Arg : TDoubleArray);
  66. Procedure GetArgument(var Arg : TStringArray);
  67. Procedure GetArgument(var Arg : TStringList);
  68. Procedure GetArgument(Var Arg : Variant);
  69. Procedure GetArgument(Const Arg : TDBUSDictionary);
  70. Procedure Append(AType : cInt; Const Value);
  71. Procedure AppendArgument(Const Arg : Byte);
  72. Procedure AppendArgument(Const Arg : Boolean);
  73. Procedure AppendArgument(Const Arg : SmallInt);
  74. Procedure AppendArgument(Const Arg : Word);
  75. Procedure AppendArgument(Const Arg : Integer);
  76. Procedure AppendArgument(Const Arg : Cardinal);
  77. Procedure AppendArgument(Const Arg : Int64);
  78. Procedure AppendArgument(Const Arg : QWord);
  79. Procedure AppendArgument(Const Arg : Double);
  80. Procedure AppendArgument(Const Arg : String);
  81. end;
  82. TDBUSDictItem = Class(TCollectionItem)
  83. Protected
  84. Procedure Load(I : TDBUSMessageIterator); virtual; abstract;
  85. Procedure Save(I : TDBUSMessageIterator); virtual; abstract;
  86. end;
  87. { TDBUSDictionary }
  88. TDBUSDictionary = Class(TCollection)
  89. Protected
  90. Function AddDictItem : TDBUSDictItem;
  91. end;
  92. TDBusMessage = Class(TObject)
  93. private
  94. FFromSource: Boolean;
  95. FMessage: PDBUSMessage;
  96. FAppendCount : Integer;
  97. FAppendIterator : TDBUSMessageIterator;
  98. FGetCount : Integer;
  99. FGetIterator : TDBUSMessageIterator;
  100. procedure BeginAppend;
  101. procedure BeginGet;
  102. function BeginGetFixedArray(const AElementType: cint; var P: Pointer): cInt;
  103. procedure EndAppend;
  104. procedure EndGet;
  105. function GetMessage: PDBUSMessage;
  106. function GetReplySerial: dbus_uint32_t;
  107. function GetSerial: dbus_uint32_t;
  108. procedure SetReplySerial(const AValue: dbus_uint32_t);
  109. Protected
  110. Class function MessageType : cint; virtual; abstract;
  111. Procedure AllocateMessage; virtual; abstract;
  112. Procedure CheckNotFromSource;
  113. Procedure CheckNotAllocated;
  114. Procedure CheckAllocated;
  115. Function Allocated : boolean;
  116. Function Copy : TDBUSMessage;
  117. Procedure Error(Const Msg : String);
  118. Procedure Error(Const Fmt : String; Args : Array of Const);
  119. Property Message : PDBUSMessage Read GetMessage;
  120. Property FromSource : Boolean Read FFromSource;
  121. Property Serial : dbus_uint32_t Read GetSerial;
  122. Property ReplySerial : dbus_uint32_t Read GetReplySerial Write SetReplySerial;
  123. Public
  124. Constructor Create(ASource : PDBusMessage); virtual;
  125. Destructor Destroy; override;
  126. Procedure Append(AType : cInt; Const Value);
  127. Procedure AppendArgument(Const Arg : Byte);
  128. Procedure AppendArgument(Const Arg : Boolean);
  129. Procedure AppendArgument(Const Arg : SmallInt);
  130. Procedure AppendArgument(Const Arg : Word);
  131. Procedure AppendArgument(Const Arg : Integer);
  132. Procedure AppendArgument(Const Arg : Cardinal);
  133. Procedure AppendArgument(Const Arg : Int64);
  134. Procedure AppendArgument(Const Arg : QWord);
  135. Procedure AppendArgument(Const Arg : Double);
  136. Procedure AppendArgument(Const Arg : String);
  137. Procedure Get(AType : cInt; Var Value);
  138. Procedure GetArgument(Var Arg : Byte);
  139. Procedure GetArgument(Var Arg : Boolean);
  140. Procedure GetArgument(Var Arg : SmallInt);
  141. Procedure GetArgument(Var Arg : Word);
  142. Procedure GetArgument(Var Arg : Integer);
  143. Procedure GetArgument(Var Arg : Cardinal);
  144. Procedure GetArgument(var Arg : Int64);
  145. Procedure GetArgument(Var Arg : QWord);
  146. Procedure GetArgument(var Arg : Double);
  147. Procedure GetArgument(var Arg : String);
  148. Procedure GetArgument(Var Arg : TByteArray);
  149. Procedure GetArgument(Var Arg : TBooleanArray);
  150. Procedure GetArgument(Var Arg : TSmallIntArray);
  151. Procedure GetArgument(Var Arg : TWordArray);
  152. Procedure GetArgument(Var Arg : TIntegerArray);
  153. Procedure GetArgument(Var Arg : TCardinalArray);
  154. Procedure GetArgument(var Arg : TInt64Array);
  155. Procedure GetArgument(Var Arg : TQWordArray);
  156. Procedure GetArgument(var Arg : TDoubleArray);
  157. Procedure GetArgument(var Arg : TStringArray);
  158. Procedure GetArgument(var Arg : TStringList);
  159. Procedure GetArgument(Var Arg : Variant);
  160. Procedure GetArgument(Const Arg : TDBUSDictionary);
  161. Function GetNextArgumentType : cInt;
  162. Function GetArrayElementType : cInt;
  163. Function HasPath(Const APath : String) : boolean; virtual;
  164. Function HasSender(Const ASender : String) : boolean; virtual;
  165. Function HasSignature(Const ASignature : String) : boolean; virtual;
  166. Function IsError(Const AError : string) : Boolean; virtual;
  167. end;
  168. TDBUSGUID = Array[1..32] of Byte;
  169. { TDBUSInvalidMessage }
  170. TDBUSInvalidMessage = Class(TDBusMessage)
  171. Class function MessageType : cint; override;
  172. Procedure AllocateMessage; override;
  173. end;
  174. TDBUSInterfaceMessage = Class(TDBusMessage)
  175. Private
  176. FInterface: String;
  177. FPath: String;
  178. procedure SetInterface(const AValue: String);
  179. function GetInterface: String;
  180. procedure SetPath(const AValue: String);
  181. Public
  182. Function HasPath(Const APath : String) : boolean; override;
  183. Property ObjectPath : String Read FPath Write SetPath;
  184. Property InterfaceName : String Read GetInterface Write SetInterface;
  185. end;
  186. { TDBusMethodCallMessage }
  187. TDBusMethodCallMessage = Class(TDBUSInterfaceMessage)
  188. private
  189. FDestination: String;
  190. FMethod: String;
  191. procedure SetDestination(const AValue: String);
  192. procedure SetMethod(const AValue: String);
  193. Protected
  194. Class function MessageType : cint; override;
  195. Procedure AllocateMessage; override;
  196. Public
  197. Constructor Create(Const ADestination,AObjectPath,AInterface,AMethod : String); virtual; overload;
  198. Property Destination : String Read FDestination Write SetDestination;
  199. Property MethodName : String Read FMethod Write SetMethod;
  200. end;
  201. { TDBusSignalMessage }
  202. TDBusSignalMessage = Class(TDBusInterfaceMessage)
  203. private
  204. FName: String;
  205. procedure SetName(const AValue: String);
  206. Protected
  207. Class function MessageType : cint; override;
  208. Procedure AllocateMessage; override;
  209. Public
  210. Constructor Create(Const AObjectPath,AInterface,AName : String); virtual; overload;
  211. Property Name : String Read FName Write SetName;
  212. end;
  213. { TDBusReplyToMessage }
  214. TDBusReplyToMessage = Class(TDBUSMessage)
  215. Private
  216. FReplyTo: TDBUSMessage;
  217. procedure SetReplyto(const AValue: TDBUSMessage);
  218. Public
  219. Constructor Create(Const AReplyTo : TDBUSMessage); overload;
  220. Property ReplyTo : TDBUSMessage Read FReplyTo Write SetReplyto;
  221. end;
  222. { TDBusErrorMessage }
  223. TDBusErrorMessage = Class(TDBusReplyToMessage)
  224. private
  225. FErrorMessage: String;
  226. FErrorName: String;
  227. FName: String;
  228. procedure SetErrorMessage(const AValue: String);
  229. procedure SetErrorName(const AValue: String);
  230. Protected
  231. Class function MessageType : cint; override;
  232. Procedure AllocateMessage; override;
  233. Public
  234. Constructor Create(Const AReplyTo : TDBUSMessage; Const AErrorName,AErrorMessage : String); overload;
  235. Constructor Create(Const AReplyTo : TDBUSMessage; Const AErrorName,AFormat : String; Args : Array of const); overload;
  236. Property ErrorName : String Read FErrorName Write SetErrorName;
  237. Property ErrorMessage : String Read FErrorMessage Write SetErrorMessage;
  238. end;
  239. { TDBusMethodReturnMessage }
  240. TDBusMethodReturnMessage = Class(TDBusReplyToMessage)
  241. Protected
  242. Class function MessageType : cint; override;
  243. Procedure AllocateMessage; override;
  244. end;
  245. { TDBusPendingCall }
  246. TDBusPendingCall = Class(TObject)
  247. Protected
  248. FSource : PDBusPendingCall;
  249. Public
  250. Constructor Create(Const ASource : PDBusPendingCall);
  251. Destructor Destroy; override;
  252. end;
  253. TCustomDBUSConnection = Class;
  254. TDBUSFilterItem = Class;
  255. TDBusMessageHandler = Procedure (Sender : TObject; Msg : TDBUSMessage; Var AResult : DBusHandlerResult) of Object;
  256. { TDBUSMessageItem }
  257. TDBUSMessageItem = Class(TCollectionItem)
  258. private
  259. FRegistered: Boolean;
  260. FENabled: Boolean;
  261. FOnMessage: TDBusMessageHandler;
  262. function HaveHandle: Boolean;
  263. Private
  264. procedure SetEnabled(const AValue: Boolean);
  265. procedure SetOnMessage(const AValue: TDBusMessageHandler);
  266. Protected
  267. procedure MaybeRegister;
  268. Function ConnHandle : PDBUSConnection;
  269. function AllowRegister : Boolean; virtual;
  270. Procedure Register; virtual; abstract;
  271. Procedure Unregister; virtual; abstract;
  272. Public
  273. Procedure Assign(Source : TPersistent); override;
  274. Property Registered : Boolean Read FRegistered;
  275. Published
  276. Property Enabled : Boolean Read FENabled Write SetEnabled;
  277. Property OnMessage : TDBusMessageHandler Read FOnMessage Write SetOnMessage;
  278. end;
  279. TDBUSMessageItemClass = Class of TDBUSMessageItem;
  280. { TDBUSMessages }
  281. TDBUSMessages = Class(TCollection)
  282. private
  283. FConnection: TCustomDBUSConnection;
  284. Public
  285. Constructor Create(Const AConnection : TCustomDBUSConnection; AItemClass : TDBUSMessageItemClass);
  286. Property Connection : TCustomDBUSConnection Read FConnection;
  287. end;
  288. { TDBUSFilterItem }
  289. TDBUSFilterItem = Class(TDbusMessageItem)
  290. Public
  291. Procedure Register; override;
  292. Procedure Unregister; override;
  293. end;
  294. TDBUSFilterItemClass = Class of TDBUSFilterItem;
  295. { TDBUSFilters }
  296. TDBUSFilters = Class(TDBUSMessages)
  297. Private
  298. function GetF(AIndex : Integer): TDBUSFilterItem;
  299. procedure SetF(AIndex : Integer; const AValue: TDBUSFilterItem);
  300. Public
  301. Constructor Create(Const AConnection : TCustomDBUSConnection);
  302. Property Filters[AIndex : Integer] : TDBUSFilterItem Read GetF Write SetF; default;
  303. end;
  304. { TDBUSObjectItem }
  305. TDBUSObjectItem = Class(TDbusMessageItem)
  306. private
  307. FFallBack: Boolean;
  308. FPath: String;
  309. procedure SetFallback(const AValue: Boolean);
  310. procedure SetPath(const AValue: String);
  311. Public
  312. Procedure Register; override;
  313. Procedure Unregister; override;
  314. function AllowRegister : Boolean; override;
  315. Published
  316. Property Path : String Read FPath Write SetPath;
  317. Property FallBack : Boolean Read FFallBack Write SetFallback;
  318. end;
  319. TDBUSObjectItemClass = Class of TDBUSObjectItem;
  320. { TDBUSObjectItem }
  321. { TDBUSObjects }
  322. TDBUSObjects = Class(TDBUSMessages)
  323. Private
  324. function GetO(AIndex : Integer): TDBUSObjectItem;
  325. procedure SetO(AIndex : Integer; const AValue: TDBUSObjectItem);
  326. Public
  327. Constructor Create(Const AConnection : TCustomDBUSConnection);
  328. Property Objects[AIndex : Integer] : TDBUSObjectItem Read GetO Write SetO; default;
  329. end;
  330. { TCustomDBUSConnection }
  331. TConnectionKind = (ckCustom,ckSystem,ckSession,ckStarter);
  332. TCustomDBUSConnection = Class(TComponent)
  333. private
  334. FConn : PDBusConnection;
  335. FErr : DBusError;
  336. FFilters: TDBUSFilters;
  337. FKind: TConnectionKind;
  338. FLoadConnected : Boolean;
  339. FMaxReceivedSize : clong;
  340. FMaxMessageSize: clong;
  341. FObjects: TDBUSObjects;
  342. FPath: String;
  343. FShared: Boolean;
  344. function GetAnonymous: boolean;
  345. function GetAuthenticated: boolean;
  346. function GetConnected: Boolean;
  347. function GetDispatchStatus: DBusDispatchStatus;
  348. function GetMaxMessageSize: clong;
  349. function GetMaxReceivedSize: clong;
  350. function GetOutgoingSize: clong;
  351. function GetServerID: String;
  352. procedure SetConnected(const AValue: Boolean);
  353. procedure SetFilters(const AValue: TDBUSFilters);
  354. procedure SetKind(const AValue: TConnectionKind);
  355. procedure SetMaxMessageSize(const AValue: clong);
  356. procedure SetMaxReceivedSize(const AValue: clong);
  357. procedure SetObjects(const AValue: TDBUSObjects);
  358. procedure SetPath(const AValue: String);
  359. procedure SetShared(const AValue: Boolean);
  360. Protected
  361. Procedure CheckError;
  362. procedure CheckDisconnected;
  363. procedure CheckConnected;
  364. procedure Loaded; override;
  365. Function FilterClass : TDBUSFilterItemClass;
  366. Function ObjectClass : TDBUSObjectItemClass;
  367. Public
  368. Constructor Create(AOwner : TComponent); override;
  369. Destructor Destroy; override;
  370. Procedure Error(Const Msg : String);
  371. Procedure ResetError;
  372. procedure Connect;
  373. procedure Disconnect;
  374. procedure RegisterFilters;
  375. procedure UnRegisterFilters;
  376. procedure RegisterObjects;
  377. procedure UnRegisterObjects;
  378. Function PreAllocateSend : PDBusPreallocatedSend;
  379. Procedure FreePreAllocatedSend(Allocated : PDBusPreallocatedSend);
  380. Procedure SendPreallocated(Allocated : PDBusPreallocatedSend; AMessage : TDBusMessage; out ASerial : dbus_uint32_t);
  381. Procedure SendPreallocated(Allocated : PDBusPreallocatedSend; AMessage : TDBusMessage);
  382. function Send(AMessage : TDBusMessage; out ASerial : dbus_uint32_t) : boolean;
  383. function Send(AMessage : TDBusMessage) : boolean;
  384. Function SendWithReply(AMessage : TDBusMessage; Out PendingCall : TDBUSPendingCall; Const TimeOut : cInt) : boolean;
  385. Function SendWithReplyAndBlock(AMessage : TDBusMessage; Const TimeOut : cInt) : TDBusMessage;
  386. Procedure Flush;
  387. Function ReadWriteDispatch(Const ATimeOut : cInt): Boolean;
  388. Function ReadWrite(Const ATimeOut : cInt): Boolean;
  389. Function BorrowMessage : TDBUSMessage;
  390. Function GetUnixFileDescriptor(Var fd : cInt) : Boolean;
  391. Function GetUnixProcessID(Var ID : CUlong) : Boolean;
  392. Function GetUnixUser(Var UID : CUlong) : Boolean;
  393. Function GetWindowsUser(Var SID : String) : Boolean;
  394. Function GetSocket(Var SD : cint) : Boolean;
  395. Function GetObjectPathData(Const Path : String; DoCheck : Boolean = False) : TDBUSObjectItem;
  396. Procedure SetAllowAnonymous(AValue : Boolean);
  397. Procedure SetRoutePeerMessages(AValue : Boolean);
  398. Procedure ReturnMessage(var AMessage : TDBUSMessage);
  399. Procedure StealBorrowedMessage(var AMessage : TDBUSMessage);
  400. Procedure ListRegistered(Const APath : String; AList : TStrings);
  401. Class Function AllocateDataSlot(Var slot : dbus_int32_t) : Boolean;
  402. Class procedure FreeDataSlot(Var slot : dbus_int32_t);
  403. Function SetData(Const Slot: dbus_int32_t; Const Data : Pointer; Const FreeFunction : DBUSFreeFunction) : Boolean;
  404. Function GetData(Const Slot: dbus_int32_t) : Pointer;
  405. Function PopMessage : TDBUSMessage;
  406. Function Dispatch : DBusDispatchStatus;
  407. Property DispatchStatus : DBusDispatchStatus Read GetDispatchStatus;
  408. Protected
  409. Property Connected : Boolean Read GetConnected Write SetConnected;
  410. Property Kind : TConnectionKind Read FKind Write SetKind;
  411. Property Shared : Boolean read FShared Write SetShared default true;
  412. Property Path : String Read FPath Write SetPath;
  413. Property MaxMessageSize : clong Read GetMaxMessageSize Write SetMaxMessageSize;
  414. Property MaxReceiveSize : clong Read GetMaxReceivedSize Write SetMaxReceivedSize;
  415. Property OutgoingSize : clong Read GetOutgoingSize;
  416. Property Authenticated : boolean Read GetAuthenticated;
  417. Property Anonymous : boolean Read GetAnonymous;
  418. Property ServerID : String Read GetServerID;
  419. Property Filters : TDBUSFilters Read FFilters Write SetFilters;
  420. Property Objects : TDBUSObjects Read FObjects Write SetObjects;
  421. end;
  422. TDBUSConnection = Class(TCustomDBUSConnection)
  423. Public
  424. Property OutgoingSize;
  425. Property Authenticated;
  426. Property Anonymous;
  427. Property ServerID;
  428. Published
  429. Property Connected;
  430. Property Kind;
  431. Property Shared;
  432. Property Path;
  433. Property MaxMessageSize;
  434. Property MaxReceiveSize;
  435. Property Filters;
  436. Property Objects;
  437. end;
  438. { EDBus }
  439. EDBus = Class(Exception)
  440. private
  441. FName: String;
  442. Public
  443. Property Name : String Read FName;
  444. end;
  445. Function CreateMessageFromSource(M : PDbusMessage) : TDBusMessage;
  446. Procedure RaiseDBUSError(Const AName,AMsg : String);
  447. Procedure RaiseDBUSError(Const AName,Fmt : String; Args : Array of const);
  448. implementation
  449. resourcestring
  450. SErrInvalidOperationWhileConnected = 'Cannot perform this operation when connected to the bus.';
  451. SErrInvalidOperationWhileDisconnected = 'Cannot perform this operation when disconnected from the bus.';
  452. SErrNoDBUSPath = 'No DBUS Address to connect to.';
  453. SErrEmptymessage = 'Source message is Nil';
  454. SerrWrongMessageType = 'Wrong message type. Expected %d, got %d';
  455. SErrUnknownMessageType = 'Unknown message type: %d';
  456. SErrInvalidMessageType = 'Cannot create unknown message type';
  457. SErrInvalidOperationFromSource = 'This operation cannot be performed on a message coming from the DBUS';
  458. SErrInvalidOperationWhenAllocated = 'This operation cannot be performed when a message was allocated';
  459. SErrInvalidOperationWhenNotAllocated = 'This operation cannot be performed when the is not allocated';
  460. SErrEmptyPath = 'Cannot allocate method call message: no path specified';
  461. SErrEmptyMethod = 'Cannot allocate method call message: no method specified';
  462. SErrEmptyName = 'Cannot allocate signal message: no signal name specified';
  463. SErrNoErrorName = 'Cannot allocate error message: no error name specified';
  464. SErrNoReplyTo = 'Cannot allocate error message: no reply to message specified';
  465. SErrObjectWithoutPath = 'Cannot (un)register an object without path';
  466. SErrCouldNotSetReplySerial = 'Could not set reply serial';
  467. SErrInitIter = 'Could not initialize iterator';
  468. SErrAppendFailed = 'Append of argument to message failed';
  469. SErrNoMoreArguments = 'No more arguments available';
  470. SErrInvalidArgumentType = 'Invalid argument type. Expected %s, got %s.';
  471. SErrInvalidArrayElementType = 'Invalid array element type. Expected %s got %s';
  472. SErrInvalidVariantType = 'Invalid VARIANT type';
  473. Function CreateMessageFromSource(M : PDbusMessage) : TDBusMessage;
  474. begin
  475. If M=Nil then
  476. Result:=Nil
  477. else
  478. case dbus_message_get_type(M) of
  479. DBUS_MESSAGE_TYPE_INVALID : Result:=TDBUSInvalidMessage.Create(M);
  480. DBUS_MESSAGE_TYPE_METHOD_CALL : Result:=TDBUSMethodCallmessage.Create(M);
  481. DBUS_MESSAGE_TYPE_METHOD_RETURN : Result:=TDBUSMethodReturnMessage.Create(M);
  482. DBUS_MESSAGE_TYPE_ERROR : Result:=TDBUSErrorMessage.Create(M);
  483. DBUS_MESSAGE_TYPE_SIGNAL : Result:=TDBUSSignalMessage.Create(M);
  484. else
  485. Raise EDBUS.CreateFmt(SErrUnknownMessageType,[dbus_message_get_type(M)]);
  486. end
  487. end;
  488. procedure RaiseDBUSError(const AName, AMsg: String);
  489. Var
  490. E : EDBUS;
  491. begin
  492. E:=EDBUS.Create(Amsg);
  493. E.FName:=AName;
  494. Raise E;
  495. end;
  496. procedure RaiseDBUSError(const AName, Fmt: String; Args: array of const);
  497. begin
  498. RaiseDBUSError(AName,Format(Fmt,Args));
  499. end;
  500. { TCustomDBUSConnection }
  501. function TCustomDBUSConnection.GetConnected: Boolean;
  502. begin
  503. Result:=(FConn<>Nil);
  504. If Result then
  505. begin
  506. result:=dbus_connection_get_is_connected(FConn)<>0;
  507. If not Result then
  508. Disconnect;
  509. end;
  510. end;
  511. function TCustomDBUSConnection.GetAnonymous: boolean;
  512. begin
  513. CheckConnected;
  514. Result:=False;
  515. result:=(0<>dbus_connection_get_is_anonymous(FConn));
  516. end;
  517. function TCustomDBUSConnection.GetAuthenticated: boolean;
  518. begin
  519. CheckConnected;
  520. result:=(0<>dbus_connection_get_is_authenticated(FConn));
  521. end;
  522. function TCustomDBUSConnection.GetMaxMessageSize: clong;
  523. begin
  524. if Connected then
  525. Result:=dbus_connection_get_max_message_size(FConn)
  526. else
  527. Result:=FMaxMessageSize;
  528. end;
  529. function TCustomDBUSConnection.GetMaxReceivedSize: clong;
  530. begin
  531. if Connected then
  532. Result:=dbus_connection_get_max_received_size(FConn)
  533. else
  534. Result:=FMaxReceivedSize;
  535. end;
  536. function TCustomDBUSConnection.GetOutgoingSize: clong;
  537. begin
  538. CheckConnected;
  539. Result:=dbus_connection_get_outgoing_size(fconn);
  540. end;
  541. function TCustomDBUSConnection.GetServerID: String;
  542. Var
  543. p : pchar;
  544. begin
  545. CheckConnected;
  546. p:=nil;
  547. p:=dbus_connection_get_server_id(Fconn);
  548. If p<>nil then
  549. Result:=strpas(p);
  550. end;
  551. procedure TCustomDBUSConnection.SetConnected(const AValue: Boolean);
  552. begin
  553. If (AValue=GetConnected) then exit;
  554. If (csLoading in ComponentState) then
  555. FLoadConnected:=AValue
  556. else
  557. If AValue then
  558. Connect
  559. else
  560. DisConnect;
  561. end;
  562. procedure TCustomDBUSConnection.SetFilters(const AValue: TDBUSFilters);
  563. begin
  564. if (FFilters=AValue) then exit;
  565. FFilters.Assign(AValue);
  566. end;
  567. procedure TCustomDBUSConnection.SetKind(const AValue: TConnectionKind);
  568. begin
  569. if (Kind<>AValue) then
  570. CheckDisconnected;
  571. FKind:=AValue;
  572. end;
  573. procedure TCustomDBUSConnection.SetMaxMessageSize(const AValue: clong);
  574. begin
  575. FMaxMessageSize:=AValue;
  576. If Connected and (AValue<>0) then
  577. dbus_connection_set_max_message_size(fconn,AValue);
  578. end;
  579. procedure TCustomDBUSConnection.SetMaxReceivedSize(const AValue: clong);
  580. begin
  581. FMaxMessageSize:=AValue;
  582. If Connected and (AValue<>0) then
  583. dbus_connection_set_max_received_size(fconn,AValue);
  584. end;
  585. procedure TCustomDBUSConnection.SetObjects(const AValue: TDBUSObjects);
  586. begin
  587. if FObjects=AValue then exit;
  588. FObjects.Assign(AValue);
  589. end;
  590. procedure TCustomDBUSConnection.SetPath(const AValue: String);
  591. begin
  592. if FPath=AValue then exit;
  593. CheckDisconnected;
  594. FPath:=AValue;
  595. end;
  596. procedure TCustomDBUSConnection.SetShared(const AValue: Boolean);
  597. begin
  598. if (AValue=FShared) then exit;
  599. CheckDisconnected;
  600. FShared:=AValue;
  601. end;
  602. procedure TCustomDBUSConnection.CheckError;
  603. Var
  604. E : EDBUS;
  605. begin
  606. If (dbus_error_is_set(@FErr)<>0) then
  607. begin
  608. E:=EDBUS.Create(strpas(FErr.Message));
  609. E.FName:=StrPas(FErr.Name);
  610. ResetError;
  611. Raise E;
  612. end;
  613. end;
  614. procedure TCustomDBUSConnection.CheckDisconnected;
  615. begin
  616. If Connected then
  617. Error(SErrInvalidOperationWhileConnected);
  618. end;
  619. procedure TCustomDBUSConnection.CheckConnected;
  620. begin
  621. If not Connected then
  622. Error(SErrInvalidOperationWhileDisconnected);
  623. end;
  624. procedure TCustomDBUSConnection.Loaded;
  625. begin
  626. If FLoadConnected then
  627. Connect;
  628. end;
  629. function TCustomDBUSConnection.FilterClass: TDBUSFilterItemClass;
  630. begin
  631. Result:=TDBUSFilterItem;
  632. end;
  633. function TCustomDBUSConnection.ObjectClass: TDBUSObjectItemClass;
  634. begin
  635. Result:=TDBUSObjectItem;
  636. end;
  637. constructor TCustomDBUSConnection.Create(AOwner: TComponent);
  638. begin
  639. inherited Create(AOwner);
  640. dbus_error_init(@FErr);
  641. FShared:=True;
  642. FFilters:=TDBUSFilters.Create(Self);
  643. FObjects:=TDBUSObjects.Create(Self);
  644. end;
  645. destructor TCustomDBUSConnection.Destroy;
  646. begin
  647. Disconnect;
  648. FreeAndNil(FFilters);
  649. FreeAndNil(FObjects);
  650. inherited Destroy;
  651. end;
  652. procedure TCustomDBUSConnection.Error(Const Msg: String);
  653. Var
  654. E : EDBUS;
  655. begin
  656. E:=EDBUS.Create(Msg);
  657. E.FName:=Self.Name;
  658. Raise E;
  659. end;
  660. procedure TCustomDBUSConnection.ResetError;
  661. begin
  662. dbus_error_free(@FErr);
  663. end;
  664. procedure TCustomDBUSConnection.Connect;
  665. Const
  666. CFlags : Array[TConnectionKind] of DBUSBusType
  667. = (DBUS_BUS_SYSTEM,DBUS_BUS_SYSTEM,DBUS_BUS_SESSION,DBUS_BUS_STARTER);
  668. begin
  669. if GetConnected then exit;
  670. case kind of
  671. ckCustom :
  672. begin
  673. If (FPath='') then
  674. Error(SErrNoDBUSPath);
  675. if Shared then
  676. fconn:=dbus_connection_open(pchar(FPath),@Ferr)
  677. else
  678. fconn:=dbus_connection_open_private(pchar(FPath),@Ferr);
  679. CheckError;
  680. end;
  681. ckSystem,
  682. ckSession,
  683. ckStarter :
  684. begin
  685. If Shared then
  686. FConn:=dbus_bus_get(CFlags[kind],@Ferr)
  687. else
  688. FConn:=dbus_bus_get_private(CFlags[kind],@Ferr);
  689. CheckError;
  690. if Shared then
  691. dbus_connection_set_exit_on_disconnect(FConn,Ord(False));
  692. end;
  693. end;
  694. If (FMaxMessageSize<>0) then
  695. dbus_connection_set_max_message_size(fconn,FMaxMessageSize);
  696. RegisterFilters;
  697. end;
  698. procedure TCustomDBUSConnection.Disconnect;
  699. begin
  700. UnregisterFilters;
  701. UnregisterObjects;
  702. if Not Shared then
  703. dbus_connection_close(FConn)
  704. else
  705. dbus_connection_unref(FConn);
  706. FConn:=Nil;
  707. end;
  708. procedure TCustomDBUSConnection.RegisterFilters;
  709. Var
  710. i : integer;
  711. begin
  712. For I:=0 to FFilters.Count-1 do
  713. FFilters[i].MaybeRegister;
  714. end;
  715. procedure TCustomDBUSConnection.UnRegisterFilters;
  716. Var
  717. i : integer;
  718. begin
  719. For I:=0 to FFilters.Count-1 do
  720. If FFilters[i].Registered then
  721. FFilters[i].UnRegister;
  722. end;
  723. procedure TCustomDBUSConnection.RegisterObjects;
  724. Var
  725. i : integer;
  726. begin
  727. For I:=0 to FObjects.Count-1 do
  728. FObjects[i].MaybeRegister;
  729. end;
  730. procedure TCustomDBUSConnection.UnRegisterObjects;
  731. Var
  732. i : integer;
  733. begin
  734. For I:=0 to FObjects.Count-1 do
  735. If FObjects[i].Registered then
  736. FObjects[i].UnRegister;
  737. end;
  738. function TCustomDBUSConnection.PreallocateSend: PDBusPreallocatedSend;
  739. begin
  740. CheckConnected;
  741. Result:=dbus_connection_preallocate_send(FConn);
  742. end;
  743. procedure TCustomDBUSConnection.FreePreAllocatedSend(
  744. Allocated: PDBusPreallocatedSend);
  745. begin
  746. CheckConnected;
  747. dbus_connection_free_preallocated_send(FConn,Allocated);
  748. end;
  749. procedure TCustomDBUSConnection.SendPreallocated(
  750. Allocated: PDBusPreallocatedSend; AMessage: TDBusMessage;
  751. out ASerial: dbus_uint32_t);
  752. begin
  753. CheckConnected;
  754. dbus_connection_send_preallocated(FConn,Allocated,AMessage.Message,@ASerial);
  755. end;
  756. procedure TCustomDBUSConnection.SendPreallocated(
  757. Allocated: PDBusPreallocatedSend; AMessage: TDBusMessage);
  758. Var
  759. s : dbus_uint32_t;
  760. begin
  761. SendPreallocated(Allocated,AMessage,S);
  762. end;
  763. function TCustomDBUSConnection.Send(AMessage: TDBusMessage; out
  764. ASerial: dbus_uint32_t): boolean;
  765. begin
  766. CheckConnected;
  767. Result:=dbus_connection_send(FConn,AMessage.Message,@ASerial)<>0;
  768. end;
  769. function TCustomDBUSConnection.Send(AMessage: TDBusMessage): boolean;
  770. Var
  771. s : dbus_uint32_t;
  772. begin
  773. Result:=Send(AMessage,S);
  774. end;
  775. function TCustomDBUSConnection.SendWithReply(AMessage: TDBusMessage; out
  776. PendingCall: TDBUSPendingCall; const TimeOut: cInt): boolean;
  777. Var
  778. P : PDBusPendingCall;
  779. begin
  780. CheckConnected;
  781. PendingCall:=Nil;
  782. Result:=dbus_connection_send_with_reply(FConn,AMessage.Message,@P,TimeOut)<>0;
  783. if Result then
  784. if (P<>Nil) then
  785. PendingCall:=TDBUSPendingCall.Create(P);
  786. end;
  787. function TCustomDBUSConnection.SendWithReplyAndBlock(AMessage: TDBusMessage;
  788. const TimeOut: cInt): TDBusMessage;
  789. Var
  790. M : PDBusMessage;
  791. begin
  792. CheckConnected;
  793. M:=dbus_connection_send_with_reply_and_block(FConn,AMessage.Message,TimeOut,@FErr);
  794. CheckError;
  795. Result:=CreateMessageFromSource(M);
  796. end;
  797. procedure TCustomDBUSConnection.Flush;
  798. begin
  799. CheckConnected;
  800. dbus_connection_flush(FConn);
  801. end;
  802. function TCustomDBUSConnection.ReadWriteDispatch(Const ATimeOut : cInt): Boolean;
  803. begin
  804. CheckConnected;
  805. Result:=dbus_connection_read_write_dispatch(FConn,ATimeOut)<>0;
  806. end;
  807. function TCustomDBUSConnection.ReadWrite(const ATimeOut: cInt): Boolean;
  808. begin
  809. CheckConnected;
  810. Result:=dbus_connection_read_write(FConn,ATimeOut)<>0;
  811. end;
  812. function TCustomDBUSConnection.BorrowMessage: TDBUSMessage;
  813. begin
  814. CheckConnected;
  815. Result:=CreateMessageFromSource(dbus_connection_borrow_message(FConn));
  816. end;
  817. function TCustomDBUSConnection.GetUnixFileDescriptor(Var fd: cInt) : Boolean;
  818. begin
  819. CheckConnected;
  820. Result:=dbus_connection_get_unix_fd(FConn,@fd)<>0;
  821. end;
  822. function TCustomDBUSConnection.GetUnixProcessID(var ID: CUlong): Boolean;
  823. begin
  824. checkconnected;
  825. Result:=dbus_connection_get_unix_process_id(FConn,@ID)<>0;
  826. end;
  827. function TCustomDBUSConnection.GetUnixUser(var UID: CUlong): Boolean;
  828. begin
  829. checkconnected;
  830. Result:=dbus_connection_get_unix_user(FConn,@UID)<>0;
  831. end;
  832. function TCustomDBUSConnection.GetWindowsUser(var SID: String): Boolean;
  833. Var
  834. P : PChar;
  835. begin
  836. checkconnected;
  837. Result:=dbus_connection_get_windows_user(FConn,@P)<>0;
  838. If Result and (P<>Nil) then
  839. SID:=StrPas(P)
  840. else
  841. Sid:='';
  842. end;
  843. function TCustomDBUSConnection.GetSocket(var SD: cint): Boolean;
  844. begin
  845. checkconnected;
  846. Result:=dbus_connection_get_socket(FConn,@SD)<>0;
  847. end;
  848. function TCustomDBUSConnection.GetObjectPathData(const Path : String; DoCheck : Boolean = False): TDBUSObjectItem;
  849. Var
  850. P : Pointer;
  851. I : integer;
  852. begin
  853. CheckConnected;
  854. dbus_connection_get_object_path_data(FConn,Pchar(Path),@P);
  855. Result:=Nil;
  856. If (P<>Nil) then
  857. if DoCheck then
  858. begin
  859. I:=FObjects.Count-1;
  860. While (Result=Nil) and (I>=0) do
  861. begin
  862. If (Pointer(FObjects[i])=P) then
  863. Result:=TDBUSObjectItem(P);
  864. Dec(I);
  865. end;
  866. end
  867. else
  868. Result:=TDBUSObjectItem(P);
  869. end;
  870. procedure TCustomDBUSConnection.SetAllowAnonymous(AValue: Boolean);
  871. begin
  872. CheckConnected;
  873. dbus_connection_set_allow_anonymous(FConn,Ord(AValue));
  874. end;
  875. procedure TCustomDBUSConnection.SetRoutePeerMessages(AValue: Boolean);
  876. begin
  877. CheckConnected;
  878. dbus_connection_set_route_peer_messages(FConn,Ord(AValue));
  879. end;
  880. procedure TCustomDBUSConnection.ReturnMessage(var AMessage: TDBUSMessage);
  881. begin
  882. CheckConnected;
  883. dbus_connection_return_message(FConn,AMessage.Message);
  884. AMessage.FMessage:=Nil;
  885. FreeAndNil(AMessage);
  886. end;
  887. procedure TCustomDBUSConnection.StealBorrowedMessage(var AMessage: TDBUSMessage
  888. );
  889. begin
  890. CheckConnected;
  891. dbus_connection_steal_borrowed_message(FConn,AMessage.Message);
  892. end;
  893. procedure TCustomDBUSConnection.ListRegistered(const APath: String;
  894. AList: TStrings);
  895. Var
  896. P : PPchar;
  897. begin
  898. CheckConnected;
  899. AList.Clear;
  900. if (dbus_connection_list_registered(FConn,PChar(APath),@P)<>0) then
  901. If (P<>Nil) then
  902. begin
  903. While (P^<>Nil) do
  904. begin
  905. AList.Add(StrPas(P^));
  906. Inc(P);
  907. end;
  908. dbus_free_string_array(P);
  909. end;
  910. end;
  911. class function TCustomDBUSConnection.AllocateDataSlot(var slot: dbus_int32_t
  912. ): Boolean;
  913. begin
  914. Result:=dbus_connection_allocate_data_slot(@slot)<>0;
  915. end;
  916. class procedure TCustomDBUSConnection.FreeDataSlot(var slot: dbus_int32_t);
  917. begin
  918. dbus_connection_free_data_slot(@slot);
  919. end;
  920. function TCustomDBUSConnection.SetData(const Slot: dbus_int32_t;
  921. const Data: Pointer; const FreeFunction: DBUSFreeFunction): Boolean;
  922. begin
  923. CheckConnected;
  924. Result:=0<>dbus_connection_set_Data(FConn,Slot,Data,FreeFunction);
  925. end;
  926. function TCustomDBUSConnection.GetData(const Slot: dbus_int32_t): Pointer;
  927. begin
  928. CheckConnected;
  929. Result:=dbus_connection_get_Data(FConn,Slot);
  930. end;
  931. function TCustomDBUSConnection.PopMessage: TDBUSMessage;
  932. begin
  933. CheckConnected;
  934. Result:=CreateMessageFromSource(dbus_connection_pop_message(FConn));
  935. end;
  936. function TCustomDBUSConnection.Dispatch: DBusDispatchStatus;
  937. begin
  938. CheckConnected;
  939. Result:=dbus_connection_dispatch(FConn);
  940. end;
  941. function TCustomDBUSConnection.GetDispatchStatus: DBusDispatchStatus;
  942. begin
  943. CheckConnected;
  944. Result:=dbus_connection_get_dispatch_status(FConn);
  945. end;
  946. { TDBusMessage }
  947. function TDBusMessage.GetMessage: PDBUSMessage;
  948. begin
  949. If (FMessage=Nil) then
  950. AllocateMessage;
  951. Result:=FMessage;
  952. end;
  953. function TDBusMessage.GetReplySerial: dbus_uint32_t;
  954. begin
  955. CheckAllocated;
  956. result:=dbus_message_get_reply_serial(message);
  957. end;
  958. function TDBusMessage.GetSerial: dbus_uint32_t;
  959. begin
  960. CheckAllocated;
  961. result:=dbus_message_get_serial(message);
  962. end;
  963. procedure TDBusMessage.SetReplySerial(const AValue: dbus_uint32_t);
  964. begin
  965. CheckAllocated;
  966. if dbus_message_set_reply_serial(message,AVAlue)<>0 then
  967. Raise EDBUS.Create(SErrCouldNotSetReplySerial);
  968. end;
  969. procedure TDBusMessage.CheckNotFromSource;
  970. begin
  971. If FFromSource then
  972. Error(SErrInvalidOperationFromSource);
  973. end;
  974. procedure TDBusMessage.CheckNotAllocated;
  975. begin
  976. If Allocated then
  977. Error(SErrInvalidOperationWhenAllocated);
  978. end;
  979. procedure TDBusMessage.CheckAllocated;
  980. begin
  981. If Allocated then
  982. Error(SErrInvalidOperationWhenNotAllocated);
  983. end;
  984. procedure TDBusMessage.BeginAppend;
  985. Var
  986. A : DBUSMessageIter;
  987. begin
  988. If (FAppendCount=0) then
  989. begin
  990. dbus_message_iter_init_append(message,@A);
  991. FAppendIterator:=TDBUSmessageIterator.Create(A);
  992. end;
  993. Inc(FAppendCount);
  994. end;
  995. procedure TDBusMessage.Append(AType: cInt; const Value);
  996. begin
  997. BeginAppend;
  998. try
  999. FAppendIterator.Append(Atype,Value);
  1000. finally
  1001. EndAppend;
  1002. end;
  1003. end;
  1004. procedure TDBusMessage.EndAppend;
  1005. begin
  1006. Dec(FAppendCount);
  1007. end;
  1008. function TDBusMessage.Allocated: boolean;
  1009. begin
  1010. Result:=(FMessage<>Nil);
  1011. end;
  1012. function TDBusMessage.Copy: TDBUSMessage;
  1013. begin
  1014. CheckAllocated;
  1015. Result:=CreateMessageFromSource(dbus_message_copy(message));
  1016. end;
  1017. procedure TDBusMessage.Error(const Msg: String);
  1018. begin
  1019. RaiseDBusError(ClassName,Msg);
  1020. end;
  1021. procedure TDBusMessage.Error(const Fmt: String; Args: array of const);
  1022. begin
  1023. RaiseDBUSError(ClassName,Fmt,Args);
  1024. end;
  1025. constructor TDBusMessage.Create(ASource: PDBusMessage);
  1026. Var
  1027. t : cint;
  1028. begin
  1029. If (ASource=Nil) then
  1030. Error(SErrEmptymessage);
  1031. t:=dbus_message_get_type(ASource);
  1032. If (t<>MessageType) then
  1033. Error(SerrWrongMessageType,[MessageType,T]);
  1034. FMessage:=ASource;
  1035. FFromSource:=True;
  1036. end;
  1037. destructor TDBusMessage.Destroy;
  1038. begin
  1039. if Allocated then
  1040. dbus_message_unref(FMessage);
  1041. inherited Destroy;
  1042. end;
  1043. procedure TDBusMessage.AppendArgument(const Arg: Byte);
  1044. begin
  1045. BeginAppend;
  1046. try
  1047. FAppendIterator.AppendArgument(Arg);
  1048. finally
  1049. EndAppend;
  1050. end;
  1051. end;
  1052. procedure TDBusMessage.AppendArgument(Const Arg: Boolean);
  1053. begin
  1054. BeginAppend;
  1055. try
  1056. FAppendIterator.AppendArgument(Arg);
  1057. finally
  1058. EndAppend;
  1059. end;
  1060. end;
  1061. procedure TDBusMessage.AppendArgument(const Arg: SmallInt);
  1062. begin
  1063. BeginAppend;
  1064. try
  1065. FAppendIterator.AppendArgument(Arg);
  1066. finally
  1067. EndAppend;
  1068. end;
  1069. end;
  1070. procedure TDBusMessage.AppendArgument(const Arg: Word);
  1071. begin
  1072. BeginAppend;
  1073. try
  1074. FAppendIterator.AppendArgument(Arg);
  1075. finally
  1076. EndAppend;
  1077. end;
  1078. end;
  1079. procedure TDBusMessage.AppendArgument(Const Arg: Integer);
  1080. begin
  1081. BeginAppend;
  1082. try
  1083. FAppendIterator.AppendArgument(Arg);
  1084. finally
  1085. EndAppend;
  1086. end;
  1087. end;
  1088. procedure TDBusMessage.AppendArgument(const Arg: Cardinal);
  1089. begin
  1090. BeginAppend;
  1091. try
  1092. FAppendIterator.AppendArgument(Arg);
  1093. finally
  1094. EndAppend;
  1095. end;
  1096. end;
  1097. procedure TDBusMessage.AppendArgument(const Arg: Int64);
  1098. begin
  1099. BeginAppend;
  1100. try
  1101. FAppendIterator.AppendArgument(Arg);
  1102. finally
  1103. EndAppend;
  1104. end;
  1105. end;
  1106. procedure TDBusMessage.AppendArgument(const Arg: QWord);
  1107. begin
  1108. BeginAppend;
  1109. try
  1110. FAppendIterator.AppendArgument(Arg);
  1111. finally
  1112. EndAppend;
  1113. end;
  1114. end;
  1115. procedure TDBusMessage.AppendArgument(const Arg: Double);
  1116. begin
  1117. BeginAppend;
  1118. try
  1119. FAppendIterator.AppendArgument(Arg);
  1120. finally
  1121. EndAppend;
  1122. end;
  1123. end;
  1124. procedure TDBusMessage.AppendArgument(Const Arg: String);
  1125. begin
  1126. BeginAppend;
  1127. try
  1128. FAppendIterator.AppendArgument(Arg);
  1129. finally
  1130. EndAppend;
  1131. end;
  1132. end;
  1133. procedure TDBusMessage.BeginGet;
  1134. Var
  1135. AIter : DBUSMessageIter;
  1136. begin
  1137. If (FGetCount=0) then
  1138. begin
  1139. if (0=dbus_message_iter_init(message,@AIter)) then
  1140. Error(SErrInitIter);
  1141. FGetIterator:=TDBUSMessageIterator.Create(AIter);
  1142. end;
  1143. Inc(FGetCount);
  1144. end;
  1145. procedure TDBusMessage.EndGet;
  1146. begin
  1147. Dec(FGetCount);
  1148. end;
  1149. Function TDBusMessage.GetNextArgumentType: cInt;
  1150. begin
  1151. BeginGet;
  1152. try
  1153. Result:=FGetIterator.GetArgumentType;
  1154. finally
  1155. EndGet;
  1156. end;
  1157. end;
  1158. function TDBusMessage.GetArrayElementType: cInt;
  1159. begin
  1160. BeginGet;
  1161. try
  1162. Result:=FGetIterator.GetArgumentType;
  1163. If (Result<>DBUS_TYPE_ARRAY) then
  1164. Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_ARRAY),Char(Result)]);
  1165. Result:=FGetIterator.GetElementType;
  1166. finally
  1167. EndGet;
  1168. end;
  1169. end;
  1170. procedure TDBusMessage.Get(AType: cInt; var Value);
  1171. begin
  1172. BeginGet;
  1173. try
  1174. FGetIterator.Get(AType,Value);
  1175. finally
  1176. Endget;
  1177. end;
  1178. end;
  1179. procedure TDBusMessage.GetArgument(var Arg: Byte);
  1180. begin
  1181. BeginGet;
  1182. try
  1183. FGetIterator.GetArgument(Arg);
  1184. finally
  1185. Endget;
  1186. end;
  1187. end;
  1188. procedure TDBusMessage.GetArgument(var Arg: Boolean);
  1189. begin
  1190. BeginGet;
  1191. try
  1192. FGetIterator.GetArgument(Arg);
  1193. finally
  1194. Endget;
  1195. end;
  1196. end;
  1197. procedure TDBusMessage.GetArgument(var Arg: SmallInt);
  1198. begin
  1199. BeginGet;
  1200. try
  1201. FGetIterator.GetArgument(Arg);
  1202. finally
  1203. Endget;
  1204. end;
  1205. end;
  1206. procedure TDBusMessage.GetArgument(var Arg: Word);
  1207. begin
  1208. BeginGet;
  1209. try
  1210. FGetIterator.GetArgument(Arg);
  1211. finally
  1212. Endget;
  1213. end;
  1214. end;
  1215. procedure TDBusMessage.GetArgument(var Arg: Integer);
  1216. begin
  1217. BeginGet;
  1218. try
  1219. FGetIterator.GetArgument(Arg);
  1220. finally
  1221. Endget;
  1222. end;
  1223. end;
  1224. procedure TDBusMessage.GetArgument(var Arg: Cardinal);
  1225. begin
  1226. BeginGet;
  1227. try
  1228. FGetIterator.GetArgument(Arg);
  1229. finally
  1230. Endget;
  1231. end;
  1232. end;
  1233. procedure TDBusMessage.GetArgument(var Arg: Int64);
  1234. begin
  1235. BeginGet;
  1236. try
  1237. FGetIterator.GetArgument(Arg);
  1238. finally
  1239. Endget;
  1240. end;
  1241. end;
  1242. procedure TDBusMessage.GetArgument(var Arg: QWord);
  1243. begin
  1244. BeginGet;
  1245. try
  1246. FGetIterator.GetArgument(Arg);
  1247. finally
  1248. Endget;
  1249. end;
  1250. end;
  1251. procedure TDBusMessage.GetArgument(var Arg: Double);
  1252. begin
  1253. BeginGet;
  1254. try
  1255. FGetIterator.GetArgument(Arg);
  1256. finally
  1257. Endget;
  1258. end;
  1259. end;
  1260. procedure TDBusMessage.GetArgument(var Arg: String);
  1261. begin
  1262. BeginGet;
  1263. try
  1264. FGetIterator.GetArgument(Arg);
  1265. finally
  1266. Endget;
  1267. end;
  1268. end;
  1269. Function TDBusMessage.BeginGetFixedArray(Const AElementType : cint; Var P : Pointer) : cInt;
  1270. begin
  1271. BeginGet;
  1272. try
  1273. Result:=FGetIterator.GetFixedArray(AElementType,P);
  1274. finally
  1275. Endget
  1276. end;
  1277. end;
  1278. procedure TDBusMessage.GetArgument(var Arg: TByteArray);
  1279. begin
  1280. BeginGet;
  1281. try
  1282. FGetIterator.GetArgument(Arg);
  1283. finally
  1284. Endget;
  1285. end;
  1286. end;
  1287. procedure TDBusMessage.GetArgument(var Arg: TBooleanArray);
  1288. begin
  1289. BeginGet;
  1290. try
  1291. FGetIterator.GetArgument(Arg);
  1292. finally
  1293. Endget;
  1294. end;
  1295. end;
  1296. procedure TDBusMessage.GetArgument(var Arg: TSmallIntArray);
  1297. begin
  1298. BeginGet;
  1299. try
  1300. FGetIterator.GetArgument(Arg);
  1301. finally
  1302. Endget;
  1303. end;
  1304. end;
  1305. procedure TDBusMessage.GetArgument(var Arg: TWordArray);
  1306. begin
  1307. BeginGet;
  1308. try
  1309. FGetIterator.GetArgument(Arg);
  1310. finally
  1311. Endget;
  1312. end;
  1313. end;
  1314. procedure TDBusMessage.GetArgument(var Arg: TIntegerArray);
  1315. begin
  1316. BeginGet;
  1317. try
  1318. FGetIterator.GetArgument(Arg);
  1319. finally
  1320. Endget;
  1321. end;
  1322. end;
  1323. procedure TDBusMessage.GetArgument(var Arg: TCardinalArray);
  1324. begin
  1325. BeginGet;
  1326. try
  1327. FGetIterator.GetArgument(Arg);
  1328. finally
  1329. Endget;
  1330. end;
  1331. end;
  1332. procedure TDBusMessage.GetArgument(var Arg: TInt64array);
  1333. begin
  1334. BeginGet;
  1335. try
  1336. FGetIterator.GetArgument(Arg);
  1337. finally
  1338. Endget;
  1339. end;
  1340. end;
  1341. procedure TDBusMessage.GetArgument(var Arg: TQWordArray);
  1342. begin
  1343. BeginGet;
  1344. try
  1345. FGetIterator.GetArgument(Arg);
  1346. finally
  1347. Endget;
  1348. end;
  1349. end;
  1350. procedure TDBusMessage.GetArgument(var Arg: TDoubleArray);
  1351. begin
  1352. BeginGet;
  1353. try
  1354. FGetIterator.GetArgument(Arg);
  1355. finally
  1356. Endget;
  1357. end;
  1358. end;
  1359. procedure TDBusMessage.GetArgument(var Arg: TStringArray);
  1360. begin
  1361. BeginGet;
  1362. try
  1363. FGetIterator.GetArgument(Arg);
  1364. finally
  1365. Endget;
  1366. end;
  1367. end;
  1368. procedure TDBusMessage.GetArgument(var Arg: TStringList);
  1369. begin
  1370. BeginGet;
  1371. try
  1372. FGetIterator.GetArgument(Arg);
  1373. finally
  1374. Endget;
  1375. end;
  1376. end;
  1377. procedure TDBusMessage.GetArgument(var Arg: Variant);
  1378. begin
  1379. BeginGet;
  1380. try
  1381. FGetIterator.GetArgument(Arg);
  1382. finally
  1383. Endget;
  1384. end;
  1385. end;
  1386. procedure TDBusMessage.GetArgument(Const Arg: TDBUSDictionary);
  1387. Var
  1388. I : Integer;
  1389. begin
  1390. BeginGet;
  1391. try
  1392. FGetIterator.GetArgument(Arg);
  1393. finally
  1394. EndGet;
  1395. end;
  1396. end;
  1397. function TDBusMessage.HasPath(const APath: String): boolean;
  1398. begin
  1399. Result:=Allocated;
  1400. if Result then
  1401. Result:=dbus_message_has_path(Message,PChar(APath))<>0;
  1402. end;
  1403. function TDBusMessage.HasSender(const ASender: String): boolean;
  1404. begin
  1405. Result:=Allocated;
  1406. if Result then
  1407. Result:=dbus_message_has_sender(message,PChar(ASender))<>0;
  1408. end;
  1409. function TDBusMessage.HasSignature(const ASignature: String): boolean;
  1410. begin
  1411. Result:=Allocated;
  1412. If Result then
  1413. Result:=dbus_message_has_signature(Message,Pchar(ASignature))<>0;
  1414. end;
  1415. function TDBusMessage.IsError(const AError : string): Boolean;
  1416. begin
  1417. Result:=Allocated;
  1418. if Result then
  1419. Result:=dbus_message_is_error(message,Pchar(AError))<>0;
  1420. end;
  1421. { TDBusMethodCallMessage }
  1422. procedure TDBusMethodCallMessage.SetDestination(const AValue: String);
  1423. begin
  1424. if FDestination=AValue then exit;
  1425. CheckNotAllocated;
  1426. FDestination:=AValue;
  1427. end;
  1428. function TDBusInterfaceMessage.GetInterface: String;
  1429. Var
  1430. p : pchar;
  1431. begin
  1432. If not Allocated then
  1433. Result:=FInterface
  1434. else
  1435. begin
  1436. p:=dbus_message_get_interface(message);
  1437. if (P<>Nil) then
  1438. Result:=strpas(p);
  1439. end;
  1440. end;
  1441. procedure TDBusInterfaceMessage.SetInterface(const AValue: String);
  1442. begin
  1443. if FInterface=AValue then exit;
  1444. CheckNotAllocated;
  1445. FInterface:=AValue;
  1446. end;
  1447. procedure TDBusMethodCallMessage.SetMethod(const AValue: String);
  1448. begin
  1449. if FMethod=AValue then exit;
  1450. CheckNotAllocated;
  1451. FMethod:=AValue;
  1452. end;
  1453. procedure TDBusInterfaceMessage.SetPath(const AValue: String);
  1454. begin
  1455. if FPath=AValue then exit;
  1456. CheckNotAllocated;
  1457. FPath:=AValue;
  1458. end;
  1459. constructor TDBusMethodCallMessage.Create(const ADestination, AObjectPath,
  1460. AInterface, AMethod: String);
  1461. begin
  1462. FDestination:=ADestination;
  1463. FPath:=AObjectPath;
  1464. FInterface:=AInterface;
  1465. FMethod:=AMethod;
  1466. end;
  1467. class function TDBusMethodCallMessage.MessageType: cint;
  1468. begin
  1469. Result:=DBUS_MESSAGE_TYPE_METHOD_CALL;
  1470. end;
  1471. procedure TDBusMethodCallMessage.AllocateMessage;
  1472. Var
  1473. d,i : pchar;
  1474. begin
  1475. CheckNotAllocated;
  1476. d:=nil;
  1477. i:=nil;
  1478. if (FDestination<>'') then
  1479. d:=PChar(FDestination);
  1480. if (FInterface<>'') then
  1481. i:=PChar(FInterface);
  1482. if (FPath='') then
  1483. Error(SErrEmptyPath);
  1484. if (FMethod='') then
  1485. Error(SErrEmptyMethod);
  1486. FMessage:=dbus_message_new_method_call(d,pchar(FPath),i,pchar(FMethod));
  1487. end;
  1488. function TDBusInterfaceMessage.HasPath(const APath: String): boolean;
  1489. begin
  1490. If Allocated then
  1491. Result:=Inherited HasPath(APath)
  1492. else
  1493. Result:=(FPath=APath)
  1494. end;
  1495. { TDBusPendingCall }
  1496. constructor TDBusPendingCall.Create(const ASource: PDBusPendingCall);
  1497. begin
  1498. FSource:=ASource;
  1499. end;
  1500. destructor TDBusPendingCall.Destroy;
  1501. begin
  1502. dbus_pending_call_unref(FSource);
  1503. inherited Destroy;
  1504. end;
  1505. { TDBUSMessageItem }
  1506. procedure TDBUSMessageItem.SetOnMessage(const AValue: TDBusMessageHandler);
  1507. begin
  1508. if FOnMessage=AValue then exit;
  1509. FOnMessage:=AValue;
  1510. end;
  1511. function TDBUSMessageItem.ConnHandle: PDBUSConnection;
  1512. begin
  1513. if HaveHandle then
  1514. Result:=TDBUSFilters(Collection).Connection.FConn
  1515. else
  1516. Result:=Nil
  1517. end;
  1518. function TDBUSMessageItem.AllowRegister: Boolean;
  1519. begin
  1520. Result:=(FEnabled and Assigned(FOnMessage))
  1521. end;
  1522. procedure TDBUSMessageItem.MaybeRegister;
  1523. begin
  1524. If AllowRegister and not Registered then
  1525. Register
  1526. else
  1527. UnRegister;
  1528. end;
  1529. procedure TDBUSMessageItem.SetEnabled(const AValue: Boolean);
  1530. begin
  1531. If AValue=FEnabled then exit;
  1532. FEnabled:=AValue;
  1533. MaybeRegister
  1534. end;
  1535. Function TDBUSMessageItem.HaveHandle : Boolean;
  1536. begin
  1537. Result:=Assigned(Collection)
  1538. and (Collection is TDBUSMessages)
  1539. and (Assigned(TDBUSMessages(Collection).Connection))
  1540. and (TDBUSMessages(Collection).Connection.Connected);
  1541. end;
  1542. procedure TDBUSMessageItem.Assign(Source: TPersistent);
  1543. Var
  1544. F : TDBUSMessageItem;
  1545. begin
  1546. if (Source is TDBUSMessageItem) then
  1547. begin
  1548. F:=Source as TDBUSMessageItem;
  1549. OnMessage:=F.OnMessage;
  1550. Enabled:=F.Enabled;
  1551. end;
  1552. inherited Assign(Source);
  1553. end;
  1554. { TDBUSFilterItem }
  1555. function FilterHandler(connection: PDBusConnection;
  1556. message_: PDBusMessage;
  1557. user_data: Pointer): DBusHandlerResult;cdecl;
  1558. Var
  1559. F : TDBUSFilterItem;
  1560. M : TDBUSMessage;
  1561. begin
  1562. F:=TDBUSFilterItem(user_data);
  1563. If (Connection<>F.ConnHandle) then
  1564. result:=DBUS_HANDLER_RESULT_NOT_YET_HANDLED
  1565. else
  1566. begin
  1567. M:=CreateMessageFromSource(Message_);
  1568. try
  1569. F.OnMessage(F,M,Result);
  1570. except
  1571. result:=DBUS_HANDLER_RESULT_NOT_YET_HANDLED
  1572. end;
  1573. M.Free;
  1574. end;
  1575. end;
  1576. procedure TDBUSFilterItem.Register;
  1577. begin
  1578. if HaveHandle then
  1579. FRegistered:=0<>dbus_connection_add_filter(ConnHandle,
  1580. @FilterHandler,Self,Nil);
  1581. end;
  1582. procedure TDBUSFilterItem.Unregister;
  1583. begin
  1584. if HaveHandle then
  1585. dbus_connection_remove_filter(ConnHandle,@FilterHandler,Self);
  1586. FRegistered:=False;
  1587. end;
  1588. { TDBUSFilters }
  1589. function TDBUSFilters.GetF(AIndex : Integer): TDBUSFilterItem;
  1590. begin
  1591. Result:=TDBUSFilterItem(Items[AIndex])
  1592. end;
  1593. procedure TDBUSFilters.SetF(AIndex : Integer; const AValue: TDBUSFilterItem);
  1594. begin
  1595. Items[AIndex]:=AValue;
  1596. end;
  1597. Constructor TDBUSFilters.Create(Const AConnection: TCustomDBUSConnection);
  1598. Var
  1599. C : TDBUSMessageItemClass;
  1600. begin
  1601. C:=TDBUSFilterItem;
  1602. If Assigned(AConnection) then
  1603. C:=AConnection.FilterClass;
  1604. Inherited Create(AConnection,C);
  1605. end;
  1606. { TDBUSMessages }
  1607. constructor TDBUSMessages.Create(const AConnection: TCustomDBUSConnection;
  1608. AItemClass: TDBUSMessageItemClass);
  1609. begin
  1610. Inherited Create(AItemClass);
  1611. FConnection:=AConnection;
  1612. end;
  1613. { TDBUSObjectItem }
  1614. // in fact, the same handler could be used as in filter...
  1615. function ObjectHandler(connection: PDBusConnection;
  1616. message_: PDBusMessage;
  1617. user_data: Pointer): DBusHandlerResult;cdecl;
  1618. Var
  1619. O : TDBUSObjectItem;
  1620. M : TDBUSMessage;
  1621. begin
  1622. O:=TDBUSObjectItem(user_data);
  1623. If (Connection<>O.ConnHandle) then
  1624. result:=DBUS_HANDLER_RESULT_NOT_YET_HANDLED
  1625. else
  1626. begin
  1627. M:=CreateMessageFromSource(Message_);
  1628. try
  1629. O.OnMessage(O,M,Result);
  1630. except
  1631. result:=DBUS_HANDLER_RESULT_NOT_YET_HANDLED
  1632. end;
  1633. M.Free;
  1634. end;
  1635. end;
  1636. var
  1637. ObjectVTable : DBusObjectPathVTable = (
  1638. unregister_function: Nil;
  1639. message_function: @ObjectHandler;
  1640. dbus_internal_pad1:Nil;
  1641. dbus_internal_pad2:Nil;
  1642. dbus_internal_pad3:Nil;
  1643. dbus_internal_pad4:Nil
  1644. );
  1645. procedure TDBUSObjectItem.SetPath(const AValue: String);
  1646. begin
  1647. If (FPath=AValue) then exit;
  1648. FPath:=AValue;
  1649. If (FPath<>'') then
  1650. MaybeRegister;
  1651. end;
  1652. procedure TDBUSObjectItem.SetFallback(const AValue: Boolean);
  1653. begin
  1654. if FFallBack=AValue then exit;
  1655. FFallBack:=AValue;
  1656. If Registered then
  1657. Unregister;
  1658. MaybeRegister;
  1659. end;
  1660. procedure TDBUSObjectItem.Register;
  1661. begin
  1662. If Path='' then
  1663. Raise Exception.Create(SErrObjectWithoutPath);
  1664. If HaveHandle then
  1665. if FallBack then
  1666. FRegistered:=0<>dbus_connection_register_fallback(ConnHandle,Pchar(Path),@ObjectVTable,Self)
  1667. else
  1668. FRegistered:=0<>dbus_connection_register_object_path(ConnHandle,Pchar(Path),@ObjectVTable,Self);
  1669. end;
  1670. procedure TDBUSObjectItem.Unregister;
  1671. begin
  1672. If Path='' then
  1673. Raise Exception.Create(SErrObjectWithoutPath);
  1674. if HaveHandle then
  1675. FRegistered:=0=dbus_connection_unregister_object_path(ConnHandle,Pchar(Path));
  1676. end;
  1677. function TDBUSObjectItem.AllowRegister: Boolean;
  1678. begin
  1679. Result:=inherited AllowRegister and (Path<>'');
  1680. end;
  1681. { TDBUSObjects }
  1682. function TDBUSObjects.GetO(AIndex: Integer): TDBUSObjectItem;
  1683. begin
  1684. Result:=TDBUSObjectItem(Items[AIndex]);
  1685. end;
  1686. procedure TDBUSObjects.SetO(AIndex: Integer; const AValue: TDBUSObjectItem);
  1687. begin
  1688. Items[AIndex]:=AValue;
  1689. end;
  1690. constructor TDBUSObjects.Create(const AConnection: TCustomDBUSConnection);
  1691. Var
  1692. C : TDBUSMessageItemClass;
  1693. begin
  1694. C:=TDBUSObjectItem;
  1695. If Assigned(AConnection) then
  1696. C:=AConnection.ObjectClass;
  1697. Inherited Create(AConnection,C);
  1698. end;
  1699. { TDBusSignalMessage }
  1700. procedure TDBusSignalMessage.SetName(const AValue: String);
  1701. begin
  1702. if FName=AValue then exit;
  1703. CheckNotAllocated;
  1704. FName:=AValue;
  1705. end;
  1706. class function TDBusSignalMessage.MessageType: cint;
  1707. begin
  1708. Result:= DBUS_MESSAGE_TYPE_SIGNAL;
  1709. end;
  1710. procedure TDBusSignalMessage.AllocateMessage;
  1711. Var
  1712. i : pchar;
  1713. begin
  1714. CheckNotAllocated;
  1715. i:=nil;
  1716. if (FInterface<>'') then
  1717. i:=PChar(FInterface);
  1718. if (FPath='') then
  1719. Error(SErrEmptyPath);
  1720. if (FName='') then
  1721. Error(SErrEmptyName);
  1722. FMessage:=dbus_message_new_signal(PChar(FPath),I,Pchar(Name));
  1723. end;
  1724. constructor TDBusSignalMessage.Create(const AObjectPath, AInterface,
  1725. AName: String);
  1726. begin
  1727. FPath:=AObjectPath;
  1728. FInterface:=AInterface;
  1729. FName:=AName;
  1730. end;
  1731. { TDBusErrorMessage }
  1732. procedure TDBusErrorMessage.SetErrorMessage(const AValue: String);
  1733. begin
  1734. if FErrorMessage=AValue then exit;
  1735. CheckNotAllocated;
  1736. FErrorMessage:=AValue;
  1737. end;
  1738. procedure TDBusErrorMessage.SetErrorName(const AValue: String);
  1739. begin
  1740. if FErrorName=AValue then exit;
  1741. CheckNotAllocated;
  1742. FErrorName:=AValue;
  1743. end;
  1744. procedure TDBusReplyToMessage.SetReplyto(const AValue: TDBUSMessage);
  1745. begin
  1746. if FReplyTo=AValue then exit;
  1747. CheckNotAllocated;
  1748. FReplyTo:=AValue;
  1749. end;
  1750. constructor TDBusReplyToMessage.Create(const AReplyTo: TDBUSMessage);
  1751. begin
  1752. FReplyTo:=AReplyTo;
  1753. end;
  1754. class function TDBusErrorMessage.MessageType: cint;
  1755. begin
  1756. Result:=DBUS_MESSAGE_TYPE_ERROR;
  1757. end;
  1758. procedure TDBusErrorMessage.AllocateMessage;
  1759. Var
  1760. P : PChar;
  1761. begin
  1762. If (ErrorName='') then
  1763. Error(SErrNoErrorName);
  1764. If (ReplyTo=Nil) then
  1765. Error(SErrNoReplyTo);
  1766. P:=Nil;
  1767. If (ErrorMessage<>'') then
  1768. P:=Pchar(ErrorMessage);
  1769. FMessage:=dbus_message_new_error(ReplyTo.Message,Pchar(FErrorName),P);
  1770. end;
  1771. constructor TDBusErrorMessage.Create(const AReplyTo: TDBUSMessage;
  1772. const AErrorName, AErrorMessage: String);
  1773. begin
  1774. Inherited Create(AReplyto);
  1775. FErrorName:=AErrorName;
  1776. FErrorMessage:=AErrorMessage;
  1777. end;
  1778. constructor TDBusErrorMessage.Create(const AReplyTo: TDBUSMessage;
  1779. const AErrorName, AFormat: String; Args: array of const);
  1780. begin
  1781. Inherited Create(AReplyTo);
  1782. FErrorName:=AErrorName;
  1783. FErrorMessage:=Format(AFormat,Args);
  1784. end;
  1785. { TDBusMethodReturnMessage }
  1786. class function TDBusMethodReturnMessage.MessageType: cint;
  1787. begin
  1788. Result:=DBUS_MESSAGE_TYPE_METHOD_RETURN;
  1789. end;
  1790. procedure TDBusMethodReturnMessage.AllocateMessage;
  1791. begin
  1792. If (FReplyTo=Nil) then
  1793. Error(SErrNoReplyTo);
  1794. FMessage:=dbus_message_new_method_return(FReplyTo.Message);
  1795. end;
  1796. { TDBUSInvalidMessage }
  1797. class function TDBUSInvalidMessage.MessageType: cint;
  1798. begin
  1799. Result:=DBUS_MESSAGE_TYPE_INVALID;
  1800. end;
  1801. procedure TDBUSInvalidMessage.AllocateMessage;
  1802. begin
  1803. Error(SErrInvalidMessageType);
  1804. end;
  1805. { TDBusMessageIterator }
  1806. procedure TDBusMessageIterator.Error(const Msg: String);
  1807. begin
  1808. RaiseDBusError(ClassName,Msg);
  1809. end;
  1810. procedure TDBusMessageIterator.Error(const Fmt: String; Args: array of const);
  1811. begin
  1812. RaiseDBUSError(ClassName,Fmt,Args);
  1813. end;
  1814. constructor TDBusMessageIterator.Create(AIter: DBUSMessageIter);
  1815. begin
  1816. FIter:=AIter;
  1817. end;
  1818. function TDBusMessageIterator.GetFixedArray(const AElementType: cint;
  1819. var P: Pointer): cInt;
  1820. Var
  1821. A : cInt;
  1822. AI : DBUSMessageIter;
  1823. begin
  1824. A:=dbus_message_iter_get_arg_type(@FIter);
  1825. If (A<>DBUS_TYPE_ARRAY) then
  1826. Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_ARRAY),Char(A)]);
  1827. A:=dbus_message_iter_get_element_type(@FIter);
  1828. If (A<>AElementType) then
  1829. Error(SErrInvalidArrayElementType,[Char(AElementType),Char(A)]);
  1830. dbus_message_iter_recurse(@FIter, @AI);
  1831. dbus_message_iter_get_fixed_array(@AI,@P,@Result);
  1832. end;
  1833. function TDBusMessageIterator.GetArgumentType: cint;
  1834. begin
  1835. Result:=dbus_message_iter_get_arg_type(@FIter);
  1836. end;
  1837. function TDBusMessageIterator.GetElementType: cint;
  1838. begin
  1839. Result:=dbus_message_iter_get_element_type(@FIter);
  1840. end;
  1841. function TDBusMessageIterator.Recurse: TDBusMessageIterator;
  1842. Var
  1843. AI : DBUSMessageIter;
  1844. begin
  1845. dbus_message_iter_recurse(@Fiter, @AI);
  1846. Result:=TDBusMessageIterator.Create(AI);
  1847. end;
  1848. function TDBusMessageIterator.HasNext: Boolean;
  1849. begin
  1850. Result:=dbus_message_iter_has_next(@Fiter)<>0;
  1851. end;
  1852. procedure TDBusMessageIterator.Next;
  1853. begin
  1854. dbus_message_iter_next(@FIter);
  1855. end;
  1856. procedure TDBusMessageIterator.Get(AType: cInt; var Value);
  1857. Var
  1858. A : cInt;
  1859. begin
  1860. A:=dbus_message_iter_get_arg_type(@fIter);
  1861. if (A=DBUS_TYPE_INVALID) then
  1862. Error(SErrNoMoreArguments);
  1863. if (A<>AType) then
  1864. Error(SErrInvalidArgumentType,[Char(AType),Char(A)]);
  1865. dbus_message_iter_get_basic(@FIter,@value);
  1866. next;
  1867. end;
  1868. procedure TDBusMessageIterator.GetArgument(var Arg: Byte);
  1869. begin
  1870. Get(DBUS_TYPE_BYTE,Arg);
  1871. end;
  1872. procedure TDBusMessageIterator.GetArgument(var Arg: Boolean);
  1873. Var
  1874. B : DBUS_BOOL_T;
  1875. begin
  1876. Get(DBUS_TYPE_BOOLEAN,B);
  1877. Arg:=(B<>0);
  1878. end;
  1879. procedure TDBusMessageIterator.GetArgument(var Arg: SmallInt);
  1880. begin
  1881. Get(DBUS_TYPE_INT16,Arg);
  1882. end;
  1883. procedure TDBusMessageIterator.GetArgument(var Arg: Word);
  1884. begin
  1885. Get(DBUS_TYPE_UINT16,Arg);
  1886. end;
  1887. procedure TDBusMessageIterator.GetArgument(var Arg: Integer);
  1888. begin
  1889. Get(DBUS_TYPE_INT32,Arg);
  1890. end;
  1891. procedure TDBusMessageIterator.GetArgument(var Arg: Cardinal);
  1892. begin
  1893. Get(DBUS_TYPE_UINT32,Arg);
  1894. end;
  1895. procedure TDBusMessageIterator.GetArgument(var Arg: Int64);
  1896. begin
  1897. Get(DBUS_TYPE_INT64,Arg);
  1898. end;
  1899. procedure TDBusMessageIterator.GetArgument(var Arg: QWord);
  1900. begin
  1901. Get(DBUS_TYPE_UINT64,Arg);
  1902. end;
  1903. procedure TDBusMessageIterator.GetArgument(var Arg: Double);
  1904. begin
  1905. Get(DBUS_TYPE_DOUBLE,Arg);
  1906. end;
  1907. procedure TDBusMessageIterator.GetArgument(var Arg: String);
  1908. Var
  1909. P : Pchar;
  1910. begin
  1911. p:=Nil;
  1912. Get(DBUS_TYPE_STRING,P);
  1913. if (P=Nil) then
  1914. Arg:=''
  1915. else
  1916. Arg:=StrPas(P);
  1917. end;
  1918. procedure TDBusMessageIterator.GetArgument(var Arg: TByteArray);
  1919. Var
  1920. P : Pointer;
  1921. N : cInt;
  1922. It : DBUSMessageIter;
  1923. begin
  1924. n:=GetFixedArray(DBUS_TYPE_BYTE,p);
  1925. SetLength(Arg,n);
  1926. If (N>0) then
  1927. Move(P^,Arg[0],N*sizeOf(Byte));
  1928. end;
  1929. procedure TDBusMessageIterator.GetArgument(var Arg: TBooleanArray);
  1930. Var
  1931. P : ^DBUS_BOOL_T;
  1932. N : cInt;
  1933. begin
  1934. n:=GetFixedArray(DBUS_TYPE_BOOLEAN,P);
  1935. SetLength(Arg,n);
  1936. While (N>0) do
  1937. begin
  1938. Dec(N);
  1939. Arg[N]:=(P[N]<>0);
  1940. end;
  1941. end;
  1942. procedure TDBusMessageIterator.GetArgument(var Arg: TSmallIntArray);
  1943. Var
  1944. P : Pointer;
  1945. N : cInt;
  1946. begin
  1947. n:=GetFixedArray(DBUS_TYPE_int16,P);
  1948. SetLength(Arg,n);
  1949. If (N>0) then
  1950. Move(P^,Arg[0],N*sizeOf(SmallInt));
  1951. end;
  1952. procedure TDBusMessageIterator.GetArgument(var Arg: TWordArray);
  1953. Var
  1954. P : Pointer;
  1955. N : cInt;
  1956. begin
  1957. n:=GetFixedArray(DBUS_TYPE_Uint16,P);
  1958. SetLength(Arg,n);
  1959. If (N>0) then
  1960. Move(P^,Arg[0],N*sizeOf(Word));
  1961. end;
  1962. procedure TDBusMessageIterator.GetArgument(var Arg: TIntegerArray);
  1963. Var
  1964. P : Pointer;
  1965. N : cInt;
  1966. begin
  1967. n:=GetFixedArray(DBUS_TYPE_int32,P);
  1968. SetLength(Arg,n);
  1969. If (N>0) then
  1970. Move(P^,Arg[0],N*sizeOf(Integer));
  1971. end;
  1972. procedure TDBusMessageIterator.GetArgument(var Arg: TCardinalArray);
  1973. Var
  1974. P : Pointer;
  1975. N : cInt;
  1976. begin
  1977. n:=GetFixedArray(DBUS_TYPE_Uint32,P);
  1978. SetLength(Arg,n);
  1979. If (N>0) then
  1980. Move(P^,Arg[0],N*sizeOf(Cardinal));
  1981. end;
  1982. procedure TDBusMessageIterator.GetArgument(var Arg: TInt64Array);
  1983. Var
  1984. P : Pointer;
  1985. N : cInt;
  1986. begin
  1987. n:=GetFixedArray(DBUS_TYPE_int64,P);
  1988. SetLength(Arg,n);
  1989. If (N>0) then
  1990. Move(P^,Arg[0],N*sizeOf(Int64));
  1991. end;
  1992. procedure TDBusMessageIterator.GetArgument(var Arg: TQWordArray);
  1993. Var
  1994. P : Pointer;
  1995. N : cInt;
  1996. begin
  1997. n:=GetFixedArray(DBUS_TYPE_Uint64,P);
  1998. SetLength(Arg,n);
  1999. If (N>0) then
  2000. Move(P^,Arg[0],N*sizeOf(QWord));
  2001. end;
  2002. procedure TDBusMessageIterator.GetArgument(var Arg: TDoubleArray);
  2003. Var
  2004. P : Pointer;
  2005. N : cInt;
  2006. begin
  2007. n:=GetFixedArray(DBUS_TYPE_DOUBLE,P);
  2008. SetLength(Arg,n);
  2009. If (N>0) then
  2010. Move(P^,Arg[0],N*sizeOf(Double));
  2011. end;
  2012. procedure TDBusMessageIterator.GetArgument(var Arg: TStringArray);
  2013. Var
  2014. A : cInt;
  2015. AI : DBUSMessageIter;
  2016. l : integer;
  2017. p : Pchar;
  2018. begin
  2019. A:=dbus_message_iter_get_arg_type(@fIter);
  2020. If (A<>DBUS_TYPE_ARRAY) then
  2021. Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_ARRAY),Char(A)]);
  2022. A:=dbus_message_iter_get_element_type(@fIter);
  2023. If (A<>DBUS_TYPE_STRING) then
  2024. Error(SErrInvalidArrayElementType,[Char(DBUS_TYPE_STRING),Char(A)]);
  2025. dbus_message_iter_recurse(@Fiter, @AI);
  2026. setlength(Arg,0);
  2027. l:=0;
  2028. while (dbus_message_iter_get_arg_type(@AI)<>DBUS_TYPE_INVALID) do
  2029. begin
  2030. Inc(l);
  2031. If Length(Arg)<L then
  2032. SetLength(Arg,L+10);
  2033. dbus_message_iter_get_basic(@AI,@p);
  2034. If P<>Nil then
  2035. Arg[l-1]:=StrPas(P)
  2036. else
  2037. Arg[l-1]:='';
  2038. dbus_message_iter_next(@ai)
  2039. end;
  2040. dbus_message_iter_next (@FIter);
  2041. If Length(Arg)<>L then
  2042. SetLength(Arg,L);
  2043. end;
  2044. procedure TDBusMessageIterator.GetArgument(var Arg: TStringList);
  2045. Var
  2046. A : cInt;
  2047. AI : DBUSMessageIter;
  2048. p : Pchar;
  2049. begin
  2050. A:=GetArgumentType;
  2051. If (A<>DBUS_TYPE_ARRAY) then
  2052. Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_ARRAY),Char(A)]);
  2053. A:=GetElementType;
  2054. If (A<>DBUS_TYPE_STRING) then
  2055. Error(SErrInvalidArrayElementType,[Char(DBUS_TYPE_STRING),Char(A)]);
  2056. dbus_message_iter_recurse(@FIter, @AI);
  2057. Arg.Clear;
  2058. while (dbus_message_iter_get_arg_type(@AI)<>DBUS_TYPE_INVALID) do
  2059. begin
  2060. dbus_message_iter_get_basic(@AI,@p);
  2061. If P<>Nil then
  2062. Arg.Add(StrPas(P))
  2063. else
  2064. Arg.Add('');
  2065. dbus_message_iter_next(@ai);
  2066. end;
  2067. Next;
  2068. end;
  2069. procedure TDBusMessageIterator.GetArgument(var Arg: Variant);
  2070. Var
  2071. A : cInt;
  2072. AI : DBUSMessageIter;
  2073. p : Pchar;
  2074. By : Byte;
  2075. Boo : Boolean;
  2076. S : smallint;
  2077. W : word;
  2078. I : Integer;
  2079. C : Cardinal;
  2080. I64 : Int64;
  2081. Q : QWord;
  2082. D : Double;
  2083. St : String;
  2084. IR : TDBusMessageIterator;
  2085. begin
  2086. A:=GetArgumentType;
  2087. If (A<>DBUS_TYPE_VARIANT) then
  2088. Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_VARIANT),Char(A)]);
  2089. IR:=Recurse;
  2090. try
  2091. A:=IR.GetArgumentType;
  2092. case A of
  2093. DBUS_TYPE_BYTE :
  2094. begin
  2095. IR.GetArgument(By);
  2096. Arg:=by;
  2097. end;
  2098. DBUS_TYPE_BOOLEAN :
  2099. begin
  2100. IR.GetArgument(Boo);
  2101. Arg:=Boo;
  2102. end;
  2103. DBUS_TYPE_INT16 :
  2104. begin
  2105. IR.GetArgument(S);
  2106. Arg:=S;
  2107. end;
  2108. DBUS_TYPE_UINT16 :
  2109. begin
  2110. IR.GetArgument(W);
  2111. Arg:=W;
  2112. end;
  2113. DBUS_TYPE_INT32 :
  2114. begin
  2115. IR.GetArgument(I);
  2116. Arg:=I;
  2117. end;
  2118. DBUS_TYPE_UINT32 :
  2119. begin
  2120. IR.GetArgument(C);
  2121. Arg:=C;
  2122. end;
  2123. DBUS_TYPE_INT64 :
  2124. begin
  2125. IR.GetArgument(I64);
  2126. Arg:=I64;
  2127. end;
  2128. DBUS_TYPE_UINT64 :
  2129. begin
  2130. IR.GetArgument(Q);
  2131. Arg:=Q;
  2132. end;
  2133. DBUS_TYPE_DOUBLE :
  2134. begin
  2135. IR.GetArgument(D);
  2136. Arg:=D;
  2137. end;
  2138. DBUS_TYPE_STRING :
  2139. begin
  2140. IR.GetArgument(St);
  2141. Arg:=St;
  2142. end;
  2143. else
  2144. Error(SErrInvalidVariantType,[Char(DBUS_TYPE_VARIANT),Char(A)]);
  2145. end;
  2146. finally
  2147. IR.free;
  2148. end;
  2149. Next;
  2150. end;
  2151. procedure TDBusMessageIterator.GetArgument(Const Arg: TDBUSDictionary);
  2152. Var
  2153. A : cInt;
  2154. I : TDBusMessageIterator;
  2155. begin
  2156. A:=GetArgumentType;
  2157. If (A<>DBUS_TYPE_ARRAY) then
  2158. Error(SErrInvalidArgumentType,[Char(DBUS_TYPE_ARRAY),Char(A)]);
  2159. A:=GetElementType;
  2160. If (A<>DBUS_TYPE_DICT_ENTRY) then
  2161. Error(SErrInvalidArrayElementType,[Char(DBUS_TYPE_DICT_ENTRY),Char(A)]);
  2162. I:=Recurse;
  2163. try
  2164. While I.HasNext do
  2165. Arg.AddDictItem.Load(I);
  2166. finally
  2167. I.Free;
  2168. end;
  2169. end;
  2170. procedure TDBusMessageIterator.Append(AType: cInt; const Value);
  2171. begin
  2172. if (0=dbus_message_iter_append_basic(@FIter,AType,@Value)) then
  2173. RaiseDbusError(ClassName,SErrAppendFailed);
  2174. end;
  2175. procedure TDBusMessageIterator.AppendArgument(const Arg: Byte);
  2176. begin
  2177. Append(DBUS_TYPE_BYTE,Arg);
  2178. end;
  2179. procedure TDBusMessageIterator.AppendArgument(Const Arg: Boolean);
  2180. Var
  2181. B : dbus_bool_t;
  2182. begin
  2183. B:=Ord(Arg);
  2184. Append(dbus.DBUS_TYPE_BOOLEAN,B);
  2185. end;
  2186. procedure TDBusMessageIterator.AppendArgument(const Arg: SmallInt);
  2187. begin
  2188. Append(DBUS_TYPE_INT16,Arg);
  2189. end;
  2190. procedure TDBusMessageIterator.AppendArgument(const Arg: Word);
  2191. begin
  2192. Append(DBUS_TYPE_UINT16,Arg);
  2193. end;
  2194. procedure TDBusMessageIterator.AppendArgument(Const Arg: Integer);
  2195. begin
  2196. Append(DBUS_TYPE_INT32,Arg);
  2197. end;
  2198. procedure TDBusMessageIterator.AppendArgument(const Arg: Cardinal);
  2199. begin
  2200. Append(DBUS_TYPE_UINT32,Arg);
  2201. end;
  2202. procedure TDBusMessageIterator.AppendArgument(const Arg: Int64);
  2203. begin
  2204. Append(DBUS_TYPE_INT64,Arg);
  2205. end;
  2206. procedure TDBusMessageIterator.AppendArgument(const Arg: QWord);
  2207. begin
  2208. Append(DBUS_TYPE_UINT64,Arg);
  2209. end;
  2210. procedure TDBusMessageIterator.AppendArgument(const Arg: Double);
  2211. begin
  2212. Append(DBUS_TYPE_DOUBLE,Arg);
  2213. end;
  2214. procedure TDBusMessageIterator.AppendArgument(Const Arg: String);
  2215. Var
  2216. P : PChar;
  2217. begin
  2218. P:=Pchar(Arg);
  2219. Append(DBUS_TYPE_STRING,P);
  2220. end;
  2221. { TDBUSDictionary }
  2222. function TDBUSDictionary.AddDictItem: TDBUSDictItem;
  2223. begin
  2224. Result:=Add as TDBUSDictItem;
  2225. end;
  2226. end.