Repository URL to install this package:
|
Version:
3.2.0 ▾
|
{
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 availaible';
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.