|
@@ -82,73 +82,59 @@ end;
|
|
procedure detect_linuxvcs;
|
|
procedure detect_linuxvcs;
|
|
|
|
|
|
var f:text;
|
|
var f:text;
|
|
- f_open : boolean;
|
|
|
|
- c,pc:char;
|
|
|
|
- pid,cpid,dummy:longint;
|
|
|
|
- device:dword;
|
|
|
|
|
|
+ fields:array [0..60] of int64;
|
|
|
|
+ fieldct,i:integer;
|
|
|
|
+ pid,ppid:longint;
|
|
|
|
+ magnitude:int64;
|
|
s:string[15];
|
|
s:string[15];
|
|
|
|
+ statln:ansistring;
|
|
|
|
|
|
begin
|
|
begin
|
|
{Extremely aggressive VCSA detection. Works even through Midnight
|
|
{Extremely aggressive VCSA detection. Works even through Midnight
|
|
Commander. Idea from the C++ Turbo Vision project, credits go
|
|
Commander. Idea from the C++ Turbo Vision project, credits go
|
|
to Martynas Kunigelis <[email protected]>.}
|
|
to Martynas Kunigelis <[email protected]>.}
|
|
pid:=fpgetpid;
|
|
pid:=fpgetpid;
|
|
- f_open:=false;
|
|
|
|
- {$push}
|
|
|
|
- {$I-}
|
|
|
|
- {$R-}
|
|
|
|
repeat
|
|
repeat
|
|
- cpid:=pid;
|
|
|
|
str(pid,s);
|
|
str(pid,s);
|
|
- assign(f,'/proc/'+s+'/stat');
|
|
|
|
|
|
+ assign(f, '/proc/'+s+'/stat');
|
|
|
|
+ {$I-}
|
|
reset(f);
|
|
reset(f);
|
|
|
|
+ {$I+}
|
|
if ioresult<>0 then
|
|
if ioresult<>0 then
|
|
- exit;
|
|
|
|
- f_open:=true;
|
|
|
|
- { from here we can discard I/O errors, as long as we avoid
|
|
|
|
- infinite loops }
|
|
|
|
- { first number is pid }
|
|
|
|
- dummy:=0;
|
|
|
|
- read(f,dummy);
|
|
|
|
- if dummy<>pid then
|
|
|
|
- exit;
|
|
|
|
- { after comes the name of the binary within (), look for closing brace followed by space }
|
|
|
|
- c:=#0;
|
|
|
|
- repeat
|
|
|
|
- pc:=c;
|
|
|
|
- read(f,c);
|
|
|
|
- if ioresult<>0 then
|
|
|
|
- break;
|
|
|
|
- until (pc=')') and (c=' ');
|
|
|
|
- { now comes the state letter }
|
|
|
|
- repeat
|
|
|
|
- read(f,c);
|
|
|
|
- if ioresult<>0 then
|
|
|
|
- break;
|
|
|
|
- until c=' ';
|
|
|
|
- { parent pid }
|
|
|
|
- pid:=-1;
|
|
|
|
- read(f,pid);
|
|
|
|
- { process group }
|
|
|
|
- read(f,dummy);
|
|
|
|
- { session }
|
|
|
|
- read(f,dummy);
|
|
|
|
- { device number }
|
|
|
|
- device:=0;
|
|
|
|
- read(f,device);
|
|
|
|
|
|
+ break;
|
|
|
|
+ readln(f, statln);
|
|
close(f);
|
|
close(f);
|
|
- f_open:=false;
|
|
|
|
- if (device and $ffffffc0)=$00000400 then {/dev/tty*}
|
|
|
|
|
|
+ magnitude := 1;
|
|
|
|
+ fieldct := 0;
|
|
|
|
+ fields[fieldct] := 0;
|
|
|
|
+ for i := high(statln) downto low(statln) do
|
|
begin
|
|
begin
|
|
- vcs_device:=device and $3f;
|
|
|
|
|
|
+ case statln[i] of
|
|
|
|
+ '-': magnitude := -1;
|
|
|
|
+ '0'..'9': begin
|
|
|
|
+ fields[fieldct] := fields[fieldct]
|
|
|
|
+ + (magnitude * (ord(statln[i]) - ord('0')));
|
|
|
|
+ magnitude := magnitude * 10;
|
|
|
|
+ end;
|
|
|
|
+ ' ': begin
|
|
|
|
+ magnitude := 1;
|
|
|
|
+ fieldct := fieldct + 1;
|
|
|
|
+ fields[fieldct] := 0;
|
|
|
|
+ end;
|
|
|
|
+ else
|
|
|
|
+ break;
|
|
|
|
+ end;
|
|
|
|
+ end;
|
|
|
|
+ ppid := pid;
|
|
|
|
+ pid := fields[fieldct - 1];
|
|
|
|
+ if (fields[fieldct - 4] and $ffffffc0) = $00000400 then {/dev/tty*}
|
|
|
|
+ begin
|
|
|
|
+ vcs_device:=fields[fieldct - 4] and $3f;
|
|
break;
|
|
break;
|
|
end;
|
|
end;
|
|
- until (device=0) {Not attached to a terminal, i.e. an xterm.}
|
|
|
|
- or (pid=-1)
|
|
|
|
- or (cpid=pid);
|
|
|
|
- if f_open then
|
|
|
|
- close(f);
|
|
|
|
- {$pop}
|
|
|
|
|
|
+ until (fields[fieldct - 4]=0) {Not attached to a terminal, i.e. an xterm.}
|
|
|
|
+ or (pid=-1)
|
|
|
|
+ or (ppid=pid);
|
|
end;
|
|
end;
|
|
|
|
|
|
begin
|
|
begin
|