调用外部程序的问题 ( 积分: 100 )

shipper123 · 2005-06-04

做了一个菜单，菜单里的每一项都对应一个外部的程序．我要控制同时只能打开一个外部的程序，只有当一个程序关闭的时候才可以打开第二个程序．请高手提供统计线程的函数，最好能统计当前窗口数量的函数．因为我一开机只运行一个窗口，然后调用的程序也只存在一个窗口．更希望高手能提供更好的解决办法．因为我想控制只能打开二个外部程序，或三个．．．可以人为的控制．

shipper123 · 2005-06-04

做了一个菜单，菜单里的每一项都对应一个外部的程序．我要控制同时只能打开一个外部的程序，只有当一个程序关闭的时候才可以打开第二个程序．请高手提供统计线程的函数，最好能统计当前窗口数量的函数．因为我一开机只运行一个窗口，然后调用的程序也只存在一个窗口．更希望高手能提供更好的解决办法．因为我想控制只能打开二个外部程序，或三个．．．可以人为的控制．

bjaman · 2005-06-04

参照此贴:http://www.delphibbs.com/delphibbs/dispq.asp?lid=2648444 关键字:进程阻塞

shipper123 · 2005-06-04

看了链接，还是感觉用不起来，请继续指点

appfirst · 2005-06-04

可以这样，使用SHELLEXECUTEEX打开进程，搜索此进程的PROCESSID(使用toolhelpapi)，使用enumwindows枚举所有窗口，使用GetWindowThreadProcessId检查指定窗口句柄是否为此要管理的进程ID，如是就记数加1。

shipper123 · 2005-06-05

appfirst 能不能附上完整的的代码呀？！其实我不需要对特定的窗口进行管理的，只要控制打开的程序数量不超过某个常量值就行了．

appfirst · 2005-06-05

关键的几个API我都告诉你了，自己做一下吧，可以练习并熟悉使用这些API。

江南草 · 2005-06-06

CreateProcess + CreateEvent，这样效率比较高。

shipper123 · 2005-06-06

江南草,能不能具体谈谈呀？！我也觉得上面的方法效率不是太高

dawnsong · 2005-06-07

可以CreateProcess 然后WaitForSingleObject(使用infinite参数) 参看下面这个 http://www.delphibbs.com/delphibbs/dispq.asp?lid=3058225

shipper123 · 2005-06-09

我还是没解决呀！哪位朋友帮我解决了。我把分都给他！

mosker · 2005-06-09

你是不是想控制用户同时只能运行一个程序？？或者指定数量的程序？ 如果这样的化我可能有办法。

appfirst · 2005-06-09

unit ProcessUnit; interface Uses Windows,tlhelp32,Classes,SysUtils,ComCtrls,Dialogs; function ExecProcess(FileName:String; Var hProcess,ProcessID:THandle):Boolean; procedure AddProcess(FileName:String; hProcess,ProcessID:THandle); Function StatWindows:Integer; Function StatProcess:Integer; implementation Type    PProcessInfo=^TProcessInfo;    TProcessInfo=Record        Name:String;        Path:String;        hProcess, ProcessID:THandle;    end; Var    List:TList; function ExecProcess(FileName:String; Var hProcess,ProcessID:THandle):Boolean; var    sInfo:TStartUpInfo;    pInfo:TProcessInformation; begin    Result:=False;    FillChar(sInfo,sizeof(sInfo),#0);    with sInfo do    begin      cb:=sizeof(sInfo);      dwFlags:=STARTF_USESHOWWINDOW;      lptitle:=nil;      wShowWindow:=SW_SHOW;    end;    if CreateProcess(PChar(FileName),          nil,nil,nil,true,NORMAL_PRIORITY_CLASS,nil,nil,sInfo,pInfo) then    begin        hProcess:=pInfo.hProcess;        ProcessID:=pInfo.dwProcessId;        Result:=true;    end; end; procedure AddProcess(FileName:String; hProcess,ProcessID:THandle); Var    Info

ProcessInfo; begin    New(Info);    Info.hProcess:=hProcess;    Info.ProcessID:=ProcessID;    Info.Name:=ExtractFileName(FileName);    Info.Path:=ExtractFilePath(FileName);    List.Add(Info); end; Function StatProcess:Integer; Var    Hd,Hs:THandle;    Lps:TModuleEntry32;    Lp:TProcessEntry32;    Function CheckProcess(ProcessID:THandle):Boolean;    Var        i:Integer;        Info

ProcessInfo;    begin        Result:=false;        For i:=0 to List.Count-1 do        begin            Info:=List.Items;            Result:=Info.ProcessID=ProcessID;            if Result then                break;        end;    end; begin    Result:=0;    Lp.dwSize:=sizeof(TProcessEntry32);    Hd:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);    Try        if Process32First(Hd,Lp) then            Repeat                if CheckProcess(LP.th32ProcessID) then                    Inc(Result);            Until Process32Next(Hd,Lp)=False;    Finally        CloseHandle(Hd);    end; end; Type    PResultInfo=^TResultInfo;    TResultInfo=record        ProcessID:Integer;        Result:Integer;    end; Function EnumWindowsProc(hwnd:HWND; lParam:LPARAM):Bool; stdcall; Var    ProcessID:THandle;    ValueInteger;    Function CheckProcess(ProcessID:THandle):Boolean;    Var        i:Integer;        InfoProcessInfo;    begin        Result:=false;        For i:=0 to List.Count-1 do        begin            Info:=List.Items;            Result:=Info.ProcessID=ProcessID;            if Result then                break;        end;    end; begin    Result:=true;    Value:=Ptr(LParam);    GetWindowThreadProcessId(hwnd,ProcessID);    if CheckProcess(ProcessID) then    begin        Inc(Value^);    end; end; Function StatWindows:Integer; Var    ResultInfo:TResultInfo; begin    Result:=0;    EnumWindows(@EnumWindowsProc,Integer(@Result)); end; Var    i:Integer; Initialization    List:=TList.Create; Finalization    For i:=0 to List.Count-1 do    begin        Dispose(List.Items);    end;    List.Free; end.

appfirst · 2005-06-09

unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, ShellAPI; type  TForm1 = class(TForm)    Memo1: TMemo;    Button1: TButton;    Button2: TButton;    OpenDialog1: TOpenDialog;    Button3: TButton;    procedure Button3Click(Sender: TObject);    procedure Button1Click(Sender: TObject);    procedure Button2Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1; implementation uses ProcessUnit; {$R *.dfm} procedure TForm1.Button3Click(Sender: TObject); Var    hProcess,ProcessID:THandle; begin    if Not OpenDialog1.Execute then        Exit;    if Not ExecProcess(OpenDialog1.FileName,hProcess,ProcessID) then        Exit;    AddProcess(OpenDialog1.FileName,hProcess,ProcessID);    Memo1.Lines.Add(OpenDialog1.FileName); end; procedure TForm1.Button1Click(Sender: TObject); begin    ShowMessage('本程序打开的进程所打开的窗口数量：'+IntToStr(StatWindows)); end; procedure TForm1.Button2Click(Sender: TObject); begin    ShowMessage('本程序打开的进程数量：'+IntToStr(StatProcess)); end; end.

appfirst · 2005-06-09

给你做了，不过还是应该自己多做。：）

appfirst · 2005-06-09

unit1 是调用单元，ProcessUnit是实现单元，已经调试通过，可以直接用 StatProcess返回打开了多少个进程 StatWindows返回本程序打开进程所打开的窗口数量(有点饶舌)

shipper123 · 2005-06-10

to mosker 指定数量的程序

shipper123 · 2005-06-10

to appfirst 谢谢你的帮助，我测试通过，但是里面有个BUG，希望依旧得到你的帮助，就是调用的程序，在主程序之前有个更新的界面，当关闭更新界面后，线程就捕捉不到了。显示都为0了。麻烦appfirst 继续再指点一下！

mosker · 2005-06-10

这个就好办了.给你几个函数可以控制任意用户的执行数量 function GetUserAndDomainFromPID(ProcessId: DWORD; var User: string): Boolean;    {获取进程的用户名函数} var  hToken: THandle;  cbBuf: Cardinal;  ptiUser: PSIDAndAttributes;  snu: SID_NAME_USE;  ProcessHandle: THandle;  UserSize, DomainSize: DWORD;  bSuccess: Boolean;  Domain: string; begin  Result := False;  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);  if ProcessHandle <> 0 then  begin    if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then    begin      bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);      ptiUser  := nil;      while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do      begin        ReallocMem(ptiUser, cbBuf);        bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);      end;      CloseHandle(hToken);      if not bSuccess then Exit;      UserSize := 0;      DomainSize := 0;      LookupAccountSid(nil, ptiUser.Sid, nil, UserSize, nil, DomainSize, snu);      if (UserSize <> 0) and (DomainSize <> 0) then      begin        SetLength(User, UserSize);        SetLength(Domain, DomainSize);        if LookupAccountSid(nil, ptiUser.Sid, PChar(User), UserSize,          PChar(Domain), DomainSize, snu) then        begin          Result := True;          User := StrPas(PChar(User));        end;      end;      FreeMem(ptiUser);    end;    CloseHandle(ProcessHandle);  end; end; function GetUserName:String; {获取当前登陆用户名函数} var  pcUser

Char;  dwUSize

WORD; begin  dwUSize:=40;   //用户名长度不大于20个字符  Result:='';  GetMem(pcUser,dwUSize);  try    if Windows.GetUserName(pcUser,dwUSize) then      Result:=pcUser  finally    FreeMem(pcUser);  end; end; function CheckAppNum(Username:String):Integer;      {检测当前用户程序运行数量函数} var  ProcessListHandle: THandle;  ProcessStruct: TProcessEntry32;  ContinueLoop:bool;  users,dom:string;  Num:integer; begin Num:=0; users:=''; ProcessListHandle:=CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); ProcessStruct.dwSize:=Sizeof(ProcessStruct); ContinueLoop:=Process32First(ProcessListHandle,ProcessStruct); while ContinueLoop  do begin GetUserAndDomainFromPID(ProcessStruct.th32ProcessID,users); if users=Username then Num:=Num+1; ContinueLoop:=Process32Next(ProcessListHandle,ProcessStruct); end; Result:=Num; end; 通过以上函数就可以知道任意用户名的当前运行进程,就可以控制他运行的程序数量了,以上的绝对可以用.给分吧.

shipper123 · 2005-06-14

谢谢，APPFIRST兄弟~

调用外部程序的问题 ( 积分: 100 )

shipper123

Unregistered / Unconfirmed

shipper123

Unregistered / Unconfirmed

bjaman

Unregistered / Unconfirmed

shipper123

Unregistered / Unconfirmed

appfirst

Unregistered / Unconfirmed

shipper123

Unregistered / Unconfirmed

appfirst

Unregistered / Unconfirmed

江南草

Unregistered / Unconfirmed

shipper123

Unregistered / Unconfirmed

dawnsong

Unregistered / Unconfirmed

shipper123

Unregistered / Unconfirmed

mosker

Unregistered / Unconfirmed

appfirst

Unregistered / Unconfirmed

appfirst

Unregistered / Unconfirmed

appfirst

Unregistered / Unconfirmed

appfirst

Unregistered / Unconfirmed

shipper123

Unregistered / Unconfirmed

shipper123

Unregistered / Unconfirmed

mosker

Unregistered / Unconfirmed

shipper123

Unregistered / Unconfirmed

Similar threads