liujianjun/tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

tsl

Browse Source 
更新动态库
This commit is contained in:
JianjunLiu
2022-12-01 14:22:17 +08:00
parent 5d8fb9e994
commit dc16fb9d4e
116 changed files with 282 additions and 402 deletions
Download Patch File Download Diff File Expand all files Collapse all files
funcext/tvclib/tslvcl.tsf
-332
View File
@@ -5737,338 +5737,6 @@ type TIniFileExta=class(TIniFileExter)
end
end
type TCreateProcessA = class()
{**
@explan(说明) 进程构造对象 %%
**}
private
FOnEcho;
FBufSize;
{$ifdef linux}
static FProcesswnd;
function parserasexeclevparam(exe,cmd,e,arg,envp);
begin
arg := ParserCommandLine(exe+" "+cmd);
if not arg then return 0;
e := arg[0];
for i := length(e) downto 2 do
begin
if e[i]="/" then
begin
ph := e[1:i];
break;
end
end
arg[length(arg)] := nil;
envp := array();
if ph then
begin
envp[length(envp)] := "LD_LIBRARY_PATH=LD_LIBRARY_PATH:"+ph;
end
envp[length(envp)] := getgtkdisplay();
envp[length(envp)] :=nil;
return 1;
end
function getgtkdisplay();
begin
try
dsp := sys_getenv("DISPLAY");
if dsp="" then dsp := ":0";
if not ifstring(dsp) then dsp := ":0";
except
dsp := ":0";
end;
return "DISPLAY="+dsp;
end
type tprocesswnd = class(TCustomControl)
private
fidarraya;
fidarrayb;
fidarray;
Fmsg;
public
function create(AOwner);
begin
inherited;
Visible := false;
WsPopUp := true;
ht :=Handle ;
fidarray := array();
fidarraya := array();
fidarrayb := array();
Fmsg := "";
setlength(fmsg,1024);
//bindmessage(WM_USER,thisfunction(wmuser));
end
function addproc(pid,fid,obj,t);
begin
fidarray[pid] := fid;
fidarraya[pid] := obj;
fidarrayb[pid] := t;
CallDatafunction(obj.OnPressStart,obj,pid);
_send_(WM_USER,pid,fid,1);
end
function proccount();
begin
return length(fidarrayb);
end
function clearproc();
begin
for i,v in mrows(fidarray,1) do
begin
deleteproc(v);
end
end
function deleteproc(pid,flg);
begin
tsl_gtk_closehandle(fidarray[pid]);//删除fid
reindex(fidarray,array(pid:nil));
reindex(fidarraya,array(pid:nil));
tp := fidarrayb[pid];
if (tp .& 2) and ifnil(flg) then
begin
SysTerminate(1,pid);
end
if tp .& 1 then
begin
ExitMessageLoop();
end
reindex(fidarrayb,array(pid:nil));
end
function wmuser(o,e):WM_USER;override;
begin
pid := e.wparam;
fid := e.lparam;
if pid and fid then
begin
r := _wapi.tsl_gtk_pipread(fid,Fmsg,1024);
if r=0 then
begin
deleteproc(pid,1);
return ;
end else
if r>0 then
begin
obj := fidarraya[pid];
obj.DoOnEcho(obj,Fmsg[1:r]);
end else
begin
sleep(20);
end
_send_(WM_USER,pid,fid,1);
end
end
function Recycling();override;
begin
inherited;
deleteproc();
end
end
{$endif}
public
function DoOnEcho(o,s);virtual;
begin
{**
@explan(说明) 打印
**}
if not(CallMessgeFunction(FOnEcho,o,s))then
begin
echo s;
end
end
function create();override;
begin
inherited;
{$ifdef linux}
if not FProcesswnd then FProcesswnd := new tprocesswnd(initializeapplication());
{$endif}
FBufSize := 1024;
end
function CreateProcessThread(exe,cmd);
begin
{$ifdef linux}
if parserasexeclevparam(exe,cmd,e,arg,envp)then
begin
//echo tostn(arg);
id := FProcesswnd._wapi.tsl_gtk_createprocessa(e,arg,envp,rh);
//1 跟着退出 2 4
ct := FProcesswnd.proccount();
FProcesswnd.addproc(id,rh,self(true),0);
end
return id;
{$endif}
si := new T_startupinfoa();
sa := new T_security_attributes();
pi := new T_process_information();
sa.bInheritHandle := TRUE; //必须为TRUE，父进程的读写句柄可以被子进程继承
sa.nLength := sa._size_;
//创建匿名管道
w32 := gettswin32api();
bRet := w32.CreatePipe(hRead,hWrite,sa._getptr_,0);
if not bRet then return 0;
w32.GetStartupInfoA(si._getptr_);
si.dwflags := 0x100;
si.hStdOutput := hWrite;
si.hStdError := hwrite;
p := w32.CreateProcessA(nil,format('%s %s ',exe,cmd),0,0,true,0,0,nil,si._getptr_,pi._getptr_);
return pi.hProcess;
end
function CreateProcessWaitRead(exe,cmd,hd,exitWithParent);
begin
{**
@explan(说明) 执行代码,非阻塞当前线程 %%
@param(exe)(string) 程序 %%
@param(cmd)(string) 命令行 %%
@param(hd)(pointer) 句柄,返回 %%
@return(integer) 进程退出码 %%
**}
if FCurrentExeHandle then return;
{$ifdef linux}
if parserasexeclevparam(exe,cmd,e,arg,envp)then
begin
//echo tostn(arg);
id := FProcesswnd._wapi.tsl_gtk_createprocessa(e,arg,envp,rh);
hd := id;
FCurrentExeHandle := id;
//1 跟着退出 2 4
ct := FProcesswnd.proccount();
FProcesswnd.addproc(id,rh,self(true),(((exitWithParent or ifnil(exitWithParent))* 2).| 1));
initializeapplication().run();
if ct <> FProcesswnd.proccount()then
begin
FProcesswnd.clearproc();
end
FCurrentExeHandle := 0;
end
id := 0;
return 0;
{$endif}
if not(FBufSize>100)then FBufSize := 1024;
w32 := gettswin32api();
si := new T_startupinfoa();
sa := new T_security_attributes();
pi := new T_process_information();
sa.bInheritHandle := TRUE; //必须为TRUE，父进程的读写句柄可以被子进程继承
sa.nLength := sa._size_;
//创建匿名管道
bRet := w32.CreatePipe(hRead,hWrite,sa._getptr_,0);
if not bRet then return 0;
w32.GetStartupInfoA(si._getptr_);
si.dwflags := 0x100;
si.hStdOutput := hWrite;
si.hStdError := hwrite;
p := w32.CreateProcessA(nil,format('%s %s ',exe,cmd),0,0,true,0,0,nil,si._getptr_,pi._getptr_);
hd := pi.hProcess;
FCurrentExeHandle := hd;
w32.CloseHandle(hWrite);
if p then
begin
CallDatafunction(FOnPressStart,self(true),hd);
szReadBuf := "";
setlength(szReadBuf,FBufSize);
nReadNum := 0;
ct1 := 0;
ct2 := 0;
ct3 := 0;
s := "123456";
while w32.PeekNamedPipe(hRead,s,3,ct1,ct2,ct3) do
begin
if ct1 then
begin
if w32.ReadFile__(hRead,szReadBuf,FBufSize-1,nReadNum,nil)=0 then
begin
break;
end
tcs := szreadbuf[1:nreadnum];
DoOnEcho(self(true),tcs);
end
MSG := new TTagMSG();
hmsg := MSG._getptr_;
/////////////////////////////////////////////////////
if(w32.PeekMessageA(hmsg,0,0,0,0x1))then
begin
if MSG.message=0x12 then
begin
if exitWithParent or ifnil(exitWithParent)then SysTerminate(1,hd);
w32.PostQuitMessage(0);
break;
end else
begin
w32.TranslateMessage(hmsg);
w32.DispatchMessageA(hmsg);
end
end else
begin
tslprocessmessages(false);
RunWorkerThreadLoop();
w32.WaitMessage();
end
//////////////////////////////////////////
end
hd := 0;
w32.GetExitCodeProcess(pi.hProcess,cd);
w32.CloseHandle(hRead);
FCurrentExeHandle := 0;
end
return cd;
end
function CreateProcessWaitReadBlockThread(exe,cmd);
begin
{**
@explan(说明) 阻塞当前线程等待输出 %%
@param(exe)(string) 程序 %%
@param(cmd)(string) 命令行 %%
@return(integer) 进程退出码 %%
**}
{$ifdef linux}
return 0;
{$endif}
if not(FBufSize>100)then FBufSize := 1024;
w32 := gettswin32api();
si := new T_startupinfoa();
sa := new T_security_attributes();
pi := new T_process_information();
sa.bInheritHandle := TRUE; //必须为TRUE，父进程的读写句柄可以被子进程继承
sa.nLength := sa._size_;
//创建匿名管道
bRet := w32.CreatePipe(hRead,hWrite,sa._getptr_,0);
if not bRet then return 0;
w32.GetStartupInfoA(si._getptr_);
si.dwflags := 0x100;
si.hStdOutput := hWrite;
si.hStdError := hwrite;
p := w32.CreateProcessA(nil,format('%s %s ',exe,cmd),0,0,true,0,0,nil,si._getptr_,pi._getptr_);
w32.CloseHandle(hWrite);
if p then
begin
CallDatafunction(FOnPressStart,self(true),pi.hProcess);
szReadBuf := "";
setlength(szReadBuf,FBufSize);
nReadNum := 0;
while(w32.ReadFile__(hRead,szReadBuf,FBufSize-1,nReadNum,nil)) do
begin
tcs := szreadbuf[1:nreadnum];
DoOnEcho(self(true),tcs);
nreadnum := 0;
end
end
w32.GetExitCodeProcess(pi.hProcess,cd);
w32.CloseHandle(hRead);
return cd;
end
property BufSize read FBufSize write FBufSize;
property OnEcho read FOnEcho write FOnEcho;
property LastExeHandle read FCurrentExeHandle;
property OnPressStart read FOnPressStart write FOnPressStart;
private
FOnPressStart;
FCurrentExeHandle;
{**
@param(OnEcho)(function[TCreateProcessA,s:string]) 程序 %%
**}
end
type TMyArrayA = class(tstrindexarray)
{**
@explan(数组类型) 忽略字符串下标的大小写%%
funcext/tvclib/utslvclstdctl.tsf
+235
View File
@@ -6603,6 +6603,241 @@ type tcustomipaddr = class(TCustomControl)
Fsynrects[3,1] := rc1;
end
end
type tcustomprocess = class(tcomponent) //进程对象
{**
@explan(说明)带管道的进程对象 %%
**}
public
function create(AOwner);
begin
inherited;
fprocesshandle := 0;
if not ifarray(fproces) then fproces := array();
if not ifarray(fpends) then fpends := array();
if not ftm then
begin
ftm := new tcustomtimer(nil);
ftm.Interval := 500;
ftm.Ontimer := thisfunction(dispatchproc);
end
end
function CreateProcess(exe,cmd,exitWithParent);
begin
{**
@explan(说明) 执行代码,非阻塞当前线程 %%
@param(exe)(string) 程序 %%
@param(cmd)(string|array) 命令行 %%
@param(exitWithParent)(bool) 是否跟随父进程退出 %%
@return(pointer) 句柄 %%
**}
if fprocesshandle then return 0;
if not parserasexeclevparam(exe,cmd,e,arg,envp) then return 0;
Sysexecnewpipe(0);
ferrinfo := nil;
hd := sysexec(e,arg,nil,false,code);
if hd=0 then
begin
return 0;
end
dh := (((exitWithParent or ifnil(exitWithParent))));
fprocesshandle := hd;
fexestring := e;
fparams := arg;
addto(self(true),dh);
return hd;
end
function writepipe(s);//写管道
begin
{**
@explan(说明) 写管道%%
@param(s)(string) 写入的字符 %%
@return(integer) 写的信息 %%
**}
if fprocesshandle<>0 and ifstring(s) and s then
begin
return SysExecWritePipe(fprocesshandle,s);
end
return 0;
end
function terminate(code);
begin
{**
@explan(说明) 停止当前进程 %%
@param(code)(integer) 退出码 %%
**}
if not(code>0 or code<0) then code := 1;
if fprocesshandle<>0 then
begin
SysTerminate(code,fprocesshandle);
end
end
function Recycling();override;
begin
inherited;
id := fprocesshandle;
if (id<>0) and fpends[id] then SysTerminate(1,id);
FOnEcho := nil;
fonprcstart := nil;
fonprocended := nil;
end
published
property handle read fprocesshandle;
property errinfo read ferrinfo;
property exename read fexestring;
property paramarray read fparams;
property OnEcho read FOnEcho write FOnEcho;
property onstarted read fonprcstart write fonprcstart;
property onended read fonprocended write fonprocended;
{**
@param(OnEcho)(function[tcustomprocess,str]) 打印信息回调 %%
@param(onstarted)(function[tcustomprocess,nil]) 启动回调 %%
@param(onended)(function[tcustomprocess,str]) 停止回调 %%
@param(handle)(pointer) 进程句柄 %%
**}
private //成员变量
ferrinfo;
fonprcstart;
fprocesshandle;
FOnEcho;
fonprocended;
fexestring;
fparams;
private //处理函数
function doprocecho(o,s); //打印
begin
if not(CallMessgeFunction(FOnEcho,o,s))then
begin
echo s;
end
end
function doonprocend(o,e);
begin
CallMessgeFunction(fonprocended,o,e) ;
fexestring := nil;
fparams := nil;
end
function doonprocstart(o,e);
begin
CallMessgeFunction(fonprcstart,o,e) ;
end
function parserasexeclevparam(exe,cmd,e,arg,envp);
begin
envp := nil;
if ifstring(cmd) then
begin
arg := ParserCommandLine(cmd);
end else
begin
arg := cmd;
end
if not arg then return 0;
if ifstring(exe) and exe then
begin
e := exe;
end
else
begin
e := arg[0];
end
if not(ifstring(e) and e) then return 0;
{$ifdef linux}
for i := length(e) downto 2 do
begin
if e[i]="/" then
begin
ph := e[1:i];
break;
end
end
envp := array();
if ph then
begin
envp[length(envp)] := "LD_LIBRARY_PATH=LD_LIBRARY_PATH:"+ph;
end
envp[length(envp)] := getgtkdisplay();
Sysexecsetenvs(envp,0);
{$endif}
return 1;
end
function getgtkdisplay();
begin
try
dsp := sysgetenv("DISPLAY");
if dsp="" then dsp := ":0";
if not ifstring(dsp) then dsp := ":0";
except
dsp := ":0";
end;
return "DISPLAY="+dsp;
end
private //静态处理函数
class function dispatchproc(); //循环处理打印
begin
for i,v in mrows(fproces,1) do
begin
doecho(v);
end
end
class function doecho(pid);//打印处理
begin
obj := fproces[pid];
if not(obj) then return ;
sg := SysWaitForSingleObject(pid,10);
if sg<>258 then //如果退出
begin
obj.ferrinfo := sg;
while true do //读完pip
begin
try
s := Sysexecreadpipe(pid);
except
s := 0;
end
if s then
begin
obj.doprocecho(obj,s);
end else //读完后删除对象
begin
del(pid);
break;
end
end
end else //没有退出
begin
s := Sysexecreadpipe(pid); //读一次
if s then
begin
obj.doprocecho(obj,s);
end
end
end
class function addto(obj,f);//添加
begin
id := obj.handle;
fproces[id] := obj;
fpends[id] := f;
obj.doonprocstart(obj,nil);
if length(fproces)=1 then
begin
ftm.start();
end
end
class function del(pid); //删除
begin
Sysexecdeletepipe(pid);
obj := fproces[pid];
//obj.ExecuteCommand("clearhandle",0);
obj.fprocesshandle := 0;
reindex(fproces,array(pid:nil));
reindex(fpends,array(pid:nil));
obj.doonprocend(obj,nil);
if length(fproces)<1 then ftm.stop();
end
private //静态存储变量
static ftm;
static fproces;
static fpends;
end
implementation
type TtoolbuttonActionLink=class(TControlActionLink)
{**