{$A+,B-,D+,E+,F-,I+,L+,N-,O-,R-,S-,V-}
{$M 16000,0,50000}


(*
 * SIGDOOR.PAS v1.6
 * Copyright 1991 by Michael A. Quinlan, all rights reserved.
 * Written in Turbo Pascal v5.5
 * Uses PROKIT v3.3
 * Uses Turbo Professional 5.0 (re-compiled for Turbo Pascal 5.5)
 *
 * Provide access to the diskettes on the PC-SIG CD ROM.
 *
 *)

Program SIGDOOR;

Uses
	Dos,
	TPDos,		{Turbo Professional DOS Unit}
	TPString,	{Turbo Professional String Unit}
	MiniCrt,    {BIOS-only crt functions}
	OpenShare,  {Shared text files}
	MdosIO,     {Dos-level random access files}
	BufIO,      {Buffered record i/o}
	qRead,      {Quick string qReadLn procedure}
	Tools,      {Various utilities}
	ProData,    {ProDoor/pcboard data}
	ProRoot,    {ProKit main support library}
	ProSysf,    {ProKit Status display, function keys, system functions}
	ProScan,	{ProKit File display  and colorizing}
	ProUtil,    {ProKit utility library #1}
	ProUtil2,   {proKit utility library #2}
	KitInit;    {ProKit initialization/deinit}

{$DEFINE PCB14}         {Compile for PCBoard 14.0 (otherwise 12.1)}

type textbuftp = array [0..65534] of char;
	 textbufpt = ^textbuftp;

var dodfn		: string[80];		{ Diskette Description File Filename }
	scrpath		: string[80];		{ Path to place archived diskettes into }

	textbufs	: word;				{ Buffer size for description file }
	searchpause	: word;				{ Timeout interval for keyword search }

	textbufp	: textbufpt;		{ Ptr to buffer for description file }

	SrchTable	: TPString.BTable;	{ Used by Keyword Search }

	Prep_files  : word;				{ # of files prepared for download }
	Prep_kbytes	: word;				{ # of K bytes prepared for download }
	Prep_dlmin	: word;				{ # of download minutes prepared for download }

	rom_drive	: char;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  quit_to_bbs - Terminate and return to the BBS.                  *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure quit_to_bbs;
begin
	display_file('GOODBYE');
	uninit;
	halt(0);
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  prompt_for_command - Prompt for a command to process.           *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure prompt_for_command;
begin
	disp(aWHITE);
	display_time_left;
	disp(aWHITE+'Command? ');
	get_cmdline;		{get cmdline, map to upper case}
	newline;
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  strip_trailing - remove trailing blanks from a string.          *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure strip_trailing(var s : string);
begin
	while (Length(s) > 0) and (s[Length(s)] = ' ') do
		s[0] := Chr(Length(s) - 1);
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  LongToStr - Convert a byte, integer, word, or longint to a      *)
(*              string representation.                              *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
function LongToStr(l : longint) : string;
var s : string[11];
begin
	str(l, s);
	LongToStr := s;
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  IsNumber - Returns true of the string is a number.              *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
function IsNumber(s : string) : boolean;
var i : integer;
begin
	strip_trailing(s);
	IsNumber := FALSE;
	if length(s) <> 0 then begin
		i := 1;
		while s[i] = ' ' do inc(i);
		for i := i to length(s) do
			if (s[i] < '0') or (s[i] > '9') then exit;
		IsNumber := TRUE;
	end;
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  lpad - Add blanks to the left of a string until it reaches a    *)
(*         given length.                                            *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
function lpad(s : string; n : integer; c : char) : string;
var ss : string;
begin
	ss := s;
	while length(ss) < n do ss := c + ss;
	lpad := ss;
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  rpad - Add blanks to the right of a string until it reaches a   *)
(*         given length.                                            *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
function rpad(s : string; n : integer; c : char) : string;
var ss : string;
begin
	ss := s;
	while length(ss) < n do ss := ss + c;
	rpad := ss;
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  ftime - format the time (from a file) into a date and time      *)
(*          string.                                                 *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
function ftime(ldt : longint) : string;
var dt : DateTime;
begin
	UnpackTime(ldt, dt);
	ftime := lpad(LongToStr(dt.Month), 2, '0') + '/'  +
				lpad(LongToStr(dt.Day),   2, '0') + '/'  +
				lpad(LongToStr(dt.Year),  4, '0') + '  ' +
				lpad(LongToStr(dt.Hour),  2, '0') + ':'  +
				lpad(LongToStr(dt.Min),   2, '0');
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  AllocBuf - Call DOS to allocate a buffer outside of the Turbo   *)
(*             Pascal heap. This is used as an I/O buffer, and is   *)
(*             freed as soon as the file is closed.                 *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure AllocBuf(var size : word; var pp);
var p : pointer absolute pp;
var r : registers;
begin
	r.ah := $48;					{ Allocate Memory }
	r.bx := (size + 15) div 16;		{ # of paragraphs to allocate }
	MsDos(r);						{ Have DOS allocate the memeory }
	if (r.flags and $0001) <> 0 then begin	{ request failed }
		if r.bx >= 32 then begin
			r.ah := $48;			{ Allocate Memory }
			size := r.bx * 16;		{ Remember how much we allocated }
			MsDos(r);				{ Allocate all of memory }
			if (r.flags and $0001) <> 0 then begin	{ request failed }
				make_log_entry('Warning: unable to allocate I/O buffer', TRUE);
				r.ax := 0;
				size := 0;
			end;
		end
		else begin
			make_log_entry('Warning: insufficient free memory for I/O buffer', TRUE);
			r.ax := 0;
			size := 0;
		end;
	end;
	p := Addr(Mem[r.ax:0]);
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  FreeBuf - Release a buffer allocated by AllocBuf.               *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure FreeBuf(var pp);
var p : ^char absolute pp;
var r : registers;
begin
	r.ah := $49;					{ Free Allocated Memory }
	r.es := Seg(p^);				{ Segment of block to free }
	MsDos(r);						{ Have DOS free the memeory }
	if (r.flags and 1) <> 0 then 
		make_log_entry('DEBUG: FreeMem failed: ' + LongToStr(r.ax), TRUE);
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  elapsed_time - compute the elapsed time from a given start time.*)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
function elapsed_time(start_time : real) : real;
var e : real;
begin
	e := get_time - start_time;
	if e < 0 then elapsed_time := e + (24*60*60)
	else elapsed_time := e;
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  cond_enter - ask for an ENTER at the end of the screen.         *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure cond_enter;
begin
	if (user.pagelen <> 0) then begin
		if linenum >= user.pagelen then begin
			force_enter;
			linenum := 0;
		end;
	end;
end;



(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  adjust_filename - change '#' drive letter in file names to the  *)
(*                    CD ROM drive letter.                          *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure adjust_filename(var fn : string);
begin
	if fn[1] = '#' then fn[1] := rom_drive;
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  load_params - read the SIGDOOR.CNF file to get the various      *)
(*                parameters for the program.                       *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure load_params;
var pf		: TEXT;
	line	: string[80];
	code	: integer;
begin

	{$I-} assign(pf, ParamStr(1)); {$I+}
	if IOResult <> 0 then begin
		make_log_entry('Cannot open ' + ParamStr(1), TRUE);
		quit_to_bbs;
	end;

	FileMode := 0;
	{$I-} reset(pf); {$I+}
	if IOResult <> 0 then begin
		make_log_entry(aMAGENTA+'Cannot open ' + ParamStr(1), TRUE);
		quit_to_bbs;
	end;

	ReadLn(pf);						{ Discard 1st line }

	ReadLn(pf, dodfn);				{ Line 2 = diskette descriptions file }
	strip_trailing(dodfn);

	ReadLn(pf, scrpath);			{ Line 3 = path to put archives }
	strip_trailing(scrpath);
	while scrpath[length(scrpath)] = '\' do
		delete(scrpath, length(scrpath), 1);

	ReadLn(pf, line);				{ Line 4 = buffer size }
	Val(line, textbufs, code);
	if code <> 0 then begin
		Make_Log_Entry('Invalid DOD buffer size: ' + line, TRUE);
		quit_to_bbs;
	end;
	if textbufs < 512 then textbufs := 512
	else textbufs := (textbufs div 512) * 512;

	ReadLn(pf, line);				{ Line 5 = search timeout }
	Val(line, searchpause, code);
	if code <> 0 then begin
		make_log_entry('Invalid search pause interval: ' + line, TRUE);
		quit_to_bbs;
	end;

	ReadLn(pf, line);				{ Line 6 = CD ROM Drive Letter }
	rom_drive := UpCase(line[1]);

	adjust_filename(dodfn);

	close(pf);

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  search_by_keyword - Search the diskette directory by keyword.   *)
(*                      This version (the 3rd attempt) optimizes by *)
(*                      using the Boyer-Moore string search         *)
(*                      algorithm (from Turbo Professional), AND by *)
(*                      doing high-speed block mode I/O instead of  *)
(*                      slow text I/O.  Doing the block I/O adds a  *)
(*                      number of complications to the code.        *)
(*																	*)
(*						V1.6 adds code to search for whole words	*)
(*						only, which adds further complications to	*)
(*						the code.									*)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure search_by_keyword;
var dodf		: file	;		{ Diskette Descriptions }
	keyword		: string;		{ Keyword we are looking for }
	n			: longint;		{ Number of disk blocks we have read }
	h			: longint;		{ Number of "hits" we have so far }
	start_time	: real;			{ Start time of search (or last hit) }
	blksize		: word;			{ Size of blocks for high speed I/O }
	blkoff		: word;			{ Pointer for finding our way within a block }
	blkptr		: word;			{ Pointer for finding our way within a block }
	charonline  : integer;		{ # chars on this line }
	eoffound	: boolean;		{ TRUE when EOF is found }
	wholeword	: boolean;		{ TRUE if search is for whole words only }
	wordmatched : boolean;		{ TRUE if whole word does match }
	c			: char;			{ Work character }
	cp			: ^char;		{ Work pointer to char }
	w			: string;

	(* ------------------------------------------------------------ *)
	(*                                                              *)
	(*  cleanup - make sure files are closed and the buffer is      *)
	(*            released before exiting search_by_keyword.        *)
	(*                                                              *)
	(* ------------------------------------------------------------ *)
	procedure cleanup;
	begin
		{$I-} close(dodf); {$I+}
		if IOResult <> 0 then ;
		if textbufp <> NIL then begin
			FreeBuf(textbufp);
			textbufp := NIL;
		end;
	end;

begin

	textbufp := NIL;

	{$I-} assign(dodf, dodfn); {$I+}
	if IOResult <> 0 then begin
		make_log_entry('Cannot open ' + dodfn, TRUE);
		exit;
	end;

	AllocBuf(textbufs, textbufp);
	if textbufp = NIL then begin
		make_log_entry('Cannot allocate buffer for ' + dodfn, TRUE);
		exit;
	end;

	FileMode := 0;
	{$I-} reset(dodf, 1); {$I+}
	if IOResult <> 0 then begin
		Make_log_entry('Cannot open ' + dodfn, TRUE);
		cleanup;
		exit;
	end;

	if length(cmdline) = 0 then
		get_defen('Keyword to search for:');

	if length(cmdline) = 0 then exit;

	get_nextpar;
	keyword := par;

	get_def('Search for whole word(s)?', '(Enter)=No ');
	get_nextpar;
	wholeword := (par[1] = 'Y') or (par[1] = 'W');

	if wholeword then w := 'word'
	else w := 'string';

	TPString.BMMakeTable(keyword, SrchTable);

	cond_enter;
	displn(aGREEN + 'Searching for ' + w + ' "' + keyword + '".');
	displn(aGREEN + 'This may take several minutes...');
	n := 0;
	h := 0;
	start_time := get_time;
	eoffound := FALSE;
	while not eoffound and not Eof(dodf) and not nomore and not dump_user do begin

			{ Read a block of data }

		BlockRead(dodf, textbufp^, textbufs, blksize);

			{ There is, in general, a partial line at the end of the block. }
			{ Find the line and delete it. Reposition the file so we will   }
			{ begin the next block at the start of the truncated line.		}

		eoffound := textbufs <> blksize;
		blkoff := 0;
		blkptr := blksize-1;			{ Point to last byte of buffer }
		while (blkoff < blksize) and (textbufp^[blkptr] <> #$0A) do begin
			dec(blkptr);
			inc(blkoff);
		end;
		Seek(dodf, FilePos(dodf)-blkoff);
		dec(blksize, blkoff);

		inc(n);					{ Incr # of blocks read }
		blkptr := 0;			{ Point at start of block }
		while (blkptr < blksize) and not dump_user do begin		{ Find each match }
			cp := addr(textbufp^[blkptr]);
			blkoff := TPString.BMSearchUC(cp^, blksize-blkptr, SrchTable, keyword);
			if blkoff <> $FFFF then begin		{ found a match }

					{ We found a match. If looking for a whole word, check the }
					{ bytes before and after the match for non-letters. If a   }
					{ whole word match is required but not found, position 1   }
					{ byte after the first byte of the match and continue.	   }

				inc(blkptr, blkoff);			{ Point to the match location }
				wordmatched := TRUE;

				if wholeword then begin
					if blkptr = 0 then c := ' '
					else c := UpCase(textbufp^[blkptr-1]);
					if (c >= 'A') and (c <= 'Z') then wordmatched := FALSE;
					c := UpCase(textbufp^[blkptr+length(keyword)]);
					if (c >= 'A') and (c <= 'Z') then wordmatched := FALSE;
				end;

				if not wordmatched then inc(blkptr)
				else begin
					{ We found a match. Find the start of the line containing  }
					{ the match, then display from the start to the end of the }
					{ line. Position to resume the search with the following   }
					{ line.													   }

					while (blkptr > 0) and (textbufp^[blkptr] <> #$0A) do begin
						dec(blkptr);
					end;
					if textbufp^[blkptr] = #$0A then begin		{ Skip the #$0A character }
						inc(blkptr);
					end;
					disp(aWHITE);			{ Display the line 1 byte at a time }
					charonline := 0;
					while (textbufp^[blkptr] <> #$0D) do begin
						if charonline < 79 then begin
							inc(charonline);
							disp(textbufp^[blkptr]);
						end;
						inc(blkptr);
					end;
					newline;
					if nomore or dump_user then begin
						cleanup;
						exit;
					end;
					start_time := get_time;		{ Reset timeout clock }
					inc(h);						{ Incr number of "hits" }
				end
			end
			else begin

					{ Done searching the block. Check for a timeout. }

				blksize := 0;
				if elapsed_time(start_time) >= searchpause then begin
					get_def(LongToStr(n) + ' of ' +
						LongToStr(FileSize(dodf) div (textbufs - 80) + 1) +
						' blocks processed. Continue searching?', '(Enter)=Yes ');
					get_nextpar;
					if (par[1] = 'N') or dump_user then begin
						cleanup;
						exit;
					end;
					start_time := get_time;
				end;

			end;
		end;
	end;

	if dump_user then exit;

	cond_enter;
	displn(aGREEN + 'Search completed. Found ' + LongToStr(h) + ' matches.');

	cleanup;

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  display_info - Display a file based on the command entered.     *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure display_info(menu_list : string);
var
	line : string;
	len  : integer;
	mlst : text;
begin
	Assign(mlst, menu_list);
	{$I-} Reset(mlst); {$I+}
	if ioresult <> 0 then begin
		make_log_entry(aMAGENTA + 'Cannot open ' + menu_list, TRUE);
		exit;
	end;

	len := length(par);

	while not eof(mlst) do begin
		readln(mlst, line);
		strip_trailing(line);
		if par = line then begin
			readln(mlst, line);
			strip_trailing(line);
			adjust_filename(line);
			display_file(line);
			close(mlst);
			exit;
		end;
		readln(mlst, line);
	end;

	close(mlst);

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  generalized_menu - Display a menu based on a menu file.         *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure generalized_menu(menu_file: string; menu_list : string; menu_help : string);
begin

	{ main command loop }
	repeat

		{ prompt for input only if there is not a stacked command pending }
		if length(cmdline) = 0 then
		begin
			display_file(menu_file);
			prompt_for_command;
		end;

		if dump_user then exit;		{leave menu if carrier lost}
		get_nextpar;				{scan next parameter from cmdline into par}

		{ process commands }

		if par = 'M' then exit;
		if par = 'Q' then quit_to_bbs;
		if par = '?' then display_file(menu_help)
		else display_info(menu_list);

	until dump_user;

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  category_menu - Display diskettes by category. Use the category *)
(*                  menu file.                                      *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure category_menu;
begin
	generalized_menu('CATMENU', 'CATMENU.LST', 'CATMENU.HLP');
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  list_description - Display the description for a specific       *)
(*                     diskette. Use the index file to position     *)
(*                     within the description file.                 *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure list_description(disk : string);
var dodf	   	: TEXT;
	dixf	   	: file of Longint;
	line	   	: string;
	diski	   	: word;
	disk4	   	: string[4];
	code		: integer;
	diskpos		: Longint;

	procedure cleanup;
	begin
		{$I-} close(dodf); {$I+}
		if IOResult <> 0 then ;

		{$I-} close(dixf); {$I+}
		if IOResult <> 0 then ;

		if textbufp <> NIL then begin
			FreeBuf(textbufp);
			textbufp := NIL;
		end;
	end;

begin

	textbufp := NIL;

	{$I-} assign(dodf, dodfn); {$I+}
	if IOResult <> 0 then begin
		make_log_entry('Cannot open ' + dodfn, TRUE);
		exit;
	end;

	if textbufs > 0 then begin
		AllocBuf(textbufs, textbufp);
		if textbufp <> NIL then begin
			settextbuf(dodf, textbufp^, textbufs);
		end;
	end;

	FileMode := 0;
	{$I-} reset(dodf); {$I+}
	if IOResult <> 0 then begin
		make_log_entry('Cannot open ' + dodfn, TRUE);
		cleanup;
		exit;
	end;

	{$I-} assign(dixf, 'DODINDEX.DAT'); {$I+}
	if IOResult <> 0 then begin
		make_log_entry('Cannot open DODINDEX.DAT', TRUE);
		exit;
	end;

	FileMode := 0;
	{$I-} reset(dixf); {$I+}
	if IOResult <> 0 then begin
		make_log_entry('Cannot open DODINDEX.DAT', TRUE);
		cleanup;
		exit;
	end;

	val(disk, diski, code);

	if (code <> 0) or (diski = 0) or (diski >= FileSize(dixf)) then begin
		cond_enter;
		displn(aMAGENTA+'Invalid disk number: ' + disk);
		cleanup;
		exit;
	end;

	str(diski, disk4);
	if disk4[1] = ' ' then disk4[1] := '0';
	disk4 := lpad(disk4, 4, '0');

	Seek(dixf, diski);
	Read(dixf, diskpos);

	if diskpos = -1 then begin
		cond_enter;
		displn(aMAGENTA+'There is no description for DISK' + disk4);
		cleanup;
		exit;
	end
	else begin
		if not TextSeek(dodf, diskpos) then begin
			make_log_entry('Failure seeking in file ' + dodfn, TRUE);
			cleanup;
			exit;
		end
		else begin
			while not Eof(dodf) and not dump_user do begin
				ReadLn(dodf, line);
				if line <> '' then begin
					if copy(line, 1, 4) = disk4 then begin
						repeat
							if length(line) >= 80 then line[0] := Chr(79);
							if line <> '' then displn(aWHITE + line);
							ReadLn(dodf, line);
						until Eof(dodf) or nomore or dump_user or (copy(line, 1, 4) > disk4);
						cleanup;
						exit;
					end;
				end
			end;
		end;
	end;

	cond_enter;
	displn(aMAGENTA+'Disk ' + disk4 + ' was not found.');
	cleanup;

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  list_description_prompt - prompt for a diskette number, then    *)
(*                            call list_description to display the  *)
(*                            description for that diskette.        *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure list_description_prompt;
begin

	if length(cmdline) = 0 then
		get_defen('Disk number:');

	if length(cmdline) = 0 then exit;

	get_nextpar;
	list_description(par);

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  search_dod_menu - Implement the Search Descriptions menu.       *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure search_dod_menu;
begin

	newline;

	{ main command loop }
	repeat

		{ prompt for input only if there is not a stacked command pending }
		if length(cmdline) = 0 then
		begin
			display_file('SRCHMENU');
			prompt_for_command;
		end;

		if dump_user then exit;		{leave menu if carrier lost}
		get_nextpar;				{scan next parameter from cmdline into par}

		{ process commands }

		case par[1] of
			'S': begin
					search_by_keyword;
					wait_for_enter;
				  end;
			'L': begin
					category_menu;
				 	wait_for_enter;
				  end;
			'D': begin
					list_description_prompt;
				 	wait_for_enter;
				  end;

			'?': display_file('SRCHMENU.HLP');

			'M': exit;
			'Q': quit_to_bbs;

			else begin
				 end;
		end;

	until dump_user;

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  sig_path - Find the path for a diskette, given a diskette       *)
(*             number. Scan the LIBDEF file to find the path.       *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
function sig_path(disk : integer) : string;
var p : string[80];
	n	: integer;
	f	: TEXT;
begin

	{$I-} assign(f, 'LIBDEF'); {$I+}
	if IOResult <> 0 then begin
		make_log_entry('Unable to open LIBDEF', TRUE);
		quit_to_bbs;
	end;

	FileMode := 0;
	{$I-} reset(f); {$I+}
	if IOResult <> 0 then begin
		make_log_entry('Unable to open LIBDEF', TRUE);
		quit_to_bbs;
	end;

	while not eof(f) do begin
		{$I-} ReadLn(f, n, p); {$I+}
		if IOResult = 0 then begin
			if disk <= n then begin
				while (length(p) > 0) and (p[1] = ' ') do delete(p, 1, 1);
				stoupper(p);
				adjust_filename(p);
				sig_path := p + LongToStr(disk);
				close(f);
				exit;
			end;
		end;
	end;

	close(f);
	sig_path := '';

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  show_file_info - display file size and estimated download time. *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure show_file_info(file_sz : LongInt);
var	dl_min	: Integer;
begin
	dl_min  := (file_sz div topcps) div 60 + 1;
	displn(aYELLOW + Lpad(LongToStr(file_sz), 6, ' ') + ' bytes, approx. ' +
		Lpad(LongToStr(dl_min), 3, ' ') + ' minutes to download at ' +
		baudrate + 'bps');
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  prepare_diskette - Make an archive of the contents of a diskette*)
(*                     so the user can download it.                 *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure prepare_diskette(disk : string);
var fname	: string[80];
	diski	: word;
	code	: integer;
	s		: SearchRec;
	dstname	: string[80];
	srcname	: string[80];
begin

	val(disk, diski, code);

	if (code <> 0) or (diski = 0) then begin
		cond_enter;
		displn(aMAGENTA+'Invalid disk number: ' + disk);
		exit;
	end;

	fname  := 'DISK' + lpad(LongToStr(diski), 4, '0') + '.ZIP';

	dstname := scrpath + '\' + fname;
	if dos_exists(dstname) then begin
		newline;
		cond_enter;
		displn(aYELLOW + 'This diskette is already available as ' + fname);
		make_log_entry(fname + ' is already prepared', FALSE);
		cond_enter;
		show_file_info(file_size(dstname));
		exit;
	end;

	srcname := sig_path(diski);
	if srcname = '' then begin
		make_log_entry('Cannot locate ' + fname, TRUE);
		exit;
	end;

	srcname := srcname + '\' + fname;
	FindFirst(srcname, 0, s);
	if DosError <> 0 then begin
		make_log_entry('Cannot locate ' + srcname, TRUE);
		exit;
	end;

	clear_screen;
	cond_enter;
	displn(aGREEN + 'Copying the file...');
	SwapVectors;
	code := ExecDos('COPY ' + srcname + ' ' + dstname, TRUE, NIL);
	SwapVectors;
	clear_screen;

	FindFirst(dstname, 0, s);
	if (code <> 0) or (DosError <> 0) then begin
		make_log_entry('"COPY ' + srcname + ' ' + dstname + '" failed.', TRUE);
		exit;
	end;

	newline;
	cond_enter;
	displn(aYELLOW + 'Download the diskette as file ' + fname);
	make_log_entry(fname + ' copied to ' + dstname, FALSE);
	cond_enter;
	show_file_info(file_size(dstname));
	force_enter;

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  prepare_diskette_prompt - prompt for a diskette number, then    *)
(*                            call prepare_diskette to prepare the  *)
(*                            diskette for downloading.             *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure prepare_diskette_prompt;
begin

	if length(cmdline) = 0 then
		get_defen('Disk number:');

	if length(cmdline) = 0 then exit;

	get_nextpar;
	prepare_diskette(par);

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  display_info_menu - Display PC-SIG information, from the \INFO  *)
(*                      subdirectory on the CD ROM.                 *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure display_info_menu;
begin
	generalized_menu('INFOMENU', 'INFOMENU.LST', 'INFOMENU.HLP');
end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  list_prepared_diskettes - display all DISKnnnn files.           *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure list_prepared_diskettes;
var path : string[80];
	s    : SearchRec;
begin
	path := scrpath + '\DISK*.ZIP';

	FindFirst(path, 0, s);
	if DosError <> 0 then begin
		displn(aYELLOW + 'No prepared diskettes found.');
		exit;
	end;

	newline;
	cond_enter;
	displn(aGREEN + 'Prepared Diskettes');
	newline;
	while (DosError = 0) and not dump_user and not nomore do begin
		disp(aYELLOW + '  ' + rpad(s.name,12, ' ') + ' ');
		show_file_info(s.size);
		FindNext(s);
	end;

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  Main_Menu - Process the main menu.                              *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
procedure Main_Menu;
begin

	{ main command loop }
	repeat

		{ prompt for input only if there is not a stacked command pending }
		if length(cmdline) = 0 then
		begin
			display_file('MAINMENU');
			prompt_for_command;
		end;

		if dump_user then exit;		{leave menu if carrier lost}
		get_nextpar;				{scan next parameter from cmdline into par}

		{ process commands }
		case par[1] of
			'V': display_info_menu;
			'S': search_dod_menu;
			'P': prepare_diskette_prompt;
			'L': list_prepared_diskettes;
			'?': display_file('MAINMENU.HLP');

			'Q': exit;
			else begin
				 end;
		end;

	until dump_user;

end;


(* ---------------------------------------------------------------- *)
(*                                                                  *)
(*  Main Program - Initialize, do the main menu, then terminate.    *)
(*                                                                  *)
(* ---------------------------------------------------------------- *)
begin		{main block}
	init;

	load_color_constants('PROCOLOR');
	load_params;

	Prep_files  := 0;
	Prep_kbytes := 0;
	Prep_dlmin  := 0;

	progname := 'SIGDOOR';

	display_file('WELCOME');

	Main_Menu;

	display_file('GOODBYE');

	uninit;
end.