Contributor: TIM VILLA
{
Hi all, I just wanted to leave a note of congratulations and appreciation on
your efforts at the SWAG archive. The reader is a great little app (I did
the screen saver!) and I've just found quite a few cool things that I hadn't
even thought of trying before in the hardware archive.
I don't know if it's be useful to anyone but I'd like to contribute
something as pretty much everything else I've ever done is already here.
This is the source to a command interpreter with some unix functionality I
call Shell which I've been playing with on and off over the past few years.
I haven't released the source until now but I felt that seeing so many other
people contribute I should do so as well in return. Shell is available on
SimTel and Oak and is quite widely used. I don't mind the code being
distributed.
Thanks
Tim
}
{$DEFINE qdebug}
{$IFDEF debug}
{$A-,B-,D+,E-,F-,G+,I+,L+,N-,O-,Q+,R+,S+,V-,X-,M 2700,0,0}
{$ELSE}
{$A-,B-,D-,E-,F-,G+,I-,L-,N-,O-,Q-,R-,S-,V-,X-,M 2300,0,0}
{$ENDIF}
program Shell;
uses crt,dos;
const
BACKSPACE=#8; {Keyboard character codes}
CTRLD=#4;
CTRLU=#21;
CTRLBACKSPACE=#127;
TAB=#9;
ENTER=#13;
ESCAPE=#27;
KHOME=#71;
UP=#72;
KPGUP=#73;
LEFT=#75;
RIGHT=#77;
KEND=#79;
DOWN=#80;
KPGDN=#81;
INSERTKEY=#82;
DELKEY=#83;
F1=#59;
F2=#60;
F3=#61;
F7=#65;
F8=#66;
F10=#68;
GUP=TRUE; {Scrolling}
GDOWN=FALSE;
QUITCMD='exit'; {Quit command}
IOINT=$10; {DOS IO interrupt}
DOSINT=$21; {DOS function interrupt}
MOUSEINT=$33; {Mouse interrupt number}
SCREEN=$B800; {Screen memory address}
KEYBSTATUS=$417; {Keyboard status offset}
ALLFILES=$37; {File mask minus volumeid}
var
tvdos:pathstr; {TVDOS envvar}
path:pathstr; {PATH envvar}
ppos:byte; {Path pointer for GFN}
history:array[1..21]of comstr; {History}
comcount:byte; {History list counter}
{The following are only globals to save parameter space}
firstagain:boolean; {Look for 1st file again}
tabflag:boolean; {Has tab been pressed}
command:comstr; {The command line}
promptcolor:byte; {Prompt color}
dummy:integer; {Local dummy}
procedure Initialize;
begin
checkbreak:=false;
directvideo:=false; {For speech assistants}
tvdos:=getenv('TVDOS');
{ tvdos := 'c:'; }
if tvdos=''then
begin
writeln('SHELL: no TVDOS environment variable');
halt;
end;{if}
path:=getenv('PATH');
{Add curdir to the path for GFN}
if pos('.\',path)=0 then path:='.\;'+path;
if paramcount>0 then
val(paramstr(1),promptcolor,dummy)
else
promptcolor:=lightblue;
writeln(#13+'SHELL V1.9.1 by Tim Villa');
writeln('Type "'+QUITCMD+'" to escape to DOS');
{Initialize the history}
for comcount:=19 downto 0 do history[comcount+1]:='';
{Initialize the mouse}
asm
mov ax,0 {Reset mouse}
int MOUSEINT
mov dummy,ax
mov ax,7 {Set X range}
mov cx,1
mov dx,632;
int MOUSEINT
mov ax,8 {Set Y range}
mov cx,1
mov dx,392
int MOUSEINT
end;{asm}
write('Mouse ');
if dummy=0 then write('not ');
writeln('detected');
end;{Initialize}
function WhereX:byte;
{Returns x pos on screen}
var
temp:byte;
begin
asm
mov bh,0 {"Graphics" page}
mov ah,3 {Read cursor position}
int IOINT
inc dl {To preserve 0..79}
mov temp,dl {Mov x result to temp}
end;
WhereX:=temp;
end;{WhereX}
procedure GotoX(x:byte);
{Move cursor to x,wherey}
begin
asm
mov bh,0 {"Graphics" page}
mov ah,3 {Read cursor position}
int IOINT
mov ah,2 {Set cursor position}
dec x {Columns starts at 0, !1}
mov dl,x
int IOINT
end;{asm}
end;{GotoX}
function Button(which:char):boolean;
{True if left button down}
label
LButton,TrueRes,FalseRes;
begin
asm
mov ax,3 {Get mouse state}
int MOUSEINT
cmp bx,3
je TrueRes {bx 3 if any button down}
cmp which,LEFT
je LButton {Check right utton}
cmp bx,2
je TrueRes
jmp FalseRes {Nope}
LButton:
cmp bx,1
je TrueRes {...else dropout to FalseRes}
end;{asm}
FalseRes:Button:=false;
exit;
TrueRes:Button:=true;
end;{Button}
function GetFileName(sofar:string):string;
{Responds to TAB to finish command line.
Returns the remainder of the filename [or whole filename if none given]}
var
filerec:searchrec; {For findfirst}
prefix:pathstr; {Directory to look in}
filename:pathstr; {Name we found}
i:byte; {Index}
dircmd:boolean; {Is this a directory command}
cmd:boolean; {Is this a command}
procedure GetDirEntry;
{Skips all non directory entries}
begin writeln(filerec.name,'',filerec.attr);
while ((filerec.attr and DIRECTORY)<>DIRECTORY) and (doserror<>18) do
findnext(filerec);
if doserror=18 then filerec.name:='';
end;{GetDirEntry}
procedure GetCmdEntry;
{Skips all non .EXE .COM .BAT files}
begin
while (pos('.EXE',filerec.name)=0) and (pos('.COM',filerec.name)=0) and
(pos('.BAT',filerec.name)=0) and ((filerec.attr and DIRECTORY) <> DIRECTORY) and
(doserror<>18) do
findnext(filerec);
if doserror=18 then firstagain:=true;
end;{GetCmdEntry}
begin {GetFileName}
{Convert command to lowercase (everything here is in lowercase)}
for i:=1 to length(sofar) do
if sofar[i] in ['A'..'Z'] then
sofar[i]:=chr(ord(sofar[i])+32);
{Check for a directory oriented command. Use "prefix" to save memory}
prefix:=copy(sofar,1,pos(' ',sofar)-1);
dircmd:=(prefix='cd') or (prefix='rd') or
(prefix='chdir') or (prefix='rmdir');
cmd:=pos(' ',sofar)=0;
{Eliminate everything before the current "word"}
while pos(' ',sofar)>0 do delete(sofar,1,pos(' ',sofar));
{And convert forward slashes to backslashes}
while pos('/',sofar)>0 do sofar[pos('/',sofar)]:='\';
if firstagain then
begin
{We're starting from scratch. The current directory is in the
path as set in Initialize so we search the path from the start}
GetFileName:='';
repeat
prefix:='';
i:=pos(';',copy(path,ppos,79));
if i=0 then i:=255;
if (pos('\',sofar)=0) and (pos(':',sofar)=0) then
begin
{No drive/path has been specified by the user}
prefix:=copy(path,ppos,i-1);
if prefix[length(prefix)]<>'\'then
prefix:=prefix+'\';
end;{if}
filerec.name:='';
findfirst(prefix+sofar+'*.*',ALLFILES,filerec);
{Ignore . and .. filenames}
while (filerec.name[1]='.') and (doserror<>18) do
findnext(filerec);
{Now ignore all but directories if DIRCMD}
if dircmd then GetDirEntry;
if cmd then GetCmdEntry;
tabflag:=true;
if i<255 then ppos:=ppos+i;
until (i=255) or (doserror<>18);
{If i is 255 we have run out of subdirs- 255>length(pathstr)
doserror<>18 means we have found a match somewhere}
if i=255 then ppos:=1;
if doserror=18 then exit; {No file. Return ''}
filename:=filerec.name;
firstagain:=false;
end{if}
else
begin
{Set filename to what we found here last time}
{Ignore all but directories if DIRCMD}
if dircmd then GetDirEntry;
if cmd then GetCmdEntry;
filename:=filerec.name;
end;{else}
{Convert result to lowercase}
for i:=1 to length(filename) do
if filename[i] in ['A'..'Z'] then
filename[i]:=chr(ord(filename[i])+32);
{Set up for next TAB}
findnext(filerec);
{If no more files, start again}
if doserror=18 then firstagain:=true;
{We need to extract the command line entered so far so we can return
only the remainder, ie the rest of the filename. First we find the
last occurrence of a : or \ so we know the where the last instance of
a filename begins}
i:=length(sofar)+1;
repeat
dec(i);
until (sofar[i] in ['\',':']) or (i=0);
{Establish h/m chars we are tacking on}
i:=length(sofar)-i;
{Extract these chars to get result}
GetFileName:=copy(filename,1+i,12);
end;{GetFileName}
function GetCmdLine:string;
const
keymap='qwertyuiop!!!!asdfghjkl!!!!!zxcvbnm';
var
index,c:byte; {String index, counter}
key:char; {User}
cmdline:COMSTR; {Command line}
lasttabname:string[12]; {Last name from tab press}
comscroll:byte; {For DOSKEY command scrolling}
gotnull:boolean; {Has a ctrl char been pressed}
start,stop:byte; {Sel start/end, line#}
linenum:integer; {Line number mouse is on}
mtext:string[80]; {C&P text from mouse}
attrline:array[1..80]of byte; {Original attr b/4 highlight}
inson:boolean; {Insert on or off}
dirlen:byte; {Length of dirname}
m,s,s100,oldtime,time:word; {For double click test}
firstscroll:boolean;
label
MyLabel1; {Dummy label}
procedure ToggleInsert;
begin
inson:=not inson;
if inson then
asm
mov ah,1 {Set cursor type}
mov ch,1
mov cl,4
int IOINT
end{asm}
else
asm
mov ah,1 {Set cursor type}
mov ch,4
mov cl,5
int IOINT;
end;{asm}
end;{ToggleInsert}
procedure ScrollLastCommand(up:boolean);
{DOSKEY up arrow}
begin
if comcount=0 then exit;
if firstscroll then
begin
firstscroll:=false;
comscroll:=comscroll+1;
end;{if}
if up then
begin
dec(comscroll);
if comscroll=0 then comscroll:=comcount;
end{if}
else
begin
inc(comscroll);
if comscroll>comcount then comscroll:=1;
end;{else}
GotoX(dirlen+2); {Go to start of cmdline}
clreol;
cmdline:=history[comscroll];
write(cmdline);
index:=length(cmdline)+1;
end;{ScrollLastCommand}
procedure NormalKey;
{Normal alphanumerics}
begin
tabflag:=false;
firstagain:=true;
firstscroll:=true;
ppos:=1;
if gotnull then exit;
if key=CTRLD then
begin
{We have a ^D character}
while pos(' ',cmdline)>0 do delete(cmdline,1,pos(' ',cmdline));
cmdline:=tvdos+'\LISTNAME.EXE '+cmdline;
key:=#13;
exit;
end;{if}
if inson then
begin
{Insert the char}
insert(key,cmdline,index);
inc(index);
{Write what we got now}
GotoX(dirlen+2);
write(cmdline);
{Move one pos to the right of old pos}
GotoX(dirlen+index+1);
exit;
end;{if}
if index>length(cmdline) then cmdline:=cmdline+key
else cmdline[index]:=key;
write(key);
inc(index);
end;{NormalKey}
procedure GetOldAttr;
{Saves original chacter attributes}
var
c:byte; {Counter}
begin
{We don't want the area under the mouse so hide it}
asm
mov ax,2 {Hide mouse cursor}
int MOUSEINT
end;{asm}
for c:=1 to 80 do
attrline[c]:=mem[SCREEN:linenum+(2*c-1)];
asm
mov ax,1 {Show mouse cursor}
int MOUSEINT
end;{asm}
end;{GetOldAttr}
procedure RestoreOldAttr(start:byte);
{Restores old attributes to highlighted text}
var
c:byte; {Counter}
begin
if linenum=-maxint then exit;
for c:=start to 80 do
mem[SCREEN:linenum+2*c-1]:=attrline[c];
end;{RestoreOldAttr}
function GetCutAndPaste:string;
{Returns text selected with mouse}
var
xpos:byte; {Mouse x pos ; dummy byte}
c,offs:integer; {Counter, offset of start}
cutstr:string[80]; {Selected text}
begin
asm
mov ax,2 {Hide mouse cursor}
int MOUSEINT
end;{asm}
RestoreOldAttr(1); {Clear old highlighted text}
{Get the initial pos}
asm
mov ax,3 {Get mouse state}
int MOUSEINT
mov ax,cx {Load divisor: x coord}
add ax,8
mov bl,8 {Set dividend}
div bl
mov xpos,al {Use xpos to save mem}
mov ax,dx {Load divisor: y coord}
add ax,8
div bl
dec al {Now calculate (al-1)*160}
mov dh,160
mul dh
mov offs,ax {Use offs to save mem}
end;{asm}
{Linenum represents (linenum-1)*160 for offset}
linenum:=offs;
start:=xpos;
GetOldAttr;
{Ok highlight etc until the button is released}
repeat
asm
mov ax,3 {Get mouse state}
int MOUSEINT
mov ax,cx
add ax,8
mov bl,8
div bl
mov xpos,al
end;{asm}
for c:=linenum+(start*2-1) to linenum+(xpos*2-2) do
if odd(c) then mem[SCREEN:c]:=black+lightgray*16;
RestoreOldAttr(xpos);
until not Button(LEFT);
asm
mov ax,1 {Show mouse cursor}
int MOUSEINT
end;{asm}
{Might have to get new mouse x here?}
{Get our new position and calulate the initial offset}
stop:=xpos-1;
offs:=linenum+(start*2-2);
{Fill in the string from memory}
cutstr:='';
for c:=0 to (stop-start)*2 do
if not odd(c) then cutstr:=cutstr+chr(mem[SCREEN:offs+c]);
if start>=stop then GetCutAndPaste:='' else GetCutAndPaste:=cutstr;
end;{GetCutAndPaste}
function GetWord:string;
{Gets current word as indicated by double clicking}
var
xpos:byte; {Mouse x,y coords}
offs:integer;
cutstr:string[80]; {Selected text}
c:integer;
begin
asm
mov ax,2 {Hide mouse cursor}
int MOUSEINT
end;{asm}
{Get the initial pos}
asm
mov ax,3 {Get mouse state}
int MOUSEINT
mov ax,cx {Load divisor: x coord}
add ax,8
mov bl,8 {Set dividend}
div bl
mov xpos,al {x coord}
mov ax,dx {Load divisor: y coord}
add ax,8
div bl
dec al {Now calculate (al-1)*160}
mov dh,160
mul dh
mov offs,ax {This is the memory offset}
end;{asm}
{Go back to closest space or SOLN}
while (mem[SCREEN:offs+(xpos-1)*2]<>32) and (xpos<>0) do
xpos:=xpos-1;
{Now move to the right, adding characters until space or EOLN}
cutstr:='';
while (mem[SCREEN:offs+(xpos)*2]<>32) and (xpos<80) do
begin
cutstr:=cutstr+chr(mem[SCREEN:offs+xpos*2]);
{Highlight character}
mem[SCREEN:offs+xpos*2+1]:=black+lightgray*16;
xpos:=xpos+1;
end;{while}
asm
mov ax,1 {Show mouse cursor}
int MOUSEINT
end;{asm}
GetWord:=cutstr;
end;{GetWord}
procedure FinishCommand;
{DOSKEY F8}
var
i:byte;
begin
if comcount=0 then exit;
for i:=comcount downto 1 do
if pos(cmdline,history[i])=1 then
begin
cmdline:=history[i];
GotoX(dirlen+2);
write(cmdline);
index:=length(cmdline)+1;
exit;
end;{if}
end;{FinishCommand}
begin {GetCmdLine}
if WhereX<>1 then writeln;
getdir(0,cmdline); {Var used to save memory}
textcolor(promptcolor);
write(cmdline+'>');
textattr:=lightgray;
clreol;
dirlen:=length(cmdline);
cmdline:='';
comscroll:=comcount; {Reset scroller}
index:=1;
tabflag:=false; {Reset TAB assoc variables}
firstagain:=true;
lasttabname:='';
ppos:=1;
gotnull:=false;
inson:=true;
ToggleInsert; {Sets to false, reset cursor}
start:=0; {Reset cut & paste}
stop:=0;
mtext:='';
linenum:=-maxint;
time:=65535;
repeat
repeat
if Button(LEFT) then
begin
oldtime:=time;
gettime(s,m,s,s100);
mtext:=GetCutAndPaste;
time:=m*60000+s*100+s100;
if time-oldtime<20 then mtext:=GetWord;
end;{if}
if Button(RIGHT) then
begin
RestoreOldAttr(1);
inc(index,length(mtext));
{Gotta check for len here}
cmdline:=cmdline+mtext;
write(mtext);
repeat until not Button(RIGHT)
end;{if}
until keypressed;
key:=readkey;
if gotnull then
begin
gotnull:=false;
case key of
UP:ScrollLastCommand(GUP); {DOH2}
DOWN:ScrollLastCommand(GDOWN);
LEFT:
if index>1 then
begin
write(BACKSPACE);
dec(index);
end;{KLEFT}
RIGHT:
if index1 then
begin
if copy(cmdline,length(cmdline),1)=' 'then
begin
tabflag:=false;
firstagain:=true;
end;{if}
if index0 then
lasttabname[0]:=chr(ord(lasttabname[0])-1);
firstagain:=true;
end;{if}
end;{else}
end;{BACKSPACE}
TAB:
begin
gotnull:=false;
if tabflag then
begin
{Erase all signs of existence the last
TAB caused}
c:=length(lasttabname);
GotoX(WhereX-c);
clreol;
index:=index-c;
cmdline:=copy(cmdline,1,
length(cmdline)-c);
end;{if}
lasttabname:=GetFileName(cmdline);
cmdline:=cmdline+lasttabname;
GotoX(WhereX-index+1);
write(cmdline);
index:=index+length(lasttabname);
end;{TAB}
ESCAPE,CTRLU:
begin
GotoX(1); {So can redraw prompt}
clreol;
GetCmdLine:='';
firstscroll:=true;
exit;
end;{ESCAPE}
ENTER:
begin
firstscroll:=true;
RestoreOldAttr(1);
asm
mov ax,2 {Hide mouse cursor}
int 51
end;{asm}
writeln;
end;{ENTER}
CTRLBACKSPACE:halt;
#0:gotnull:=true;
#3:; {Ignore leftover ^C}
else NormalKey;
end;{case}
until key=ENTER;
while copy(cmdline,1,1)=' 'do delete(cmdline,1,1);
GetCmdLine:=cmdline;
end;{GetCmdLine}
function Exclusions(temp:string):boolean;
{Determines whether command is valid}
{Also executes SHELL commands}
var
i:byte; {Index}
begin
Exclusions:=false;
for i:=1 to length(temp) do temp[i]:=upcase(temp[i]);
if copy(temp,1,4)='SET ' then
writeln('SHELL: Cannot set environment variables');
if temp='HISTORY' then
begin
for i:=1 to comcount do writeln(i:2,' ',history[i]);
Exclusions:=true;
end;{if}
end;{Exclusions}
procedure UpdateCommands;
{Adds latest command to command list}
var
i,j:byte; {Counter/index}
begin
inc(comcount);
i:=1;
while (i<=comcount) and (command<>history[i]) do inc(i);
if i0) and (i0 then
for i:=comcount downto 1 do
if pos(command,history[i])=1 then
begin
command:=history[i];
exit;
end;{if}
command:='';
end;{BuildLastCommand}
procedure DoCommands;
{Reads and executes commands}
begin
repeat
repeat
asm
mov ax,1 {Show mouse cursor}
int 51
mov ax,8 {Set Y range}
mov cx,1
mov dx,392
int MOUSEINT
end;{asm}
command:=GetCmdLine;
if command[1]='!'then BuildLastCommand;
until command<>'';
if copy(command,1,12)<>'C:\TVDOS\SH_' then
UpdateCommands;
if (command<>QUITCMD) and (not Exclusions(command)) then
begin
swapvectors;
exec(tvdos+'\COMMAND.COM','/C '+command);
swapvectors;
case doserror of 0:;
1:writeln('SHELL: Cannot use root directory for TVDOS');
2:writeln('SHELL: Command interpreter missing');
3:writeln('SHELL: Bad TVDOS directory');
8:writeln('SHELL: Out of memory or system error');
else writeln('SHELL: error ',doserror);
end;{case}
end;{if}
until command=QUITCMD;
end;{DoCommands}
begin
Initialize;
DoCommands;
writeln('SHELL: Terminating');
end.
NOTES
We get a stack overflow every time NormalKey is pressed when DEBUG is on.
There don't appear to be any problems with the stack but bear this in mind!
Check to see if there is a * around here somewhere so we can find partly
specified extensions}
Use mem[$0:$417]:=0; to switch off all key locks
Taken from Exclusions:
if (pos('SHELL',temp)>0) and ((pos('DEL',temp)>0) or (pos('REN',temp)>0)) then
begin
writeln('SHELL: Access denied');
Exclusions:=true;
end;{if}
QUIRKS
8. The stack is unstable. Don't make it any smaller
11. Pressing F3 to recall a shorter command. No bug but hmmm...
BUGS
12. Use of TAB after starting a new line causes error 201
13. Use of TAB after a . is on the command line screws up GFN
14. Can't cd TAB for directories with A bit set-check (attr && DIRECTORY)
ERROR CODES
01: (Not sure why) $TVDOS is in a root directory. Probably C:\\ I guess
02: File not found-$TVDOS \COMMAND.COM is missing
08: Not enough memory. No memory or system error
VERSION
1.8.2 Fixed bug where prompt color is used by DOS command
1.9.0
1.9.1 Get network directory names completing properly