Category : Pascal Source Code
Archive   : INSTDEMO.ZIP
Filename : INSTDEMO.PAS

 
Output of file : INSTDEMO.PAS contained in archive : INSTDEMO.ZIP
{INSTDEMO.PAS -- a demonstration installation program. It prompts the user
for a source drive and a target drive:\directory. It performs SOME tests and
copies all the files from the source drive root directory to the target path.
There are still ways for the user to screw this up, but not many. This com-
piles successfully under Turbo Pascal 6.0 and ought to compile under QuickPas
cal also. Good Luck}

PROGRAM instdemo;
{$M 3000,0,0} {Limit heap use so child process can run!}

USES Crt, Dos;

CONST allfiles = '\*.*';
userstop = 'INSTDEMO halted by user. TEST not installed!';

VAR
source,target,cmd : string;
errnum : Integer;
ch : Char;


FUNCTION Upstr(inp : string) : string;

VAR
i : integer;


BEGIN

FOR i := 1 TO Length(inp) DO inp[i] := Upcase(inp[i]);
Upstr := inp;
END; {Upstr}

PROCEDURE userquits;
BEGIN
Window(1,1,80,25);
ClrScr;
Writeln(userstop);
Halt(1);

END; {userquits}


PROCEDURE GetInput(var indrive,outdrive : String);

VAR ind,outd : String;

BEGIN

ClrScr;
Window(10,4,80,8);
REPEAT
ClrScr;
ind := '';
Write('ENTER SOURCE DRIVE "Q" alone Quits: ');
Readln(ind);
Delete(ind,2,Length(ind) - 1); {Get drive letter uppercase}
ind := Upstr(ind);
UNTIL (ind = 'A') OR (ind = 'B') OR (ind = 'Q');
IF ind = 'Q' THEN userquits
ELSE ind := ind + ':';
indrive := ind;
Writeln;
Writeln('Default Drive/Directory is C:\INSTTEST');
Writeln('Enter your own or Press ENTER to accept the default.');
Write(' "Q" Quits. Enter choice: ');
Readln(outd);
outd := UpStr(outd);
IF outd = 'Q' THEN userquits
ELSE IF outd = '' THEN outd := 'C:\INSTTEST'
ELSE IF Copy(outd,Length(outd),1) = '\' THEN
outd := Copy(outd,1,Length(outd) - 1);
outdrive := outd;
END; {GetInput}

PROCEDURE MakeDirectory;

BEGIN
Window(1,1,80,25);
ClrScr;
Writeln(' Please insert the program diskette in ', source );
Write(' Press a Key when ready....');
ch := ReadKey;
{$I-} ChDir(target); {$I+} {Attempt to change to target. If success}
errnum := IOResult; {warn the user it already exists!}
Writeln;
IF errnum = 0 THEN BEGIN
Write(target, ' already exists. Use anyway? "Y" is yes, anything else quits: ');
ch := ReadKey;
IF UpCase(ch) <> 'Y' THEN userquits
ELSE exit;
END;

Writeln;
Writeln('Creating directory ',target);
{$I-} MkDir(target); {$I+}
errnum := IOResult;
IF errnum <> 0 THEN BEGIN
Writeln('Error making directory ', target);
Writeln('Press a key to exit and try again...');
ch := Readkey;
ClrScr;
userquits;
END;
END; {MakeDirectory}

PROCEDURE WriteFiles;

BEGIN
Writeln('Copying files: ',source + allfiles,
' to ', target);
SwapVectors; {Remove TP interrupt handlers}
cmd := '/C COPY ' + source + allfiles + ' ' + target;
Exec(GetEnv('COMSPEC'),cmd);
SwapVectors; {Restore TP interrupt handlers}
IF DosError <> 0 THEN BEGIN
Writeln('Copy unsuccessful or incomplete!');
Halt(1);
END
ELSE BEGIN
ClrScr;
Writeln;
Writeln('Installation successful! The TEST files have been copied to ',target);
Writeln(' Press a Key to end.....');
ch := ReadKey;
ClrScr;
END;
END;


BEGIN
source := ''; {Initialize all string values to ''}
target := '';
cmd := '';
ClrScr;
Writeln('Welcome to the TEST Installation program. This program will prompt you for');
Writeln('the source and target drives for installing TEST''s files. It will offer a ');
Writeln('default directory "INSTTEST" to be created on the specified targer drive or');
Writeln('you can name the directory yourself. Please press a key to continue.....');
ch := ReadKey;
GetInput(source,target);
MakeDirectory;
WriteFiles;
END.









  3 Responses to “Category : Pascal Source Code
Archive   : INSTDEMO.ZIP
Filename : INSTDEMO.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/