![]() |
#2
wp2319572012-11-17 07:53
|

program test;
{$APPTYPE CONSOLE}
uses
Windows, SysUtils, ActiveX, MSHTML,Messages;
var
h:hwnd;
doc:IHTMLDocument2;
procedure GetDocumentPtrFromWnd(Wnd: HWND; var pDoc: IHTMLDocument2);
type
TObjectFromLResult = function(LRESULT: LRESULT; const IID: TGUID; wParam: WPARAM; out PObject): HRESULT; stdcall;
var
GetDocPtr: TObjectFromLResult;
hModule: THandle;
Msg: Integer;
lRes: DWORD;
begin
hModule := LoadLibrary('OLEACC.DLL');
try
if hModule <> 0 then
begin
GetDocPtr := GetProcAddress(hModule, 'ObjectFromLresult');
if @GetDocPtr <> nil then
begin
Msg := RegisterWindowMessage('WM_HTML_GETOBJECT'); //难道不能处理消息?
SendMessageTimeOut(Wnd, Msg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
if GetDocPtr(lRes, IID_IHTMLDocument2, 0, pDoc) = S_OK then //这里死活不成功,失败了
begin
MessageBox(Wnd, '恭喜成功进入', '提示:', MB_ICONEXCLAMATION + MB_OK);
end
else
begin
pDoc := nil;
end;
end;
end;
finally
FreeLibrary(hModule);
end;
end;
begin
h:=FindWindow('IEFrame',nil);
h:=FindWindowEx(h,0,'Shell DocObject View',nil);
h:=FindWindowEx(h,0,'Internet Explorer_Server',nil);
if h=0 then Exit;
GetDocumentPtrFromWnd(h,doc);
if doc = nil then //doc始终为空,不知为何。
begin
MessageBox(h, '获取失败', '提示:', MB_ICONEXCLAMATION + MB_OK);
end;
end.
//上面的代码如果用有 窗体的WINFORM程序 的话就能成功进去获取成功。
//但是如果和现在编译 控制台 或 DLL 的话就死活不成功,实在不解啊,求各位帮帮忙,谢谢了!
//救命 - Delphi控制台或DLL编译的话就失败,如果用窗体的话就成功,实在不理解,帮帮忙!(TObjectFromLResult)
{$APPTYPE CONSOLE}
uses
Windows, SysUtils, ActiveX, MSHTML,Messages;
var
h:hwnd;
doc:IHTMLDocument2;
procedure GetDocumentPtrFromWnd(Wnd: HWND; var pDoc: IHTMLDocument2);
type
TObjectFromLResult = function(LRESULT: LRESULT; const IID: TGUID; wParam: WPARAM; out PObject): HRESULT; stdcall;
var
GetDocPtr: TObjectFromLResult;
hModule: THandle;
Msg: Integer;
lRes: DWORD;
begin
hModule := LoadLibrary('OLEACC.DLL');
try
if hModule <> 0 then
begin
GetDocPtr := GetProcAddress(hModule, 'ObjectFromLresult');
if @GetDocPtr <> nil then
begin
Msg := RegisterWindowMessage('WM_HTML_GETOBJECT'); //难道不能处理消息?
SendMessageTimeOut(Wnd, Msg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes);
if GetDocPtr(lRes, IID_IHTMLDocument2, 0, pDoc) = S_OK then //这里死活不成功,失败了
begin
MessageBox(Wnd, '恭喜成功进入', '提示:', MB_ICONEXCLAMATION + MB_OK);
end
else
begin
pDoc := nil;
end;
end;
end;
finally
FreeLibrary(hModule);
end;
end;
begin
h:=FindWindow('IEFrame',nil);
h:=FindWindowEx(h,0,'Shell DocObject View',nil);
h:=FindWindowEx(h,0,'Internet Explorer_Server',nil);
if h=0 then Exit;
GetDocumentPtrFromWnd(h,doc);
if doc = nil then //doc始终为空,不知为何。
begin
MessageBox(h, '获取失败', '提示:', MB_ICONEXCLAMATION + MB_OK);
end;
end.
//上面的代码如果用有 窗体的WINFORM程序 的话就能成功进去获取成功。
//但是如果和现在编译 控制台 或 DLL 的话就死活不成功,实在不解啊,求各位帮帮忙,谢谢了!
//救命 - Delphi控制台或DLL编译的话就失败,如果用窗体的话就成功,实在不理解,帮帮忙!(TObjectFromLResult)
[ 本帖最后由 qq1172527602 于 2012-11-16 22:59 编辑 ]