mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 14:27:59 +02:00
* fix for ExecuteProcess - starting of different executable types works properly now; dependency on unit Dos removed; redefinitions of imports from DosCalls removed also - unit DosCalls used directly now
git-svn-id: trunk@19319 -
This commit is contained in:
Tomas Hajny
parent
908f9865d4
commit
e9f6afe5e0
@ -22,9 +22,6 @@ interface
|
||||
{ force ansistrings }
|
||||
{$H+}
|
||||
|
||||
uses
|
||||
Dos;
|
||||
|
||||
{$DEFINE HAS_SLEEP}
|
||||
{ Include platform independent interface part }
|
||||
{$i sysutilh.inc}
|
||||
@ -33,460 +30,21 @@ uses
|
||||
implementation
|
||||
|
||||
uses
|
||||
sysconst;
|
||||
sysconst, DosCalls;
|
||||
|
||||
|
||||
type
|
||||
(* Necessary here due to a different definition of TDateTime in DosCalls. *)
|
||||
TDateTime = System.TDateTime;
|
||||
|
||||
{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
|
||||
{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
|
||||
{$DEFINE FPC_FEXPAND_GETENV_PCHAR}
|
||||
|
||||
{ Include platform independent implementation part }
|
||||
{$i sysutils.inc}
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
System (imported) calls
|
||||
****************************************************************************}
|
||||
|
||||
(* "uses DosCalls" could not be used here due to type *)
|
||||
(* conflicts, so needed parts had to be redefined here). *)
|
||||
|
||||
type
|
||||
TFileStatus = object
|
||||
end;
|
||||
PFileStatus = ^TFileStatus;
|
||||
|
||||
TFileStatus3 = object (TFileStatus)
|
||||
DateCreation, {Date of file creation.}
|
||||
TimeCreation, {Time of file creation.}
|
||||
DateLastAccess, {Date of last access to file.}
|
||||
TimeLastAccess, {Time of last access to file.}
|
||||
DateLastWrite, {Date of last modification of file.}
|
||||
TimeLastWrite:word; {Time of last modification of file.}
|
||||
FileSize, {Size of file.}
|
||||
FileAlloc:cardinal; {Amount of space the file really
|
||||
occupies on disk.}
|
||||
AttrFile:cardinal; {Attributes of file.}
|
||||
end;
|
||||
PFileStatus3=^TFileStatus3;
|
||||
|
||||
TFileStatus4=object(TFileStatus3)
|
||||
cbList:cardinal; {Length of entire EA set.}
|
||||
end;
|
||||
PFileStatus4=^TFileStatus4;
|
||||
|
||||
TFileStatus3L = object (TFileStatus)
|
||||
DateCreation, {Date of file creation.}
|
||||
TimeCreation, {Time of file creation.}
|
||||
DateLastAccess, {Date of last access to file.}
|
||||
TimeLastAccess, {Time of last access to file.}
|
||||
DateLastWrite, {Date of last modification of file.}
|
||||
TimeLastWrite:word; {Time of last modification of file.}
|
||||
FileSize, {Size of file.}
|
||||
FileAlloc:int64; {Amount of space the file really
|
||||
occupies on disk.}
|
||||
AttrFile:cardinal; {Attributes of file.}
|
||||
end;
|
||||
PFileStatus3L=^TFileStatus3L;
|
||||
|
||||
TFileStatus4L=object(TFileStatus3L)
|
||||
cbList:cardinal; {Length of entire EA set.}
|
||||
end;
|
||||
PFileStatus4L=^TFileStatus4L;
|
||||
|
||||
TFileFindBuf3=object(TFileStatus)
|
||||
NextEntryOffset: cardinal; {Offset of next entry}
|
||||
DateCreation, {Date of file creation.}
|
||||
TimeCreation, {Time of file creation.}
|
||||
DateLastAccess, {Date of last access to file.}
|
||||
TimeLastAccess, {Time of last access to file.}
|
||||
DateLastWrite, {Date of last modification of file.}
|
||||
TimeLastWrite:word; {Time of last modification of file.}
|
||||
FileSize, {Size of file.}
|
||||
FileAlloc:cardinal; {Amount of space the file really
|
||||
occupies on disk.}
|
||||
AttrFile:cardinal; {Attributes of file.}
|
||||
Name:shortstring; {Also possible to use as ASCIIZ.
|
||||
The byte following the last string
|
||||
character is always zero.}
|
||||
end;
|
||||
PFileFindBuf3=^TFileFindBuf3;
|
||||
|
||||
TFileFindBuf4=object(TFileStatus)
|
||||
NextEntryOffset: cardinal; {Offset of next entry}
|
||||
DateCreation, {Date of file creation.}
|
||||
TimeCreation, {Time of file creation.}
|
||||
DateLastAccess, {Date of last access to file.}
|
||||
TimeLastAccess, {Time of last access to file.}
|
||||
DateLastWrite, {Date of last modification of file.}
|
||||
TimeLastWrite:word; {Time of last modification of file.}
|
||||
FileSize, {Size of file.}
|
||||
FileAlloc:cardinal; {Amount of space the file really
|
||||
occupies on disk.}
|
||||
AttrFile:cardinal; {Attributes of file.}
|
||||
cbList:cardinal; {Size of the file's extended attributes.}
|
||||
Name:shortstring; {Also possible to use as ASCIIZ.
|
||||
The byte following the last string
|
||||
character is always zero.}
|
||||
end;
|
||||
PFileFindBuf4=^TFileFindBuf4;
|
||||
|
||||
TFileFindBuf3L=object(TFileStatus)
|
||||
NextEntryOffset: cardinal; {Offset of next entry}
|
||||
DateCreation, {Date of file creation.}
|
||||
TimeCreation, {Time of file creation.}
|
||||
DateLastAccess, {Date of last access to file.}
|
||||
TimeLastAccess, {Time of last access to file.}
|
||||
DateLastWrite, {Date of last modification of file.}
|
||||
TimeLastWrite:word; {Time of last modification of file.}
|
||||
FileSize, {Size of file.}
|
||||
FileAlloc:int64; {Amount of space the file really
|
||||
occupies on disk.}
|
||||
AttrFile:cardinal; {Attributes of file.}
|
||||
Name:shortstring; {Also possible to use as ASCIIZ.
|
||||
The byte following the last string
|
||||
character is always zero.}
|
||||
end;
|
||||
PFileFindBuf3L=^TFileFindBuf3L;
|
||||
|
||||
TFileFindBuf4L=object(TFileStatus)
|
||||
NextEntryOffset: cardinal; {Offset of next entry}
|
||||
DateCreation, {Date of file creation.}
|
||||
TimeCreation, {Time of file creation.}
|
||||
DateLastAccess, {Date of last access to file.}
|
||||
TimeLastAccess, {Time of last access to file.}
|
||||
DateLastWrite, {Date of last modification of file.}
|
||||
TimeLastWrite:word; {Time of last modification of file.}
|
||||
FileSize, {Size of file.}
|
||||
FileAlloc:int64; {Amount of space the file really
|
||||
occupies on disk.}
|
||||
AttrFile:cardinal; {Attributes of file.}
|
||||
cbList:cardinal; {Size of the file's extended attributes.}
|
||||
Name:shortstring; {Also possible to use as ASCIIZ.
|
||||
The byte following the last string
|
||||
character is always zero.}
|
||||
end;
|
||||
PFileFindBuf4L=^TFileFindBuf4L;
|
||||
|
||||
TFSInfo = record
|
||||
case word of
|
||||
1:
|
||||
(File_Sys_ID,
|
||||
Sectors_Per_Cluster,
|
||||
Total_Clusters,
|
||||
Free_Clusters: cardinal;
|
||||
Bytes_Per_Sector: word);
|
||||
2: {For date/time description,
|
||||
see file searching realted
|
||||
routines.}
|
||||
(Label_Date, {Date when volume label was created.}
|
||||
Label_Time: word; {Time when volume label was created.}
|
||||
VolumeLabel: ShortString); {Volume label. Can also be used
|
||||
as ASCIIZ, because the byte
|
||||
following the last character of
|
||||
the string is always zero.}
|
||||
end;
|
||||
PFSInfo = ^TFSInfo;
|
||||
|
||||
TCountryCode=record
|
||||
Country, {Country to query info about (0=current).}
|
||||
CodePage: cardinal; {Code page to query info about (0=current).}
|
||||
end;
|
||||
PCountryCode=^TCountryCode;
|
||||
|
||||
TTimeFmt = (Clock12, Clock24);
|
||||
|
||||
TCountryInfo=record
|
||||
Country, CodePage: cardinal; {Country and codepage requested.}
|
||||
case byte of
|
||||
0:
|
||||
(DateFormat: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
|
||||
CurrencyUnit: array [0..4] of char;
|
||||
ThousandSeparator: char; {Thousands separator.}
|
||||
Zero1: byte; {Always zero.}
|
||||
DecimalSeparator: char; {Decimals separator,}
|
||||
Zero2: byte;
|
||||
DateSeparator: char; {Date separator.}
|
||||
Zero3: byte;
|
||||
TimeSeparator: char; {Time separator.}
|
||||
Zero4: byte;
|
||||
CurrencyFormat, {Bit field:
|
||||
Bit 0: 0=indicator before value
|
||||
1=indicator after value
|
||||
Bit 1: 1=insert space after
|
||||
indicator.
|
||||
Bit 2: 1=Ignore bit 0&1, replace
|
||||
decimal separator with
|
||||
indicator.}
|
||||
DecimalPlace: byte; {Number of decimal places used in
|
||||
currency indication.}
|
||||
TimeFormat: TTimeFmt; {12/24 hour.}
|
||||
Reserve1: array [0..1] of word;
|
||||
DataSeparator: char; {Data list separator}
|
||||
Zero5: byte;
|
||||
Reserve2: array [0..4] of word);
|
||||
1:
|
||||
(fsDateFmt: cardinal; {1=ddmmyy 2=yymmdd 3=mmddyy}
|
||||
szCurrency: array [0..4] of char;
|
||||
{null terminated currency symbol}
|
||||
szThousandsSeparator: array [0..1] of char;
|
||||
{Thousands separator + #0}
|
||||
szDecimal: array [0..1] of char;
|
||||
{Decimals separator + #0}
|
||||
szDateSeparator: array [0..1] of char;
|
||||
{Date separator + #0}
|
||||
szTimeSeparator: array [0..1] of char;
|
||||
{Time separator + #0}
|
||||
fsCurrencyFmt, {Bit field:
|
||||
Bit 0: 0=indicator before value
|
||||
1=indicator after value
|
||||
Bit 1: 1=insert space after
|
||||
indicator.
|
||||
Bit 2: 1=Ignore bit 0&1, replace
|
||||
decimal separator with
|
||||
indicator}
|
||||
cDecimalPlace: byte; {Number of decimal places used in
|
||||
currency indication}
|
||||
fsTimeFmt: byte; {0=12,1=24 hours}
|
||||
abReserved1: array [0..1] of word;
|
||||
szDataSeparator: array [0..1] of char;
|
||||
{Data list separator + #0}
|
||||
abReserved2: array [0..4] of word);
|
||||
end;
|
||||
PCountryInfo=^TCountryInfo;
|
||||
|
||||
TRequestData=record
|
||||
PID, {ID of process that wrote element.}
|
||||
Data: cardinal; {Information from process writing the data.}
|
||||
end;
|
||||
PRequestData=^TRequestData;
|
||||
|
||||
{Queue data structure for synchronously started sessions.}
|
||||
TChildInfo = record
|
||||
case boolean of
|
||||
false:
|
||||
(SessionID,
|
||||
Return: word); {Return code from the child process.}
|
||||
true:
|
||||
(usSessionID,
|
||||
usReturn: word); {Return code from the child process.}
|
||||
end;
|
||||
PChildInfo = ^TChildInfo;
|
||||
|
||||
TStartData=record
|
||||
{Note: to omit some fields, use a length smaller than SizeOf(TStartData).}
|
||||
Length:word; {Length, in bytes, of datastructure
|
||||
(24/30/32/50/60).}
|
||||
Related:word; {Independent/child session (0/1).}
|
||||
FgBg:word; {Foreground/background (0/1).}
|
||||
TraceOpt:word; {No trace/trace this/trace all (0/1/2).}
|
||||
PgmTitle:PChar; {Program title.}
|
||||
PgmName:PChar; {Filename to program.}
|
||||
PgmInputs:PChar; {Command parameters (nil allowed).}
|
||||
TermQ:PChar; {System queue. (nil allowed).}
|
||||
Environment:PChar; {Environment to pass (nil allowed).}
|
||||
InheritOpt:word; {Inherit environment from shell/
|
||||
inherit environment from parent (0/1).}
|
||||
SessionType:word; {Auto/full screen/window/presentation
|
||||
manager/full screen Dos/windowed Dos
|
||||
(0/1/2/3/4/5/6/7).}
|
||||
Iconfile:PChar; {Icon file to use (nil allowed).}
|
||||
PgmHandle:cardinal; {0 or the program handle.}
|
||||
PgmControl:word; {Bitfield describing initial state
|
||||
of windowed sessions.}
|
||||
InitXPos,InitYPos:word; {Initial top coordinates.}
|
||||
InitXSize,InitYSize:word; {Initial size.}
|
||||
Reserved:word;
|
||||
ObjectBuffer:PChar; {If a module cannot be loaded, its
|
||||
name will be returned here.}
|
||||
ObjectBuffLen:cardinal; {Size of your buffer.}
|
||||
end;
|
||||
PStartData=^TStartData;
|
||||
|
||||
TResultCodes=record
|
||||
TerminateReason, {0 = Normal termionation.
|
||||
1 = Critical error.
|
||||
2 = Trapped. (GPE, etc.)
|
||||
3 = Killed by DosKillProcess.}
|
||||
ExitCode:cardinal; {Exit code of child.}
|
||||
end;
|
||||
|
||||
const
|
||||
ilStandard = 1; (* Use TFileStatus3/TFindFileBuf3 *)
|
||||
ilQueryEASize = 2; (* Use TFileStatus4/TFindFileBuf4 *)
|
||||
ilQueryEAs = 3;
|
||||
ilQueryFullName = 5;
|
||||
ilStandardL = 11; (* Use TFileStatus3L/TFindFileBuf3L *)
|
||||
ilQueryEASizeL = 12; (* Use TFileStatus4L/TFindFileBuf4L *)
|
||||
ilQueryEAsL = 13;
|
||||
|
||||
quFIFO = 0;
|
||||
quLIFO = 1;
|
||||
quPriority = 2;
|
||||
|
||||
quNoConvert_Address = 0;
|
||||
quConvert_Address = 4;
|
||||
|
||||
{Start the new session independent or as a child.}
|
||||
ssf_Related_Independent = 0; {Start new session independent
|
||||
of the calling session.}
|
||||
ssf_Related_Child = 1; {Start new session as a child
|
||||
session to the calling session.}
|
||||
|
||||
{Start the new session in the foreground or in the background.}
|
||||
ssf_FgBg_Fore = 0; {Start new session in foreground.}
|
||||
ssf_FgBg_Back = 1; {Start new session in background.}
|
||||
|
||||
{Should the program started in the new session
|
||||
be executed under conditions for tracing?}
|
||||
ssf_TraceOpt_None = 0; {No trace.}
|
||||
ssf_TraceOpt_Trace = 1; {Trace with no notification
|
||||
of descendants.}
|
||||
ssf_TraceOpt_TraceAll = 2; {Trace all descendant sessions.
|
||||
A termination queue must be
|
||||
supplied and Related must be
|
||||
ssf_Related_Child (=1).}
|
||||
|
||||
{Will the new session inherit open file handles
|
||||
and environment from the calling process.}
|
||||
ssf_InhertOpt_Shell = 0; {Inherit from the shell.}
|
||||
ssf_InhertOpt_Parent = 1; {Inherit from the calling process.}
|
||||
|
||||
{Specifies the type of session to start.}
|
||||
ssf_Type_Default = 0; {Use program's type.}
|
||||
ssf_Type_FullScreen = 1; {OS/2 full screen.}
|
||||
ssf_Type_WindowableVIO = 2; {OS/2 window.}
|
||||
ssf_Type_PM = 3; {Presentation Manager.}
|
||||
ssf_Type_VDM = 4; {DOS full screen.}
|
||||
ssf_Type_WindowedVDM = 7; {DOS window.}
|
||||
{Additional values for Windows programs}
|
||||
Prog_31_StdSeamlessVDM = 15; {Windows 3.1 program in its
|
||||
own windowed session.}
|
||||
Prog_31_StdSeamlessCommon = 16; {Windows 3.1 program in a
|
||||
common windowed session.}
|
||||
Prog_31_EnhSeamlessVDM = 17; {Windows 3.1 program in enhanced
|
||||
compatibility mode in its own
|
||||
windowed session.}
|
||||
Prog_31_EnhSeamlessCommon = 18; {Windows 3.1 program in enhanced
|
||||
compatibility mode in a common
|
||||
windowed session.}
|
||||
Prog_31_Enh = 19; {Windows 3.1 program in enhanced
|
||||
compatibility mode in a full
|
||||
screen session.}
|
||||
Prog_31_Std = 20; {Windows 3.1 program in a full
|
||||
screen session.}
|
||||
|
||||
{Specifies the initial attributes for a OS/2 window or DOS window session.}
|
||||
ssf_Control_Visible = 0; {Window is visible.}
|
||||
ssf_Control_Invisible = 1; {Window is invisible.}
|
||||
ssf_Control_Maximize = 2; {Window is maximized.}
|
||||
ssf_Control_Minimize = 4; {Window is minimized.}
|
||||
ssf_Control_NoAutoClose = 8; {Window will not close after
|
||||
the program has ended.}
|
||||
ssf_Control_SetPos = 32768; {Use InitXPos, InitYPos,
|
||||
InitXSize, and InitYSize for
|
||||
the size and placement.}
|
||||
|
||||
|
||||
function DosSetFileInfo (Handle: THandle; InfoLevel: cardinal; AFileStatus: PFileStatus;
|
||||
FileStatusLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 218;
|
||||
|
||||
function DosQueryFSInfo (DiskNum, InfoLevel: cardinal; var Buffer: TFSInfo;
|
||||
BufLen: cardinal): cardinal; cdecl; external 'DOSCALLS' index 278;
|
||||
|
||||
function DosQueryFileInfo (Handle: THandle; InfoLevel: cardinal;
|
||||
AFileStatus: PFileStatus; FileStatusLen: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 279;
|
||||
|
||||
function DosScanEnv (Name: PChar; var Value: PChar): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 227;
|
||||
|
||||
function DosFindFirst (FileMask: PChar; var Handle: THandle; Attrib: cardinal;
|
||||
AFileStatus: PFileStatus; FileStatusLen: cardinal;
|
||||
var Count: cardinal; InfoLevel: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 264;
|
||||
|
||||
function DosFindNext (Handle: THandle; AFileStatus: PFileStatus;
|
||||
FileStatusLen: cardinal; var Count: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 265;
|
||||
|
||||
function DosFindClose (Handle: THandle): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 263;
|
||||
|
||||
function DosQueryCtryInfo (Size: cardinal; var Country: TCountryCode;
|
||||
var Res: TCountryInfo; var ActualSize: cardinal): cardinal; cdecl;
|
||||
external 'NLS' index 5;
|
||||
|
||||
function DosMapCase (Size: cardinal; var Country: TCountryCode;
|
||||
AString: PChar): cardinal; cdecl; external 'NLS' index 7;
|
||||
|
||||
function DosDelete(FileName:PChar): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 259;
|
||||
|
||||
function DosMove(OldFile, NewFile:PChar): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 271;
|
||||
|
||||
function DosQueryPathInfo(FileName:PChar;InfoLevel:cardinal;
|
||||
AFileStatus:PFileStatus;FileStatusLen:cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 223;
|
||||
|
||||
function DosSetPathInfo(FileName:PChar;InfoLevel:cardinal;
|
||||
AFileStatus:PFileStatus;FileStatusLen,
|
||||
Options:cardinal):cardinal; cdecl;
|
||||
external 'DOSCALLS' index 219;
|
||||
|
||||
function DosClose(Handle: THandle): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 257;
|
||||
|
||||
function DosRead(Handle:THandle; var Buffer; Count: cardinal;
|
||||
var ActCount: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 281;
|
||||
|
||||
function DosWrite(Handle: THandle; Buffer: pointer; Count: cardinal;
|
||||
var ActCount: cardinal): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 282;
|
||||
|
||||
procedure DosSleep (MSec: cardinal); cdecl; external 'DOSCALLS' index 229;
|
||||
|
||||
function DosCreateQueue (var Handle: THandle; Priority:longint;
|
||||
Name: PChar): cardinal; cdecl;
|
||||
external 'QUECALLS' index 16;
|
||||
|
||||
function DosReadQueue (Handle: THandle; var ReqBuffer: TRequestData;
|
||||
var DataLen: cardinal; var DataPtr: pointer;
|
||||
Element, Wait: cardinal; var Priority: byte;
|
||||
ASem: THandle): cardinal; cdecl;
|
||||
external 'QUECALLS' index 9;
|
||||
|
||||
function DosCloseQueue (Handle: THandle): cardinal; cdecl;
|
||||
external 'QUECALLS' index 11;
|
||||
|
||||
function DosStartSession (var AStartData: TStartData;
|
||||
var SesID, PID: cardinal): cardinal; cdecl;
|
||||
external 'SESMGR' index 37;
|
||||
|
||||
function DosFreeMem(P:pointer):cardinal; cdecl; external 'DOSCALLS' index 304;
|
||||
|
||||
function DosExecPgm (ObjName: PChar; ObjLen: longint; ExecFlag: cardinal;
|
||||
Args, Env: PByteArray; var Res: TResultCodes;
|
||||
FileName:PChar): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 283;
|
||||
|
||||
type
|
||||
TDT=packed record
|
||||
Hour,
|
||||
Minute,
|
||||
Second,
|
||||
Sec100,
|
||||
Day,
|
||||
Month: byte;
|
||||
Year: word;
|
||||
TimeZone: smallint;
|
||||
WeekDay: byte;
|
||||
end;
|
||||
|
||||
function DosGetDateTime(var Buf: TDT): cardinal; cdecl;
|
||||
external 'DOSCALLS' index 230;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
File Functions
|
||||
****************************************************************************}
|
||||
@ -561,7 +119,7 @@ function FileWrite (Handle: THandle; const Buffer; Count: longint): longint;
|
||||
Var
|
||||
T: cardinal;
|
||||
begin
|
||||
DosWrite (Handle, @Buffer, Count, T);
|
||||
DosWrite (Handle, Buffer, Count, T);
|
||||
FileWrite := longint (T);
|
||||
end;
|
||||
|
||||
@ -625,7 +183,7 @@ end;
|
||||
type TRec = record
|
||||
T, D: word;
|
||||
end;
|
||||
PSearchRec = ^SearchRec;
|
||||
PSearchRec = ^TSearchRec;
|
||||
|
||||
function FindFirst (const Path: string; Attr: longint; out Rslt: TSearchRec): longint;
|
||||
|
||||
@ -720,9 +278,10 @@ function FileGetDate (Handle: THandle): longint;
|
||||
var
|
||||
FStat: TFileStatus3;
|
||||
Time: Longint;
|
||||
RC: cardinal;
|
||||
begin
|
||||
DosError := DosQueryFileInfo(Handle, ilStandard, @FStat, SizeOf(FStat));
|
||||
if DosError=0 then
|
||||
RC := DosQueryFileInfo(Handle, ilStandard, @FStat, SizeOf(FStat));
|
||||
if RC = 0 then
|
||||
begin
|
||||
Time := FStat.TimeLastWrite + longint (FStat.DateLastWrite) shl 16;
|
||||
if Time = 0 then
|
||||
@ -830,32 +389,44 @@ end;
|
||||
|
||||
|
||||
function SetCurrentDir (const NewDir: string): boolean;
|
||||
var
|
||||
OrigInOutRes: word;
|
||||
begin
|
||||
OrigInOutRes := InOutRes;
|
||||
InOutRes := 0;
|
||||
{$I-}
|
||||
{$WARNING Should be rewritten to avoid unit dos dependency!}
|
||||
ChDir (NewDir);
|
||||
Result := (IOResult = 0);
|
||||
Result := InOutRes = 0;
|
||||
{$I+}
|
||||
InOutRes := OrigInOutRes;
|
||||
end;
|
||||
|
||||
|
||||
function CreateDir (const NewDir: string): boolean;
|
||||
var
|
||||
OrigInOutRes: word;
|
||||
begin
|
||||
OrigInOutRes := InOutRes;
|
||||
InOutRes := 0;
|
||||
{$I-}
|
||||
{$WARNING Should be rewritten to avoid unit dos dependency!}
|
||||
MkDir (NewDir);
|
||||
Result := (IOResult = 0);
|
||||
Result := InOutRes = 0;
|
||||
{$I+}
|
||||
InOutRes := OrigInOutRes;
|
||||
end;
|
||||
|
||||
|
||||
function RemoveDir (const Dir: string): boolean;
|
||||
var
|
||||
OrigInOutRes: word;
|
||||
begin
|
||||
OrigInOutRes := InOutRes;
|
||||
InOutRes := 0;
|
||||
{$I-}
|
||||
{$WARNING Should be rewritten to avoid unit dos dependency!}
|
||||
RmDir (Dir);
|
||||
Result := (IOResult = 0);
|
||||
{$I+}
|
||||
Result := InOutRes = 0;
|
||||
{$I+}
|
||||
InOutRes := OrigInOutRes;
|
||||
end;
|
||||
|
||||
|
||||
@ -885,7 +456,7 @@ end;
|
||||
|
||||
procedure GetLocalTime (var SystemTime: TSystemTime);
|
||||
var
|
||||
DT: TDT;
|
||||
DT: DosCalls.TDateTime;
|
||||
begin
|
||||
DosGetDateTime(DT);
|
||||
with SystemTime do
|
||||
@ -977,6 +548,66 @@ end;
|
||||
OS Utils
|
||||
****************************************************************************}
|
||||
|
||||
function GetEnvPChar (EnvVar: shortstring): PChar;
|
||||
(* The assembler version is more than three times as fast as Pascal. *)
|
||||
var
|
||||
P: PChar;
|
||||
begin
|
||||
EnvVar := UpCase (EnvVar);
|
||||
{$ASMMODE INTEL}
|
||||
asm
|
||||
cld
|
||||
mov edi, Environment
|
||||
lea esi, EnvVar
|
||||
xor eax, eax
|
||||
lodsb
|
||||
@NewVar:
|
||||
cmp byte ptr [edi], 0
|
||||
jz @Stop
|
||||
push eax { eax contains length of searched variable name }
|
||||
push esi { esi points to the beginning of the variable name }
|
||||
mov ecx, -1 { our character ('=' - see below) _must_ be found }
|
||||
mov edx, edi { pointer to beginning of variable name saved in edx }
|
||||
mov al, '=' { searching until '=' (end of variable name) }
|
||||
repne
|
||||
scasb { scan until '=' not found }
|
||||
neg ecx { what was the name length? }
|
||||
dec ecx { corrected }
|
||||
dec ecx { exclude the '=' character }
|
||||
pop esi { restore pointer to beginning of variable name }
|
||||
pop eax { restore length of searched variable name }
|
||||
push eax { and save both of them again for later use }
|
||||
push esi
|
||||
cmp ecx, eax { compare length of searched variable name with name }
|
||||
jnz @NotEqual { ... of currently found variable, jump if different }
|
||||
xchg edx, edi { pointer to current variable name restored in edi }
|
||||
repe
|
||||
cmpsb { compare till the end of variable name }
|
||||
xchg edx, edi { pointer to beginning of variable contents in edi }
|
||||
jz @Equal { finish if they're equal }
|
||||
@NotEqual:
|
||||
xor eax, eax { look for 00h }
|
||||
mov ecx, -1 { it _must_ be found }
|
||||
repne
|
||||
scasb { scan until found }
|
||||
pop esi { restore pointer to beginning of variable name }
|
||||
pop eax { restore length of searched variable name }
|
||||
jmp @NewVar { ... or continue with new variable otherwise }
|
||||
@Stop:
|
||||
xor eax, eax
|
||||
mov P, eax { Not found - return nil }
|
||||
jmp @End
|
||||
@Equal:
|
||||
pop esi { restore the stack position }
|
||||
pop eax
|
||||
mov P, edi { place pointer to variable contents in P }
|
||||
@End:
|
||||
end ['eax','ecx','edx','esi','edi'];
|
||||
GetEnvPChar := P;
|
||||
end;
|
||||
{$ASMMODE ATT}
|
||||
|
||||
|
||||
Function GetEnvironmentVariable(Const EnvVar : String) : String;
|
||||
|
||||
begin
|
||||
@ -1009,108 +640,131 @@ end;
|
||||
function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString;Flags:TExecuteFlags=[]):
|
||||
integer;
|
||||
var
|
||||
HQ: THandle;
|
||||
SPID, STID, QName: shortstring;
|
||||
SD: TStartData;
|
||||
SID, PID: cardinal;
|
||||
RD: TRequestData;
|
||||
PCI: PChildInfo;
|
||||
CISize: cardinal;
|
||||
Prio: byte;
|
||||
E: EOSError;
|
||||
CommandLine: ansistring;
|
||||
Args0, Args: PByteArray;
|
||||
Args0, Args: DosCalls.PByteArray;
|
||||
ObjNameBuf: PChar;
|
||||
ArgSize: word;
|
||||
Res: TResultCodes;
|
||||
ObjName: shortstring;
|
||||
RC: cardinal;
|
||||
ExecAppType: cardinal;
|
||||
|
||||
const
|
||||
MaxArgsSize = 3072; (* Amount of memory reserved for arguments in bytes. *)
|
||||
ObjBufSize = 512;
|
||||
|
||||
function StartSession: cardinal;
|
||||
var
|
||||
HQ: THandle;
|
||||
SPID, STID, QName: shortstring;
|
||||
SID, PID: cardinal;
|
||||
SD: TStartData;
|
||||
RD: TRequestData;
|
||||
PCI: PChildInfo;
|
||||
CISize: cardinal;
|
||||
Prio: byte;
|
||||
begin
|
||||
ObjName := '';
|
||||
GetMem (ObjNameBuf, ObjBufSize);
|
||||
FillChar (ObjNameBuf^, ObjBufSize, 0);
|
||||
if ComLine = '' then
|
||||
begin
|
||||
Args0 := nil;
|
||||
Args := nil;
|
||||
end
|
||||
Result := $FFFFFFFF;
|
||||
FillChar (SD, SizeOf (SD), 0);
|
||||
SD.Length := SizeOf (SD);
|
||||
SD.Related := ssf_Related_Child;
|
||||
SD.PgmName := PChar (Path);
|
||||
if ComLine <> '' then
|
||||
SD.PgmInputs := PChar (ComLine);
|
||||
SD.InheritOpt := ssf_InhertOpt_Parent;
|
||||
Str (GetProcessID, SPID);
|
||||
Str (ThreadID, STID);
|
||||
QName := '\QUEUES\FPC_ExecuteProcess_p' + SPID + 't' + STID + '.QUE'#0;
|
||||
SD.TermQ := @QName [1];
|
||||
SD.ObjectBuffer := ObjNameBuf;
|
||||
SD.ObjectBuffLen := ObjBufSize;
|
||||
RC := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
|
||||
if RC <> 0 then
|
||||
Move (QName [1], ObjNameBuf^, Length (QName))
|
||||
else
|
||||
begin
|
||||
GetMem (Args0, MaxArgsSize);
|
||||
Args := Args0;
|
||||
(* Work around a bug in OS/2 - argument to DosExecPgm *)
|
||||
(* should not cross 64K boundary. *)
|
||||
if ((PtrUInt (Args) + 1024) and $FFFF) < 1024 then
|
||||
Inc (pointer (Args), 1024);
|
||||
ArgSize := 0;
|
||||
Move (Path [1], Args^ [ArgSize], Length (Path));
|
||||
Inc (ArgSize, Length (Path));
|
||||
Args^ [ArgSize] := 0;
|
||||
Inc (ArgSize);
|
||||
{Now do the real arguments.}
|
||||
Move (ComLine [1], Args^ [ArgSize], Length (ComLine));
|
||||
Inc (ArgSize, Length (ComLine));
|
||||
Args^ [ArgSize] := 0;
|
||||
Inc (ArgSize);
|
||||
Args^ [ArgSize] := 0;
|
||||
end;
|
||||
Result := DosExecPgm (ObjNameBuf, ObjBufSize, 0, Args, nil, Res, PChar (Path));
|
||||
if Args0 <> nil then
|
||||
FreeMem (Args0, MaxArgsSize);
|
||||
if Result = 0 then
|
||||
begin
|
||||
Result := Res.ExitCode;
|
||||
FreeMem (ObjNameBuf, ObjBufSize);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (Result = 190) or (Result = 191) then
|
||||
RC := DosStartSession (SD, SID, PID);
|
||||
if (RC = 0) or (RC = 457) then
|
||||
begin
|
||||
FillChar (SD, SizeOf (SD), 0);
|
||||
SD.Length := 24;
|
||||
SD.Related := ssf_Related_Child;
|
||||
CommandLine := FExpand (Path); (* Needed for other session types... *)
|
||||
SD.PgmName := PChar (CommandLine);
|
||||
if ComLine <> '' then
|
||||
SD.PgmInputs := PChar (ComLine);
|
||||
SD.InheritOpt := ssf_InhertOpt_Parent;
|
||||
Str (GetProcessID, SPID);
|
||||
Str (ThreadID, STID);
|
||||
QName := '\QUEUES\FPC_ExecuteProcess_p' + SPID + 't' + STID + '.QUE'#0;
|
||||
SD.TermQ := @QName [1];
|
||||
Result := DosCreateQueue (HQ, quFIFO or quConvert_Address, @QName [1]);
|
||||
if Result = 0 then
|
||||
RC := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
|
||||
if RC = 0 then
|
||||
begin
|
||||
Result := DosStartSession (SD, SID, PID);
|
||||
if (Result = 0) or (Result = 457) then
|
||||
begin
|
||||
Result := DosReadQueue (HQ, RD, CISize, PCI, 0, 0, Prio, 0);
|
||||
if Result = 0 then
|
||||
begin
|
||||
Result := PCI^.Return;
|
||||
DosCloseQueue (HQ);
|
||||
DosFreeMem (PCI);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
Result := PCI^.Return;
|
||||
DosCloseQueue (HQ);
|
||||
DosFreeMem (PCI);
|
||||
FreeMem (ObjNameBuf, ObjBufSize);
|
||||
end;
|
||||
end
|
||||
else
|
||||
ObjName := StrPas (ObjNameBuf);
|
||||
DosCloseQueue (HQ);
|
||||
end;
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := integer ($FFFFFFFF);
|
||||
ObjName := '';
|
||||
GetMem (ObjNameBuf, ObjBufSize);
|
||||
FillChar (ObjNameBuf^, ObjBufSize, 0);
|
||||
|
||||
if (DosQueryAppType (PChar (Path), ExecAppType) = 0) and
|
||||
(ApplicationType and 3 = ExecAppType and 3) then
|
||||
(* DosExecPgm should work... *)
|
||||
begin
|
||||
if ComLine = '' then
|
||||
begin
|
||||
Args0 := nil;
|
||||
Args := nil;
|
||||
end
|
||||
else
|
||||
begin
|
||||
GetMem (Args0, MaxArgsSize);
|
||||
Args := Args0;
|
||||
(* Work around a bug in OS/2 - argument to DosExecPgm *)
|
||||
(* should not cross 64K boundary. *)
|
||||
if ((PtrUInt (Args) + 1024) and $FFFF) < 1024 then
|
||||
Inc (pointer (Args), 1024);
|
||||
ArgSize := 0;
|
||||
Move (Path [1], Args^ [ArgSize], Length (Path));
|
||||
Inc (ArgSize, Length (Path));
|
||||
Args^ [ArgSize] := 0;
|
||||
Inc (ArgSize);
|
||||
{Now do the real arguments.}
|
||||
Move (ComLine [1], Args^ [ArgSize], Length (ComLine));
|
||||
Inc (ArgSize, Length (ComLine));
|
||||
Args^ [ArgSize] := 0;
|
||||
Inc (ArgSize);
|
||||
Args^ [ArgSize] := 0;
|
||||
end;
|
||||
Res.ExitCode := $FFFFFFFF;
|
||||
RC := DosExecPgm (ObjNameBuf, ObjBufSize, 0, Args, nil, Res, PChar (Path));
|
||||
if Args0 <> nil then
|
||||
FreeMem (Args0, MaxArgsSize);
|
||||
if RC = 0 then
|
||||
begin
|
||||
Result := Res.ExitCode;
|
||||
FreeMem (ObjNameBuf, ObjBufSize);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (RC = 190) or (RC = 191) then
|
||||
Result := StartSession;
|
||||
end;
|
||||
end
|
||||
else
|
||||
Result := StartSession;
|
||||
if RC <> 0 then
|
||||
begin
|
||||
ObjName := StrPas (ObjNameBuf);
|
||||
FreeMem (ObjNameBuf, ObjBufSize);
|
||||
if ComLine = '' then
|
||||
CommandLine := Path
|
||||
else
|
||||
CommandLine := Path + ' ' + ComLine;
|
||||
if ObjName = '' then
|
||||
E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, Result])
|
||||
E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, RC])
|
||||
else
|
||||
E := EOSError.CreateFmt (SExecuteProcessFailed + '(' + ObjName + ')', [CommandLine, Result]);
|
||||
E := EOSError.CreateFmt (SExecuteProcessFailed + ' (' + ObjName + ')', [CommandLine, RC]);
|
||||
E.ErrorCode := Result;
|
||||
raise E;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user