398 lines
10 KiB
Plaintext
398 lines
10 KiB
Plaintext
unit uvclthreadworker;
|
|
{**
|
|
@explan(说明)支持工作线程
|
|
注意:工作线程中仅仅支持运算,不支持窗口的操作,
|
|
**}
|
|
//20210902 添加未初始化之前postmessage的缓存
|
|
interface
|
|
uses cstructurelib;
|
|
function RunThreadWorkerClient(this); //运行子任务
|
|
function RunThreadWorkerHost(); //分发worker消息
|
|
type tworkerclient = class(TArray)
|
|
{**
|
|
@explan(说明) 工作线程 %%
|
|
**}
|
|
function Create(ph);
|
|
begin
|
|
inherited create();
|
|
FConnectHandle := ph;
|
|
uisetthreadworkerdata(ph,0x30,self.handle); //构造
|
|
end
|
|
function close(); //请求关闭 0x10
|
|
begin
|
|
uisetthreadworkerdata(FConnectHandle,0x10,0);
|
|
end
|
|
function PostMessage(d);
|
|
begin
|
|
uisetthreadworkerdata(FConnectHandle,0x20,d);
|
|
end
|
|
function DoOnMessage(d); //执行onmessage 任务
|
|
begin
|
|
if iffuncptr(FOnMessage) then
|
|
begin
|
|
try
|
|
return call(FOnMessage,self,d);
|
|
except
|
|
uisetthreadworkerdata(FConnectHandle,0x40,exceptobject.ErrInfo);
|
|
end;
|
|
end
|
|
end
|
|
property ConnectHandle read FConnectHandle;
|
|
property OnMessage read FOnMessage write FOnMessage;
|
|
{**
|
|
@param(OnMessage)(function[tworkerclient,data]) 消息回调 %%
|
|
**}
|
|
function destroy();override;
|
|
begin
|
|
FOnMessage := nil;
|
|
inherited;
|
|
end
|
|
private
|
|
[weakref] FOnMessage; //onpost message
|
|
FConnectHandle; //句柄
|
|
end
|
|
type TCustomThreadworker = class()
|
|
{**
|
|
@explan(说明) 工作线程宿主 %%
|
|
**}
|
|
function Create(s,lib,declaration);
|
|
begin
|
|
if not ifarray(FThreaders) then FThreaders := array();
|
|
FThreader := new tworkerHost();
|
|
FThreaders[inttostr(FThreader.handle)] := FThreader;
|
|
if not (checkok(s,lib,declaration)) then raise "工作线程构造失败!";
|
|
uibeginthreadworker(FScript);
|
|
end
|
|
function Operator [](idx);
|
|
begin
|
|
{**
|
|
@explan(说明) get数据 %%
|
|
**}
|
|
return FThreader[idx];
|
|
end
|
|
function Operator [1](idx,v);
|
|
begin
|
|
{**
|
|
@explan(说明) set数据 %%
|
|
**}
|
|
FThreader[idx] := v;
|
|
end
|
|
function Close(); //关闭
|
|
begin
|
|
if FThreader then
|
|
begin
|
|
FThreader.close();
|
|
end
|
|
end
|
|
function terminate();
|
|
begin
|
|
Close();
|
|
end
|
|
function PostMessage(d);
|
|
begin
|
|
{**
|
|
@expaln(说明) 发送数据给子线程 %%
|
|
@param(d)(any) 发送数据,基础数据,不能传送对象 %%
|
|
**}
|
|
FThreader.PostMessage(d);
|
|
end
|
|
class function dispatch();
|
|
begin
|
|
if not FThreaders then return ;
|
|
for idx,i in mrows( FThreaders,1) do
|
|
begin
|
|
o := FThreaders[i];
|
|
try
|
|
oh := o.handle;
|
|
except
|
|
DeleteWorker(i);
|
|
uideleteworkerdata(oh); //删除数据
|
|
end
|
|
if uifeachthreadworkerdata(oh,msg,data) then
|
|
begin
|
|
case msg of
|
|
0x30: //构成成功
|
|
begin
|
|
o.ClientReady(data);
|
|
end
|
|
0x10: //请求关闭
|
|
begin
|
|
o.close();
|
|
end
|
|
0x12: //成功关闭
|
|
begin
|
|
uideleteworkerdata(oh); //删除数据
|
|
o.ClientReady(0);
|
|
DeleteWorker(i);
|
|
o.destroy();
|
|
end
|
|
0x40: //错误
|
|
begin
|
|
o.DoOnError(data);
|
|
end
|
|
0x20 : //传输数据
|
|
begin
|
|
o.DoOnMessage(data);
|
|
end
|
|
end ;
|
|
break;
|
|
end
|
|
end
|
|
end
|
|
function destroy();override;
|
|
begin
|
|
close();
|
|
inherited;
|
|
end
|
|
property componet read getcomponet write setcomponet;
|
|
property OnMessage read GetOnMessage write SetOnMessage;
|
|
property OnError read GetOnError write SetOnError;
|
|
property OnStart read GetOnStart Write SetOnStart;
|
|
{**
|
|
@param(OnMessage)(function[TThreadWorker,data]) 消息回调 %%
|
|
@param(OnStart)(function[TThreadWorker]) 子线程启动 %%
|
|
@param(OnError)(function[TThreadWorker,d]) 子线程启动 %%
|
|
**}
|
|
protected
|
|
function Check_TslCode(FScript,err);virtual;
|
|
begin
|
|
return true;
|
|
end
|
|
private
|
|
class function DeleteWorker(h);
|
|
begin
|
|
if h then
|
|
reindex( FThreaders,array(h:nil));
|
|
end
|
|
function checkok(s,libs,declaration);
|
|
begin
|
|
if ifstring(s) then
|
|
begin
|
|
lib := "";
|
|
if ifarray(libs) and libs then
|
|
begin
|
|
lib := ","+array2str(libs,",");
|
|
end
|
|
dc := "";
|
|
if ifstring(declaration) then
|
|
begin
|
|
dc := declaration;
|
|
end
|
|
FScript := format( %%
|
|
uses uvclthreadworker%s;
|
|
this := new unit(uvclthreadworker).tworkerclient(%s);
|
|
%s;
|
|
unit(uvclthreadworker).RunThreadWorkerClient(this);
|
|
%s;
|
|
|
|
%%,lib,inttostr(FThreader.handle),s,dc);
|
|
r := Check_TslCode(FScript,err);
|
|
if not r then FScript := "";
|
|
end
|
|
return r;
|
|
end
|
|
function GetOnMessage();
|
|
begin
|
|
return FThreader.OnMessage;
|
|
end
|
|
function SetOnMessage(m);
|
|
begin
|
|
FThreader.OnMessage := m;
|
|
end
|
|
function GetOnError()begin
|
|
return FThreader.OnError ;
|
|
end
|
|
function SetOnError(e)begin
|
|
FThreader.OnError := e ;
|
|
end
|
|
function GetOnStart()begin
|
|
return FThreader.OnStart ;
|
|
end
|
|
function SetOnStart(e)begin
|
|
FThreader.OnStart := e ;
|
|
end
|
|
[weakref]static FThreaders;
|
|
FScript; //脚本
|
|
FThreader;//host对象
|
|
function setcomponet(v);
|
|
begin
|
|
FThreader.componet := v;
|
|
end
|
|
function getcomponet();
|
|
begin
|
|
return FThreader.componet;
|
|
end
|
|
end
|
|
implementation
|
|
function RunThreadWorkerHost();
|
|
begin
|
|
class(TCustomThreadworker).dispatch();
|
|
end
|
|
function RunThreadWorkerClient(this);
|
|
begin
|
|
{**
|
|
@explan(说明) 工作线程主循环 %%
|
|
**}
|
|
h := this.handle;
|
|
ph := this.ConnectHandle;
|
|
while true do
|
|
begin
|
|
if uifeachthreadworkerdata(h,msg,d) then
|
|
begin
|
|
case msg of
|
|
0x11 : //关闭
|
|
begin
|
|
uisetthreadworkerdata(ph,0x12,0); //关闭完成
|
|
uideleteworkerdata(h); //删除消息
|
|
return;
|
|
end
|
|
0x20 : //post
|
|
begin
|
|
this.DoOnMessage(d);
|
|
end
|
|
end ;
|
|
sleep(1);
|
|
end else
|
|
begin
|
|
sleep(10);
|
|
end
|
|
tslprocessmessages(false); //20230428添加tsl消息分发
|
|
end
|
|
end
|
|
type TArray = class
|
|
function create();
|
|
begin
|
|
FData := array();
|
|
fobj := new tcbytearray(4);
|
|
FHandle := fobj._getptr_() ;
|
|
end
|
|
function Operator [](idx);
|
|
begin
|
|
return FData[idx];
|
|
end
|
|
function Operator [1](idx,v);
|
|
begin
|
|
FData[idx] := v;
|
|
end
|
|
function destroy();virtual;
|
|
begin
|
|
FData := array();
|
|
fobj := nil;
|
|
end
|
|
property handle read FHandle ;
|
|
private
|
|
FData;
|
|
FHandle;
|
|
fobj;
|
|
end
|
|
|
|
type tworkerHost = class(TArray)
|
|
function Create();
|
|
begin
|
|
inherited;
|
|
FConnectHandle := 0;
|
|
FCatcheData := array();
|
|
end
|
|
property OnMessage read FOnMessage write FOnMessage;
|
|
property OnStart read FOnStart write FOnStart;
|
|
property OnError read FOnError write FOnError;
|
|
property componet read Fcomponet write Fcomponet;
|
|
function close(); //关闭命令 0x10
|
|
begin
|
|
if FConnectHandle then
|
|
begin
|
|
uisetthreadworkerdata(FConnectHandle,0x11,0);
|
|
end
|
|
end
|
|
function ClientReady(h); //任务句柄改变
|
|
begin
|
|
FConnectHandle := h;
|
|
if h then
|
|
begin
|
|
if iffuncptr(FOnStart) then
|
|
begin
|
|
try
|
|
if Fcomponet then o := Fcomponet;
|
|
else o:= self;
|
|
call(FOnStart,o);
|
|
except
|
|
|
|
end;
|
|
end
|
|
if FCatcheData then
|
|
begin
|
|
for i,v in FCatcheData do
|
|
begin
|
|
uisetthreadworkerdata(FConnectHandle,0x20,v);
|
|
end
|
|
FCatcheData := array();
|
|
end
|
|
end
|
|
end
|
|
function PostMessage(d); //发送数据
|
|
begin
|
|
if FConnectHandle then
|
|
begin
|
|
if FCatcheData then
|
|
begin
|
|
for i,v in FCatcheData do
|
|
begin
|
|
uisetthreadworkerdata(FConnectHandle,0x20,v);
|
|
end
|
|
FCatcheData := array();
|
|
end
|
|
uisetthreadworkerdata(FConnectHandle,0x20,d);
|
|
end else
|
|
begin
|
|
FCatcheData[length(FCatcheData)] := d;
|
|
end
|
|
end
|
|
function DoOnError(d);//处理错误
|
|
begin
|
|
if iffuncptr(FOnError) then
|
|
begin
|
|
try
|
|
if Fcomponet then o := Fcomponet;
|
|
else o:= self;
|
|
return call(FOnError,o,d);
|
|
except
|
|
end;
|
|
end
|
|
end
|
|
function DoOnMessage(d); //处理数据
|
|
begin
|
|
if iffuncptr(FOnMessage) then
|
|
begin
|
|
try
|
|
if Fcomponet then o := Fcomponet;
|
|
else o:= self;
|
|
return call(FOnMessage,o,d);
|
|
except
|
|
end;
|
|
end
|
|
end
|
|
function destroy();override;
|
|
begin
|
|
FOnMessage := nil;
|
|
FOnError := nil;
|
|
OnStart := nil;
|
|
FCatcheData := array();
|
|
inherited;
|
|
end
|
|
private
|
|
FCatcheData; //构造数据
|
|
weakref
|
|
FOnMessage; //onpost message
|
|
FOnError;
|
|
FOnStart;
|
|
Fcomponet;
|
|
autoref
|
|
FConnectHandle; //句柄
|
|
end
|
|
function iffuncptr(fn);
|
|
begin
|
|
//return datatype(fn)=7;
|
|
return ifobj(fn);
|
|
end
|
|
initialization
|
|
end. |