tsl

更新动态库

designer/utslcodeeditor.tsf

@@ -4,7 +4,7 @@ unit UtslCodeEditor;
 20220520 分离调试器代码
 }
 interface
-uses utslvcldesignerresource,cstructurelib,utslvclauxiliary,utslvclmemstruct,utslvclgdi,
+uses utslvcldesignerresource,cstructurelib,utslvclauxiliary,utslvclmemstruct,utslvclgdi,utslvclstdctl,
      tslvcl,UTslmemo,UTslSynMemo,utslvclsyntaxparser,utslvcldebuger;
 {
 1. page标签
@@ -2034,23 +2034,10 @@ type TEditer=class(TCustomcontrol) //
     begin
         if not it then return;
         ShowEchoWnd();
-        //exe :=(FTslExe and ifstring(FTslExe))?FTslExe:SysExecName();
+        if FEchoWnd.Exeing()then return FEchoWnd.Endexe();
-        if FEchoWnd.Exeing()then FEchoWnd.Endexe();
         s := FExecuteEditer.GetCurrentExuteString(it.Scriptpath);
-        // echo s,"\r\n";
+        FEchoWnd.Exec("",s,h);
-        FEchoWnd.Exec(s,"",h);
-        //FEchoWnd.Exec(exe,format('"%s" -libpath "%s"',it.ScriptPath,getdirfromfile(it.ScriptPath)),h);
     end
-    {function ExecutePageItemWithCmd(it);
-    begin
-    s := FExecuteEditer.GetCurrentExuteString(it.Scriptpath);
-    hd := "d:\\test\\execmd.cmd";
-    //RewriteString(hd,s);
-    _wapi.WinExec("cmd.exe",1); 
-    //_wapi.WinExec("",1); 
-    //SysExec("","cmd.exe /c " + s,nil,false,c,nil);
-    //echo "===\r\n";        
-    end }
     function SavePageItem(it,f);
     begin
         if not it then return -1;
@@ -4256,60 +4243,47 @@ type TEditerEchoWnd=class(TSynMemoNorm) //
             ClearAll();
             AppendString("ctrl+z 停止;ctrl+c 复制选择\r\n");
         end;
-        FProcess := new TCreateProcessA();
+        FProcess := new tcustomprocess(self);
-        FProcess.BufSize := 1024 * 5;
         FProcess.OnEcho := thisfunction(TEchoToString);
+        FProcess.onended := thisfunction(onprocend);
+        FProcess.onstarted := thisfunction(onprocstart);        
         AppendString("ctrl+z 停止;ctrl+c 复制选择\r\n");
         F_Highlighter := new TSynHighLighter(self);
         //Highlighter := new TSynHighLighter(self);
     end
+    function onprocstart(o,e);
+    begin
+        AppendString("开始执行");
+    end 
+    function onprocend(o,e);
+    begin
+        AppendString(format("\r\n执行结束:endcode:%d\r\n",o.ErrInfo));
+    end 
     function TEchoToString(o,s);
     begin
-        //t := now();
-        {if (t-FDoLockTime)>(0.3E-5) then 
-        begin 
-        FDoLockTime := t;
-        if FIsLocked then 
-        begin 
-        FIsLocked := false;
-        DecPaintLock();
-        end else 
-        begin 
-        FIsLocked := true;
-        IncPaintLock();
-        end     
-        end }
         AppendString(s);
-        //Visible := true;
         return true;
     end
     function Exec(exe,cmd,h);
     begin
-        //AppendString(format('"%s" %s\r\n',exe,cmd));  
         self.HighLighter := nil;
         AppendString(format('%s %s\r\n',exe,cmd));
-        //EndExe();
+        r := FProcess.CreateProcess(exe,cmd);
-        r := FProcess.CreateProcessWaitRead(exe,cmd,h);
+        h := r;
-        AppendString(format("\r\nÖ´ÐнáÊø:endcode:%d\r\n",r));
+        if r=0 then AppendString("执行失败!");
-        {if FIsLocked then 
-        begin
-        FIsLocked := false;
-        DecPaintLock();
-        end }
         self.HighLighter := F_Highlighter;
-        h := 0;
         return r;
     end
     function Exeing();
     begin
-        return FProcess.LastExeHandle;
+        return FProcess.Handle;
     end
     function EndExe();
     begin
-        if FProcess.LastExeHandle then
+        if FProcess.Handle then
         begin
             r := 1;
-            SysTerminate(r,FProcess.LastExeHandle);
+            SysTerminate(r,FProcess.Handle);
         end
     end
     function KeyDown(o,e);override;

designer/utslvcldebuger.tsf

@@ -4,7 +4,7 @@ interface
     @explan(说明) 编辑器调试功能 %%
     @date(20220520)    
 **}
-uses cstructurelib,utslvclauxiliary,utslvclmemstruct, UTslMemo,UTslSynMemo, tslvcl;
+uses cstructurelib,utslvclauxiliary,utslvclmemstruct, UTslMemo,UTslSynMemo,utslvclstdctl, tslvcl;
 function tdbgcallback(); //调试回调
 type TTslDebug = class(TTslDebuga)
     function create(AOwner);
@@ -263,7 +263,7 @@ type TTslDebuga=class(TCustomControl)
     FRuningfile; //执行脚本文件名
     FRuningItem; //执行的pageitem 
     FCurrentgotoitem; //当前运行到的pageitem
-    FDebughandle; //µ÷ÊԵľä±ú   
+    fdebugproc;  
     Fdebugedwhandle ;//调试的窗口 
     FDebugExe; //调试功能的exe 
     FConnectchannel; //调试的 通道
@@ -611,7 +611,6 @@ type TTslDebuga=class(TCustomControl)
         fremotedbugstart := true;
         fscriptbrks := array();
         {$ifdef linux}
-        //
         sp := ioFileseparator();
         for i:= length(FDebugExe) downto 1 do 
         begin
@@ -619,15 +618,14 @@ type TTslDebuga=class(TCustomControl)
             begin
                 exepath := FDebugExe[1:i];
                 break;
-            end 
+            end             
         end 
         npm := array("LD_LIBRARY_PATH=" $ exepath ,getgtkdisplay());
-        exestr := ParserCommandLine(exestr);
+        Sysexecsetenvs(npm,0);
-        {$else }
+        exestr := ParserCommandLine(exestr);        
-        npm := nil;
         {$endif}
-        FDebughandle := sysexec(FDebugExe,exestr,npm,0,rcode,0); 
+        h := fdebugproc.CreateProcess(nil,exestr);
-        if FDebughandle then
+        if h then
         begin
             ExecuteCommand("dbgcreatechannel");
             ExecuteCommand("showeval","调试程序:"+FDebugExe);
@@ -716,6 +714,15 @@ type TTslDebuga=class(TCustomControl)
                 ow.DebugPageItem(ow.GetCurrentItem());
             end 
         end 
+        fdebugproc := new tcustomprocess(self);
+        fdebugproc.onended := function(o,e)
+        begin
+            toolbtnState("Í£Ö¹");
+        end 
+        fdebugproc.OnEcho := function();
+        begin
+            return 1;
+        end 
     end
     function addbreak(item,idx,n); //添加断点
     begin
@@ -771,7 +778,7 @@ type TTslDebuga=class(TCustomControl)
         {$ifdef linux}
         {$else}
         if not Fdebugedwhandle then 
-            Fdebugedwhandle := GetWindowHandleByPID(_wapi.GetProcessId(FDebughandle),_wapi);
+            Fdebugedwhandle := GetWindowHandleByPID(_wapi.GetProcessId(fdebugproc.Handle),_wapi);
         if Fdebugedwhandle then 
         begin
             _wapi.SetForegroundWindow(Fdebugedwhandle);
@@ -859,7 +866,7 @@ type TTslDebuga=class(TCustomControl)
             FConnectchannel := 0;
             g_tsldbgcallback_handle := nil;
             if FCurrentgotoitem and FCurrentgotoitem.FEditer then FCurrentgotoitem.FEditer.ExecuteCommand("ecruningto",nil);
-            FDebughandle := 0;Fdebugedwhandle := 0;
+            Fdebugedwhandle := 0;
             toolbtnState("停止");
             return;
         end
@@ -1163,11 +1170,11 @@ type TTslDebuga=class(TCustomControl)
             begin
                 if FConnectchannel then
                 begin
-                    if FDebughandle then
+                    if fdebugproc.Handle then
                     begin
                         
                         //cd := {$ifdef linux} 1 {$else} -1 {$endif} ;
-                        return SysTerminate(1,FDebughandle);
+                        fdebugproc.terminate(1);
                     end
                     if FAttchedid then
                     begin
@@ -1232,15 +1239,11 @@ type TTslDebuga=class(TCustomControl)
     end
     //property rundirect read Frundirect write Frundirect;
     private
-    function getgtkdisplay();
+    function getgtkdisplay(); //È¥µôtry
     begin
-        try
+        dsp := Sysgetenv("DISPLAY");
-            dsp := sys_getenv("DISPLAY");
+        if dsp="" then dsp := ":0"; 
-            if dsp="" then dsp := ":0"; 
+        if not ifstring(dsp) then dsp := ":0";
-            if not ifstring(dsp) then dsp := ":0";
-        except
-            dsp := ":0";
-        end;
         return "DISPLAY="+dsp;
     end
     function getdefaultdbger();
@@ -1527,10 +1530,10 @@ type TTslDebuga=class(TCustomControl)
     end
     function stopdebug(); //结束进程
     begin
-        if FDebughandle then
+        if fdebugproc.Handle then
         begin
-            SysTerminate(1,FDebughandle);
+            fdebugproc.terminate(1);
-            FDebughandle := 0; Fdebugedwhandle := 0;
+            Fdebugedwhandle := 0;
         end
     end
     function parseriteminfo(item,idx,n,usr);

funcext/tvclib/tslvcl.tsf

@@ -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

@@ -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)
     {**