I try to get the IUPnPService for a IUPnPDevice.
I can find the Services with: services:=device.Services;
services.Count tells me that there should be one Service.
The interface to IUPnPServices is a Collection of Interfaces.
I try to get the service with the _newEnum-Method.
The Method services._newEnum seems to work correctly.
With Enum.Next(1, ResultItem, Fetched) I get the Result: -2147220224
The correct Result should be S_OK (0).
Does anybody know what is wrong with my code?
Thank you for your help.
Here is my code:
//*****************************************
procedure TForm1.Button2Click(Sender: TObject);
var finder: IUPnPDeviceFinder;
device: IUPnPDevice;
service: IUPnPService;
services: IUPnPServices;
Enum: IEnumVariant;
Fetched: Cardinal;
ResultItem: OleVariant;
erg: HRESULT;
begin
finder := CoUPnPDeviceFinder.Create;
if finder<>nil then
begin
//UDN-name is for AVM Fritz!Box Fon WLAN
device:=finder.FindByUDN('uuid:75802409-bccb-40e7-8e6c-fa095ecce13e-00150c085665');
if device<>nil then
begin
try
services:=device.Services;
Memo1.Lines.Add('Number of Services:
'+IntToStr(services.Count));
Enum := services._newEnum as IEnumVariant;
erg:=Enum.Reset;
erg:= Enum.Next(1, ResultItem, Fetched);
while (erg = S_OK) do
begin
service := IDispatch(ResultItem) as IUPnPService;
Memo1.Lines.Add('ServiceID: '+ service.Id);
erg:= Enum.Next(1, ResultItem, Fetched);
end;
Enum := nil;
Memo1.Lines.Add('Name device: '+device.FriendlyName);
except
on E: exception do
begin
Label1.Caption := E.Message;
end;
end;
end;
end;
end;
> I try to get the IUPnPService for a IUPnPDevice.
>
> I can find the Services with: services:=device.Services;
> services.Count tells me that there should be one Service.
>
> The interface to IUPnPServices is a Collection of Interfaces.
> I try to get the service with the _newEnum-Method.
>
> The Method services._newEnum seems to work correctly.
>
> With Enum.Next(1, ResultItem, Fetched) I get the Result:
> -2147220224 The correct Result should be S_OK (0).
>
> Does anybody know what is wrong with my code?
> Thank you for your help.
>
[ code snipped ]
I'm not sure what's wrong with your code, but perhaps you could try
using this class to access the enumeration:
http://www.techvanguards.com/com/tutorials/tips.asp#Know how to
implement clients that iterate IEnumVARIANT-based collections
You need Binh Ly's ComLib
http://www.techvanguards.com/files/ComLib.zip
Have you tried accessing the services by looping an index from 0 or
1 to count, and using the Item property of IUPnPServices?
By the way, the problem may lie elsewhere, because the documentation
for IUPnPServices::_NewEnum says that it may return
UPNP_E_DOCUMENT_INVALID which means "The service description
contained an error." and this is the error code you are getting.
Here are some translated error codes from UPnP.h which may help you:
uses
windows;
const
{ This is a standard com error base }
COM_ERROR_BASE = (SEVERITY_ERROR shl 31) or
(FACILITY_ITF shl 16);
UPNP_E_ROOT_ELEMENT_EXPECTED = COM_ERROR_BASE or $0200;
UPNP_E_DEVICE_ELEMENT_EXPECTED = COM_ERROR_BASE or $0201;
UPNP_E_SERVICE_ELEMENT_EXPECTED = COM_ERROR_BASE or $0202;
UPNP_E_SERVICE_NODE_INCOMPLETE = COM_ERROR_BASE or $0203;
UPNP_E_DEVICE_NODE_INCOMPLETE = COM_ERROR_BASE or $0204;
UPNP_E_ICON_ELEMENT_EXPECTED = COM_ERROR_BASE or $0205;
UPNP_E_ICON_NODE_INCOMPLETE = COM_ERROR_BASE or $0206;
UPNP_E_INVALID_ACTION = COM_ERROR_BASE or $0207;
UPNP_E_INVALID_ARGUMENTS = COM_ERROR_BASE or $0208;
UPNP_E_OUT_OF_SYNC = COM_ERROR_BASE or $0209;
UPNP_E_ACTION_REQUEST_FAILED = COM_ERROR_BASE or $0210;
UPNP_E_TRANSPORT_ERROR = COM_ERROR_BASE or $0211;
UPNP_E_VARIABLE_VALUE_UNKNOWN = COM_ERROR_BASE or $0212;
UPNP_E_INVALID_VARIABLE = COM_ERROR_BASE or $0213;
UPNP_E_DEVICE_ERROR = COM_ERROR_BASE or $0214;
UPNP_E_PROTOCOL_ERROR = COM_ERROR_BASE or $0215;
UPNP_E_ERROR_PROCESSING_RESPONSE = COM_ERROR_BASE or $0216;
UPNP_E_DEVICE_TIMEOUT = COM_ERROR_BASE or $0217;
UPNP_E_INVALID_DOCUMENT = COM_ERROR_BASE or $0500;
UPNP_E_EVENT_SUBSCRIPTION_FAILED = COM_ERROR_BASE or $0501;
FAULT_INVALID_ACTION = 401;
FAULT_INVALID_ARG = 402;
FAULT_INVALID_SEQUENCE_NUMBER = 403;
FAULT_INVALID_VARIABLE = 404;
FAULT_DEVICE_INTERNAL_ERROR = 501;
FAULT_ACTION_SPECIFIC_BASE = 600;
FAULT_ACTION_SPECIFIC_MAX = 899;
UPNP_E_ACTION_SPECIFIC_BASE = COM_ERROR_BASE or $0300;
UPNP_E_ACTION_SPECIFIC_MAX = (UPNP_E_ACTION_SPECIFIC_BASE +
(FAULT_ACTION_SPECIFIC_MAX - FAULT_ACTION_SPECIFIC_BASE));
I hope this gets you going again!
The code with IEnumVariant was correct. The only
problem was, that there was no service.
With your help it was possible to use the StartAsyncFind-Method.
The Callback-Procedure is working very good.
With each Callback-Procedure I get a device.
With this device I look with device.HasChildren-Property if there are
further devices.
With ChildrenDevices:=pDevice.Children I get a new Devicelist.
To realize the Enum.Next-Loop I use an interesting method that I found
in the internet. With this method I can use the Delphi2005 "in" Loop.
The code is very simple and it works.
The new devices can also have Children. Then you can do the same again.
For each device in the tree you can look for Services.
With the Delphi2005 "in" Loop it is possible to find a single service.
The first service I found belongs to a Children-device.
Even the Callback-Procedure for the Children-device is working.
I had no time till now to walk through the complete tree.
I paste the the code for all three moduls here. (In the Modul UPnP.pas
you only need thre Buttons (Button1, Button2, Button3) and a Memo-Object
(Memo1).
//*********** TestUPnP.dpr***************
uses
Forms,
UPnP in 'UPnP.pas' {Form1},
UPNPLib_TLB in 'UPNPLib_TLB.pas',
uComEnumerator in 'uComEnumerator.pas';
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
//*****************************************
//************* UPnP.pas *******************
unit UPnP;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, UPNPLib_TLB, StdCtrls, ComObj, ActiveX;
type
//FinderCallback is working
IUPnPDeviceFinderCallback = interface(IUnknown)
['{415A984A-88B3-49F3-92AF-0508BEDF0D6C}']
function DeviceAdded(lFindData: integer; pDevice: IUPnPDevice): HRESULT;
stdcall;
function DeviceRemoved(lFindData: integer; bstrUDN: widestring):
HRESULT; stdcall;
function SearchComplete(lFindData: integer): HRESULT; stdcall;
end;
TCallback = class(TInterfacedObject, IUPnPDeviceFinderCallback, IUnknown)
protected
function DeviceAdded(lFindData: integer; pDevice: IUPnPDevice): HRESULT;
stdcall;
function DeviceRemoved(lFindData: integer; bstrUDN: widestring):
HRESULT; stdcall;
function SearchComplete(lFindData: integer): HRESULT; stdcall;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
end;
//ServiceCallback does not work (maybe not correct) but no error
IUPnPServiceCallback = interface(IUnknown)
['{31fadca9-ab73-464b-b67d-5c1d0f83c8b8}']
function StateVariableChanged(pus: IUPnPService; pcwszStateVarName:
pwidestring; vaValue: Variant): HResult; stdcall;
function ServiceInstanceDied(pus: IUPnPService): HResult; stdcall;
end;
TServiceCallback = class(TInterfacedObject, IUPnPServiceCallback)
protected
function StateVariableChanged(pus: IUPnPService; pcwszStateVarName:
pwidestring; vaValue: Variant): HResult; stdcall;
function ServiceInstanceDied(pus: IUPnPService): HResult; stdcall;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Memo1: TMemo;
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
FCallback: IUPnPDeviceFinderCallback;
finder: IUPnPDeviceFinder;
service: IUPnPService;
FCallbackService: IUPnPServiceCallback;
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
uses uComEnumerator;
{$R *.dfm}
const vbObject = 9;
var
tempDevice : IUnknown;
tempService: IUnknown;
function TCallback.DeviceAdded(lFindData: integer; pDevice: IUPnPDevice):
HRESULT;
var ChildrenDevices: IUPnPDevices;
ChildrenChildrenDevices: IUPnPDevices;
Idevice: IInterface;
IdeviceC: IInterface;
services: IUPnPServices;
ChildrenServices: IUPnPServices;
Iservice: IInterface;
IserviceC: IInterface;
begin
Form1.Memo1.Lines.Add('Found! Name: ' + pDevice.FriendlyName);
Form1.Memo1.Lines.Add('Found! Type: ' + pDevice.Type_);
Form1.Memo1.Lines.Add('Found! UDN: ' + pDevice.UniqueDeviceName);
services:=pDevice.Services;
for Iservice in GetCOMEnumerator(services._NewEnum) do
Form1.Memo1.Lines.Add('Service: '+(Iservice as IUPnPService).Id);
if pDevice.HasChildren then
begin
ChildrenDevices:=pDevice.Children;
if ChildrenDevices<>nil then
begin
Form1.Memo1.Lines.Add('ChildrenDevices-count:
'+IntToStr(ChildrenDevices.Count));
for Idevice in GetCOMEnumerator(ChildrenDevices._NewEnum) do
begin
Form1.Memo1.Lines.Add((Idevice as IUPnPDevice).FriendlyName);
if (Idevice as IUPnPDevice).HasChildren then
begin
ChildrenChildrenDevices:=(Idevice as
IUPnPDevice).Children;
Form1.Memo1.Lines.Add('ChildrenChildrenDevices-count:
'+IntToStr(ChildrenChildrenDevices.Count));
for IdeviceC in
GetCOMEnumerator(ChildrenChildrenDevices._NewEnum) do
begin
Form1.Memo1.Lines.Add((IdeviceC as
IUPnPDevice).FriendlyName);
end;
end;
ChildrenServices:=(Idevice as IUPnPDevice).Services;
for IserviceC in GetCOMEnumerator(ChildrenServices._NewEnum)
do
begin
try
Form1.service:=(IserviceC as IUPnPService);
Form1.service.AddCallback(Form1.FCallbackService);
except
on E: exception do
Form1.Memo1.Lines.Add(E.Message);
end;
Form1.Memo1.Lines.Add('ChildrenService: '+(IserviceC as
IUPnPService).Id);
end;
end;
end;
end;
result := S_OK;
end;
function TCallback.DeviceRemoved(lFindData: integer; bstrUDN: widestring):
HRESULT;
begin
form1.Memo1.Lines.Add('Device removed: ' + bstrUDN);
result := S_OK;
end;
function TCallback.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
result := Inherited QueryInterface(IID, obj);
end;
function TCallback.SearchComplete(lFindData: integer): HRESULT;
begin
form1.Memo1.Lines.Add('Search Complete');
result := S_OK;
end;
function TServiceCallback.StateVariableChanged(pus: IUPnPService;
pcwszStateVarName: pwidestring; vaValue: Variant): HRESULT;
var
output: string;
varname: WideString;
i: integer;
Value: string;
begin
varname:=WideString(pcwszStateVarName);
if VarType(vaValue)=varOleStr then
Value := vaValue;
output:='State changed: '+pus.Id +' VarName: '+varname+' Varianttype:
'+VarTypeAsText(VarType(vaValue))+' Value '+Value;
Form1.Memo1.Lines.Add(output);
end;
function TServiceCallback.ServiceInstanceDied(pus: IUPnPService): HRESULT;
var
output: string;
begin
output:='Service died: '+pus.Id;
Form1.Memo1.Lines.Add(output);
end;
function TServiceCallback.QueryInterface(const IID: TGUID; out Obj):
HResult;
begin
result := Inherited QueryInterface(IID, obj);
end;
procedure TForm1.FormCreate(Sender: TObject);
var erg: HRESULT;
begin
erg:=CoInitialize(nil);
case erg of
S_OK : Memo1.Lines.Add('S_OK: CoInitialize');
S_FALSE: Memo1.Lines.Add('S_FALSE: CoInitialize (already
initialized)');
RPC_E_CHANGED_MODE: Memo1.Lines.Add('RPC_E_CHANGED_MODE: CoInitialize');
E_INVALIDARG: Memo1.Lines.Add('E_INVALIDARG: CoInitialize');
E_OUTOFMEMORY: Memo1.Lines.Add('E_OUTOFMEMORY: CoInitialize');
E_UNEXPECTED: Memo1.Lines.Add('E_UNEXPECTED: CoInitialize');
end; //case
tempDevice := TCallback.Create;
OLECheck(tempDevice.QueryInterface(IUPnPDeviceFinderCallback,FCallback));
tempService := TServiceCallback.Create;
OLECheck(tempService.QueryInterface(IUPnPServiceCallback,FCallbackService));
end;
procedure TForm1.Button1Click(Sender: TObject);
var findDataI: integer;
begin
//create Finder-Object
// finder := CreateOleObject('UPnP.UPnPDeviceFinder') as
IUPnPDeviceFinder;
finder := CoUPnPDeviceFinder.Create;
if not VarIsEmpty(finder) then
begin
Memo1.Lines.Add('Create AsyncFind');
//create AsyncFind and pass Callback-Interface
//Callback should inform about start, stop and finding devices
findDataI:=finder.CreateAsyncFind('upnp:rootdevice',0,FCallback);
//start findign
finder.StartAsyncFind(findDataI);
Memo1.Lines.Add('Start AsyncFind');
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var finder: IUPnPDeviceFinder;
device: IUPnPDevice;
service: IUPnPService;
services: IUPnPServices;
Iservice: IInterface;
// das Interface zum Collection-Container
Enum: IEnumVariant;
// Anzahl der zurückgelieferten Elemente
Fetched: Cardinal;
// Der Empfänger des Collection-Objektes
ResultItem: OleVariant;
erg: HRESULT;
begin
//create Finder-Object
// finder := CreateOleObject('UPnP.UPnPDeviceFinder') as
IUPnPDeviceFinder;
finder := CoUPnPDeviceFinder.Create;
if finder<>nil then
begin
//UDN-name is for AVM Fritz!Box Fon WLAN
//
device:=finder.FindByUDN('uuid:75802409-bccb-40e7-8e6c-fa095ecce13e-00150c085665');
device:=finder.FindByUDN('uuid:75802409-bccb-40e7-8e6c-fa095ecce13f-00150c085665');
if device<>nil then
begin
Memo1.Lines.Add(device.FriendlyName);
try
services:=device.Services;
if services<>nil then
begin
Memo1.Lines.Add('Anzahl Services:
'+IntToStr(services.Count));
//****** Versuch mit GetCOMEnumerator *******************
for Iservice in GetCOMEnumerator(services._NewEnum) do
Memo1.Lines.Add((Iservice as IUPnPService).Id);
//************ Versuch selbst geschrieben
*********************
// die Collection zurückgeben lassen
Enum := IEnumVariant(services._newEnum); // as IEnumVariant;
// die Collection reseten (ist theoretisch beim ersten
Durchlauf nicht nötig
// sollte imho aber gemacht werden
erg:=Enum.Reset;
if erg=S_OK then
Memo1.Lines.Add('S_OK: Reset');
// das erste Element ermitteln
// der erste Parameter gibt an, wie viele Objekte
zurückgeliefert werden
// sollen
// der zweite Parameter nimmt das Zielobjekt auf
// für diesen kann auch ein SafeArray von OleVariants
übergeben werden
// der dritte Parameter gibt an, wieviele Objekte
zurückgeliefert wurden
//
// die Übergabe von "1" für den ersten Parameter entspricht
dem VB Konstrukt
// for each Item in Collection
erg:= Enum.Next(1, ResultItem, Fetched);
while (erg = S_OK) do
begin
// jetzt auf das gewünschte Interface casten - dazu als
erstes das IDispatch
// Interface ermitteln und dann das Ziel-Interface
service := IDispatch(ResultItem) as IUPnPService;
// und nun wie gewohnt arbeiten...
Memo1.Lines.Add('ServiceID: '+ service.Id);
// das nächste Element ermitteln und weiter im Job...
erg:= Enum.Next(1, ResultItem, Fetched);
end;
// jetzt noch die Collection freigeben - oder einfach
weglassen, dann tut
// Delphi dieses spätestens beim Verlassen der Prozedur
Enum := nil;
end;
except
on E: exception do
begin
Memo1.Lines.Add('Error Service: '+E.Message);
end;
end;
end;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var finder: IUPnPDeviceFinder;
devices: IUPnPDevices;
Idevice: IInterface;
begin
//create Finder-Object
// finder := CreateOleObject('UPnP.UPnPDeviceFinder') as
IUPnPDeviceFinder;
finder := CoUPnPDeviceFinder.Create;
if not VarIsEmpty(finder) then
begin
Memo1.Lines.Add('Start FindByType');
devices:=finder.FindByType('urn:schemas-upnp-org:device:InternetGatewayDevice:1',0)
as IUPnPDevices;
if devices<>nil then
begin
Memo1.Lines.Add('devices-count: '+IntToStr(devices.Count));
for Idevice in GetCOMEnumerator(devices._NewEnum) do
Memo1.Lines.Add((Idevice as IUPnPDevice).FriendlyName);
end;
Memo1.Lines.Add('Stop FindByType');
end;
end;
end.
//*****************************************
//*********** UPNPLib_TLB.pas **************
can be created with Delphi from upnp.dll
//*****************************************
//*********** uComEnumerator.pas **************
{*=====================================================================
Classes:
TComEnumerator
File:
uComEnumerator.pas
Summary:
Simply pass the IEnumVariant collection to GetCOMEnumerator and
let
it and Delphi 2005 do the rest for you. The object created will
be
destroyed by the for...in...do loop construct automatically,
even
in the event of an exception in your code.
Simple pass the collection to the Create-method of the
class and let Delphi do the rest for you.
---------------------------------------------------------------------
This file is submitted by:
Daniel "sakura" Wischnewski
gate(n)etwork GmbH
Email me with your suggestions: sak...@delphipraxis.net
Visit our Web to stay tuned on Delphi: www.delphipraxis.net (GERMAN only)
THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY
KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A
PARTICULAR PURPOSE.
=====================================================================*}
unit uComEnumerator;
interface
type
IEnumVariant = interface(IUnknown)
['{00020404-0000-0000-C000-000000000046}']
function Next(celt: LongWord; var rgvar : OleVariant;
out pceltFetched: LongWord): HResult; stdcall;
function Skip(celt: LongWord): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out Enum: IEnumVariant): HResult; stdcall;
end;
// the "TComEnumerator" class basically just follows the outline of
Borlands
// Enumerator classes. All methods are implemented as asked for in the
Delphi
// 2005 Help
TComEnumerator = class
private
FEnum: IEnumVariant;
FCurrent: IInterface;
public
constructor Create(aEnum: IInterface);
function GetEnumerator: TComEnumerator;
function GetCurrent: IInterface;
function MoveNext: Boolean;
property Current: IInterface read GetCurrent;
end;
// use "GetCOMEnumerator" to get an "TComEnumerator" class for your
// for...in...do constructs
// - Paramter aEnum
// an interface that implements the default IEnumVariant interface as
// defined by Microsoft (and found in ActiveX.pas)
// - Return value
// the Enumerator class that is used in for...in...do constructs.
//
// Attention: Call GetCOMEnumerator() each time you want to pass an
enumeration
// to Delphi's for...in...do construct. Do not cache this object, Delphi
will
// automatically destroy it (using an internal try...finally...end block)
once
// the for...in...do loop has been finished.
//
// Note: You can use GetCOMEnumerator() on any COM Enum Variant collection.
To
// access your object directly simply cast the enumerated value to the COM
type
// needed (provided that it is supported ;))
function GetCOMEnumerator(aEnum: IInterface): TComEnumerator;
implementation
function GetCOMEnumerator(aEnum: IInterface): TComEnumerator;
begin
Result := TComEnumerator.Create(aEnum);
end;
{ TComEnumerator }
constructor TComEnumerator.Create(aEnum: IInterface);
begin
inherited Create;
try
// save the enumeration
FEnum := aEnum as IEnumVariant;
except
// fetch developer errors :-O
FEnum := nil;
end;
end;
function TComEnumerator.GetCurrent: IInterface;
begin
// return the current object
Result := FCurrent;
end;
function TComEnumerator.GetEnumerator: TComEnumerator;
begin
// return the class itself as enumerator for the Delphi-Language
Result := Self;
end;
function TComEnumerator.MoveNext: Boolean;
var
OleCurrent: OleVariant;
Fetched: Cardinal;
begin
if FEnum <> nil then
begin
// fetch the next element from the collection list
FEnum.Next(1, OleCurrent, Fetched);
if Fetched = 1 then
begin
// another object was fetched
FCurrent := OleCurrent;
Result := True;
end
else
begin
// no more objects in enumaration
Result := False;
end;
end
else
begin
Result := False;
end;
end;
end.
//*****************************************
"John Carlyle-Clarke" <joh...@nospam.europlacer.co.uk> schrieb im
Newsbeitrag news:Xns970A643FC9528jo...@192.168.1.69...