使用CreateProcess执行一个外部程序遇到的问题(100分)

  • 主题发起人 xiaoyue_a
  • 开始时间
X

xiaoyue_a

Unregistered / Unconfirmed
GUEST, unregistred user!
想用程序实现调用外部程序,在cmd下他可以这样被运行
e:/12/$function_a parameter_a
而且在cmd下 只能转到这个e:/12目录中才能正确运行 $functiona_a parameter_a
想通过程序调用 $functiona_a parameter_a,而他所在的目录可以由用户指定。
而且必须等待这个程序运行结束才能往下运行其他处理。
我使用CreateProcess,试了好多次。终究没弄出来。各位大侠帮忙看看
我用的是D2007
 
兄弟们,帮我看看吧!!
 
你的问题是需要把路径转为短文件名吧,用ExtractShortPathName转换一下试试
给你个函数,等待外部程序,第一个是可执行文件名,第二是传入的参数
调用
M_wait_rar(ExtractShortPathName(extractfilepath(application.ExeName)+'rar.exe'),'x -o+ c:/xx.rar');
函数代码
procedure TForm1.M_wait_rar(M_filename1, M_cmd1: string);
var SUInfo: TStartupInfo;
ProcInfo: TProcessInformation;
CmdLine2: string;
result1: boolean;
begin
CmdLine2 := '"' + M_filename1 + '"' + M_cmd1;
{ 注意检查长文件名}
FillChar(SUInfo, SizeOf(SUInfo), #0);
with SUInfodo
begin
cb := SizeOf(SUInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := sw_shownormal;
end;

Result1 := CreateProcess(nil, PChar(CmdLine2), NIL, NIL,
FALSE,CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, NIL,
PChar(ExtractFilePath(M_filename1)), SUInfo, ProcInfo);
if Result1 then
{等待结束 }
begin
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
CloseHandle(ProcInfo.hProcess);
{清理句柄 }
CloseHandle(ProcInfo.hThread);
end;

end;
 
各位高手,指导一下啊
 
是因为你的function_a程序内部反问文件使用单前目录,例如:
AssignFile(Fl,'a.txt');
应该为
AssignFile(Fl,'c:/abc/a.txt');
// 必须有路径!
所以不是CreatreProcess的问题!
 
function ExecAppWait(AppName, Params: string): Boolean;
var
// Structure containing and receiving info about application to start
ShellExInfo: TShellExecuteInfo;
begin
FillChar(ShellExInfo, SizeOf(ShellExInfo), 0);
with ShellExInfodo
begin
cbSize := SizeOf(ShellExInfo);
fMask := see_Mask_NoCloseProcess;
Wnd := Application.Handle;
lpFile := PChar(AppName);
lpParameters := PChar(Params);
nShow := sw_ShowNormal;
end;
Result := ShellExecuteEx(@ShellExInfo);
if Result then
while WaitForSingleObject(ShellExInfo.HProcess, 100) = WAIT_TIMEOUTdo
begin
Application.ProcessMessages;
if Application.Terminated then
Break;
end;
end;
 
再顶一下
 
ShellExecute(NULL,"open","路徑",NULL,NULL,SW_SHOWNORMAL);

用這個試一下!
 
unit uConsole;
interface
uses windows, SysUtils;
type
TOnData = procedure(Sender: TObject;
Data: string) of object;
TOnRun = procedure(Sender: TObject) of object;
TRedirectedConsole = class(TObject)
private
fStdInRead, fStdInWrite: THandle;
fStdOutRead, fStdOutWrite: THandle;
fStdErrRead, fStdErrWrite: THandle;
fSA: TSecurityAttributes;
fPI: TProcessInformation;
fSI: TStartupInfo;
fCmdLine: string;
fpath: string;
fOnStdOut, fOnStdErr: TOnData;
fOnRun, fOnEnd: TOnRun;
fIsRunning: Boolean;
fHidden: boolean;
fTerminate: boolean;
function ReadHandle(h: THandle;
var s: string): integer;
protected
public
constructor Create(CommandLine, path: string);
destructor Destroy;
override;
function Run: integer;
procedure SendData(s: string);
property OnStdOut: TOnData read fOnStdOut write fOnStdOut;
property OnStdErr: TOnData read fOnStdErr write fOnStdErr;
property OnRun: TOnRun read fOnRun write fOnRun;
property OnEnd: TOnRun read fOnEnd write fOnend;
property IsRunning: boolean read fIsRunning;
property HideWindow: boolean read fHidden write fHidden;
end;

implementation
const BufSize = 1024;
constructor TRedirectedConsole.Create(CommandLine, path: string);
begin
inherited Create;
fCmdLine := CommandLine;
fIsRunning := False;
fHidden := True;
fpath := path;
FillChar(fSA, SizeOf(fSA), 0);
fSA.nLength := SizeOf(fSA);
fSA.lpSecurityDescriptor := nil;
fSA.bInheritHandle := True;
CreatePipe(fStdInRead, fStdInWrite, @fSA, BufSize);
CreatePipe(fStdOutRead, fStdOutWrite, @fSA, BufSize);
CreatePipe(fStdErrRead, fStdErrWrite, @fSA, BufSize);
end;

destructor TRedirectedConsole.Destroy;
begin
if fIsRunning then
begin
fTerminate := True;
end;
CloseHandle(fStdInWrite);
CloseHandle(fStdOutRead);
CloseHandle(fStdErrRead);
inherited;
end;

function TRedirectedConsole.ReadHandle(h: THandle;
var s: string): integer;
var
BytesWaiting: Cardinal;
Buf: array[1..BufSize] of char;
{$IFDEF VER100}
BytesRead: Integer;
{$else
}
BytesRead: Cardinal;
{$ENDIF}
begin
Result := 0;
PeekNamedPipe(h, nil, 0, nil, @BytesWaiting, nil);
if BytesWaiting > 0 then
begin
if BytesWaiting > BufSize then
BytesWaiting := BufSize;
ReadFile(h, Buf[1], BytesWaiting, BytesRead, nil);
s := Copy(Buf, 1, BytesRead);
Result := BytesRead;
end;
end;

procedure TRedirectedConsole.SendData(s: string);
var
{$IFDEF VER100}
BytesWritten: Integer;
{$else
}
BytesWritten: Cardinal;
{$ENDIF}
begin
if fIsRunning then
begin
WriteFile(fStdInWrite, s[1], Length(s), BytesWritten, nil);
end;
end;

function TRedirectedConsole.Run: integer;
var
s: string;
code: Dword;
ppath: pchar;
begin
result := -1;
fTerminate := False;
FillChar(fSI, SizeOf(fSI), 0);
fSI.cb := SizeOf(fSI);
//fHidden := false;
if fHidden then
fSI.wShowWindow := SW_HIDE
else
fSI.wShowWindow := SW_SHOWDEFAULT;
fSI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
{fSI.hStdInput := fStdInRead;
fSI.hStdOutput := fStdOutWrite;
fSI.hStdError := fStdErrWrite;
}
ppath := nil;
if fpath = '' then

else
begin
//getmem(ppath,length(fpath)+1);
//strpcopy(ppath,fpath);
//getmem(ppath,4);
//strpcopy(ppath,'c:/');
end;

if CreateProcess(nil, // 模块名或执行文件名
PChar(fCmdLine), // 参数
nil, // 安全属性
nil, // 安全属性
True, // 安全属性继承性
NORMAL_PRIORITY_CLASS, // 线程优先等级
nil, // 环境块
ppath, // 当前路径
fSI, // 启动信息
fPI // 过程信息
) then
begin
fIsRunning := True;
CloseHandle(fStdOutWrite);
CloseHandle(fStdErrWrite);
CloseHandle(fStdInRead);
CloseHandle(fPI.hThread);
while WaitForSingleObject(fPI.hProcess, 10) = WAIT_TIMEOUTdo
begin
if fTerminate then
begin
TerminateProcess(fPi.hProcess, 0);
end;
if ReadHandle(fStdOutRead, s) > 0 then
if Assigned(fOnStdOut) then
fOnStdOut(Self, s);
if ReadHandle(fStdErrRead, s) > 0 then
if Assigned(fOnStdErr) then
fOnStdErr(Self, s);
if Assigned(fOnRun) then
fOnRun(Self);
end;

if GetExitCodeProcess(fpi.hProcess, code) then
result := code;
CloseHandle(fPI.hProcess);
fIsRunning := False;
end;
end;

end.
 
ppath, // 当前路径
在这里设置你的运行路径
 
顶部