◆ [VBScript] 非同期処理(マルチスレッド)は実現でけた!
どーもボキです。

でけた。TTimerを使えばよかった。

TThread.Execute内(スレッド)で実行すると、Invokeがうまく処理できないが、
スレッド以外でInvokeすれば、うまく処理できる。
なら、TTimerで処理したらどうだろう?とやってみたら、うまくいった。

下図のように、メインプロセスはInputBox(「コマンド入力」ダイアログ)で止まっているが、
バックグラウンド(cscript)では、Func_Inc1、Func_Inc5、Func_Inc10 が実行されていることがわかる。

正確にはタイマーじゃけどね。そもそも用途がなかったわ。
a0021757_17542871.gif
サンプルプログラム

サンプルの使い方
 1.SampleActiveXの登録.bat を実行する (SampleActiveX.dllの登録)
 2.ActiveX_DLL.vbs を実行


SampleActiveX.dllの関数
 ・関数の登録 : SetFunc GetRefでの関数ポインタ, 関数名, 関数実行間隔[msec]
 ・関数の実行 : ExeFunc 関数の登録インデックス (0~)

VBSのソース
Set ActiveX_DLL = CreateObject("SampleActiveX.CoClass")

GVal = 0

ActiveX_DLL.SetFunc GetRef("Func_Inc1" ),"Func_Inc1" , 1000
ActiveX_DLL.SetFunc GetRef("Func_Inc5" ),"Func_Inc5" , 5000
ActiveX_DLL.SetFunc GetRef("Func_Inc10"),"Func_Inc10",10000

ActiveX_DLL.ExeFunc 0
ActiveX_DLL.ExeFunc 1
ActiveX_DLL.ExeFunc 2

While(1)
Execute InputBox("コマンド?","コマンド入力","MsgBox GVal")
WEnd

'関数の定義 ---------------------------------------------------
Sub Func_Inc1
GVal = GVal +1
WScript.Echo "VBS:Func_Inc1 実行 GVal=" & GVal
End Sub

Sub Func_Inc5
GVal = GVal +5
WScript.Echo "VBS:Func_Inc5 実行 GVal=" & GVal
End Sub

Sub Func_Inc10
GVal = GVal +10
WScript.Echo "VBS:Func_Inc10 実行 GVal=" & GVal
End Sub


Delphiソース
unit uCoClass;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
Windows,
ExtCtrls, // TTimer
SysUtils, Variants, ComObj, ComServ, ActiveX, SampleActiveX_TLB, StdVcl;

type
TVBSFunc = Record
FuncDisp : IDispatch;
FuncName : OleVariant;
Timer : TTimer;
end;

type
TCoClass = class(TAutoObject, Interface_)
protected
disp : IDispatch;
FuncList : Array of TVBSFunc;
procedure SetFunc(var FuncDisp: OleVariant; FuncName: OleVariant;
ExecInterval: Integer); safecall;
procedure ExeFunc(FuncIndex: Integer); safecall;
private
procedure _OnTimer(Sender : TObject);
end;

implementation



procedure TCoClass.SetFunc(var FuncDisp: OleVariant; FuncName: OleVariant;
ExecInterval: Integer);
var
idx : Integer;
begin
idx := Length(FuncList);
SetLength(FuncList, idx+1);

FuncList[idx].FuncDisp := FuncDisp;
FuncList[idx].FuncName := FuncName;
FuncList[idx].Timer := TTimer.Create(nil);
FuncList[idx].Timer.Enabled := False;
FuncList[idx].Timer.Interval := ExecInterval;
FuncList[idx].Timer.Tag := idx; // 格納インデックスをTagに格納
FuncList[idx].Timer.OnTimer := _OnTimer;
end;



procedure TCoClass._OnTimer(Sender: TObject);
const
IID_NULL : TGUID='{00000000-0000-0000-0000-000000000000}';
var
fidx : Integer;
disp : IDispatch;
wsname : WideString;
szName: POleStr;
dispID: TDispID;
varParam, varChars: Variant;
params : DISPPARAMS;
begin
// Tagから格納インデックスを取得
fidx := TTimer(Sender).Tag;

// 格納情報を取得
disp := FuncList[fidx].FuncDisp;
wsname := FuncList[fidx].FuncName;
szName := @(wsname[1]);

// 関数のマッピング
if FAILED(disp.GetIDsOfNames(IID_NULL, POleStrList(@szName), 1,
LOCALE_SYSTEM_DEFAULT, PDispIDList(@dispID))) then Exit;

// 引数の設定
varParam := 0;
params.rgvarg := @varParam;
params.rgdispidNamedArgs := nil;
params.cArgs := 0;
params.cNamedArgs := 0;

// 関数の実行
if FAILED(disp.Invoke(dispID, IID_NULL, LOCALE_SYSTEM_DEFAULT,
DISPATCH_METHOD, params, @varChars, nil, nil)) then Exit;
end;



procedure TCoClass.ExeFunc(FuncIndex: Integer);
begin
if FuncIndex < 0 then exit;
if FuncIndex > High(FuncList) Then exit;

// タイマーを実行
FuncList[FuncIndex].Timer.Enabled := True;
end;



initialization
TAutoObjectFactory.Create(ComServer, TCoClass, Class_CoClass,
ciMultiInstance, tmApartment);
end.

[PR]
by yozda | 2010-03-14 17:43 | プログラミング | Trackback | Comments(0)
トラックバックURL : http://yozda.exblog.jp/tb/10185398
トラックバックする(会員専用) [ヘルプ]
<< 春を見つけた [ペパクラ] Deep Str... >>