帮忙找一个例程(190分)

wenqy · 2003-11-02

我想打开和关闭一个外部程序,如pro1:=c/aa/bb.exe我以前曾看到一个例程 用CREATEPROCESS调用改程序，得到一个HANDLE， 然后TerminateProcess 。 这两天要用却怎么也搜不到,请指点!!

hfghfghfg · 2003-11-02

procedure TForm1.Button1Click(Sender: TObject); var st:TStartUpInfo; pp:TProcessInformation; ppp:Thandle; begin FillChar(st,sizeof(st),#0); with st do begin   cb:=sizeof(st);   dwFlags:=StartF_UsesTDHandles or STARTF_USESHOWWINDOW;   lptitle:=nil;   wShowWindow:=SW_Show; end; CreateProcess(PChar('c:/program files/microsoft office/office/winword.exe'),       nil,nil,nil,true,DETACHED_PROCESS,nil,nil,st,pp); //关闭进程 {  ppp:=OpenProcess(PROCESS_ALL_ACCESS, FALSE,pp.dwProcessId );   TerminateProcess(ppp,0);} end;

hfghfghfg · 2003-11-02

给你个例子，哈哈摘自CORE API HELP，DFW就有下，快去吧。 Creating A Semaphore To Synchronize Multiple Processes procedure TForm1.ShowProgress; var   ICount: Integer;    // general loop counter begin   {wait for the semaphore, and get ownership}   WaitForSingleObject(SemaphoreHandle, INFINITE);   {display a visual indicator}   for ICount := 1 to 1000 do   begin     Gauge1.Progress := ICount;   end;   {release the semaphore}   ReleaseSemaphore(Form1.SemaphoreHandle, 1, nil); end; procedure TForm1.Button1Click(Sender: TObject); var   StartUpInfo: TStartUpInfo;        // holds startup information   ProcessInfo: TProcessInformation; // holds process information   CurDir: string;                   // holds the current directory begin   {create the semaphore, nonsignaled}   SemaphoreHandle := CreateSemaphore(nil, 0, 2, 'MikesSemaphore');   {initialize the startup info structure}   FillChar(StartupInfo, SizeOf(TStartupInfo), 0);   with StartupInfo do   begin     cb := SizeOf(TStartupInfo);     dwFlags := STARTF_USESHOWWINDOW;     wShowWindow := SW_SHOWNORMAL;   end;   {launch the semaphore sibling program for the example}   CurDir := ExtractFilePath(ParamStr(0))+'ProjectOpenSemaphore.exe';   CreateProcess(PChar(CurDir), nil, nil, nil, False,       NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo); end; procedure TForm1.Button2Click(Sender: TObject); var   OldValue: DWORD;  // holds the previous semaphore count begin   {release the semaphore}   ReleaseSemaphore(SemaphoreHandle, 2, @OldValue);   {start the visual indication}   ShowProgress; end; The Semaphore Sibling Program procedure TForm1.Button1Click(Sender: TObject); var   ICount: Integer;               // general loop counter   SemaphoreHandle: THandle;      // holds the semaphore handle   PrevCount: DWORD;              // holds the previous semaphore counter begin   {Open a handle to the semaphore}   SemaphoreHandle := OpenSemaphore($00f0000 or $00100000 or $3, FALSE,                                    'MikesSemaphore');   {wait to achieve ownership of the semaphore}   WaitForSingleObject(SemaphoreHandle, INFINITE);   {display a visual indication}   for ICount := 1 to 100000 do   begin     Gauge1.Progress := ICount;   end;   {release the semaphore}   ReleaseSemaphore(SemaphoreHandle, 1, @PrevCount); end;

wfzha · 2003-11-02

在google中搜索CREATEPROCESS delphi

wenqy · 2003-11-02

请告诉我在哪里下?我找不到

lich · 2003-11-02

uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,   TlHelp32, Registry;     function FindApp(AppName: String): Integer;     function KillApp(ProcessId: Integer): Integer;     function IsRun(ProcessId: Integer): Boolean;     function IsBusy(ProcessId: Integer): Integer;     function RunApp(AppName, CmdLine: String; nCmdShow: Integer): Integer; function TCcfRunMonitor2.FindApp(AppName: String): Integer; var   PShot: THandle;   Pe: TProcessEntry32;   CanNext: Boolean;   ProcessId: Integer;   Found: Boolean;   function FindModule: Boolean;   var     MShot: THandle;     HasNext: Boolean;     Me: TModuleEntry32;     MfName: String;   begin     Result := False;     MShot := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, ProcessId);     Me.dwSize := SizeOf(Me);     HasNext := Module32First(MShot, Me);     while HasNext do     begin       MfName := Me.szExePath;       if SameText(MfName, AppName) then       begin         Result := True;         Break;       end;       HasNext := Module32Next(MShot, Me);         end;     CloseHandle(MShot);   end; begin   PShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);   Pe.dwSize := SizeOf(Pe);   ProcessId := 0;   Found := False;   CanNext := Process32First(PShot, Pe);   while CanNext do   begin     ProcessId := Pe.th32ProcessID;     if ProcessId > 0 then     begin       Found := FindModule;       if Found then Break;     end;     CanNext := Process32Next(PShot, Pe);   end;   CloseHandle(PShot);   if Found then Result := ProcessId else Result := 0; end; function TCcfRunMonitor2.GetServiceController: TServiceController; begin   Result := ServiceController; end; function TCcfRunMonitor2.IsBusy(ProcessId: Integer): Integer; var   Ph: THandle; begin   Ph := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessId);   if Ph <> 0 then   begin     if WaitForInputIdle(Ph, 10) = WAIT_TIMEOUT then       Result := 1     else       Result := 0;     CloseHandle(Ph);   end   else Result := -1; end; function TCcfRunMonitor2.IsRun(ProcessId: Integer): Boolean; var   Ph: THandle; begin   Ph := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessId);   if Ph <> 0 then   begin     Result := WaitForSingleObject(Ph, 0) = WAIT_TIMEOUT;     CloseHandle(Ph);   end   else Result := False; end; function TCcfRunMonitor2.KillApp(ProcessId: Integer): Integer; var   Ph: THandle; begin   Ph := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessId);   if Ph <> 0 then   begin     Result := Integer(TerminateProcess(Ph, 2701));     CloseHandle(Ph);   end   else Result := 0; end; function TCcfRunMonitor2.RunApp(AppName, CmdLine: String;   nCmdShow: Integer): Integer; var   Sti: TStartupInfo;   Psi: TProcessInformation; begin   FillMemory(@Sti, SizeOf(Sti), 0);   Sti.wShowWindow := nCmdShow;   Sti.dwFlags := STARTF_USEFILLATTRIBUTE;   Sti.dwFillAttribute := FOREGROUND_INTENSITY or BACKGROUND_BLUE;   if CreateProcess(PChar(AppName), PChar(CmdLine),     nil, nil, False,     0, nil, PChar(ExtractFilePath(AppName)),     Sti, Psi) then   begin     Result := Psi.dwProcessId;   end   else Result := 0; end;

wenqy · 2003-11-02

看清问题了吗,好象不应该这么复杂吧

lich · 2003-11-02

是啊，只用其中的这一点就够了， function TCcfRunMonitor2.RunApp(AppName, CmdLine: String;  nCmdShow: Integer): Integer; var  Sti: TStartupInfo;  Psi: TProcessInformation; begin  FillMemory(@Sti, SizeOf(Sti), 0);  Sti.wShowWindow := nCmdShow;  Sti.dwFlags := STARTF_USEFILLATTRIBUTE;  Sti.dwFillAttribute := FOREGROUND_INTENSITY or BACKGROUND_BLUE;  if CreateProcess(PChar(AppName), PChar(CmdLine),    nil, nil, False,    0, nil, PChar(ExtractFilePath(AppName)),    Sti, Psi) then  begin    Result := Psi.dwProcessId;  end  else Result := 0; end; function TCcfRunMonitor2.KillApp(ProcessId: Integer): Integer; var  Ph: THandle; begin  Ph := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessId);  if Ph <> 0 then  begin    Result := Integer(TerminateProcess(Ph, 2701));    CloseHandle(Ph);  end  else Result := 0; end;

fly2003 · 2003-11-02

来晚了！

wenqy · 2003-11-02

不知咋搞的老是出错,函数声明 function FindApp(AppName: String): Integer;    function KillApp(ProcessId: Integer): Integer;    function IsRun(ProcessId: Integer): Boolean;    function IsBusy(ProcessId: Integer): Integer;    function RunApp(AppName, CmdLine: String; nCmdShow: Integer): Integer; 应该写在那里.试了一下,怎么提示多处错误!! 我以前编的函数,不用声明,直接带上参数用就行了. 谁能简化一下 我只想打开和关闭一个外部程序,如pro1:=c/aa/bb.exe

lich · 2003-11-02

声明放在 implementation 之前 函数实现放在其之后 声明： function .RunApp(AppName, CmdLine: String; nCmdShow: Integer): Integer; function KillApp(ProcessId: Integer): Integer; 实现： function .RunApp(AppName, CmdLine: String; nCmdShow: Integer): Integer; var Sti: TStartupInfo; Psi: TProcessInformation; begin FillMemory(@Sti, SizeOf(Sti), 0); Sti.wShowWindow := nCmdShow; Sti.dwFlags := STARTF_USEFILLATTRIBUTE; Sti.dwFillAttribute := FOREGROUND_INTENSITY or BACKGROUND_BLUE; if CreateProcess(PChar(AppName), PChar(CmdLine),   nil, nil, False,   0, nil, PChar(ExtractFilePath(AppName)),   Sti, Psi) then begin   Result := Psi.dwProcessId; end else Result := 0; end; function KillApp(ProcessId: Integer): Integer; var Ph: THandle; begin Ph := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessId); if Ph <> 0 then begin   Result := Integer(TerminateProcess(Ph, 2701));   CloseHandle(Ph); end else Result := 0; end;

帮忙找一个例程(190分)

wenqy

Unregistered / Unconfirmed

hfghfghfg

Unregistered / Unconfirmed

hfghfghfg

Unregistered / Unconfirmed

wfzha

Unregistered / Unconfirmed

wenqy

Unregistered / Unconfirmed

lich

Unregistered / Unconfirmed

wenqy

Unregistered / Unconfirmed

lich

Unregistered / Unconfirmed

fly2003

Unregistered / Unconfirmed

wenqy

Unregistered / Unconfirmed

lich

Unregistered / Unconfirmed

Similar threads