Category : Pascal Source Code
Archive   : STAY50.ZIP
Filename : DEMO.PAS

 
Output of file : DEMO.PAS contained in archive : STAY50.ZIP

{$I direct.inc}
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Turbo Pascal Stay Resident Shell Demonstation }
{ Copyright (C) 1988 Lane Ferris }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Send Suggestions and Bug reports to COMPUSERVE ID: 70357,2716 }
{ or write: 4268 26th St. SanFrancisco, Ca 94131 }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}

uses
crt,dos,
macros, { assorted inlines }
SR50, { stayres kernel }
SR50subs, { stayres subs }
SRmsgu , { mailbox unit }
FListu ; { file list unit }


const
AltD : word = $2000 ; { AltD int 16 keycode }
AltL : word = $2600 ; { AltL int 16 keycode }
var
Attr : byte ;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Clock }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Displays digital clock in upper right of screen }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{$F+}Procedure Clock ; {$F-}

var
SystemTimer : longint absolute $40:$6c ;
Hours : longint ;
minutes,
seconds : longint ;
ticks : longint ;

Hoursstr : string[2] ;
Minutesstr : string[2] ;
secondsstr : string[2] ;
ampm : string[2] ;
ClockStr : string[11] ;
SaveWindow : array[1..4] of byte ;

SaveCurPos : word ;
BiosCurPos : word absolute $40:$50 ; { BIOS cursor position page 1 }

BEGIN
While true do begin { do forever }
ticks := SystemTimer ;
Hours := ticks div 65543 ; { 65543 ticks per hour }
dec(ticks,Hours*65543) ;
minutes := ticks div 1092 ; { 1092 ticks per minute }
dec(ticks,minutes*1092) ;
seconds := ticks div 18 ; { 18.2 ticks per second }
(** { account for .2 tick error }
seconds := seconds - (seconds div 20) ; { as 1 tick in 20 err }
**)
if seconds >59 then seconds := 59 ;
if Hours > 12 then begin
dec(Hours,12) ;
ampm := 'pm' ;
end
else ampm := 'am' ;

str(Hours :2,hoursstr ) ;
str(Minutes:2,minutesstr ) ;
str(seconds:2,secondsstr ) ;
{ force leading zeros }
Hoursstr[1] := char(ord(hoursstr[1]) or ord('0')) ;
Minutesstr[1] := char(ord(Minutesstr[1]) or ord('0')) ;
Secondsstr[1] := char(ord(Secondsstr[1]) or ord('0')) ;

ClockStr := Hoursstr+':'+Minutesstr+':'+secondsstr+ampm ;
resource(reserve,_crt) ;
move(Windmin,SaveWindow,4) ;
SaveCurPos := BiosCurPos ;
window(68,1,79,2) ; { a window resets cursor posn etc }
write( ClockStr) ;
move(SaveWindow,Windmin,4) ;
BiosCurPos := SaveCurPos ;
resource(rlse,_crt) ;
Yield ; { give up cpu control }

end {while true } ;
END; {Clock}

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ ShowDir }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Yet another directory display routine }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
const
maxentries = 78 ; {÷1024 bytes}
var
Filenames : array[1..maxentries] of string[13] ;
OldWindowPtr : pointer ; { pointer to old window on heap }
const
DirContents : pointer = nil ; { process window contents to restore }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ DirPop }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ popup/dn maintenance routine called from SR50 }
{ each time the hotkey is activated from the keyboard }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{$F+} Procedure DirPop(popupdn:boolean) ; {$F-}

Begin
resource(reserve,_crt) ;
case popupdn of
True : Begin { This is a popup }
SaveWindow(1,1,68,20,OldWindowPtr) ; { save forgound window }
BorderWindow(1,1,68,20,border) ; { make window with border }
if DirContents <> nil then { restore contents if any }
RestoreWindow(2,2,67,19,DirContents) ;
end {popup} ;
false: Begin { this is a popdown}
SaveWindow(2,2,67,19,DirContents) ; { save window contents }
RestoreWindow(1,1,68,20,OldWindowPtr) ; { restore foreground }
end {popdown}
end {case};;
resource(rlse,_crt) ;
End {DirPop} ;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Sort em }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Insertion sort filenames into alpa order }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Sortem(entries : integer ) ;
var
i, j, lowest, highest, center : integer ;
tempstr : string[13] ;

begin
for i := 2 to entries do begin
tempstr := Filenames[i] ;
lowest := 1 ;
highest := i - 1 ;

while lowest <= highest do begin
center := (lowest + highest) div 2 ;
if tempstr < filenames[center] then
highest := center - 1
else lowest := center +1 ;
end {while lowest..} ;

for j := i - 1 downto lowest do
filenames[j+1] := filenames[j] ;
filenames[lowest] := tempstr ;
end {for i..} ;
end {Sortem} ;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Show em }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ display partial sorted directory entries on video }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure Showem(entries : integer ) ;
var
i, j : integer ;
begin
clrscr ;
j := 0 ;
for i := 1 to entries do begin
Resource(reserve,_CRT) ;
write(filenames[i]) ;
Resource( rlse,_CRT) ;
inc(j) ;
if j = 5 then begin
Resource(reserve,_CRT) ;
writeln ;
Resource(rlse,_CRT) ;
j := 0 ;
end{if j}
end {for i} ;
end{showem} ;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ ShowDir (main procedure) }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ShowDir ;
const
blanks : string[13] = ' ' ;
var
FilePath : string ;
FileAttr : byte ;
FileSearchRec : SearchRec ;
i : integer ;
ch : char ;

begin {ShowDir}
FilePath := '*.*' ;
FileAttr := AnyFile ;
i := 1 ;

FindFirst(FilePath,FileAttr,FileSearchRec) ;


while DosError = 0 do begin
With FileSearchRec do begin
blanks[0] := char(13-length(name)) ;
Filenames[i] := Name+blanks ;
inc(i) ;
if i = maxentries+1 then begin
sortem(i-1) ;
showem(i-1) ;
Resource(reserve,_CRT) ;
writeln;write('Count was: ',i-1) ;
Resource(rlse,_CRT) ;
while not keypressed do Yield ;
ch := readkey ; { eat the key }
i := 1 ; { restart the array }
end {if i..} ;
end {with file..} ;
FindNext( FileSearchRec ) ;
end{while DosError..} ;

sortem(i-1) ;
showem(i-1) ;
Resource(reserve,_CRT) ;
writeln;writeln('Count was: ',i-1) ;
Resource(rlse,_CRT) ;

while not keypressed do yield ;
ch := readkey ;

End {ShowDir} ;

{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ DirTask }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Hotkey task in infinite loop with Yield to SR50 at bottom }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure DirTask ;
begin
While true do begin
ShowDir ; { Display the Directory }
Yield ; { tell SR50 its finished }
end {while true..} ;
end {DirTask} ;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ ListFile }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ If you're one who believes that Dinasours died of their own }
{ stupditiy.. you'll love this. }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ This is an exercise in mailbox maintenance. It sends commands }
{ to a mailbox, and receives the results. Message passing is fun }
{ .. but, ever so slow.. Dinasaurs dont care . }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Const
ListContents : pointer = nil ; { contents of window }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ ListPop }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ popup/down maintenance routine called from SR50 }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{$F+} Procedure ListPop(popupdn:boolean) ; {$F-}

Begin
resource(reserve,_crt) ;
case popupdn of
True : Begin { This is a popup }
SaveWindow(4,4,68,21,OldWindowPtr) ; { save forgound window }
BorderWindow(4,4,68,21,border) ; { make window with border }
if ListContents <> nil then { restore contents if any }
RestoreWindow(5,5,67,20,ListContents) ;
end {popup} ;
false: Begin { this is a popdown}
SaveWindow(5,5,67,20,ListContents) ; { save window contents }
RestoreWindow(4,4,68,21,OldWindowPtr) ; { restore foreground }
end {popdown}
end {case};;
resource(rlse,_crt) ;
End {ListPop} ;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ ListTask }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Alt-L popup Showing lines of a file in window }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ListTask ;

const
esc = 27 ;
pgup = 73 + 128 ;
pgdn = 81 + 128 ;
uparr = 72 + 128 ;
dnarr = 80 + 128 ;
ctlpgup = 132 + 128 ;
ctlpgdn = 118 + 128 ;
ctlhome = 119 + 128 ;
ctlend = 117 + 128 ;

pagesize = 10 ;

var
i : integer ;
key : integer ; { keyboard input + 128 }
LineNr : integer ; { File line number }
LastLineNr : integer ; { Last line in file }
Nrtoshow : integer ; { Num lines to show }
result : integer ; { perverbial round can }
StrPtr : pointer ; { utility pointer }
message : string ; { utility string }
done : boolean ; { utility boolean }
textwidth : byte ; { max text to write }

begin {main}

MakeMailbox('ListMail') ; { Make a listing mailbox }

While True do Begin { repeat forever }
textwidth := lo(windmax) - lo(windmin) - 6 ;
Clrscr ;

REPEAT {until done }
resource(reserve,_CRT) ;
write('Enter Filename to List:');
resource(rlse,_CRT) ;
Readln(Message) ;
Message := 'Open '+Message ; { create Open file command }
Send('ListMail',@Message) ; { Send command to mailbox }
Receive('ListMail',strptr) ; { wait for message reply }
if integer(strptr^) = 0
then done := true
else done := false ;
UNTIL done = true ;
LineNr := 1 ;
LastLineNr := maxint ;
NrtoShow := pagesize ;
resource(reserve,_CRT) ;
clrscr ;
gotoxy((lo(windmax)-lo(windmin))shr 1-7,
(hi(windmax)-hi(windmin))shr 1) ;
writeln( '<'#24#25'>') ;
gotoxy(1,1) ;
resource(rlse,_CRT) ;

REPEAT
key := byte(readkey) ;
if key = 0 then key := 128 + byte(readkey) ;
case key of

uparr : begin
dec(LineNr,1) ;
Nrtoshow := 1 ;
end ;
dnarr : begin
inc(LineNr) ;
Nrtoshow := 1 ;
end ;
pgup : begin
dec(LineNr,pagesize) ;
Nrtoshow := pagesize ;
end ;
pgdn : begin
inc(LineNr,pagesize) ;
NrtoShow := pagesize ;
end ;
ctlPgup,
ctlHome : begin
LineNr := 1 ;
Nrtoshow := 1 ;
end ;
ctlpgdn,
ctlEnd : begin
LineNr := maxint ;
Nrtoshow := 1 ;
end ;
esc : ;
else key := 0 ;
end {case} ;

if key <> 0 then begin
if LineNr > LastLineNr then LineNr := LastLineNr - 1;
if LineNr < 1 then LineNr := 1 ;
if LineNr-1+Nrtoshow > LastLineNr then
Nrtoshow := LastLineNr-LineNr+1 ;
for i := LineNr to LineNr-1+Nrtoshow do
begin
str(i,Message) ;
Message := 'Read '+Message ;
Strptr := @Message ;
Send('ListMail',Strptr) ; { Send readfile to mailbox }
Receive('ListMail',strptr) ; { wait for message reply }
{ Strptr := FLgetNr(i) ; }
if Strptr <> nil then begin
if string(Strptr^)[1] = #26 then
val(copy(string(Strptr^),2,5),LastLineNr,result) ;
if byte(Strptr^) > textwidth { truncate string & write }
then byte(Strptr^) := textwidth ;
if string(strptr^)[length(string(strptr^))-1] = ^M
then dec(string(strptr^)[0],2) ;
resource(reserve,_crt) ;
writeln(i:3,string(Strptr^)) ;
resource(rlse,_crt) ;
end ;

if (Strptr = nil) then { an error has occured }
LastLineNr := 1 ;
end {for..} ;
end {if key..} ;
UNTIL key = esc ;
{ FLclose('test.dat') ;}
Message := 'Close sr50.pas' ;
Send('ListMail',@Message) ; { Send open file to mailbox }
Receive('ListMail',strptr) ; { wait for message reply }

End {while True} ;
End {ListTask} ;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ List Send/Receive task }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Execute commands from 'ListMail' box and send back results }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
Procedure ListCmds ;
var
Strptr : pointer ;
result : integer ;
lineNr : word ;
Cmdstr : string[5] ;

Begin

While true do begin {forever}


REPEAT
{ loop until Mailbox is created and a message is waiting }
Receive('ListMail',Strptr) ;
if Strptr = nil then yield ;
UNTIL Strptr <> nil ;


Cmdstr := copy(string(Strptr^),1,pos(' ',string(Strptr^))-1) ;
Caps(Cmdstr) ;

If Cmdstr = 'OPEN' then begin
result := FLopen(copy(string(Strptr^),6,sizeof(Filenamestr)-1)) ;
Send('ListMail',@result) ;
end {if..open} ;

If Cmdstr = 'CLOSE' then begin
FLclose(copy(string(Strptr^),7,sizeof(Filenamestr)-1)) ;
result := 0 ;
Send('ListMail',@result) ;
end {if..close} ;

If CmdStr = 'READ' then begin
{$R-} val(copy(string(Strptr^),6,5),lineNr,result) ; {$R+}
if result <>0 then Strptr := nil
else FLgetNr(lineNr,string(Strptr^)) ; { get data string or }
Send('ListMail',Strptr) ; { nil if end of file }
end {if..read} ;

end {while..forever} ;
End {ListSR} ;
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
{ Main }
{ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ}
begin {main}

{ Debug should be false to allow SR to go resident }
{ else it runs as a normal (if that's the word) task }

SR50.Debug := false ; { turn off/on debugging }
if paramstr(1) = 'debug' then SR50.Debug := true ;

writeln ;
writeln(RUTidBlk.RUTidStr, ' is active' ) ;
writeln;
writeln( ' toggles a directory list' ) ;
writeln( ' toggles a program list' ) ;
writeln;
writeln('"DEMO quit" will terminate the demonstation') ;
writeln;
writeln( ' copyright (c) 1988 Lane Ferris ' ) ;
writeln( ' The Hunters'' Helper' ) ;
writeln ;

Attr := textattr or $08 ; ; { bright clock color }

Attach(@Clock,TimerType,18,NIL,'CLOCK') ; { Add Clock as a task }

Attach(@DirTask,KeyType,AltD, { Add ShowDir task }
@DirPop,'DIRPOP') ;
Attach(@ListTask,KeyType,AltL, { Add List Display task }
@ListPop,'LISTPOP') ;
Attach(@ListCmds,TimerType,1, { Add File Read task }
NIL,'LISTCMDS') ;
StartTSR ; { jump to TSR code }
{ never to return here }
end. {main}

(**)FREEZE;NMI;(**)


  3 Responses to “Category : Pascal Source Code
Archive   : STAY50.ZIP
Filename : DEMO.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/