◆ [VBScript] 非同期処理(マルチスレッド) 参考ページ
どーもボキです。



http://www.roy.hi-ho.ne.jp/mutaguchi/bbs/list127.shtml
say さん 20041115144436
GetRef返却値のVBS実装予想

GetRefが返す関数ポインタがVBSでどう解釈されているかどなたかご教授
ください。VBS上でポインタは全てIDispatchらしいのはわかるのですが、
これをオブジェクト変数に入れて関数を呼び出せる機構がぜんぜん想像
できません。オブジェクトのメンバ関数として呼ぶならメンバ関数名を
どう処理しているのかどうにも見当がつきません。




魔界の仮面弁士 さん 20041115203159
》 sayさん
> GetRefが返す関数ポインタがVBSでどう解釈されているかどなたかご教授
> ください。VBS上でポインタは全てIDispatchらしいのはわかるのですが、

GetRef関数の戻り値は、ディスパッチID = 0 なメソッド
(つまり、規定のメソッド)を持ったオブジェクトへの参照です。

スクリプトコンポーネントで言えば、
<public><method name="MyMethod" dispid="0" /></public>
を公開しているクラスのような状態ですね。

ちなみに、GetRef関数の戻り値が VB/VBA に渡された場合は、
CallByName objGetRef, "", VbMethod, 引数…
のようにして呼び出せるようです。


# …って、そういう事を聞いているのでは無いのかな。(汗


http://www.delphigroups.info/2/2/259285.html
procedure ProcessTextStream(Disp: IDispatch);
var
szName: POleStr;
dispID: TDispID;
varParam, varChars: Variant;
params: DISPPARAMS;
begin
// get the DISPID of the TextStream.Read() method...
szName := 'Read';
if FAILED(Disp.GetIDsOfNames(IID_NULL, POleStrList(@szName), 1,
LOCALE_SYSTEM_DEFAULT, PDispIDList(@dispID))) then Exit;
// prepare to call Read()...
varParam := NumberOfBytesToRead;
params.rgvarg = @varParam;
params.rgdispidNamedArgs := nil;
params.cArgs := 1;
params.cNamedArgs := 0;
// call Read()...
if FAILED(Disp.Invoke(dispID, IID_NULL, LOCALE_SYSTEM_DEFAULT,
DISPATCH_METHOD, params, @varChars, nil, nil)) then Exit;
// process varChars as needed
// should be of type VT_BSTR...
end;
function TMyClassImpl.method(Value: Variant): HResult; stdcall;
begin
ProcessTextStream(Value);
Result := S_OK;
end;


http://www.koders.com/delphi/fid98A11BDAACE081E6C8377524581986EFC561053F.aspx
//data and utility functions of use for the whole project
unit barutil;

interface

uses windows,controls,sysutils;


type

LPCREATESTRUCT=^TCreateStructW;

IWndHook = interface//(IUnknown)
function getIEproc : TFarProc; stdcall;
procedure setIEproc(wndProc:TFarproc); stdcall;
function getMyProc : TFarProc; stdcall;
function getIErebar: HWND; stdcall;
procedure setIErebar(xrebar:HWND); stdcall;
end; // IWndHook

// procedure ComRelease(var x:Pointer);
function installWndHookTBAR(var HWNDtb:HWND;ref:Pointer):WordBool;
function installWndHookTMARKER(var HWNDtb:HWND;var ref:Pointer):WordBool;
procedure FreeWndProcInstance(ProcInstance: Pointer);
function MakeWndProcInstance(M: TMethod): Pointer;
procedure broadcast(rebar:HWND;uid:UInt;lPar:lParam);

const

show_debug=false;

//IID_NULL: TGUID='{00000000-0000-0000-0000-000000000000}';
//SID_SShellBrowser :TGUID = '{000214E2-0000-0000-C000-000000000046}';
//SID_IDocViewSite :TGUID = '{87D605E0-C511-11CF-89A9-00A0C9054129}';
//SID_IShellFolder2 :TGUID = '{93F2F68C-1D1B-11D3-A30E-00C04F79ABD1}';
//SID_SInternetExplorer:TGUID = '{0002DF05-0000-0000-C000-000000000046}';
//SID_SWebBrowserApp :TGUID = '{0002DF05-0000-0000-C000-000000000046}';

NEXTNOTE='#$$#'; //used in the supplet files for separation of entries

True: wordbool=(1=1);
False:wordbool=(1=2);

//Toolbarbutton Command IDs
TB_DOMARKER= 12366;
TB_DONOTE= 12368;
TB_DOSHEET= 12370;
TB_GOHELP= 12372;
TB_DOATTACHMAIL=12374;


//Inter-Window Communication Messages
WM_SUPPLETBAR_VIS=23052099;
WM_SUPPLETBAR_SHOW=23052004;
WM_SUPPLETBAR_HIDE=23052005;
WM_SUPPLETBAR_DESTROY=23052006;
WM_SUPPLETBAR_INFOCUS=23052007;

WM_SUPPLETDELNOTE=230520021;
WM_SUPPLETNEWNOTE=230520022;
WM_SUPPLETCOL = 230520023;

WM_SUPPLET_DOTEMA=23052013;

//remove me later
CCM_FIRST = 8192; // Common control shared messages
CCM_SETVERSION = CCM_FIRST + 7;
//end remove later


IID_CMDS: TGUID='{DE4BA900-59CA-11CF-9592-444553540000}';
ACTIVE_CMD = MF_STRING OR MF_ENABLED; //for SUPPORTED or ENABLED
INACTIVE_CMD = MF_STRING OR MF_GRAYED;//for SUPPORTED but not ENABLED

OLECMDF_SUPPORTED = 1;
OLECMDF_ENABLED = 2;
OLECMDF_LATCHED = 4;
OLECMDF_NINCHED = 8;

CONTEXT_MENU_TEXTSELECT = 4;
CONTEXT_MENU_HYPERTEXT = 5;
CONTEXT_PICTURE = 1;

//CHECK THIS LATER:
IDM_MULTILEVELUNDO = 44;

//basic commands in a selection popup menu
IDM_CUT = 16;
IDM_COPY = 15;
IDM_PASTE = 26;
IDM_SELECTALL = 31;
IDM_PRINT = 27;

//extended hyperlink context menu commands
IDM_FOLLOWLINKC = 2136;
IDM_FOLLOWLINKN = 2137;
IDM_SAVETARGET = 2268;
IDM_PRINTTARGET = 2273;

IDM_COPYSHORTCUT = 2262;

IDM_ADDFAVORITES = 2261;

IDM_PROPERTIES = 28;

//Picture commands
IDM_SHOWPICTURE = 2269;
IDM_SAVEPICTURE = 2270;
IDM_MP_EMAILPICTURE = 2288;
IDM_MP_PRINTPICTURE = 2289;
IDM_MP_MYPICS = 2287;
IDM_SETWALLPAPER = 2264;
IDM_SETDESKTOPITEM = 2278;

//and, of course, ourselves
IDM_TEXTMARK = 1981;
IDM_ALTTEXTMARK = 1983;
IDM_ANNOTATE = 1982;
IDM_DELMARK = 1985;
IDM_DELNOTE = 1986;

DISPID_BEFORENAVIGATE = 100; // this is sent before navigation to give a chance to abort
DISPID_NAVIGATECOMPLETE = 101; // in async, this is sent when we have enough to show
DISPID_STATUSTEXTCHANGE = 102;
DISPID_QUIT = 103;
DISPID_DOWNLOADCOMPLETE = 104;
DISPID_COMMANDSTATECHANGE= 105;
DISPID_DOWNLOADBEGIN = 106;
DISPID_NEWWINDOW = 107; // sent when a new window should be created
DISPID_PROGRESSCHANGE = 108; // sent when download progress is updated
DISPID_WINDOWMOVE = 109; // sent when main window has been moved
DISPID_WINDOWRESIZE = 110; // sent when main window has been sized
DISPID_WINDOWACTIVATE = 111; // sent when main window has been activated
DISPID_PROPERTYCHANGE = 112; // sent when the PutProperty method is called
DISPID_TITLECHANGE = 113; // sent when the document title changes
DISPID_TITLEICONCHANGE = 114; // sent when the top level window icon may have changed.

DISPID_FRAMEBEFORENAVIGATE = 200;
DISPID_FRAMENAVIGATECOMPLETE = 201;
DISPID_FRAMENEWWINDOW = 204;

DISPID_BEFORENAVIGATE2 = 250; // hyperlink clicked on
DISPID_NEWWINDOW2 = 251;
DISPID_NAVIGATECOMPLETE2 = 252; // UIActivate new document
DISPID_ONQUIT = 253;
DISPID_ONVISIBLE = 254; // sent when the window goes visible/hidden
DISPID_ONTOOLBAR = 255; // sent when the toolbar should be shown/hidden
DISPID_ONMENUBAR = 256; // sent when the menubar should be shown/hidden
DISPID_ONSTATUSBAR = 257; // sent when the statusbar should be shown/hidden
DISPID_ONFULLSCREEN = 258; // sent when kiosk mode should be on/off
DISPID_DOCUMENTCOMPLETE = 259; // new document goes ReadyState_Complete
DISPID_ONTHEATERMODE = 260; // sent when theater mode should be on/off
DISPID_ONADDRESSBAR = 261; // sent when the address bar should be shown/hidden
DISPID_WINDOWSETRESIZABLE = 262; // sent to set the style of the host window frame
DISPID_WINDOWCLOSING = 263; // sent before script window.close closes the window
DISPID_WINDOWSETLEFT = 264; // sent when the put_left method is called on the WebOC
DISPID_WINDOWSETTOP = 265; // sent when the put_top method is called on the WebOC
DISPID_WINDOWSETWIDTH = 266; // sent when the put_width method is called on the WebOC
DISPID_WINDOWSETHEIGHT = 267; // sent when the put_height method is called on the WebOC
DISPID_CLIENTTOHOSTWINDOW = 268; // sent during window.open to request conversion of dimensions
DISPID_SETSECURELOCKICON = 269; // sent to suggest the appropriate security icon to show
DISPID_FILEDOWNLOAD = 270; // Fired to indicate the File Download dialog is opening
DISPID_NAVIGATEERROR = 271; // Fired to indicate the a binding error has occured
DISPID_PRIVACYIMPACTEDSTATECHANGE = 272; // Fired when the user's browsing experience is impacted
//end event constans

SID_STopLevelBrowser: TGUID='{4C96BE40-915C-11CF-99D3-00AA004AE837}';
IID_IInputObjectSite:TGUID='{f1db8392-7331-11d0-8c99-00a0c92dbfe8}';
IID_IOleWindow:TGUID='{00000114-0000-0000-C000-000000000046}';
IID_IDockingWindowFrame:TGUID='{47d2657a-7b27-11d0-8ca9-00a0c92dbfe8}';
IID_IDockingWindowSite:TGUID='{2a342fc2-7b26-11d0-8ca9-00a0c92dbfe8}';

Class_bar: TGUID ='{A7AF8533-1047-46FD-9745-CE9B0E2B45D9}';

browserhelperobjects = '\Software\Microsoft\Windows\CurrentVersion\explorer\Browser Helper Objects';
verticalBarCatID='Implemented Categories\{00021493-0000-0000-C000-000000000046}';
BarPath='\Software\Microsoft\Internet Explorer\Explorer Bars';

author='Johannes Knabe';

Bar_CLASS_NAME: PChar='Supplet';
Bar_Class_NameW: PWideChar='Supplet';

implementation

uses
bar,mark,
//just temporary for debug:
Dialogs, Messages,
ActiveX, ComObj, ComServ,
Forms,Registry, MSHTML_TLB, SHDocVw_TLB, SHLOBJ,CommCtrl;

function MakeWndProcInstance(M: TMethod): Pointer;
begin
GetMem(Result, 15);
asm
// MOV ECX,
MOV BYTE PTR [EAX], $B9
MOV ECX, M.Data
MOV DWORD PTR [EAX+$1], ECX
// POP EDX
MOV BYTE PTR [EAX+$5], $5A
// PUSH ECX
MOV BYTE PTR [EAX+$6], $51
// PUSH EDX
MOV BYTE PTR [EAX+$7], $52
// MOV ECX,
MOV BYTE PTR [EAX+$8], $B9
MOV ECX, M.Code
MOV DWORD PTR [EAX+$9], ECX
// JMP ECX
MOV BYTE PTR [EAX+$D], $FF
MOV BYTE PTR [EAX+$E], $E1
end;
end;

procedure FreeWndProcInstance(ProcInstance: Pointer);
begin
FreeMem(ProcInstance, 15);
end;

procedure broadcast(rebar:HWND;uid:UInt;lPar:lParam);
begin
if(isWindow(rebar))then
SendMessage(rebar,uid,23,lPar);
//MessageDlg('broadcasted '+inttostr(),mtInformation,[mbOk], 0);
end;

{procedure ComRelease(var x:Pointer);
begin
//MessageDlg('Release:'+inttostr(integer(x)),mtInformation,[mbOk], 0);
if(Assigned(x))then
begin
IUnknown(x)._Release;
x:=nil;
end;
end;
}

//installWndHookTBAR is only for TBar, but just due to the casting :-(
function installWndHookTBAR(Var HWNDtb:HWND;ref:Pointer):WordBool;
var
myIEbarProc:TFarProc;
myRebar:HWND;
begin

myRebar:=getParent(HWNDtb);
myRebar:=SendMessage(hwndTB,TB_SETPARENT,myRebar,0);
SendMessage(hwndTB,TB_SETPARENT,myRebar,0);

if not(isWindow(myRebar))then
begin
Result:=false;
exit;
end;
if(show_debug)then
MessageDlg('gotParent: '+inttostr(myrebar)+' Ref:'+inttostr(integer(ref)),mtInformation,[mbOk], 0);

TBar(ref).setIErebar(myRebar);

myIEbarProc:=TFarProc(GetWindowLong(myRebar,GWL_WNDPROC));
if(Assigned(myIEbarProc))then
TBar(ref).setIEproc(myIEbarProc)
else
begin
Result:=false;
exit;
end;
if(show_debug)then
MessageDlg('gotWndProc: '+inttostr(integer(myIEbarProc)),mtInformation,[mbOk], 0);

myIEbarProc:=TBar(ref).getMyProc;
SetWindowlong(myRebar,GWL_WNDPROC,longword(myIEbarProc));
if(show_debug)then
MessageDlg('hook installed',mtInformation,[mbOk], 0);
Result:=true;
end; //installWndHookTBAR

//installWndHookTMARKER exactly like above, just casting changed
//should query for an interface instead...
function installWndHookTMARKER(Var HWNDtb:HWND;Var ref:Pointer):WordBool;
var
myIEbarProc:TFarProc;
myRebar:HWND;
begin

myRebar:=getParent(HWNDtb);
myRebar:=SendMessage(hwndTB,TB_SETPARENT,myRebar,0);
SendMessage(hwndTB,TB_SETPARENT,myRebar,0);

if not(isWindow(myRebar))then
begin
Result:=false;
exit;
end;
if(show_debug)then
MessageDlg('gotParent: '+inttostr(myrebar)+' Ref:'+inttostr(integer(ref)),mtInformation,[mbOk], 0);

TMarker(ref).setIErebar(myRebar);

myIEbarProc:=TFarProc(GetWindowLong(myRebar,GWL_WNDPROC));
if(Assigned(myIEbarProc))then
TMarker(ref).setIEproc(myIEbarProc)
else
begin
Result:=false;
exit;
end;
if(show_debug)then
MessageDlg('gotWndProc: '+inttostr(integer(myIEbarProc)),mtInformation,[mbOk], 0);

myIEbarProc:=TMarker(ref).getMyProc;
SetWindowlong(myRebar,GWL_WNDPROC,longword(myIEbarProc));
if(show_debug)then
MessageDlg('hook installed',mtInformation,[mbOk], 0);
Result:=true;
end; //InstallWndHookTMarker

end.

[PR]
by yozda | 2010-03-15 22:57 | プログラミング | Trackback | Comments(0)
トラックバックURL : http://yozda.exblog.jp/tb/10195563
トラックバックする(会員専用) [ヘルプ]
<< 33回目の誕生日 春を見つけた >>