难道现在论坛里真的没有高手了？ (100分)

to xwings:
这样就可以让程序的窗体嵌入到IE里打开文件么？[?][?]

是这样工作的，客户端安装一个程序负责打开这个xyz文件，当用户点击链接到.xyz文件的连接时，ie会自动调用你的程序来处理.xyz文件。
如果需要在ie中打开窗口，我想应该编写一个自动化对象，页面中包含创建对象的脚本代
码。和我说的不是一回事了。
如果你想象word那样直接嵌在网页中打开doc文件。那么你的程序应该支持自动化处理。其他的不变，应该可以，不过我没有试过。

其实我现在困惑的就是在自动化服务器中怎么实现这个功能[]

o .这个可能就是早期的ole实现吧。我也没有做过。不过我想实现起来应该没有难度的啊。

我们都不行，
你是高手

不好意思，我也不会，不过可以抽空试试看。

我这里有个方法，我测试了可以实现部分的Activex Document功能。大家可以研究研究。
来字Delphi Magazine Issue 43 ，包括三个单元。



{*******************************************************}
{ }
{ ActiveX Document Support Unit }
{ Copyright (c) 1999, Steve Teixeira }
{ }
{*******************************************************}

unit AxDocs;

interface

uses
Windows, ComObj, ActiveX, AxCtrls, Controls, Classes, Menus, Messages,Variants;

type
TActiveXDocumentFactory = class;

TActiveXDocument = class(TActiveXControl, IOleDocument, IOleDocumentView,
IOleInPlaceActiveObject, IOleInPlaceObject)
private
FFactory: TActiveXDocumentFactory;
FMenu: TMainMenu;
FOleMenu: HMENU;
FSharedMenu: HMENU;
function GetAncestorValueByField(FieldNum: Cardinal): Cardinal;
procedure SetAncestorValueByField(FieldNum, Value: Cardinal);
function GetOleInPlaceSite: IOleInPlaceSite;
procedure SetOleInPlaceSite(const Value: IOleInPlaceSite);
procedure InPlaceMenuCreate;
procedure InPlaceMenuDestroy;
procedure MergeMenus(SharedMenu, SourceMenu: HMENU;
MenuWidths: PInteger
WidthIndex: Integer);
procedure UnmergeMenus(SharedMenu, SourceMenu: HMENU);
protected
{ IOleDocument methods }
function CreateView(Site: IOleInPlaceSite
Stream: IStream
rsrvd: DWORD;
out View: IOleDocumentView):HResult
stdcall;
function GetDocMiscStatus(var Status: DWORD):HResult
stdcall;
function EnumViews(out Enum: IEnumOleDocumentViews;
out View: IOleDocumentView):HResult
stdcall;
{ IOleDocumentView methods }
function SetInPlaceSite(Site: IOleInPlaceSite): HResult
stdcall;
function GetInPlaceSite(out Site: IOleInPlaceSite): HResult
stdcall;
function GetDocument(out P: IUnknown): HResult
stdcall;
function SetRect(const View: TRECT): HResult
stdcall;
function GetRect(var View: TRECT): HResult
stdcall;
function SetRectComplex(const View, HScroll, VScroll, SizeBox): HResult
stdcall;
function Show(fShow: BOOL): HResult
stdcall;
function UIActivate(fUIActivate: BOOL): HResult
stdcall;
function Open: HResult
stdcall;
function CloseView(dwReserved: DWORD): HResult
stdcall;
function SaveViewState(pstm: IStream): HResult
stdcall;
function ApplyViewState(pstm: IStream): HResult
stdcall;
function Clone(NewSite: IOleInPlaceSite
out NewView: IOleDocumentView):HResult
stdcall;
{ IOleInPlaceActiveObject }
function OnDocWindowActivate(fActivate: BOOL): HResult
stdcall;
{ IOleInPlaceObject }
function InPlaceDeactivate: HResult
stdcall;
{ Overrides }
procedure GetDocUIInfo(var Menu: TMainMenu);
function InPlaceActivate(ActivateUI: Boolean): HResult
override;
procedure WndProc(var Message: TMessage)
override;
public
procedure Initialize
override;
function ObjQueryInterface(const IID: TGUID
out Obj): HResult
override;
property Menu: TMainMenu read FMenu write FMenu;
property OleInPlaceSite: IOleInPlaceSite read GetOleInPlaceSite write SetOleInPlaceSite;
end;

TActiveXDocClass = class of TActiveXDocument;

TActiveXDocumentFactory = class(TActiveXControlFactory)
private
FDocMiscStatus: DWORD;
FHandler: string;
public
property DocMiscStatus: DWORD read FDocMiscStatus;
constructor Create(ComServer: TComServerObject;
ActiveXDocClass: TActiveXDocClass
WinControlClass: TWinControlClass;
const ClassID: TGUID
ToolboxBitmapID, MiscStatus: Integer;
ThreadingModel: TThreadingModel
const Handler: string;
DocMiscStatus: DWORD);
procedure UpdateRegistry(Register: Boolean)
override;
end;

implementation

uses ComServ, SysUtils, Forms;

{ TActiveXDocument }

function TActiveXDocument.ObjQueryInterface(const IID: TGUID
out Obj): HResult;
begin
// Must stub out IOleLink, or container will assume this is a linked object
// rather than an embedded object.
if IsEqualGuid(IID, IOleLink) then Result := E_NOINTERFACE
else Result := inherited ObjQueryInterface(IID, Obj);
end;

function TActiveXDocument.GetOleInPlaceSite: IOleInPlaceSite;
begin
// Work around fact that FOleInPlaceSite is private in TActiveXControl
// Note: this work around only guaranteed to work in Delphi 4
Result := IOleInPlaceSite(GetAncestorValueByField(9));
end;

procedure TActiveXDocument.SetOleInPlaceSite(const Value: IOleInPlaceSite);
begin
// Work around fact that FOleInPlaceSite is private in TActiveXControl
// Note: this work around only guaranteed to work in Delphi 4
SetAncestorValueByField(9, Cardinal(Value));
end;

function TActiveXDocument.GetAncestorValueByField(FieldNum: Cardinal): Cardinal;
var
ParentInstanceSize, Ofs: Cardinal;
begin
// Nasty hack: this method returns the value of a particular field in the
// ancestor class, with the assumption that the given field and all prior
// fields are 4 bytes in size.
ParentInstanceSize := ClassParent.ClassParent.InstanceSize;
Ofs := ParentInstanceSize + ((FieldNum - 1) * 4);
asm
mov eax, Self
add eax, Ofs
mov eax, dword ptr [eax]
mov @Result, eax
end;
end;

procedure TActiveXDocument.SetAncestorValueByField(FieldNum, Value: Cardinal);
var
ParentInstanceSize, Ofs: Cardinal;
begin
// Nasty hack: this method sets the value of a particular field in the
// ancestor class, with the assumption that the given field and all prior
// fields are 4 bytes in size.
ParentInstanceSize := ClassParent.ClassParent.InstanceSize;
Ofs := ParentInstanceSize + ((FieldNum - 1) * 4);
asm
mov eax, Self
add eax, Ofs
mov ecx, Value
mov dword ptr [eax], ecx
end;
end;

procedure TActiveXDocument.Initialize;
begin
inherited Initialize;
FFactory := Factory as TActiveXDocumentFactory;
end;

procedure TActiveXDocument.GetDocUIInfo(var Menu: TMainMenu);
begin
Menu := nil;
end;

function TActiveXDocument.InPlaceActivate(ActivateUI: Boolean): HResult;
begin
Result := inherited InPlaceActivate(ActivateUI);
InPlaceMenuCreate;
end;

procedure TActiveXDocument.WndProc(var Message: TMessage);
begin
inherited WndProc(Message);
if Message.Msg = WM_LBUTTONDBLCLK then InPlaceActivate(True);
end;

procedure TActiveXDocument.InPlaceMenuCreate;
var
IPFrame: IOleInPlaceFrame;
IPSite: IOleInPlaceSite;
IPUIWindow: IOleInPlaceUIWindow;
omgw: TOleMenuGroupWidths;
FrameInfo: TOleInPlaceFrameInfo;
PosRect, ClipRect: TRect;
begin
OleCheck(ClientSite.QueryInterface(IOleInPlaceSite, IPSite));
FrameInfo.cb := sizeof(FrameInfo);
IPSite.GetWindowContext(IPFrame, IPUIWindow, PosRect, ClipRect, FrameInfo);
FillChar(omgw, SizeOf(omgw), 0);
omgw.width[1] := 1;
// Create a blank menu and ask the container to add it's menus into the
// TOleMenuGroupWidths record
FSharedMenu := CreateMenu;
try
OleCheck(IPFrame.InsertMenus(FSharedMenu, omgw));
if FMenu = nil then Exit;
MergeMenus(FSharedMenu, FMenu.Handle, @omgw.width, 1);
// Send the menu to the client
FOleMenu := OleCreateMenuDescriptor(FSharedMenu, omgw);
IPFrame.SetMenu(FSharedMenu, FOleMenu, Control.Handle);
except
DestroyMenu(FSharedMenu);
FSharedMenu := 0;
raise;
end;
end;

procedure TActiveXDocument.InPlaceMenuDestroy;
var
IPFrame: IOleInPlaceFrame;
IPSite: IOleInPlaceSite;
IPUIWindow: IOleInPlaceUIWindow;
FrameInfo: TOleInPlaceFrameInfo;
PosRect, ClipRect: TRect;
begin
// Get the clients IOleInPlaceFrame so we can ask it to remove it's menu
OleCheck(ClientSite.QueryInterface(IOleInPlaceSite, IPSite));
FrameInfo.cb := sizeof(FrameInfo);
IPSite.GetWindowContext(IPFrame, IPUIWindow, PosRect, ClipRect, FrameInfo);
if IPFrame <> nil then IPFrame.SetMenu(0, 0, 0);
OleDestroyMenuDescriptor(FOleMenu);
FOleMenu := 0;
UnmergeMenus(FSharedMenu, FMenu.Handle);
end;

type
PIntArray = ^TIntArray;
TIntArray = array[0..0] of Integer;

procedure TActiveXDocument.MergeMenus(SharedMenu, SourceMenu: HMENU;
MenuWidths: PInteger
WidthIndex: Integer);
var
MenuItems, GroupWidth, Position, I, Len: Integer;
MenuState: UINT;
PopupMenu: HMENU;
ItemText: array[0..255] of char;
begin
// Copy the popups from the pMenuSource
MenuItems := GetMenuItemCount(SourceMenu);
GroupWidth := 0;
Position := 0;
// Insert at appropriate spot depending on WidthIndex
if (WidthIndex < 0) or (WidthIndex > 1) then Exit;
if WidthIndex = 1 then Position := MenuWidths^;
for I := 0 to MenuItems - 1 do
begin
// Get the HMENU of the popup
PopupMenu := GetSubMenu(SourceMenu, I);
// Separators move us to next group
MenuState := GetMenuState(SourceMenu, I, MF_BYPOSITION);
if (PopupMenu = NULL) and ((MenuState and MF_SEPARATOR) <> 0) then
begin
if WidthIndex > 5 then Exit
// Servers should not touch past 5
PIntArray(MenuWidths)^[WidthIndex] := GroupWidth;
GroupWidth := 0;
if WidthIndex < 5 then
Inc(Position, PIntArray(MenuWidths)^[WidthIndex + 1]);
Inc(WidthIndex, 2);
end
else begin
// Get the menu item text
Len := GetMenuString(SourceMenu, I, ItemText, SizeOf(ItemText), MF_BYPOSITION);
// Popups are handled differently than normal menu items
if PopupMenu <> 0 then
begin
if GetMenuItemCount(PopupMenu) <> 0 then
begin
// Strip the HIBYTE because it contains a count of items
MenuState := LoByte(MenuState) or MF_POPUP
// Must be popup
// Non-empty popup -- add it to the shared menu bar
InsertMenu(SharedMenu, Position, MenuState or MF_BYPOSITION, PopupMenu,
ItemText);
Inc(Position);
Inc(GroupWidth);
end;
end
else if Len > 0 then
begin
// only non-empty items are added
if ItemText <> '' then
begin
// here the state does not contain a count in the HIBYTE
InsertMenu(SharedMenu, Position, MenuState or MF_BYPOSITION,
GetMenuItemID(SourceMenu, I), ItemText);
Inc(Position);
Inc(GroupWidth);
end;
end;
end;
end;
end;

procedure TActiveXDocument.UnmergeMenus(SharedMenu, SourceMenu: HMENU);
var
TheseItems, MenuItems, I, J: Integer;
PopupMenu: HMENU;
begin
MenuItems := GetMenuItemCount(SharedMenu);
TheseItems := GetMenuItemCount(SourceMenu);
for I := MenuItems - 1 downto 0 do
begin
// Check the popup menus
PopupMenu := GetSubMenu(SharedMenu, I);
if PopupMenu <> 0 then
begin
// If it is one of ours, remove it from the SharedMenu
for J := 0 to TheseItems - 1 do
begin
if GetSubMenu(SourceMenu, J) = PopupMenu then
begin
// Remove the menu from SharedMenu
RemoveMenu(SharedMenu, I, MF_BYPOSITION);
Break;
end;
end;
end;
end;
end;

{ TActiveXDocument.IOleDocument }

function TActiveXDocument.CreateView(Site: IOleInPlaceSite;
Stream: IStream
rsrvd: DWORD
out View: IOleDocumentView): HResult;
var
OleDocView: IOleDocumentView;
begin
Result := S_OK;
try
if View = nil then
begin
Result := E_POINTER;
Exit;
end;
OleDocView := Self as IOleDocumentView;
if (OleInPlaceSite = nil) or (OleDocView = nil) then
begin
Result := E_FAIL;
Exit;
end;
// Use site provided
if Site <> nil then OleDocView.SetInPlaceSite(Site);
// Use stream provided for initialization
if Stream <> nil then OleDocView.ApplyViewState(Stream);
// Return the view
View := OleDocView;
except
Result := E_FAIL;
end;
end;

function TActiveXDocument.EnumViews(out Enum: IEnumOleDocumentViews;
out View: IOleDocumentView): HResult;
begin
Result := S_OK;
try
// We only support one view
View := Self as IOleDocumentView;
except
Result := E_FAIL;
end;
end;

function TActiveXDocument.GetDocMiscStatus(var Status: DWORD): HResult;
begin
Status := (Factory as TActiveXDocumentFactory).DocMiscStatus;
Result := S_OK;
end;

{ TActiveXDocument.IOleDocument }

function TActiveXDocument.ApplyViewState(pstm: IStream): HResult;
begin
Result := E_NOTIMPL;
end;

function TActiveXDocument.Clone(NewSite: IOleInPlaceSite;
out NewView: IOleDocumentView): HResult;
begin
Result := E_NOTIMPL;
end;

function TActiveXDocument.CloseView(dwReserved: DWORD): HResult;
begin
Result := S_OK;
try
Show(False);
SetInPlaceSite(nil);
except
Result := E_UNEXPECTED;
end;
end;

function TActiveXDocument.GetDocument(out P: IUnknown): HResult;
begin
Result := S_OK;
try
P := Self as IUnknown;
except
Result := E_FAIL;
end;
end;

function TActiveXDocument.GetInPlaceSite(out Site: IOleInPlaceSite): HResult;
begin
Result := S_OK;
try
Site := OleInPlaceSite;
except
Result := E_FAIL;
end;
end;

function TActiveXDocument.GetRect(var View: TRECT): HResult;
begin
Result := S_OK;
try
View := Control.BoundsRect;
except
Result := E_UNEXPECTED;
end;
end;

function TActiveXDocument.Open: HResult;
begin
Result := E_NOTIMPL;
end;

function TActiveXDocument.SaveViewState(pstm: IStream): HResult;
begin
Result := E_NOTIMPL;
end;

function TActiveXDocument.SetInPlaceSite(Site: IOleInPlaceSite): HResult;
begin
Result := S_OK;
try
if OleInPlaceSite <> nil then
Result := InPlaceDeactivate;
if Result <> S_OK then Exit;
if Site <> nil then OleInPlaceSite := Site;
except
Result := E_UNEXPECTED;
end;
end;

function TActiveXDocument.SetRect(const View: TRECT): HResult;
begin
// Implement using TActiveXControl's IOleInPlaceObject.SetObjectRects impl
Result := SetObjectRects(View, View);
end;

function TActiveXDocument.SetRectComplex(const View
const HScroll;
const VScroll
const SizeBox): HResult;
begin
Result := E_NOTIMPL;
end;

function TActiveXDocument.Show(fShow: BOOL): HResult;
begin
try
if fShow then
Result := InPlaceActivate(False)
else begin
Result := UIActivate(False);
Control.Visible := False;
end;
except
Result := E_UNEXPECTED;
end;
end;

function TActiveXDocument.UIActivate(fUIActivate: BOOL): HResult;
begin
Result := S_OK;
try
if FUIActivate then
begin
if OleInPlaceSite <> nil then InPlaceActivate(True)
else Result := E_UNEXPECTED;
end
else begin
UIDeactivate;
InPlaceMenuDestroy;
end;
except
Result := E_UNEXPECTED;
end;
end;

{ TActiveXDocument.IOleInPlaceActiveObject }

function TActiveXDocument.OnDocWindowActivate(fActivate: BOOL): HResult;
begin
Result := inherited OnDocWindowActivate(fActivate);
if fActivate then InPlaceMenuCreate
else InPlaceMenuDestroy;
end;

{ TActiveXDocument.IOleInPlaceObject }

function TActiveXDocument.InPlaceDeactivate: HResult;
var
ParentWnd: HWND;
begin
// This is a work-around for the fact that TActiveXControl implementation of
// this method makes the control go away to ParkingWindow la-la land. It
// needs to stay put within the document.
ParentWnd := Control.ParentWindow;
Result := inherited InplaceDeactivate;
Control.ParentWindow := ParentWnd;
Control.Visible := True;
end;

{ TActiveXDocumentFactory }

constructor TActiveXDocumentFactory.Create(ComServer: TComServerObject;
ActiveXDocClass: TActiveXDocClass
WinControlClass: TWinControlClass;
const ClassID: TGUID
ToolboxBitmapID, MiscStatus: Integer;
ThreadingModel: TThreadingModel
const Handler: string;
DocMiscStatus: DWORD);
begin
FDocMiscStatus := DocMiscStatus;
if Handler <> '' then FHandler := Handler
else FHandler := 'ole32.dll';
inherited Create(ComServer, ActiveXDocClass, WinControlClass, ClassId,
ToolboxBitmapID, '', MiscStatus, ThreadingModel);
end;

procedure TActiveXDocumentFactory.UpdateRegistry(Register: Boolean);
var
ClassKey, ProgKey, MiscFlags: string;
begin
ClassKey := 'CLSID/' + GUIDToString(ClassID) + '/';
ProgKey := ProgID + '/';
if Register then
begin
inherited UpdateRegistry(Register);
MiscFlags := IntToStr(FDocMiscStatus);
// Add reg keys under CLSID
CreateRegKey(ClassKey + 'DocObject', '', MiscFlags);
CreateRegKey(ClassKey + 'Programmable', '', '');
CreateRegKey(ClassKey + 'Insertable', '', '');
CreateRegKey(ClassKey + 'InprocHandler32', '', FHandler);
// Add reg keys under ProgID
CreateRegKey(ProgKey + 'DocObject', '', MiscFlags);
CreateRegKey(ProgKey + 'Insertable', '', '');
// Need to remove "control" key added by inherited method
DeleteRegKey(ClassKey + 'Control');
end
else begin
DeleteRegKey(ClassKey + 'DefaultExtension');
DeleteRegKey(ClassKey + 'DefaultIcon');
DeleteRegKey(ClassKey + 'DocObject');
DeleteRegKey(ClassKey + 'Programmable');
DeleteRegKey(ClassKey + 'Insertable');
DeleteRegKey(ClassKey + 'InprocHandler32');
DeleteRegKey(ProgKey + 'DocObject');
DeleteRegKey(ProgKey + 'Insertable');
inherited UpdateRegistry(Register);
end;
end;

end.

2、MainForm Unit

unit MainForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus;

type
TFormMain = class(TForm)
Memo: TMemo;
MainMenu: TMainMenu;
File1: TMenuItem;
Save1: TMenuItem;
ColorDialog: TColorDialog;
procedure Save1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
FormMain: TFormMain;

implementation

uses AxCtrls;

{$R *.DFM}

procedure TFormMain.Save1Click(Sender: TObject);
begin
if ColorDialog.Execute then
Memo.Color := ColorDialog.Color;
end;

end.

3、Program Unit

program DAXDoc;

uses
ComServ,
Forms,
DAXDoc_TLB in 'DAXDoc_TLB.pas',
Main in 'Main.pas' {DelphiAxDoc: CoClass},
MainForm in 'MainForm.pas' {FormMain},
AxCtrls in 'axctrls.pas',
AxDocs in 'AxDocs.pas';

{$R *.TLB}

{$R *.RES}

begin
Application.Initialize;
// Don't show main form when started via automation
Application.ShowMainForm := ComServer.StartMode = smStandAlone;
Application.CreateForm(TFormMain, FormMain);
Application.Run;
end.

不太明白，可以给个例子么？

给个邮箱

foundworld@163.com
谢谢！

检查！！

试过了，还是不能嵌入[]

例子中有一个ActiveDoc.htm,用IE打开，能够看到菜单的融合技术。
只是这个activeDoc 是从ActiveControl继承来的。所以没有占全部的客户区。仔细研究一下源码，应该可以解决。另外，例程没有注册shell接口，所以不能打开文件。但是肯定可以。