mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 15:47:52 +02:00
* fixes for Exec - execution of different application types, fixed memory leak and avoided queue name collisions
git-svn-id: trunk@19324 -
This commit is contained in:
Tomas Hajny
parent
f13c5fae05
commit
67612af07d
156
rtl/os2/dos.pas
156
rtl/os2/dos.pas
@ -79,6 +79,7 @@ implementation
|
||||
|
||||
threadvar
|
||||
LastDosErrorModuleName: string;
|
||||
ExecCounter: cardinal;
|
||||
|
||||
|
||||
const FindResvdMask = $00003737; {Allowed bits in attribute
|
||||
@ -143,24 +144,38 @@ end;
|
||||
|
||||
procedure Exec (const Path: PathStr; const ComLine: ComStr);
|
||||
{Execute a program.}
|
||||
var Args0, Args: PByteArray;
|
||||
ArgSize: word;
|
||||
Res: TResultCodes;
|
||||
ObjName: string;
|
||||
RC: longint;
|
||||
HQ: THandle;
|
||||
SPID, STID, QName: string;
|
||||
SD: TStartData;
|
||||
SID, PID: cardinal;
|
||||
RD: TRequestData;
|
||||
PCI: PChildInfo;
|
||||
CISize: cardinal;
|
||||
Prio: byte;
|
||||
var
|
||||
Args0, Args: PByteArray;
|
||||
ArgSize: word;
|
||||
Res: TResultCodes;
|
||||
ObjName: string;
|
||||
RC: cardinal;
|
||||
ExecAppType: cardinal;
|
||||
HQ: THandle;
|
||||
SPID, STID, SCtr, QName: string;
|
||||
SID, PID: cardinal;
|
||||
SD: TStartData;
|
||||
RD: TRequestData;
|
||||
PCI: PChildInfo;
|
||||
CISize: cardinal;
|
||||
Prio: byte;
|
||||
DSS: boolean;
|
||||
SR: SearchRec;
|
||||
|
||||
const
|
||||
MaxArgsSize = 3072; (* Amount of memory reserved for arguments in bytes. *)
|
||||
MaxArgsSize = 3072; (* Amount of memory reserved for arguments in bytes. *)
|
||||
|
||||
begin
|
||||
{ LastDosExitCode := Exec (Path, ExecRunFlags (ExecFlags), efDefault, ComLine);}
|
||||
QName := FExpand (Path);
|
||||
ObjName := '';
|
||||
(* FExpand should be used only for the DosStartSession part
|
||||
and only if the executable is in the current directory. *)
|
||||
FindFirst (Path, AnyFile, SR);
|
||||
if DosError = 0 then
|
||||
QName := FExpand (Path)
|
||||
else
|
||||
QName := Path;
|
||||
FindClose (SR);
|
||||
if ComLine = '' then
|
||||
begin
|
||||
Args0 := nil;
|
||||
@ -186,57 +201,77 @@ begin
|
||||
Inc (ArgSize);
|
||||
Args^ [ArgSize] := 0;
|
||||
end;
|
||||
RC := DosExecPgm (ObjName, cardinal (ExecFlags), Args, nil, Res, Path);
|
||||
if RC = 0 then
|
||||
|
||||
if (DosQueryAppType (PChar (Args), ExecAppType) = 0) and
|
||||
(ApplicationType and 3 = ExecAppType and 3) then
|
||||
(* DosExecPgm should work... *)
|
||||
begin
|
||||
LastDosExitCode := Res.ExitCode;
|
||||
LastDosErrorModuleName := '';
|
||||
DSS := false;
|
||||
Res.ExitCode := $FFFFFFFF;
|
||||
RC := DosExecPgm (ObjName, cardinal (ExecFlags), Args, nil, Res, Path);
|
||||
if RC = 0 then
|
||||
begin
|
||||
LastDosExitCode := Res.ExitCode;
|
||||
LastDosErrorModuleName := '';
|
||||
end
|
||||
else
|
||||
if (RC = 190) or (RC = 191) then
|
||||
DSS := true;
|
||||
end
|
||||
else
|
||||
if (RC = 190) or (RC = 191) then
|
||||
begin
|
||||
FillChar (SD, SizeOf (SD), 0);
|
||||
SD.Length := 24;
|
||||
SD.Related := ssf_Related_Child;
|
||||
if Args = nil then
|
||||
DSS := true;
|
||||
if DSS then
|
||||
begin
|
||||
FillChar (SD, SizeOf (SD), 0);
|
||||
SD.Length := SizeOf (SD);
|
||||
SD.Related := ssf_Related_Child;
|
||||
if Args = nil then
|
||||
(* No parameters passed, Args not allocated for DosExecPgm, so allocate now. *)
|
||||
begin
|
||||
GetMem (Args, MaxArgsSize);
|
||||
Move (QName [1], Args^ [0], Length (QName));
|
||||
Args^ [Length (QName)] := 0;
|
||||
end
|
||||
else
|
||||
SD.PgmInputs := PChar (@Args^ [Length (QName) + 1]);
|
||||
SD.PgmName := PChar (Args);
|
||||
SD.InheritOpt := ssf_InhertOpt_Parent;
|
||||
Str (GetProcessID, SPID);
|
||||
Str (ThreadID, STID);
|
||||
QName := '\QUEUES\FPC_Dos_Exec_p' + SPID + 't' + STID + '.QUE'#0;
|
||||
SD.TermQ := @QName [1];
|
||||
RC := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
|
||||
if RC = 0 then
|
||||
begin
|
||||
RC := DosStartSession (SD, SID, PID);
|
||||
if (RC = 0) or (RC = 457) then
|
||||
begin
|
||||
RC := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
|
||||
if RC = 0 then
|
||||
begin
|
||||
LastDosExitCode := PCI^.Return;
|
||||
DosCloseQueue (HQ);
|
||||
DosFreeMem (PCI);
|
||||
end
|
||||
else
|
||||
begin
|
||||
GetMem (Args0, MaxArgsSize);
|
||||
Args := Args0;
|
||||
Move (QName [1], Args^ [0], Length (QName));
|
||||
Args^ [Length (QName)] := 0;
|
||||
end
|
||||
else
|
||||
SD.PgmInputs := PChar (@Args^ [Length (QName) + 1]);
|
||||
SD.PgmName := PChar (Args);
|
||||
SD.InheritOpt := ssf_InhertOpt_Parent;
|
||||
Str (GetProcessID, SPID);
|
||||
Str (ThreadID, STID);
|
||||
Str (ExecCounter, SCtr);
|
||||
Inc (ExecCounter);
|
||||
QName := '\QUEUES\FPC_Dos_Exec_p' + SPID + 't' + STID + '.QUE'#0;
|
||||
SD.TermQ := @QName [1];
|
||||
SD.ObjectBuffer := @ObjName [1];
|
||||
SD.ObjectBuffLen := SizeOf (ObjName) - 1;
|
||||
RC := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
|
||||
if RC <> 0 then
|
||||
ObjName := Copy (QName, 1, Pred (Length (QName)))
|
||||
else
|
||||
begin
|
||||
RC := DosStartSession (SD, SID, PID);
|
||||
if (RC = 0) or (RC = 457) then
|
||||
begin
|
||||
RC := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
|
||||
if RC = 0 then
|
||||
begin
|
||||
LastDosExitCode := PCI^.Return;
|
||||
DosCloseQueue (HQ);
|
||||
end
|
||||
else
|
||||
DosCloseQueue (HQ);
|
||||
end;
|
||||
end
|
||||
else
|
||||
LastDosErrorModuleName := ObjName;
|
||||
DosFreeMem (PCI);
|
||||
end
|
||||
else
|
||||
DosCloseQueue (HQ);
|
||||
end
|
||||
else
|
||||
DosCloseQueue (HQ);
|
||||
end;
|
||||
end;
|
||||
if RC <> 0 then
|
||||
LastDosExitCode := 0; (* Needed for TP/BP compatibility *)
|
||||
begin
|
||||
LastDosErrorModuleName := ObjName;
|
||||
LastDosExitCode := 0; (* Needed for TP/BP compatibility *)
|
||||
end;
|
||||
DosError := RC;
|
||||
if Args0 <> nil then
|
||||
FreeMem (Args0, MaxArgsSize);
|
||||
@ -529,4 +564,5 @@ begin
|
||||
LastDosExitCode := 0;
|
||||
LastDosErrorModuleName := '';
|
||||
ExecFlags := 0;
|
||||
ExecCounter := 0;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user