{ $Id$ This file is part of the Free Pascal run time library. Copyright (c) 1999-2000 by Florian Klaempfl member of the Free Pascal development team Sysutils unit for OS/2 See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} unit sysutils; interface {$MODE objfpc} { force ansistrings } {$H+} uses Dos; {$DEFINE HAS_SLEEP} { Include platform independent interface part } {$i sysutilh.inc} implementation uses sysconst; { 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; 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:longint; {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; 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 enviroment 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; const ilStandard = 1; ilQueryEAsize = 2; ilQueryEAs = 3; ilQueryFullName = 5; 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 DosOpen(FileName:PChar;var Handle: THandle; var Action: cardinal; InitSize,Attrib,OpenFlags,FileMode:cardinal; EA:Pointer):cardinal; cdecl; external 'DOSCALLS' index 273; 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; function DosSetFilePtr(Handle: THandle; Pos: longint; Method: cardinal; var PosActual: cardinal): cardinal; cdecl; external 'DOSCALLS' index 256; function DosSetFileSize (Handle: THandle; Size: cardinal): cardinal; cdecl; external 'DOSCALLS' index 272; 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; 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 ****************************************************************************} const ofRead = $0000; {Open for reading} ofWrite = $0001; {Open for writing} ofReadWrite = $0002; {Open for reading/writing} doDenyRW = $0010; {DenyAll (no sharing)} faCreateNew = $00010000; {Create if file does not exist} faOpenReplace = $00040000; {Truncate if file exists} faCreate = $00050000; {Create if file does not exist, truncate otherwise} FindResvdMask = $00003737; {Allowed bits in attribute specification for DosFindFirst call.} function FileOpen (const FileName: string; Mode: integer): longint; Var Handle: THandle; Rc, Action: cardinal; begin (* DenyNone if sharing not specified. *) if Mode and 112 = 0 then Mode:=Mode or 64; Rc:=DosOpen(PChar (FileName), Handle, Action, 0, 0, 1, Mode, nil); If Rc=0 then FileOpen:=Handle else FileOpen:=-RC; end; function FileCreate (const FileName: string): longint; Const Mode = ofReadWrite or faCreate or doDenyRW; (* Sharing to DenyAll *) Var Handle: THandle; RC, Action: cardinal; Begin RC:=DosOpen(PChar (FileName), Handle, Action, 0, 0, $12, Mode, Nil); If RC=0 then FileCreate:=Handle else FileCreate:=-RC; End; function FileCreate (const FileName: string; Mode: integer): longint; begin FileCreate := FileCreate(FileName); end; function FileRead (Handle: longint; var Buffer; Count: longint): longint; Var T: cardinal; begin DosRead(Handle, Buffer, Count, T); FileRead := longint (T); end; function FileWrite (Handle: longint; const Buffer; Count: longint): longint; Var T: cardinal; begin DosWrite (Handle, @Buffer, Count, T); FileWrite := longint (T); end; function FileSeek (Handle, FOffset, Origin: longint): longint; var npos: cardinal; begin if DosSetFilePtr (Handle, FOffset, Origin, npos) = 0 Then FileSeek:= longint (npos) else FileSeek:=-1; end; function FileSeek (Handle: longint; FOffset, Origin: Int64): Int64; begin {$warning need to add 64bit call } Result:=FileSeek(Handle,Longint(Foffset),Longint(Origin)); end; procedure FileClose (Handle: longint); begin DosClose(Handle); end; function FileTruncate (Handle, Size: longint): boolean; begin FileTruncate:=DosSetFileSize(Handle, Size)=0; FileSeek(Handle, 0, 2); end; function FileAge (const FileName: string): longint; var Handle: longint; begin Handle := FileOpen (FileName, 0); if Handle <> -1 then begin Result := FileGetDate (Handle); FileClose (Handle); end else Result := -1; end; function FileExists (const FileName: string): boolean; var SR: TSearchRec; RC: longint; begin FileExists:=False; if FindFirst (FileName, faAnyFile, SR)=0 then FileExists:=True; FindClose(SR); end; type TRec = record T, D: word; end; PSearchRec = ^SearchRec; function FindFirst (const Path: string; Attr: longint; var Rslt: TSearchRec): longint; var SR: PSearchRec; FStat: PFileFindBuf3; Count: cardinal; Err: cardinal; I: cardinal; begin New (FStat); Rslt.FindHandle := $FFFFFFFF; Count := 1; Err := DosFindFirst (PChar (Path), Rslt.FindHandle, Attr and FindResvdMask, FStat, SizeOf (FStat^), Count, ilStandard); if (Err = 0) and (Count = 0) then Err := 18; FindFirst := -Err; if Err = 0 then begin Rslt.Name := FStat^.Name; Rslt.Size := FStat^.FileSize; Rslt.Attr := FStat^.AttrFile; Rslt.ExcludeAttr := 0; TRec (Rslt.Time).T := FStat^.TimeLastWrite; TRec (Rslt.Time).D := FStat^.DateLastWrite; end; Dispose (FStat); end; function FindNext (var Rslt: TSearchRec): longint; var SR: PSearchRec; FStat: PFileFindBuf3; Count: cardinal; Err: cardinal; begin New (FStat); Count := 1; Err := DosFindNext (Rslt.FindHandle, FStat, SizeOf (FStat^), Count); if (Err = 0) and (Count = 0) then Err := 18; FindNext := -Err; if Err = 0 then begin Rslt.Name := FStat^.Name; Rslt.Size := FStat^.FileSize; Rslt.Attr := FStat^.AttrFile; Rslt.ExcludeAttr := 0; TRec (Rslt.Time).T := FStat^.TimeLastWrite; TRec (Rslt.Time).D := FStat^.DateLastWrite; end; Dispose (FStat); end; procedure FindClose (var F: TSearchrec); var SR: PSearchRec; begin DosFindClose (F.FindHandle); F.FindHandle := 0; end; function FileGetDate (Handle: longint): longint; var FStat: TFileStatus3; Time: Longint; begin DosError := DosQueryFileInfo(Handle, ilStandard, @FStat, SizeOf(FStat)); if DosError=0 then begin Time := FStat.TimeLastWrite + longint (FStat.DateLastWrite) shl 16; if Time = 0 then Time := FStat.TimeCreation + longint (FStat.DateCreation) shl 16; end else Time:=0; FileGetDate:=Time; end; function FileSetDate (Handle, Age: longint): longint; var FStat: PFileStatus3; RC: cardinal; begin New (FStat); RC := DosQueryFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^)); if RC <> 0 then FileSetDate := -1 else begin FStat^.DateLastAccess := Hi (Age); FStat^.DateLastWrite := Hi (Age); FStat^.TimeLastAccess := Lo (Age); FStat^.TimeLastWrite := Lo (Age); RC := DosSetFileInfo (Handle, ilStandard, FStat, SizeOf (FStat^)); if RC <> 0 then FileSetDate := -1 else FileSetDate := 0; end; Dispose (FStat); end; function FileGetAttr (const FileName: string): longint; var FS: PFileStatus3; begin New(FS); Result:=-DosQueryPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^)); If Result=0 Then Result:=FS^.attrFile; Dispose(FS); end; function FileSetAttr (const Filename: string; Attr: longint): longint; Var FS: PFileStatus3; Begin New(FS); FillChar(FS, SizeOf(FS^), 0); FS^.AttrFile:=Attr; Result:=-DosSetPathInfo(PChar (FileName), ilStandard, FS, SizeOf(FS^), 0); Dispose(FS); end; function DeleteFile (const FileName: string): boolean; Begin Result:=(DosDelete(PChar (FileName))=0); End; function RenameFile (const OldName, NewName: string): boolean; Begin Result:=(DosMove(PChar (OldName), PChar (NewName))=0); End; {**************************************************************************** Disk Functions ****************************************************************************} function DiskFree (Drive: byte): int64; var FI: TFSinfo; RC: cardinal; begin {In OS/2, we use the filesystem information.} RC := DosQueryFSInfo (Drive, 1, FI, SizeOf (FI)); if RC = 0 then DiskFree := int64 (FI.Free_Clusters) * int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector) else DiskFree := -1; end; function DiskSize (Drive: byte): int64; var FI: TFSinfo; RC: cardinal; begin {In OS/2, we use the filesystem information.} RC := DosQueryFSinfo (Drive, 1, FI, SizeOf (FI)); if RC = 0 then DiskSize := int64 (FI.Total_Clusters) * int64 (FI.Sectors_Per_Cluster) * int64 (FI.Bytes_Per_Sector) else DiskSize := -1; end; function GetCurrentDir: string; begin GetDir (0, Result); end; function SetCurrentDir (const NewDir: string): boolean; begin {$I-} {$WARNING Should be rewritten to avoid unit dos dependancy!} ChDir (NewDir); Result := (IOResult = 0); {$I+} end; function CreateDir (const NewDir: string): boolean; begin {$I-} {$WARNING Should be rewritten to avoid unit dos dependancy!} MkDir (NewDir); Result := (IOResult = 0); {$I+} end; function RemoveDir (const Dir: string): boolean; begin {$I-} {$WARNING Should be rewritten to avoid unit dos dependancy!} RmDir (Dir); Result := (IOResult = 0); {$I+} end; function DirectoryExists (const Directory: string): boolean; var SR: TSearchRec; begin DirectoryExists:=FindFirst(Directory, faDirectory, SR)=0; FindClose(SR); end; {**************************************************************************** Time Functions ****************************************************************************} procedure GetLocalTime (var SystemTime: TSystemTime); var DT: TDT; begin DosGetDateTime(DT); with SystemTime do begin Year:=DT.Year; Month:=DT.Month; Day:=DT.Day; Hour:=DT.Hour; Minute:=DT.Minute; Second:=DT.Second; MilliSecond:=DT.Sec100; end; end; {**************************************************************************** Misc Functions ****************************************************************************} procedure Beep; begin end; {**************************************************************************** Locale Functions ****************************************************************************} procedure InitAnsi; var I: byte; Country: TCountryCode; begin for I := 0 to 255 do UpperCaseTable [I] := Chr (I); Move (UpperCaseTable, LowerCaseTable, SizeOf (UpperCaseTable)); FillChar (Country, SizeOf (Country), 0); DosMapCase (SizeOf (UpperCaseTable), Country, @UpperCaseTable); for I := 0 to 255 do if UpperCaseTable [I] <> Chr (I) then LowerCaseTable [Ord (UpperCaseTable [I])] := Chr (I); end; procedure InitInternational; var Country: TCountryCode; CtryInfo: TCountryInfo; Size: cardinal; RC: cardinal; begin Size := 0; FillChar (Country, SizeOf (Country), 0); FillChar (CtryInfo, SizeOf (CtryInfo), 0); RC := DosQueryCtryInfo (SizeOf (CtryInfo), Country, CtryInfo, Size); if RC = 0 then begin DateSeparator := CtryInfo.DateSeparator; case CtryInfo.DateFormat of 1: begin ShortDateFormat := 'd/m/y'; LongDateFormat := 'dd" "mmmm" "yyyy'; end; 2: begin ShortDateFormat := 'y/m/d'; LongDateFormat := 'yyyy" "mmmm" "dd'; end; 3: begin ShortDateFormat := 'm/d/y'; LongDateFormat := 'mmmm" "dd" "yyyy'; end; end; TimeSeparator := CtryInfo.TimeSeparator; DecimalSeparator := CtryInfo.DecimalSeparator; ThousandSeparator := CtryInfo.ThousandSeparator; CurrencyFormat := CtryInfo.CurrencyFormat; CurrencyString := PChar (CtryInfo.CurrencyUnit); end; InitAnsi; end; function SysErrorMessage(ErrorCode: Integer): String; begin Result:=Format(SUnknownErrorCode,[ErrorCode]); end; {**************************************************************************** OS Utils ****************************************************************************} Function GetEnvironmentVariable(Const EnvVar : String) : String; begin GetEnvironmentVariable := StrPas (GetEnvPChar (EnvVar)); end; procedure Sleep (Milliseconds: cardinal); begin DosSleep (Milliseconds); end; function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString): 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; begin FillChar (SD, SizeOf (SD), 0); SD.Length := 24; SD.Related := ssf_Related_Child; SD.PgmName := PChar (Path); SD.PgmInputs := PChar (ComLine); Str (ProcessID, 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 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; DosCloseQueue (HQ); end; if ComLine = '' then CommandLine := Path else CommandLine := Path + ' ' + ComLine; E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, Result]); E.ErrorCode := Result; raise E; end; function ExecuteProcess (const Path: AnsiString; const ComLine: array of AnsiString): integer; var CommandLine: AnsiString; I: integer; begin Commandline := ''; for I := 0 to High (ComLine) do if Pos (' ', ComLine [I]) <> 0 then CommandLine := CommandLine + ' ' + '"' + ComLine [I] + '"' else CommandLine := CommandLine + ' ' + Comline [I]; ExecuteProcess := ExecuteProcess (Path, CommandLine); end; {**************************************************************************** Initialization code ****************************************************************************} Initialization InitExceptions; { Initialize exceptions. OS independent } InitInternational; { Initialize internationalization settings } Finalization DoneExceptions; end. { $Log$ Revision 1.43 2004-02-22 15:01:49 hajny * lots of fixes (regcall, THandle, string operations in sysutils, longint2cardinal according to OS/2 docs, dosh.inc, ...) Revision 1.42 2004/02/15 21:36:10 hajny * overloaded ExecuteProcess added, EnvStr param changed to longint Revision 1.41 2004/02/15 08:02:44 yuri * fixes for dosh.inc * Executeprocess iverloaded function * updated todo Revision 1.40 2004/01/20 23:11:20 hajny * ExecuteProcess fixes, ProcessID and ThreadID added Revision 1.39 2003/11/26 20:00:19 florian * error handling for Variants improved Revision 1.38 2003/11/23 15:50:07 yuri * Now native Revision 1.37 2003/11/05 09:14:00 yuri * exec fix * unused units removed Revision 1.36 2003/10/27 12:19:20 yuri * GetLocatTime now also native Revision 1.35 2003/10/27 11:43:40 yuri * New set of native functions Revision 1.34 2003/10/18 16:58:39 hajny * stdcall fixes again Revision 1.33 2003/10/13 21:17:31 hajny * longint to cardinal corrections Revision 1.32 2003/10/08 05:22:47 yuri * Some emx code removed Revision 1.31 2003/10/07 21:26:34 hajny * stdcall fixes and asm routines cleanup Revision 1.30 2003/10/03 21:46:41 peter * stdcall fixes Revision 1.29 2003/06/06 23:34:40 hajny * better fix for bug 2518 Revision 1.28 2003/06/06 23:31:17 hajny * fix for bug 2518 applied to OS/2 as well Revision 1.27 2003/04/01 15:57:41 peter * made THandle platform dependent and unique type Revision 1.26 2003/03/31 02:18:39 yuri FileClose bug fixed (again ;)) Revision 1.25 2003/03/29 19:14:16 yuri * Directoryexists function header changed back. Revision 1.24 2003/03/29 18:53:10 yuri * Fixed DirectoryExists function header Revision 1.23 2003/03/29 15:01:20 hajny + DirectoryExists added for main branch OS/2 too Revision 1.22 2003/03/01 21:19:14 hajny * FileClose bug fixed Revision 1.21 2003/01/04 16:25:08 hajny * modified to make use of the common GetEnv code Revision 1.20 2003/01/03 20:41:04 peter * FileCreate(string,mode) overload added Revision 1.19 2002/11/18 19:51:00 hajny * another bunch of type corrections Revision 1.18 2002/09/23 17:42:37 hajny * AnsiString to PChar typecast Revision 1.17 2002/09/07 16:01:25 peter * old logs removed and tabs fixed Revision 1.16 2002/07/11 16:00:05 hajny * FindFirst fix (invalid attribute bits masked out) Revision 1.15 2002/01/25 16:23:03 peter * merged filesearch() fix }