我是新手。希望能给点提示,谢谢!
解决方案 »
- delphi xe2 的datasnap 的TDataSet参数的问题
- 公司的面试题目
- 重分打造 在DBGRID里合并记录
- 做CORBA服务器运行时的一个问题!
- 嘿嘿 你试过没有? 在线等待 来者有分
- 很怪的一个问题,我在WIN2KP或WINXP上卸掉DELPHI5之后,就再也安装不上D5了!什么原因?
- 怎样取得SQL执行后的返回值,比如:。。。。。
- 谁能说说从一个ListView拖动文件到另一个ListView中
- 初学delphi,qreport问题,报表中的数据通过adoquery查询参数得到。如参数为5个用户id,每一个id应对应一张报表,当报表预览时,如何单击n
- Listview 在report视图的时候怎样读写第a行第b列的内容?
- wise install9.02 做OCX(mapx)安装程序出错如下,求救,马上给分
- 求助:怎样把excel的数据导入进paradox表,谢谢。。。
高手帮忙看看啊!Question: How to implements object collection that support Visual Basic's For Each construct ?
Answer: In order to implements an object collection yout object have to return
IEnumVariant pointer from a special property named _NewEnum.
IEnumVariant is a special COM interface defined as : IEnumVARIANT = interface (IUnknown)
function Next (celt; var rgvar; pceltFetched): HResult;
function Skip (celt): HResult;
function Reset: HResult;
function Clone(out Enum): HResult;
end; For Each is a special construct that knows how to call the IEnumVARIANT methods
(particularly Next) to iterate through all elements in the collection. Say you have a collection interface that looks like this: //single item
IMyItem = interface (IDispatch); //collection of MyItem items
IMyItems = interface (IDispatch)
property Count : integer;
property Item [Index : integer] : IMyItem;
end; 1. To be able to implement IEnumVARIANT, your collection interface must support
automation (be IDispatch-based) and your individual collection item data type
must be VARIANT compatible (automation compatible).
In our example, IMyItems must be IDispatch-based and IMyItem must be
VARIANT compatible (that could be byte, BSTR, long, IUnknown, IDispatch, etc.). 2. Add a read-only property named _NewEnum to the collection interface.
_NewEnum must return IUnknown and must have a dispid = -4 (DISPID_NEWENUM).
So our definition of IMyItems change to : IMyItems = interface (IDispatch)
property Count : integer;
property Item [Index : integer] : IMyItem;
property _NewEnum : IUnknown; dispid -4;
end; 3. _NewEnum must return IEnumVARIANT pointer. To further illistrate the concept I will give you a more thorough example bellow.
In this example I create dummy asp component that only have one collection object
Recipients which suppose to hold list of email addresses. I didn't include the
*.tlb and *_TLB.pas file, so in order to compile it you have to create it yourself.
( you have to do somekind of reverse engineering, from class implementation to
interface declaration using Delphi TypeLib Editor )
______________________________________________________________________
______________________________________________________________________ Additional Note : In above example the collection object is use to store
string data. But you could easily change the example so the collection
will hold for example any other COM object that implement IUnknown or IDispatch.
In that case you'll have to use Delphi TInterfaceList to hold all of your COM object
Windows, Classes, ComObj, ActiveX, AspTlb, enumdem_TLB, StdVcl; type
IEnumVariant = interface(IUnknown)
['{00020404-0000-0000-C000-000000000046}']
function Next(celt: LongWord; var rgvar : OleVariant;
pceltFetched: PLongWord): HResult; stdcall;
function Skip(celt: LongWord): HResult; stdcall;
function Reset: HResult; stdcall;
function Clone(out Enum: IEnumVariant): HResult; stdcall;
end; TRecipients = class (TAutoIntfObject, IRecipients, IEnumVariant)
protected
PRecipients : TStringList;
FIndex : Integer; function Get_Count: Integer; safecall;
function Get_Items(Index: Integer): OleVariant; safecall;
procedure Set_Items(Index: Integer; Value: OleVariant); safecall;
function Get__NewEnum: IUnknown; safecall;
procedure AddRecipient(Recipient: OleVariant); safecall; function Next(celt: LongWord; var rgvar : OleVariant;
pceltFetched: PLongWord): HResult; stdcall;
function Skip(celt: LongWord): HResult; stdcall;
function Reset : HResult; stdcall;
function Clone (out Enum: IEnumVariant): HResult; stdcall;
public
constructor Create;
constructor Copy(slRecipients : TStringList); destructor Destroy; override;
end; TEnumDemo = class(TASPObject, IEnumDemo)
protected
FRecipients : IRecipients; procedure OnEndPage; safecall;
procedure OnStartPage(const AScriptingContext: IUnknown); safecall;
function Get_Recipients: IRecipients; safecall;
end; implementation uses ComServ,
SysUtils; constructor TRecipients.Create;
begin
inherited Create (ComServer.TypeLib, IRecipients); PRecipients := TStringList.Create;
FIndex := 0;
end; constructor TRecipients.Copy(slRecipients : TStringList);
begin
inherited Create (ComServer.TypeLib, IRecipients); PRecipients := TStringList.Create;
FIndex := 0; PRecipients.Assign(slRecipients);
end; destructor TRecipients.Destroy;
begin
PRecipients.Free; inherited;
end; function TRecipients.Get_Count: Integer;
begin
Result := PRecipients.Count;
end; function TRecipients.Get_Items(Index: Integer): OleVariant;
begin
if (Index >= 0) and (Index < PRecipients.Count) then
Result := PRecipients[Index]
else
Result := '';
end; procedure TRecipients.Set_Items(Index: Integer; Value: OleVariant);
begin
if (Index >= 0) and (Index < PRecipients.Count) then
PRecipients[Index] := Value;
end; function TRecipients.Get__NewEnum: IUnknown;
begin
Result := Self;
end; procedure TRecipients.AddRecipient(Recipient: OleVariant);
var
sTemp : String;
begin
PRecipients.Add(Recipient); sTemp := Recipient;
end; function TRecipients.Next(celt: LongWord; var rgvar : OleVariant;
pceltFetched: PLongWord): HResult;
type
TVariantList = array [0..0] of olevariant;
var
i : longword;
begin
i := 0; while (i < celt) and (FIndex < PRecipients.Count) do
begin
TVariantList (rgvar) [i] := PRecipients[FIndex];
inc (i);
inc (FIndex);
end; { while } if (pceltFetched <> nil) then
pceltFetched^ := i;
if (i = celt) then
Result := S_OK
else
Result := S_FALSE;
end; function TRecipients.Skip(celt: LongWord): HResult;
begin
if ((FIndex + integer (celt)) <= PRecipients.Count) then
begin
inc (FIndex, celt);
Result := S_OK;
end
else
begin
FIndex := PRecipients.Count;
Result := S_FALSE;
end; { else }
end; function TRecipients.Reset : HResult;
begin
FIndex := 0;
Result := S_OK;
end; function TRecipients.Clone (out Enum: IEnumVariant): HResult;
begin
Enum := TRecipients.Copy(PRecipients);
Result := S_OK;
end; procedure TEnumDemo.OnEndPage;
begin
inherited OnEndPage;
end; procedure TEnumDemo.OnStartPage(const AScriptingContext: IUnknown);
begin
inherited OnStartPage(AScriptingContext);
end; function TEnumDemo.Get_Recipients: IRecipients;
begin
if FRecipients = nil then
FRecipients := TRecipients.Create; Result := FRecipients;
end; initialization
TAutoObjectFactory.Create(ComServer, TEnumDemo, Class_EnumDemo,
ciMultiInstance, tmApartment);
end.
______________________________________________________________________ Below I give you the asp script I use to test the component.
For this example I use only asp script. But the code should also
work perfectly in VB or VBA. ______________________________________________________________________ Set DelphiASPObj = Server.CreateObject("enumdem.EnumDemo") DelphiASPObj.Recipients.AddRecipient "[email protected]"
DelphiASPObj.Recipients.AddRecipient "[email protected]"
DelphiASPObj.Recipients.AddRecipient "[email protected]" Response.Write "Using For Next Structure" for i = 0 to DelphiASPObj.Recipients.Count-1
Response.Write "DelphiASPObj.Recipients.Items[" & i & "] = " & _
DelphiASPObj.Recipients.Items(i) & "
"
next Response.Write "
Using For Each Structure" for each sRecipient in DelphiASPObj.Recipients
Response.Write "Recipient : " & sRecipient & "
"
next Set DelphiASPObj = Nothing