* overloaded ExecuteProcess added, EnvStr param changed to longint

This commit is contained in:
Tomas Hajny 2004-02-15 21:26:36 +00:00
parent 5c9963cc57
commit 04a8acc442
6 changed files with 152 additions and 48 deletions

View File

@ -434,7 +434,7 @@ None.
\begin{function}{EnvStr}
\Declaration
Function EnvStr (Index: integer) : string;\Description
Function EnvStr (Index: longint) : string;\Description
\var{EnvStr} returns the \var{Index}-th \var{Name=Value} pair from the list
of environment variables.

View File

@ -856,7 +856,11 @@ end;
******************************************************************************}
Var
{$ifdef HASTHREADVAR}
threadvar
{$else HASTHREADVAR}
var
{$endif HASTHREADVAR}
LastDosExitCode: word;
@ -1502,7 +1506,7 @@ end;
End;
Function EnvStr(Index: Integer): String;
Function EnvStr(Index: longint): String;
Begin
EnvStr:='';
End;
@ -1608,7 +1612,10 @@ End.
{
$Log$
Revision 1.5 2004-02-09 12:03:16 michael
Revision 1.6 2004-02-15 21:26:37 hajny
* overloaded ExecuteProcess added, EnvStr param changed to longint
Revision 1.5 2004/02/09 12:03:16 michael
+ Switched to single interface in dosh.inc
Revision 1.4 2002/09/07 16:01:16 peter

View File

@ -281,7 +281,11 @@ End;
--- Exec ---
******************************************************************************}
{$ifdef HASTHREADVAR}
threadvar
{$else HASTHREADVAR}
var
{$endif HASTHREADVAR}
LastDosExitCode: word;
@ -806,7 +810,7 @@ End;
Function EnvStr(Index: Integer): String;
Function EnvStr (Index: longint): String;
Var
i : longint;
p : ppchar;
@ -965,7 +969,10 @@ finalization
end.
{
$Log$
Revision 1.6 2004-02-09 12:03:16 michael
Revision 1.7 2004-02-15 21:26:37 hajny
* overloaded ExecuteProcess added, EnvStr param changed to longint
Revision 1.6 2004/02/09 12:03:16 michael
+ Switched to single interface in dosh.inc
Revision 1.5 2003/12/03 20:53:22 olle

View File

@ -255,6 +255,7 @@ begin
Result:=StrPas(beos.Getenv(PChar(EnvVar)));
end;
function ExecuteProcess (const Path: AnsiString; const ComLine: AnsiString):
integer;
@ -275,6 +276,27 @@ begin
ExecuteProcess := beos.shell (CommandLine);
end;
function ExecuteProcess (const Path: AnsiString;
const ComLine: array of AnsiString): integer;
{$WARNING Should be probably changed according to the Unix version}
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
****************************************************************************}
@ -287,7 +309,10 @@ Finalization
end.
{
$Log$
Revision 1.8 2004-01-20 23:09:14 hajny
Revision 1.9 2004-02-15 21:26:37 hajny
* overloaded ExecuteProcess added, EnvStr param changed to longint
Revision 1.8 2004/01/20 23:09:14 hajny
* ExecuteProcess fixes, ProcessID and ThreadID added
Revision 1.7 2003/11/26 20:00:19 florian

View File

@ -92,13 +92,18 @@ Type
execwinflags=(efdefault,efminimize,efmaximize,effullscreen,
efwindowed);
{OS/2 specific functions}
function exec(path:pathstr;runflags:execrunflags;winflags:execwinflags;
const comline:comstr):longint;
function GetEnvPChar (EnvVar: string): PChar;
const
(* For compatibility with VP/2, used for runflags in Exec procedure. *)
ExecFlags: cardinal = ord (efwait);
var
dosexitcode:word;
implementation
var
@ -323,12 +328,19 @@ begin
end ['eax','ebx','ecx','edx','esi','edi'];
end;
{$ifdef HASTHREADVAR}
threadvar
{$else HASTHREADVAR}
var
{$endif HASTHREADVAR}
LastDosExitCode: longint;
procedure exec(const path:pathstr;const comline:comstr);
{Execute a program.}
begin
dosexitcode:=word(exec(path,execrunflags(ExecFlags),efdefault,comline));
LastDosExitCode := Exec (Path, ExecRunFlags (ExecFlags), efdefault, comline);
end;
function exec(path:pathstr;runflags:execrunflags;winflags:execwinflags;
@ -477,6 +489,14 @@ begin
a system function I ever wrote!}
end;
function DosExitCode: word;
begin
DosExitCode := LastDosExitCode and $FFFF;
end;
function dosversion:word;assembler;
{Returns DOS version in DOS and OS/2 version in OS/2}
@ -485,16 +505,16 @@ asm
call syscall
end ['eax'];
procedure GetDate (var Year, Month, Day, DayOfWeek: word);
procedure GetDate (var Year, Month, MDay, WDay: word);
begin
asm
movb $0x2a, %ah
call syscall
xorb %ah, %ah
movl DayOfWeek, %edi
movl WDay, %edi
stosw
movl Day, %edi
movl MDay, %edi
movb %dl, %al
stosw
movl Month, %edi
@ -512,12 +532,12 @@ procedure SetDate (Year, Month, Day: word);
var DT: TDateTime;
begin
if os_mode = osOS2 then
begin
DosGetDateTime (DT);
DT.Year := Year;
DT.Month := byte (Month);
DT.Day := byte (Day);
DosSetDateTime (DT);
begin
DosGetDateTime (DT);
DT.Year := Year;
DT.Month := byte (Month);
DT.Day := byte (Day);
DosSetDateTime (DT);
end
else
asm
@ -1010,40 +1030,40 @@ const
{$UNDEF FPC_FEXPAND_DRIVES}
{$UNDEF FPC_FEXPAND_UNC}
procedure packtime(var d:datetime;var time:longint);
procedure PackTime (var T: DateTime; var P: longint);
var zs:longint;
begin
time:=-1980;
time:=time+d.year and 127;
time:=time shl 4;
time:=time+d.month;
time:=time shl 5;
time:=time+d.day;
time:=time shl 16;
zs:=d.hour;
zs:=zs shl 6;
zs:=zs+d.min;
zs:=zs shl 5;
zs:=zs+d.sec div 2;
time:=time+(zs and $ffff);
P := -1980;
P := P + T.Year and 127;
P := P shl 4;
P := P + T.Month;
P := P shl 5;
P := P + T.Day;
P := P shl 16;
zs:= T.hour;
zs:= zs shl 6;
zs:= zs + T.Min;
zs:= zs shl 5;
zs:= zs + T.Sec div 2;
P := P + (zs and $ffff);
end;
procedure unpacktime (time:longint;var d:datetime);
procedure unpacktime (P: longint; var T: DateTime);
begin
d.sec:=(time and 31) * 2;
time:=time shr 5;
d.min:=time and 63;
time:=time shr 6;
d.hour:=time and 31;
time:=time shr 5;
d.day:=time and 31;
time:=time shr 5;
d.month:=time and 15;
time:=time shr 4;
d.year:=time+1980;
T.Sec := (P and 31) * 2;
P := P shr 5;
T.Min := P and 63;
P := P shr 6;
T.Hour := P and 31;
P := P shr 5;
T.Day := P and 31;
P := P shr 5;
T.Month := P and 15;
P := P shr 4;
T.Year := P + 1980;
end;
procedure getfattr(var f;var attr : word);
@ -1165,14 +1185,36 @@ var
oldexit : pointer;
{******************************************************************************
--- Not Supported ---
******************************************************************************}
procedure Keep (ExitCode: word);
begin
end;
procedure GetIntVec (IntNo: byte; var Vector: pointer);
begin
end;
procedure SetIntVec (IntNo: byte; Vector: pointer);
begin
end;
begin
oldexit:=exitproc;
exitproc:=@doneenvironment;
InitEnvironment;
LastDosExitCode := 0;
end.
{
$Log$
Revision 1.9 2004-02-09 12:03:16 michael
Revision 1.10 2004-02-15 21:26:37 hajny
* overloaded ExecuteProcess added, EnvStr param changed to longint
Revision 1.9 2004/02/09 12:03:16 michael
+ Switched to single interface in dosh.inc
Revision 1.8 2003/12/26 22:20:44 hajny

View File

@ -1111,6 +1111,26 @@ begin
end;
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
****************************************************************************}
@ -1124,7 +1144,10 @@ end.
{
$Log$
Revision 1.14 2004-01-20 23:05:31 hajny
Revision 1.15 2004-02-15 21:26:37 hajny
* overloaded ExecuteProcess added, EnvStr param changed to longint
Revision 1.14 2004/01/20 23:05:31 hajny
* ExecuteProcess fixes, ProcessID and ThreadID added
Revision 1.13 2003/11/26 20:00:19 florian