En/na Jonathan ha escrit:
On Mon, 18 May 2009 13:38:55 +0200
Matthias Klumpp <matth...@nlinux.org> wrote:
I've spent hours to get the Pascal DBus interface working for me, but even
the example code does not work.
I need to use DBus to but I can not make it work.
Has anyone made DBus and HAL work with fpc?
About a year and a half ago I had DBus working, but I used it only to
communicate between my apps (so I have both a server and a client part).
Sorry, I cannot help too much, I just hope that whatever change is made
it doesn't break backwards compatibility.
Below is the client part (the usage of the reply parameters is specific
to my application, but the method should be general) inside a form.
ErrorDbus is a method that displays and logs the error message.
some private fields of the form:
//Dbus
err: DBusError;
conn: PDBusConnection;
in formCreate:
{ Initializes the errors }
dbus_error_init(@err);
{ Connection }
conn := dbus_bus_get(DBUS_BUS_SYSTEM, @err);
if dbus_error_is_set(@err) <> 0 then
begin
ErrorDbus('Connection Error: ' + err.message);
dbus_error_free(@err);
end;
cyclic bus call (called from a 200ms timer), note that I expect 14
parameters in the reply.
procedure TEstadoForm.BusCall;
const MAXPARAM=14;
var
msg: PDBusMessage;
args: DBusMessageIter;
pending: PDBusPendingCall;
param: PChar;
i:integer;
numparams:integer;
LocByte:byte;
LocString:string;
LocInteger:integer;
NoMoreParams:boolean;
procedure NextParam;
begin
if NoMoreParams then exit;
numparams:=numparams+1;
if dbus_message_iter_next(@args)=0 then
begin
if numparams<=MAXPARAM then ErrorDbus('Not enough parameters');
NoMoreParams:=true;
end;
end;
function GetStringParam:boolean;
begin
if NoMoreParams then
begin
result:=false;
exit;
end;
result:=dbus_message_iter_get_arg_type(@args)=DBUS_TYPE_STRING;
if not result then
begin
ErrorDbus(format('Parameter %d is not a string',[numparams]));
exit;
end;
dbus_message_iter_get_basic(@args, @param);
LocString:=strpas(param);
end;
function GetByteParam:boolean;
var partype:cint;
begin
if NoMoreParams then
begin
result:=false;
exit;
end;
partype:=dbus_message_iter_get_arg_type(@args);
result:=partype=DBUS_TYPE_BYTE;
if not result then
begin
//dirty trick: since the first response parameter should be
//a byte, here I check if it is a string
//in such case it is a dbus error message
if (numparams=1) and (partype=DBUS_TYPE_STRING) then
begin
dbus_message_iter_get_basic(@args, @param);
ErrorDbus(param);
numparams:=MAXPARAM;
exit;
end;
ErrorDbus(format('Parameter %d is not a byte',[numparams]));
exit;
end;
dbus_message_iter_get_basic(@args, @LocByte);
end;
function GetIntegerParam:boolean;
begin
result:=false;
if NoMoreParams then exit;
if dbus_message_iter_get_arg_type(@args)<>DBUS_TYPE_INT32 then
begin
ErrorDbus(format('Parameter %d is not int32',[numparams]));
exit;
end;
result:=true;
dbus_message_iter_get_basic(@args, @LocInteger);
end;
begin
ErrorDbus('ok');
// create a new method call and check for errors
msg := dbus_message_new_method_call('es.wetron.almacen_tapas.server',
// target for the method call
'/almacen_tapas/method/Object',
// object to call on
'es.wetron.almacen_tapas.method.Status', // interface to call on
'GetStatus'); // method name
if (msg = nil) then
begin
ErrorDbus('Message Null');
Exit;
end;
// send message and get a handle for a reply
if (dbus_connection_send_with_reply(conn, msg, @pending, -1) = 0)
then // -1 is default timeout
begin
ErrorDbus('Out Of Memory!');
Exit;
end;
if (pending = nil) then
begin
ErrorDbus('Pending Call Null');
Exit;
end;
dbus_connection_flush(conn);
//WriteLn('Request Sent');
// free message
dbus_message_unref(msg);
// block until we recieve a reply
dbus_pending_call_block(pending);
// get the reply message
msg := dbus_pending_call_steal_reply(pending);
if (msg = nil) then
begin
ErrorDbus('Reply Null');
Exit;
end;
// free the pending message handle
dbus_pending_call_unref(pending);
// read the parameters
if dbus_message_iter_init(msg, @args)=0 then
begin
ErrorDbus('No parameters in reply')
end else
begin
numparams:=1;
NoMoreParams:=false;
if GetByteParam then VisualizaBits(FEntradas,locbyte);
NextParam;
if GetByteParam then VisualizaBits(FSalidas, locbyte);
NextParam;
if GetStringParam then LabelEstadoLectura.caption:=LocString;
NextParam;
if GetStringParam then LabelEstadoSalida.caption:=LocString;
NextParam;
for i:=1 to 4 do
begin
if GetStringParam then PantallaDescarga[i].caption:=LocString;
NextParam;
end;
if GetIntegerParam then
DescargaBandejaPidiendo.caption:=IntToStr(LocInteger);
NextParam;
if GetIntegerParam then
DescargaBandejaBoca.caption:=IntToStr(LocInteger);
NextParam;
if GetStringParam then LabelEstadoEntrada.caption:=LocString;
NextParam;
for i:=1 to 4 do
begin
if GetStringParam then PantallaCarga[i].caption:=LocString;
NextParam;
end;
if GetIntegerParam then
CargaBandejaPidiendo.caption:=IntToStr(LocInteger);
NextParam;
if GetIntegerParam then CargaBandejaBoca.caption:=IntToStr(LocInteger);
NextParam;
if GetStringParam then for i:=1 to 7 do
DescargaGrid.Cells[i,1]:=ExtractWord(i,LocString,[',']);
NextParam;
if GetIntegerParam then if Initfifo or (LocInteger<>FifoSerial)
then GetFifo(LocInteger);
end;
// free reply
dbus_message_unref(msg);
end;
Bye
--
Luca
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
