home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / utility / tdir92.zip / TDIR.PAS < prev   
Pascal/Delphi Source File  |  1992-03-05  |  63KB  |  1,494 lines
  1. {$M 16384,8192,327680}
  2. program TDir;
  3.  
  4. USES DOS;
  5.  
  6. { ──────────────────────────────────────────────────────────────── }
  7. { Name:        TDir.pas -> Tdir.exe                                }
  8. { Version:     0.92                                                }
  9. { Date:        December 23, 1990                                   }
  10. { Rev Date:    March 3, 1992                                       }
  11. { Purpose:     Interactive Tree Directory & text file browser      }
  12. { Compiler:    Turbo Pascal 6.00                                   }
  13. { Hardware:    XT,AT,386,486 or PS/2                               }
  14. { Video:       CGA,MDA,Herc,EGA or VGA                             }
  15. { Video Modes: 2, 3 or 7                                           }
  16. { By:          J. Rockford Cogar                                   }
  17. { Address:     119 Oklahoma Avenue Oak Ridge, TN 37830             }
  18. { Rights:      FREEWARE. Use this program any way you want.        }
  19. { ──────────────────────────────────────────────────────────────── }
  20.  
  21. { ────────────────────────── Constants ──────────────────────────────────────────────────── }
  22. CONST
  23.   { -------------------- Typed Constants ------------------------------------------------------------------------ }
  24.   PMLOC       : string[21] = 'File Manager Name is:';
  25.   FileManager : string[65] = 'c:\UTIL\CO.COM';
  26.   WRITEERROR  : string[11] = 'Write Error';
  27.   OPENERROR   : string[10] = 'Open Error';
  28.   NOFILE      : string[14] = 'File Not Found';
  29.   READERROR   : string[10] = 'Read Error';
  30.   RAMERROR    : string[14] = 'Not Enough RAM';
  31.   NORMAL      : string[1]  = ' ';
  32.   WRONGVIDEO  : string[14] = 'Text mode only';
  33.   SEARCHING   : string[9]  = 'Searching';
  34.   SPROMPT     : string[5]  = 'Find:';
  35.   WRIT        : string[16] = 'Turbo Pascal 6.0';
  36.   LINEPR      : string[15] = 'Reading Record:';
  37.   STAT1       : string[65] = 'Row: 0    Col:                     Left Column: 0   Right Column:';
  38.   STAT2       : string[77] = 'TreeDir 0.92            Up = |   Down = |   Left = -   Right = -   Exit = Esc';
  39.   STAT3       : string[69] = 'By: J. Rockford Cogar   Help = F1  Save File = F2  String Search = F9';
  40.   HELP1       : string[31] = 'Ctrl PgUp = Move to Top of File';
  41.   HELP2       : string[31] = 'Ctrl PgDn = Move to End of File';
  42.   HELP3       : string[32] = 'F8        = Repeat String Search';
  43.   HELP4       : string[22] = 'F2        = Print File' ;
  44.   HELP5       : string[45] = 'RETURN    = Jump to the selected Subdirectory';
  45.   HELP6       : string[70] = 'F4        = Run the File Manager (CO.COM) on the selected Subdirectory';
  46.   HELP8       : string[59] = 'J. Rockford Cogar, 119 Oklahoma Avenue, Oak Ridge, TN 37830.';
  47.   PROGNAME    : string[66] = 'TreeDir 0.92  (3/4/92) Shows File Storage on a Subdirectory Basis.';
  48.   PROGBY      : string[48] = 'By: J. Rockford Cogar, Oak Ridge TN USA  3/4/92';
  49.   PROMPT1     : string[23] = 'Processing Directory: \';
  50.   PROMPT2     : string[28] = 'Subdirectory   Storage in KB';
  51.   F1STR       : string[2]  = 'F1';
  52.   F2STR       : string[2]  = 'F2';
  53.   F9STR       : string[2]  = 'F9';
  54.   ESCSTR      : string[3]  = 'Esc';
  55.   { -------------------- Untyped Constants --------------------------------------------------------------------- }
  56.   carry        = 1;
  57.   directory    = $10;  { directory attribute }
  58.   NumberDirs   = 1024; { 1024 records should be enough room for directory data }
  59.   ActiveCol    = 23;   { output column during 'explore' }
  60.   SIDEJUMP     = 20;   { columns to scroll sideways }
  61.   SEARLEN      = 20;   { number of bytes in a search string }
  62.   NORMALEXIT   = 0;    { normal exit code to DOS }
  63.   ERROREXIT    = 1;    { error exit code to DOS }
  64.   VIDEOEXIT    = 2;    { wrong video EXIT }
  65.   CHANGEDEXIT  = 3;    { CHDIR Exit }
  66.   NUMBLINES    = 4096; { max number of allowed lines  }
  67.   TEXTCOLOR    = 31;   { color to show normal text in }
  68.   HELPCOLOR    = 30;   { color to show Help text in   }
  69.   STATUSCOLOR  = 49;   { command/status color         }
  70.   CTRCOLOR     = 63;   { color to show counters in }
  71.   BLINKCOLOR   = 207;  { blinking color }
  72.   FINDCOLOR    = 95;   { color of found strings }
  73.   BARCOLOR     = 79;   { bounce bar color }
  74.   DIRCOLOR     = 14;   { DIR Name color }
  75.   PAGESIZE     = 21;   { pageup/pagedown line lengths }
  76.   COL_LOC      = 15;   { location of column index }
  77.   ROW_LOC      = 5;    { location of row index }
  78.   _ESC         = 1;    { Esc scan code }
  79.   _PGUP        = 73;   { Page Up key }
  80.   _PGDN        = 81;   { Page DN key }
  81.   _UPAR        = 72;   { Up arrow key }
  82.   _DNAR        = 80;   { down arrow key }
  83.   _CTRLF5      = 98;   { ctrl f5 key }
  84.   _F8          = 66;   { f8 key. repeat string search }
  85.   _F9          = 67;   { F9 key. string search }
  86.   _F1          = 59;   { F1 key. help key }
  87.   _F2          = 60;   { F2 key. save buffers to disk }
  88.   _F3          = 61;   { F3 Key. Print buffers }
  89.   _F4          = 62;   { Run CO.COM }
  90.   _RIAR        = 77;   { right arrow key }
  91.   _LEAR        = 75;   { left arraow key }
  92.   _HOME        = 71;   { Home key }
  93.   _END         = 79;   { End key }
  94.   _CTRL_PGUP   = 132;  { control pageup }
  95.   _CTRL_PGDN   = 118;  { control pageup }
  96.   _DEL         = 83;   { delete key }
  97.   _BKSPC       = 14;   { backspace key }
  98.   _INSERT      = 82;   { insert key }
  99.   _RET         = 28;   { return key. jump to selected DIR }
  100.   _X           = 45;   { X key }
  101.   LEFTMAX      = 175;  { greatest allowed left edge of the display }
  102.   X1_          = 0;    { corners locations for the TreeDir explore screen }
  103.   X2_          = 79;
  104.   Y1_          = 8;
  105.   Y2_          = Y1_ + 5;
  106.   XWIDE_       = X2_ - X1_ - 4;
  107.   SCLRLEN_     = XWIDE_ - ActiveCol;
  108.   FILEMODE     = 1;  { running as a text file browser }
  109.   TREEDIRMODE  = 2;  { use a TreeDir }
  110. { ────────────────────────── Constants ──────────────────────────────────────────────────── }
  111.  
  112. { ────────────────────────── Data Types ──────────────────────────────────────────────────── }
  113. TYPE
  114.   BUFF_TYPE   = string[254];     { the type that a buffer line is }
  115.   BUFFER_PTR  = ^BUFF_TYPE;      { pointer to a 254 byte string }
  116.   SEARCH_TYPE = string[SEARLEN]; { string of a specified length for string search uses }
  117.   STRING128   = string[128];     { filename string type. (command line params can be this long) }
  118.  
  119.   fname = array[1..80] of char;
  120.   str80 = string[80];            { generic string }
  121.  
  122.   DTransA_ = record
  123.          filler    : array[1..21] of byte;
  124.          attribute : byte;
  125.          file_time : word;
  126.          file_date : word;
  127.          file_size : array[1..2] of word;
  128.          file_name : fname;
  129.          end;
  130.  
  131.   SubDir_ = record
  132.           Size  : longint;    { bytes in the subdir           4 }
  133.           Index : integer;    { index of the previous record  2 }
  134.           Level : integer;    { depth in the tree             2 }
  135.           Name  : string[13]; { name of a subdirectory       13 }
  136.          end;                 { Total bytes:                 21 }
  137.  
  138. { ────────────────────────── Data Types ──────────────────────────────────────────────────── }
  139.  
  140. { ────────────────────────── Global Data ──────────────────────────────────────────────────── }
  141. VAR
  142.   acty        : integer;                            { row being edited                 }
  143.   actx        : integer;                            { column being edited              }
  144.   curx        : integer;                            { cursor column                    }
  145.   cury        : integer;                            { cursor row                       }
  146.   linestr     : SEARCH_TYPE;                        { processed search string          }
  147.   iname       : STRING128;                          { filename var                     }
  148.   buffer      : array [0..NUMBLINES] of BUFFER_PTR; { pointers to 4096 strings         }
  149.   cpybuff     : array [0..NUMBLINES] of BUFFER_PTR; { pointers to 4096 strings         }
  150.   max         : integer;                            { loop stop point                  }
  151.   key         : integer;                            { keyboard scan code value         }
  152.   refresh     : boolean;                            { refresh the screen               }
  153.   star        : integer;                            { first text line to display       }
  154.   row         : integer;                            { row to display                   }
  155.   left        : integer;                            { left edge of screen              }
  156.   find        : integer;                            { set to -1 if no string was found }
  157.   actbuff     : BUFF_TYPE;                          { buffer of line being edited      }
  158.   asc         : byte;                               { ascii key code                   }
  159.   raw         : integer;                            { raw key code                     }
  160.   SubDir      : array[0..NumberDirs] of SubDir_;    { array of recs to store dir info in }
  161.   filestorage : longint;                            { temp var to store bytes in a subdir }
  162.   pattern     : string[70];                         { directory search pattern }
  163.   sdir        : str80;                              { scaler string for filenames }
  164.   OldDir      : str80;                              { current subdirectory at startup }
  165.   fir         : integer;                            { index for subdirectories }
  166.   CurDir      : str80;                              { explore time current directory }
  167.   by          : byte;                               { generic byte }
  168.   level       : integer;                            { level in the dir tree }
  169.   prev        : integer;                            { previous subdirectory index }
  170.   next        : integer;                            { next subdirectory index }
  171.   curr        : integer;                            { current subdirectory index }
  172.   ostr        : str80;                              { final output string }
  173.   spstr       : str80;                              { string of space chars }
  174.   maxlen      : integer;                            { max filename length }
  175.   maxlevel    : integer;                            { max level reached }
  176.   padlen      : integer;                            { numb spaces to padd with }
  177.   maxsize     : longint;                            { largest amount storage in a dir }
  178.   CurNumbLen  : integer;                            { length of the current number string }
  179.   NumbPad     : integer;                            { length of the largest number string }
  180.   vmode       : byte;                               { video mode at startup }
  181.   color       : integer;                            { text color }
  182.   clrstr      : str80;                              { clear string }
  183.   curtype     : integer;                            { cursor size }
  184.   SysMode     : byte;                               { 'FileMode' or 'TreeDirMode' }
  185.   GlobalDrvStr : string[3];                         { specified drive string ie: 'c:' }
  186. { ────────────────────────── Global Data ──────────────────────────────────────────────────── }
  187.  
  188. { ---- link in assembly language functions (faster & smaller than using standard libraries) ---- }
  189. procedure snowputc(col, row, color, outch, numb: word); external;
  190. procedure cursorxy(col, row: byte); external;
  191. function  getscode: integer; external;
  192. procedure puts(strg :string); external;
  193. function  getvmode: integer; external;
  194. function  readkbd: integer; external;
  195. function  cgets(VAR strg : SEARCH_TYPE): integer; external;
  196. procedure snowwrite(col, row: integer; color: byte; ptr: buffer_ptr; soff, maxchars, clrchar: integer); external;
  197. {$L conio.obj }  { assemble CONIO.ASM (with Turbo Assembler) to make CONIO.OBJ }
  198.  
  199. { a proc to write a screen width string. (saves 19 bytes per call) }
  200. { ─────────────────────────────────────────────────────────────────────────── }
  201. procedure snow(col, row: integer; color: byte; ptr: buffer_ptr);
  202. begin
  203.  snowwrite(col, row, color, ptr, 0, 80, 80);
  204. end;
  205. { ─────────────────────────────────────────────────────────────────────────── }
  206.  
  207. { changes the display attributes for a specified section the CRT whether it is a CGA, MDA or EGA type display }
  208. { ─────────────────────────────────────────────────────────────────────────── }
  209. procedure PutAttr(col, row: integer; color: byte; wide: integer);
  210. begin
  211.  ASM
  212.         push    ds                      { save data seg }
  213.         cld                             { clear direction flag }
  214.         sub     ax,ax                   { zero out AX }
  215.         mov     es,ax                   { put zero in for extra segment }
  216.         mov     al,es:[0449h]           { offset of 449h is needed }
  217.         cmp     al,7                    { is value in al 7 ? }
  218.         je      @mdacattr               { if 7 then its monochrome }
  219.         mov     ax,0b800h               { if not then use CGA for base address }
  220.         jmp     @asgncatt               { goto assign: label }
  221. @mdacattr:                              { label: where MDA address is put in AX }
  222.         mov     ax,0b000h               { MDA adapter }
  223. @asgncatt:                              { label: where extra seg is assigned }
  224.         mov     es,ax                   { point to address in video buffer }
  225.         mov     bl,byte ptr color       { get the attribute }
  226.         mov     cx,word ptr col         { column address }
  227.         mov     ax,word ptr row         { row address }
  228.         mov     dx,160                  { bytes per line in CGA }
  229.         mul     dx                      { 160 * row number }
  230.         add     ax,cx                   { add column number to offset in CGA buffer }
  231.         add     ax,cx                   { add column number to offset in CGA: again }
  232.         mov     di,ax                   { put address in CGA into DI }
  233.         inc     di                      { offset by one byte to the ATTRIBUTE }
  234.         mov     cx,word ptr wide        { get the count of chars to write }
  235.         mov     ax,es                   { refetch extra seg address }
  236.         cmp     ax,0b800h               { is it MDA or CGA ? }
  237.         mov     al,bl                   { put in an attribute byte in AL (one time !) }
  238. @mcattr:                                { top of for loop }
  239.         stosb                           { move the number of attributes }
  240.         inc     di                      { skip to next attribute (not character) }
  241.         loop    @mcattr                 { end of for loop }
  242.         pop     ds                      { restore data seg }
  243.  end;
  244.  
  245. end;
  246. { ─────────────────────────────────────────────────────────────────────────── }
  247.  
  248. { init global data }
  249. { ─────────────────────────────────────────────────────────────────────────── }
  250. procedure init;
  251. begin { procedure init() }
  252.   fillchar(SubDir,sizeof(SubDir_) * NumberDirs, #0);
  253.   SubDir[0].Name:='ROOT'#0;
  254.   pattern:='*.*'#0;
  255.   fillchar(clrstr[1],79 - ActiveCol,' ');
  256.   clrstr[0]:=chr(79 - ActiveCol);
  257.  
  258.    ASM
  259.      xor ax,ax              { zero a register }
  260.      mov word ptr level,ax  { zero out: level }
  261.      mov word ptr prev,ax   { zero out: prev  }
  262.      mov word ptr next,ax   { zero out: next  }
  263.      mov word ptr curr,ax   { zero out: curr  }
  264.      mov word ptr fir,ax    { zero out: fir   }
  265.    end;
  266.  
  267.  end; { procedure init() }
  268. { ─────────────────────────────────────────────────────────────────────────── }
  269.  
  270. { Get Cursor type }
  271. { ─────────────────────────────────────────────────────────────────────────── }
  272. function GetCurType: integer;
  273. VAR
  274.   retv: integer;
  275. begin
  276. ASM
  277.   mov ah,03h               { read cursor position function }
  278.   mov bh,00h               { video page zero               }
  279.   int 10h                  { call VIDEO BIOS               }
  280.   mov word ptr retv,cx     { copy to a temp VAR            }
  281.  end;
  282.  GetCurType:=retv;
  283. end;
  284. { ─────────────────────────────────────────────────────────────────────────── }
  285.  
  286. { Set Cursor type }
  287. { ─────────────────────────────────────────────────────────────────────────── }
  288. procedure SetCurType(ctype: integer);
  289. begin
  290.  ASM
  291.   mov ah,01h             { set cursor type function }
  292.   mov cx,word ptr ctype  { fetch cursor type        }
  293.   int 10h                { call VIDEO BIOS          }
  294.  end;
  295. end;
  296. { ─────────────────────────────────────────────────────────────────────────── }
  297.  
  298. { initialize the video }
  299. { ─────────────────────────────────────────────────────────────────────────── }
  300. procedure VideoInit;
  301. begin
  302.   curtype:=GetCurType; { get the current cursor type }
  303. end;
  304. { ─────────────────────────────────────────────────────────────────────────── }
  305.  
  306. { 'make' a long string of spaces have 'numb' length }
  307. { ─────────────────────────────────────────────────────────────────────────── }
  308. procedure padstr(numb : integer; VAR ostr : str80);
  309. begin
  310.   if (numb < 0) then exit;   { range check      }
  311.   if (numb > 0) then fillchar(ostr,numb + 1,' ');
  312.   ostr[0]:=chr(numb);        { init length byte }
  313. end;
  314. { ─────────────────────────────────────────────────────────────────────────── }
  315.  
  316. { get the current directory string. Without the volume letter }
  317. { ─────────────────────────────────────────────────────────────────────────── }
  318. function GetCurDir(VAR DirStr : str80): integer;
  319. VAR
  320.   rg : registers;
  321.   i  : integer;
  322. begin { function GetCurDir() }
  323.  
  324.   rg.dx := 0;              { get current directory. use default drive }
  325.   rg.ds := seg(DirStr[1]);
  326.   rg.si := ofs(DirStr[1]);
  327.   rg.ax := $4700;
  328.   msdos(rg);
  329.  
  330.   i:=0;
  331.  
  332.   while (DirStr[i+1] <> #0) do inc(i);  { calc 'C' string length }
  333.  
  334.   DirStr[0]:=chr(i); { insert the string length }
  335.   GetCurDir:=i;      { ret string length        }
  336. end;                 { function GetCurDir       }
  337. { ─────────────────────────────────────────────────────────────────────────── }
  338.  
  339. { convert a 'C' string into a Turbo Pascal string }
  340. { ─────────────────────────────────────────────────────────────────────────── }
  341. function BuildString(VAR instr: fname; size : integer) : str80;
  342. VAR
  343.  i      : integer;  { loop index    }
  344.  outstr : str80;    { output string }
  345. begin
  346.   i := 1;     { start at offset of 1 }
  347.  
  348.   while (instr[i] <> #0) and (i <= size) do
  349.     begin
  350.       outstr[i]:=instr[i];  { copy the byte }
  351.       Inc(i);               { inc the loop counter }
  352.     end;
  353.  
  354.   outstr[0]:=chr(i - 1);   { set the length byte }
  355.   BuildString := outstr;   { 'return' the result }
  356. end;
  357. { ─────────────────────────────────────────────────────────────────────────── }
  358.  
  359. { explore all directories on this volume. fill the record(s) SubDir[] with data for all subdirectories }
  360. { ─────────────────────────────────────────────────────────────────────────── }
  361. procedure explore;
  362. VAR
  363.    DTransA    : DTransA_;               { data transfer record        }
  364.    Regs       : registers;              { standard interrupt 'union'  }
  365.    SubDirStr  : string[70];             { current subdirectory string }
  366.    dta_save   : array[1..2] of integer; { DTA address                 }
  367.    LowWord    : word;                   { low word of the file size   }
  368.    HighWord   : word;                   { high word of the file size  }
  369.    fbytes     : longint;                { bytes in a subdirectory     }
  370. { ─────────────────────────────────────────────────────────────────────────── }
  371. begin
  372.  
  373.    with Regs,DTransA do
  374.      begin
  375.       ax := $2F00;          { get DTA }
  376.       msdos(Dos.Registers(Regs));
  377.       dta_save[1] := es;
  378.       dta_save[2] := bx;
  379.       ax := $1A00;          { set DTA }
  380.       ds := seg(DTransA);
  381.       dx := ofs(DTransA);
  382.       msdos(Regs);
  383.       ds := seg(pattern[1]);
  384.       dx := ofs(pattern[1]);
  385.       ax := $4E00;          { find 1st file }
  386.       cx := $FF;
  387.       msdos(Regs);
  388.  
  389.       while (flags and carry) = 0 do          { loop through everything }
  390.         begin
  391.          SubDirStr:= BuildString(file_name, sizeof(file_name) );
  392.  
  393.          if ((attribute and directory) <> 0) and (SubDirStr <> '.') and ( SubDirStr <> '..') then
  394.           begin  { -------------- if the filename has a directory attribute -------------- }
  395.             SubDirStr := SubDirStr+chr(0);  { makes the string 'extra long' }
  396.             ax := $3B00;    { CHDIR }
  397.             ds := seg(SubDirStr[1]);
  398.             dx := ofs(SubDirStr[1]);
  399.             msdos(Regs);     { drop down into that directory }
  400.             inc(fir);
  401.             inc(level);
  402.  
  403.             prev:=curr;               { save this subdir index       }
  404.             curr:=next + 1;           { bump down to the next subdir }
  405.             SubDir[curr].Index:=prev; { save index for later }
  406.             next:=curr;
  407.             SubDir[curr].Level:=Level; { save tree level }
  408.  
  409.             if (curr > NumberDirs) then exit; { range check }
  410.  
  411.             SubDir[curr].Name:=SubDirStr;   { setup to update the status line }
  412.             LowWord:=GetCurDir(CurDir);
  413.             snowwrite(ActiveCol + 2, Y1_ + 4, DIRCOLOR, addr(CurDir),  0, SCLRLEN_, SCLRLEN_);
  414.  
  415.             explore;  { call this proc to dig down into the next subdir }
  416.  
  417.             ax := $3B00;    { back up to parent subdir }
  418.             SubDirStr := '..'#0;
  419.             ds := seg(SubDirStr[1]);
  420.             dx := ofs(SubDirStr[1]);
  421.             msdos(Regs);
  422.  
  423.             LowWord:=GetCurDir(CurDir);
  424.             if (CurDir[0] = #0) then CurDir:='ROOT';
  425.             snowwrite(ActiveCol + 2, Y1_ + 4, DIRCOLOR, addr(CurDir),  0, SCLRLEN_, SCLRLEN_);
  426.  
  427.             dec(level);  { we are now one level higher }
  428.             curr:=prev;  { set index to the previous subdir }
  429.             prev:=SubDir[curr].Index
  430.  
  431.            end   { -------------- if the filename has a directory attribute -------------- }
  432.          else
  433.            begin { -------------- For regular filenames  -------------- }
  434.             LowWord:= file_size[1];
  435.             HighWord:= file_size[2];
  436.  
  437.             fbytes:=(HighWord * 65536) + LowWord;
  438.  
  439.             if (GetCurDir(CurDir) > 0) then  { not root dir }
  440.               begin
  441.                 SubDir[curr].Size:= SubDir[curr].Size + fbytes; { sum used storage }
  442.               end
  443.             else                             { root dir     }
  444.               begin
  445.                 SubDir[0].Size:= SubDir[0].Size + fbytes; { sum used storage }
  446.               end;
  447.  
  448.             end;  { -------------- For regular filenames  -------------- }
  449.  
  450.          ax := $4F00;       { get next file }
  451.          msdos(Regs);
  452.         end;                { end of the WHILE loop }
  453.  
  454.       ax := $1A00;          { reset DTA }
  455.       ds := dta_save[1];
  456.       dx := dta_save[2];
  457.       msdos(Regs);
  458.  
  459.      end;             { end of the WITH block }
  460.  
  461. end;
  462. { ─────────────────────────────────────────────────────────────────────────── }
  463.  
  464. { setup a different heap error handler }
  465. { ------------------------- Begin HeapFunc --------------------------------------- }
  466. {$F+} function HeapFunc(Size: word): integer; {$F-}
  467. begin
  468.   HeapFunc:=1;
  469. end;
  470. { ------------------------- End HeapFunc   --------------------------------------- }
  471.  
  472. { ------------------------- Begin AdjustCursor  --------------------------------------- }
  473. procedure AdjustCursor;
  474. begin
  475.  cursorxy(curx,cury);  { move the cursor }
  476. end;
  477. { ------------------------- End   AdjustCursor  --------------------------------------- }
  478.  
  479. { ------------------------- Begin ShowColRow --------------------------------------- }
  480. procedure ShowColRow;
  481. Var
  482.  dstr : string[17];
  483. begin
  484.   str(acty,dstr);      { convert row index to string }
  485.   snowwrite(ROW_LOC,0,CTRCOLOR,addr(dstr),0,5,5);
  486.   str(actx,dstr);      { convert column index to string }
  487.   snowwrite(COL_LOC,0,CTRCOLOR,addr(dstr),0,5,5);
  488. end;
  489. { ------------------------- End   ShowColRow --------------------------------------- }
  490.  
  491. { clear the screen, write exit msg & go to DOS }
  492. { ------------------------- Begin ExiToDos --------------------------------------- }
  493. procedure ExitToDos(ret :integer; msg: string);
  494. begin
  495.  
  496.   if (ret <> VIDEOEXIT) then
  497.     begin
  498.      snowputc(0,0,color,32,2000);    { clear the screen }
  499.     end;
  500.  
  501.   cursorxy(0,0);                         { home the cursor  }
  502.   if (ret <> NORMALEXIT) then puts(msg); { display exit msg }
  503.   halt(ret);                             { return an errorlevel code }
  504. end;
  505. { ------------------------- End ExitToDos   --------------------------------------- }
  506.  
  507. { this draws the help screen }
  508. { ------------------------- Begin Help --------------------------------------- }
  509. procedure help;
  510.  VAR
  511.   ky : integer;  { dummy var for readkbd() }
  512. begin
  513.   { all messages are global typed constants }
  514.   snowputc(0,1,color,32,1760);                  { clear the data area }
  515.  
  516.   snow(0, 1,  color,addr(PROGNAME)); { program Name    }
  517.   snow(0, 4,  color,addr(HELP1));    { Help message #1 }
  518.   snow(0, 6,  color,addr(HELP2));    { Help message #2 }
  519.   snow(0, 8,  color,addr(HELP3));    { Help message #3 }
  520.   snow(0, 10, color,addr(HELP4));    { Help message #4 }
  521.   snow(0, 12, color,addr(HELP5));    { Help message #5 }
  522.   snow(0, 14, color,addr(HELP6));    { Help message #6 }
  523.   snow(0, 21,color,addr(HELP8));     { Help message #7 }
  524.  
  525.   refresh:=TRUE;  { redraw screen later }
  526.   ky:=readkbd;    { pause for a scan code from kbd }
  527. end;
  528. { ------------------------- End Help   --------------------------------------- }
  529.  
  530. { backwards POS(). return the offset into STRING str of CHAR ch. ret -1 if not found }
  531. { ------------------------- Begin rpos   --------------------------------------- }
  532. function rpos(str: string; ch: char): integer;
  533. Var  i:   integer;  { loop index }
  534.      loc: integer;  { location of the find }
  535. begin
  536.   i:=length(str); { string length   }
  537.   loc:=-1;        { assume failure! }
  538.  
  539.   { ---------------------- search loop ------------------------------- }
  540.   while (i > 0) and (loc = -1) do  { loop backwards through the string }
  541.     begin
  542.  
  543.       if (str[i] = ch) then  { got a match }
  544.         begin
  545.           loc:=i;  { save the index of the location }
  546.         end;
  547.  
  548.       dec(i);  { look one byte leftwards }
  549.     end;
  550.   { ---------------------- search loop ------------------------------- }
  551.  
  552.   rpos:=loc;  { the location of the find. -1 if no find }
  553. end;
  554. { ------------------------- End rpos   --------------------------------------- }
  555.  
  556. { this draws the screen for the text file browser }
  557. { ------------------------- begin video_setup --------------------------------------- }
  558. procedure Video_Setup;
  559.  Var
  560.    vmode: integer;  { current video mode }
  561. begin
  562.   vmode:=getvmode;  { get current video mode }
  563.   color:=TEXTCOLOR; { set a default color }
  564.  
  565.   if (vmode < 2) or (vmode > 7) or (vmode = 4) or (vmode = 5) or (vmode = 6) then
  566.     begin
  567.       ExitToDos(VIDEOEXIT,WRONGVIDEO);
  568.     end;
  569.  
  570.  if (vmode = 7) then  { get the color of the screen }
  571.    begin
  572.      color:= integer(mem[$b000:0001]);
  573.    end
  574.  else
  575.    begin
  576.      color:= integer(mem[$b800:0001]);
  577.    end;
  578.  
  579. end;
  580. { ------------------------- End   video_setup --------------------------------------- }
  581.  
  582. { draw the main interactive screen }
  583. { ─────────────────────────────────────────────────────────────────────────── }
  584. procedure DrawScreen;
  585. begin
  586.   snowputc(0,1,color,32,1760);                  { clear the screen  }
  587.   snow(0, 0,STATUSCOLOR,addr(STAT1));  { status message #1 }
  588.   snowputc(0,23,STATUSCOLOR,32,20);
  589.   snow(0,23,STATUSCOLOR,addr(STAT2));  { status message #2 }
  590.   snowputc(29,23,CTRCOLOR,24,1);          { ascii  24 up    }
  591.   snowputc(40,23,CTRCOLOR,25,1);          { ascii  25 down  }
  592.   snowputc(51,23,CTRCOLOR,27,1);          { ascii  27 left  }
  593.   snowputc(63,23,CTRCOLOR,26,1);          { ascii  26 right }
  594.   snowwrite(74,23,CTRCOLOR,addr(ESCSTR),0,3,3);
  595.   snowputc(0,24,STATUSCOLOR,32,20);
  596.   snow(0,24,STATUSCOLOR,addr(STAT3));  { status message #3 }
  597.   snowwrite(31,24,CTRCOLOR,addr(F1STR),0,2,2);
  598.   snowwrite(47,24,CTRCOLOR,addr(F2STR),0,2,2);
  599.   snowwrite(67,24,CTRCOLOR,addr(F9STR),0,2,2);
  600.   cursorxy(0,1);  { home the cursor }
  601. end;
  602. { ─────────────────────────────────────────────────────────────────────────── }
  603.  
  604. { this initializes a filename variable }
  605. { ------------------------- begin   Set_Filename --------------------------------------- }
  606. function Set_Filename(VAR ifname: STRING128): integer;
  607. Var
  608.  dotloc : integer;   { location of the dot in the filename }
  609.  retv   : integer;   { bool: TRUE if there was a cmd line param, else FALSE }
  610.  tempstr: STRING128; { generic temp string }
  611. begin
  612.  
  613.     retv:=0;
  614.  
  615.     if (paramcount > 0) then                               { if there were cmd line params }
  616.       begin
  617.         tempstr:=paramstr(1);                              { fetch com line parameter #1 }
  618.  
  619.         if (tempstr[1] = '-') and (tempstr[2] = 'f') then  { test for '-f<name>' syntax }
  620.           begin
  621.             retv:=length(tempstr) - 2;                     { string length less one }
  622.             tempstr:=copy(tempstr,3,retv);                 { reset string without the '-f' prefix }
  623.  
  624.             if (length(tempstr) > 0) then                  { if the string is still valid }
  625.               begin
  626.                 retv:=1;                                   { we will run in browse mode }
  627.                 ifname:=tempstr;                           { set name of file to browse }
  628.               end;
  629.  
  630.           end;
  631.       end;
  632.  
  633.   Set_Filename:=retv;
  634. end;
  635. { ------------------------- End   Set_Filename --------------------------------------- }
  636.  
  637. { this reads the file from disk into global variable: buffer[] }
  638. { ------------------------- Begin Read_File --------------------------------------- }
  639. function Read_File(ifname: string): integer;
  640. Var
  641.   inf     : text;       { file pointer               }
  642.   strg    : string;     { scaler string var          }
  643.   line    : integer;    { line index                 }
  644.   len     : integer;    { line length                }
  645.   linestr : string[20]; { str to show current line # }
  646. begin
  647.    line:= 0;       { zero line counter }
  648.  
  649.    assign(inf,ifname);
  650.    {$I-} reset(inf); {$I+}
  651.    if (IOResult <> 0) then ExitToDos(ERROREXIT,NOFILE);  { no file. exit }
  652.    snowwrite(24,12,color,addr(LINEPR),0,15,15);  { status msg }
  653.  
  654.    { ------- write the root of the filename on the CRT ------ }
  655.    if (length(ifname) < 19) then
  656.      begin
  657.        snowwrite(0,23,STATUSCOLOR,addr(ifname),0,19,19);  { write the filename on the screen }
  658.      end
  659.    else  { a complex filename is being processed }
  660.      begin
  661.        len:=rpos(ifname,'\');              { get offset into string of '\' }
  662.        linestr:=copy(ifname, len + 1, 19); { copy just the root into linestr }
  663.        snowwrite(0,23,STATUSCOLOR,addr(linestr),0,19,19);  { write the filename on the screen }
  664.      end;
  665.  
  666.    { ---- Read lines from file Loop ---- }
  667.    while NOT EOF(inf) and (line < NUMBLINES) and (MaxAvail > 1024) do
  668.      begin
  669.        {$I-}
  670.        readln(inf,strg);              { read a line from the file }
  671.        {$I+}
  672.  
  673.        if (IOResult <> 0) then  { read error }
  674.          begin
  675.            close(inf);
  676.            ExitToDos(ERROREXIT,READERROR);  { Read error. exit }
  677.          end;
  678.  
  679.        len:=length(strg) + 1;         { get line length }
  680.        getmem(buffer[line], len);     { get heap RAM for the array line }
  681.  
  682.        if (buffer[line] = NIL) then { if getmem() failed }
  683.          begin
  684.            close(inf);
  685.            ExitToDos(ERROREXIT,RAMERROR);
  686.          end;
  687.  
  688.        move(strg,buffer[line]^,len);  { copy the scaler string to the array }
  689.  
  690.        if ( (line mod 64) = 0) then  { every 64 lines update count on the CRT }
  691.          begin
  692.            str(line,linestr);             { convert line index to string }
  693.            snowwrite(40,12,color,addr(linestr),0,6,6);
  694.          end;
  695.  
  696.        inc(line); { inc the line counter }
  697.      end;  { while end }
  698.  
  699.    close(inf);
  700.  
  701. { strg:=' ';  reinit to a known state }
  702.  
  703.    { ----------- padd lines for very short text files ---------------- }
  704.    while (line <= PAGESIZE) do
  705.      begin
  706.        getmem(buffer[line], 3);    { get heap RAM for the ' ' empty array lines }
  707.        move(strg,buffer[line]^,3); { copy the scaler string to the array }
  708.        inc(line);                  { inc the line counter }
  709.      end;
  710.    { ----------- padd lines for very short text files ---------------- }
  711.  
  712.    snowputc(0,10,color,32,240);  { clear out the counter area of the CRT }
  713.  
  714.    Read_File:=line - 1;  { ret the #of lines read }
  715. end;
  716. { ------------------------- End   Read_File --------------------------------------- }
  717.  
  718. { this displays the text data on the CRT }
  719. { ------------------------- Begin Write_Data --------------------------------------- }
  720. procedure Write_Data(star, left, find: integer);
  721. Var
  722.   starstr:   string[34]; { counter display string  }
  723.   line   :   integer;    { data buffer index       }
  724.   row    :   integer;    { CRT row index           }
  725.   lstop  :   integer;    { loop stop point         }
  726.   tcolor :   integer;    { color to write the text }
  727. begin
  728.   { note: buffer[] is a global variable }
  729.  
  730.   ShowColRow;  { display active row & column indices }
  731.   str(left,starstr);      { left edge column }
  732.   snowwrite(48,0,CTRCOLOR,addr(starstr),0,3,3);
  733.   str(left + 79,starstr);  { Right edge column }
  734.   snowwrite(66,0,CTRCOLOR,addr(starstr),0,3,3);
  735.   row:=1;                 { first line to write text to }
  736.   lstop:=star + PAGESIZE; { set loop stop point         }
  737.  
  738.   for line:=star to lstop do
  739.     begin
  740.  
  741.       if (find > -1) and (line = find) then tcolor:=FINDCOLOR  { select correct color }
  742.         else tcolor:=color;
  743.  
  744.       if (line <= max) then snowwrite(0,row,tcolor,addr(buffer[line]^),left,80,80);  { write the text to the CRT }
  745.       inc(row);  { next CRT row }
  746.     end;
  747.  
  748. end;
  749. { ------------------------- End   Write_Data --------------------------------------- }
  750.  
  751. { this writes the file to disk from the global variable: buffer[] }
  752. { ------------------------- Begin Write_File --------------------------------------- }
  753. procedure Write_File(ifname: string);
  754. Var
  755.   inf  : text;    { file pointer        }
  756.   line : integer; { line index          }
  757.   len  : integer; { length of text line }
  758.   strg : string;  { scaler string var   }
  759.   key  : char;
  760. begin
  761.    line:= 0;      { zero line counter   }
  762.    assign(inf,ifname);
  763.  
  764.    {$I-} rewrite(inf); {$I+}
  765.    if (IOResult <> 0) then ExitToDos(ERROREXIT,OPENERROR);  { open() err. exit }
  766.  
  767.    { ---- Write lines to file Loop ---- }
  768.    while (line <= max) do
  769.      begin
  770.        len:=length(buffer[line]^) + 1;   { get number of bytes to copy       }
  771.        move(buffer[line]^,strg,len);     { copy a line to the scaler string  }
  772.  
  773.        {$I-}
  774.        writeln(inf, strg );  { write a line to the file }
  775.        {$I+}
  776.  
  777.        if (IOResult <> 0) then  { write error }
  778.          begin
  779.            close(inf);
  780.            ExitToDos(ERROREXIT,WRITEERROR);  { write error. exit }
  781.          end;
  782.  
  783.        inc(line); { inc the line counter }
  784.      end;  { while end }
  785.  
  786.    close(inf);
  787.  
  788. end;
  789. { ------------------------- End   Write_File --------------------------------------- }
  790.  
  791. { this does the string search. (case sensitive) }
  792. { ------------------------- Begin Search --------------------------------------- }
  793. function search(start, max : integer; sstr: string) : integer;
  794.  VAR
  795.    i : integer;  { loop index                }
  796.    ok: byte;     { position of the substring }
  797. begin
  798.    { note: buffer[] is a global variable }
  799.  
  800.    ok:=0;     { assume failure   }
  801.    i:=start;  { loop start point }
  802.  
  803.    { search through the buffer for the string }
  804.    while (ok = 0) and (i <= max) do
  805.      begin
  806.        ok:=pos(sstr, buffer[i]^);  { search the text line }
  807.        inc(i);                     { point to the next text line }
  808.      end;
  809.  
  810.    if (i <= (max + 1) ) and (ok > 0) then
  811.      begin
  812.        search:=i - 1;  { return line of the find }
  813.      end
  814.    else
  815.      begin
  816.        search:=-1;  { no find }
  817.      end;
  818.  
  819. end;
  820. { ------------------------- End Search   --------------------------------------- }
  821.  
  822. { prompt user for string to search, then do the search }
  823. { ------------------------- Begin String_Search  --------------------------------------- }
  824. function String_Search(key: integer; VAR refresh: boolean; VAR star: integer): integer;
  825. Var
  826.   off_set   : integer;     { offset in start of string search }
  827.   len       : integer;     { line length                      }
  828.   lfind     : integer;     { line of the search find          }
  829.   searchstr : SEARCH_TYPE; { ascii search string              }
  830. begin
  831.   { linestr is a global variable }
  832.  
  833.   if (key <> _F8) then
  834.     begin
  835.       cursorxy(6,24);                                    { home the cursor }
  836.       snowwrite(0,24,STATUSCOLOR,addr(SPROMPT),0,20,20); { write prompt    }
  837.       searchstr[0]:=#14;                                 { max numb bytes of input }
  838.       len:=cgets(searchstr);                             { get string from the user }
  839.       AdjustCursor;
  840.       linestr:=copy(searchstr,2,len);                    { copy the useful data to another string }
  841.       off_set:=0;                                        { start search on the current line }
  842.     end
  843.   else
  844.     begin
  845.       off_set:=1; { start search on line below current one }
  846.     end;
  847.  
  848.   snowwrite(0,24,BLINKCOLOR,addr(SEARCHING),0,20,20);  { searching msg }
  849.   len:=search(star + off_set,max,linestr);
  850.  
  851.   if (len > -1) then  { if string was found }
  852.     begin
  853.       refresh:=TRUE;                                          { set to refresh the data on the CRT }
  854.       star:=len;                                              { first line to display }
  855.       lfind:=len;                                             { line of the find }
  856.       if (lfind < 0) then lfind:=0;                           { range check find }
  857.       if (star > (max - PAGESIZE)) then star:=max - PAGESIZE; { last page case for starting line }
  858.     end
  859.   else
  860.     begin
  861.       lfind:=-1;  { no string was found }
  862.     end;
  863.  
  864.   snowputc(0,24,STATUSCOLOR,32,20);
  865.   snow(20,24,STATUSCOLOR,addr(STAT3));  { status message #3 }
  866.  
  867.   String_Search:=lfind;  { return the line number of the search find }
  868. end;
  869. { ------------------------- End   String_Search  --------------------------------------- }
  870.  
  871. { ------------------------- Begin Init_Globals  --------------------------------------- }
  872. procedure Init_Globals;
  873. begin
  874.    HeapError:=@HeapFunc; { set up our own getmem() error handler }
  875.    find:=-1;             { no find yet                           }
  876.  
  877.    ASM                       { doing this in ASM saves 4 bytes per VAR }
  878.      mov ax,1                { init a register to 1      }
  879.      mov word ptr cury,ax    { cursor row                }
  880.      mov word ptr actx,ax    { column being edited       }
  881.      xor ax,ax               { zero a register           }
  882.      mov word ptr curx,ax    { cursor column             }
  883.      mov word ptr acty,ax    { row being edited          }
  884.      mov word ptr left,ax    { initial left edge is zero }
  885.      mov word ptr star,ax    { start at first line       }
  886.      mov word ptr key,ax     { init scan code to zero    }
  887.      mov byte ptr refresh,al { no refresh yet            }
  888.   end;
  889.  
  890. end;
  891. { ------------------------- End   Init_Globals  --------------------------------------- }
  892.  
  893. { ─────────────────────────────────────────────────────────────────────────── }
  894. Procedure TreeDirScreen;
  895. VAR
  896.   y: integer;
  897. begin
  898.   snowputc(0,0,color,32,2000);    { clear the screen }
  899.  
  900.   snowputc(X1_ + 1, Y1_,     color, 196, 78);
  901.   snowputc(X1_ + 1, Y1_ + 3, color, 196, 78);
  902.   snowputc(X1_ + 1, Y2_,     color, 196, 78);
  903.  
  904.   for y:=Y1_ + 1  to Y2_ - 1 do
  905.     begin
  906.       snowputc(X1_, y, color, 179, 1);
  907.       snowputc(X2_, y, color, 179, 1);
  908.     end;
  909.  
  910.   snowputc(X1_, Y1_,     color, 218, 1);
  911.   snowputc(X1_, Y1_ + 3, color, 195, 1);
  912.   snowputc(X1_, Y2_,     color, 192, 1);
  913.  
  914.   snowputc(X2_, Y1_,     color, 191, 1);
  915.   snowputc(X2_, Y1_ + 3, color, 180, 1);
  916.   snowputc(X2_, Y2_,     color, 217, 1);
  917.  
  918. end;
  919. { ─────────────────────────────────────────────────────────────────────────── }
  920.  
  921. { Fill the buffers with Tree Directory Data }
  922. { ─────────────────────────────────────────────────────────────────────────── }
  923. function TreeDir: integer;
  924. VAR
  925.   linectr: integer; { count of lines going into the buffers   }
  926.   stlen  : integer; { length of a line going into the buffers }
  927.   DrvStr : STRING128; { string to hold the disk drive string  }
  928. begin
  929.   init;       { initialize global data }
  930.   VideoInit;  { initialize the video   }
  931.   linectr:=0; { zero the buffer index  }
  932.  
  933.   snowwrite(X1_ + 2, Y1_ + 1, color, addr(PROGNAME), 0, XWIDE_, XWIDE_);
  934.   snowwrite(X1_ + 2, Y1_ + 2, color, addr(PROGBY),   0, XWIDE_, XWIDE_);
  935.   snowwrite(X1_ + 2, Y1_ + 4, color, addr(PROMPT1),  0, XWIDE_, XWIDE_);
  936.   snowputc(ActiveCol + 1, Y1_ + 4, color - 1, ord('\'), 1);
  937.  
  938.   getdir(0,OldDir);  { save the current directory }
  939.  
  940.   if (SysMode = TREEDIRMODE) and (paramcount > 0) then  { if there was a parameter string }
  941.    begin
  942.     DrvStr:=paramstr(1);
  943.  
  944.     if ( DrvStr[2] = ':') then  { the expected value }
  945.      begin
  946.       DrvStr[0]:=#2;            { force length to 2 bytes }
  947.       GlobalDrvStr:=DrvStr;     { copy to the global var  }
  948.      end
  949.     else                        { unexpected value }
  950.      begin
  951.       DrvStr[0]:=#0;            { force length to NO bytes }
  952.       GlobalDrvStr[0]:=#0;      { make it a nil string     }
  953.      end;
  954.  
  955.     if (DrvStr[0] = #2) then chdir( DrvStr ); { change to the specifed directory }
  956.    end;
  957.  
  958.   chdir('\');        { switch to the root directory }
  959.  
  960.   SetCurType($3800);   { off the cursor }
  961.   explore;             { explore all directories on the current volume }
  962.   SetCurType(curtype); { restore the cursor }
  963.  
  964.   chdir(OldDir);  { restore the old directory }
  965.   maxsize:=0;
  966.  
  967.    ASM
  968.      xor ax,ax                { zero a register    }
  969.      mov word ptr prev,ax     { zero out: prev     }
  970.      mov word ptr maxlevel,ax { zero out: maxlevel }
  971.      mov word ptr maxlen,ax   { zero out: maxlen   }
  972.    end;
  973.  
  974.   for fir:=0 to next do  { find max level and name length }
  975.     begin
  976.       if (SubDir[fir].Level > maxlevel) then maxlevel:=SubDir[fir].Level;
  977.       if (length(SubDir[fir].Name) > maxlen) then maxlen:=length(SubDir[fir].Name);
  978.       if (SubDir[fir].Size > maxsize) then maxsize:=SubDir[fir].Size;
  979.     end;
  980.  
  981.   maxsize:=maxsize div 1024;
  982.   str(maxsize, pattern);         { int to string }
  983.   NumbPad:=length(pattern) + 1;  { length of the largest number string }
  984.  
  985.   stlen:=length(PROMPT2) + 1;           { get line length }
  986.   getmem(buffer[linectr], stlen);       { get heap RAM for the array line }
  987.   move(PROMPT2,buffer[linectr]^,stlen); { copy the scaler string to the array }
  988.   Inc(linectr);                         { add to count of lines in the buffer }
  989.  
  990.   fillchar(clrstr[1],29,#196);          { make a divider bar }
  991.   clrstr[0]:=#28;
  992.   stlen:=29;                            { get line length }
  993.   getmem(buffer[linectr], stlen);       { get heap RAM for the array line }
  994.   move(clrstr,buffer[linectr]^,stlen);  { copy the scaler string to the array }
  995.   Inc(linectr);                         { add to count of lines in the buffer }
  996.  
  997.   for fir:=0 to next do                           { loop through the whole list }
  998.     begin
  999.       ostr[0]:=#0;
  1000.       filestorage:= SubDir[fir].Size div 1024;    { bytes to KiloBytes }
  1001.       padstr(SubDir[fir].Level * 2, ostr);        { init string to 'level' spaces Times 2 }
  1002.       sdir:=SubDir[fir].Name;                     { copy name to a scaler }
  1003.       by:=byte(sdir[0]);                          { adjust for trailing }
  1004.       sdir[0]:=chr(by - 1);                       { nulls }
  1005.       ostr:= ostr + '\' + sdir;                   { add the filename }
  1006.  
  1007.       str(filestorage,pattern);                   { int to string }
  1008.       CurNumbLen:=length(pattern);                { length of the current number string }
  1009.  
  1010.       padlen:= (maxlen + (2 * maxlevel)) - length(ostr); { calc pad length }
  1011.       padlen:=padlen + (NumbPad - CurNumbLen);    { to right justify the numbers }
  1012.  
  1013.       padstr(padlen,spstr);                       { build a pad string }
  1014.       ostr:=ostr + spstr;                         { add the pad string }
  1015.  
  1016.       ostr:=ostr + pattern;                       { add number string }
  1017.  
  1018.       stlen:=length(ostr) + 1;                    { get line length }
  1019.       getmem(buffer[linectr], stlen);             { get heap RAM for the array line }
  1020.  
  1021.       if (buffer[linectr] = NIL) then             { if getmem() failed }
  1022.         begin
  1023.           ExitToDos(ERROREXIT,RAMERROR);
  1024.         end;
  1025.  
  1026.       move(ostr,buffer[linectr]^,stlen);          { copy the scaler string to the array }
  1027.  
  1028.       Inc(linectr);                               { add to count of lines in the buffer }
  1029.     end;                                          { loop end }
  1030.  
  1031.   TreeDir:=linectr - 1;                           { return the number of lines put in the buffers }
  1032. end;
  1033. { ─────────────────────────────────────────────────────────────────────────── }
  1034.  
  1035. { crude String Copy: just copy until a space char is found in the source string }
  1036. { ─────────────────────────────────────────────────────────────────────────── }
  1037. Procedure CopyTilSpace(VAR Dest, Sou : STRING128; Fir, Max : integer );
  1038. VAR
  1039.  idx, kdx : integer; { string index }
  1040. begin
  1041.  idx:=1;
  1042.  kdx:=Fir;
  1043.  
  1044.  while ( Sou[kdx] > ' ') and (idx <= Max) do
  1045.   begin
  1046.    Dest[idx]:=Sou[kdx];
  1047.    inc(idx);
  1048.    inc(kdx);
  1049.   end;
  1050.  
  1051.  Dest[0]:=chr(idx - 1);
  1052. end;
  1053. { ─────────────────────────────────────────────────────────────────────────── }
  1054.  
  1055. { build a pascal string of the selected dir. it's harder than you might think! }
  1056. { ─────────────────────────────────────────────────────────────────────────── }
  1057. procedure GetSelectedDir( idx : integer; VAR SelDir : STRING128 );
  1058. VAR
  1059.  Subs  : array[1..5] of STRING128; { array of subdir level strings }
  1060.  Loc   : integer;                  { index of '\'                  }
  1061.  Level : integer;                  { depth in tree                 }
  1062.  NewLoc : integer;                 { new location of '\'           }
  1063. begin
  1064.  Level:=1;                                             { start subdir index }
  1065.  Subs[1]:=#0; Subs[2]:=#0; Subs[3]:=#0; Subs[4]:=#0; Subs[5]:=#0;
  1066.  SelDir[0]:=#0;                                        { init to indicate failure }
  1067.  Loc:=pos('\', buffer[idx]^ );                         { get index of '\'   }
  1068.  if ( Loc > 15 ) or (Loc < 3) then exit;               { limit checking }
  1069.  
  1070.  while ( Loc > 3 ) do                                  { loop 'leftward' }
  1071.   begin
  1072.    CopyTilSpace( Subs[Level], buffer[idx]^, Loc, 12 ); { copy the dir name }
  1073.    inc(Level);                                         { bump subdir array index }
  1074.    NewLoc:=Loc;                                        { copy location index }
  1075.  
  1076.    while (NewLoc >= Loc) do                            { loop while no difference }
  1077.     begin
  1078.      dec(idx);                                         { search previous subdir }
  1079.      NewLoc:=pos('\', buffer[idx]^ );                  { get index of '\'   }
  1080.     end;
  1081.    Loc:=Loc - 2;                                       { now go left two bytes }
  1082.   end;
  1083.  
  1084.  if (Loc = 3) then                                     { now at level 1 subdir }
  1085.   begin
  1086.    CopyTilSpace( SelDir, buffer[idx]^ , 3, 12 );       { copy level 1 name }
  1087.    dec(Level);                                         { adjust index to last USED }
  1088.  
  1089.    while (Level >= 1) do                               { loop to concatenate }
  1090.    begin
  1091.     SelDir:=SelDir + Subs[Level];                      { the subdir names }
  1092.     dec(Level);                                        { into one string }
  1093.    end;
  1094.   end;
  1095.  
  1096. end;                                                   { end proc }
  1097. { ─────────────────────────────────────────────────────────────────────────── }
  1098.  
  1099. { recalc bytes used in the subdir that was just processed by CO.COM }
  1100. { ─────────────────────────────────────────────────────────────────────────── }
  1101. Procedure UpdateDirLine( VAR DirLine : STRING128 );
  1102. VAR
  1103.  DirInfo  : SearchRec;                                 { record for DIR search code }
  1104.  ByteSum  : longint;                                   { storage in the DIR }
  1105.  KStr     : string[34];                                { new size KBytes in string }
  1106.  idx, kdx : integer;                                   { string indices }
  1107. begin
  1108.  ByteSum:=0;
  1109.  FindFirst( '*.*', AnyFile, DirInfo );                 { start the DIR *.* }
  1110.  
  1111.  while ( DosError = 0 ) do                             { loop til no more files }
  1112.   begin
  1113.    ByteSum:=ByteSum + DirInfo.Size;                    { add this one's size }
  1114.    FindNext( DirInfo );                                { next file }
  1115.   end;
  1116.  
  1117.  ByteSum:=ByteSum DIV 1024;                            { convert to KBytes }
  1118.  str( ByteSum, KStr );                                 { convert to string }
  1119.  idx:=length( DirLine );                               { current line length }
  1120.  
  1121.  while ( DirLine[idx] > ' ' ) AND ( idx > 0 ) do       { loop to space out the old number }
  1122.   begin
  1123.    DirLine[idx]:=' ';                                  { make a space char }
  1124.    dec( idx );                                         { next left }
  1125.   end;
  1126.  
  1127.  idx:=length( KStr );                                  { current size length }
  1128.  kdx:=length( DirLine );                               { current line length };
  1129.  
  1130.  while (idx > 0) do                                    { loop leftwards }
  1131.   begin
  1132.    DirLine[kdx]:=KStr[idx];                            { copy from end of new number to dirline }
  1133.    dec( idx );                                         { dec both indices }
  1134.    dec( kdx );
  1135.   end;
  1136. end;                                                   { end proc   }
  1137. { ─────────────────────────────────────────────────────────────────────────── }
  1138.  
  1139. { call CO.COM to work on the selected DIR }
  1140. { ─────────────────────────────────────────────────────────────────────────── }
  1141. Procedure ExecFileManager( acty : integer );
  1142. VAR
  1143.  SelDir : STRING128;               { buffer for selected DIR }
  1144.  OldDir : STRING128;               { save of current DIR     }
  1145.  curloc : array[1..2] of integer;  { cursor save buffers     }
  1146.  ErrStr : STRING128;               { error string            }
  1147.  FullDir : STRING128;
  1148. begin
  1149.  GetSelectedDir( acty, SelDir );                    { build a pascal string of the selected dir }
  1150.  
  1151.  if ( SelDir[0] > #0) then                          { if a valid dir name was generated }
  1152.   begin
  1153.  
  1154.    if ( GlobalDrvStr[0] = #2 ) then { A drive was specified }
  1155.     begin
  1156.      FullDir:=SelDir;
  1157.      SelDir:=GlobalDrvStr;
  1158.      SelDir:=SelDir + FullDir;
  1159.     end;
  1160.  
  1161.    getdir( 0, OldDir);                              { save the current directory }
  1162.    chdir( SelDir );                                 { change to new DIR }
  1163.    exec( FileManager, '');                          { call CO.COM }
  1164.  
  1165.    if (DosError <> 0) then                          { if there was an exec() error }
  1166.     begin
  1167.      ErrStr:='EXEC() Error:';                       { root of error string }
  1168.      snowwrite(0,1,CTRCOLOR,addr(ErrStr),0,80,80);  { where is sprintf() ??? }
  1169.      str( DosError, ErrStr);                        { convert error code to string }
  1170.      snowwrite(14,1,CTRCOLOR,addr(ErrStr),0,63,63); { write rest of error string }
  1171.      raw:=getscode;                                 { pause }
  1172.     end;
  1173.  
  1174.    UpdateDirLine( buffer[acty]^ );                  { recalc bytes used in the subdir }
  1175.    chdir( OldDir );                                 { restore the current directory }
  1176.    curloc[1]:=cury;                                 { save cursor position }
  1177.    curloc[2]:=curx;
  1178.    DrawScreen;                                      { draw the main screen }
  1179.    cury:=curloc[1];                                 { restore cursor position }
  1180.    curx:=curloc[2];
  1181.    AdjustCursor;                                    { reset the cursor location }
  1182.    refresh:=TRUE;                                   { redisplay the DIR List }
  1183.   end;                                              { end valid DIR string if block }
  1184. end;                                                { end proc   }
  1185. { ─────────────────────────────────────────────────────────────────────────── }
  1186.  
  1187. { Exit into the selected DIR }
  1188. { ─────────────────────────────────────────────────────────────────────────── }
  1189. Procedure ExitToSelect( acty : integer );
  1190. VAR
  1191.  SelDir  : STRING128;
  1192.  ExitMsg : STRING128;
  1193.  FullDir : STRING128;
  1194. begin
  1195.  GetSelectedDir( acty, SelDir ); { build a pascal string of the selected dir }
  1196.  
  1197.  if ( SelDir[0] > #0) then
  1198.   begin
  1199.  
  1200.    if ( GlobalDrvStr[0] = #0 ) then { no drive was specified }
  1201.     begin
  1202.      chdir( SelDir );
  1203.     end
  1204.    else                             { a cmd line drive was specified. use it! }
  1205.     begin
  1206.      FullDir:=GlobalDrvStr;
  1207.      FullDir:=FullDir + SelDir;
  1208.      chdir( FullDir );
  1209.      SelDir:=FullDir;
  1210.     end;
  1211.  
  1212.    ExitMsg:='Changed to Subdirectory: ' + SelDir;
  1213.    ExitToDos( CHANGEDEXIT, ExitMsg );
  1214.   end;
  1215. end;                                                { end proc   }
  1216. { ─────────────────────────────────────────────────────────────────────────── }
  1217.  
  1218. { ------------------------- Begin Main (ie: main loop proc) ------------------ }
  1219. begin
  1220.    Init_Globals;              { initialize global variables }
  1221.    Video_Setup;               { set screen mode }
  1222.  
  1223.    left:=Set_Filename(iname); { initialize the filename variable (iname) }
  1224.  
  1225.    if (left > 0) then         { if there was a cmd line parameter, assume it was a filename, the load it }
  1226.      begin
  1227.        DrawScreen;            { draw the main screen }
  1228.        max:=Read_File(iname); { read the file from disk into buffer[] }
  1229.        SysMode:=FILEMODE;     { running as a text file browser }
  1230.      end
  1231.    else
  1232.      begin
  1233.        SysMode:=TREEDIRMODE;
  1234.        TreeDirScreen; { draw box on the screen }
  1235.        max:=TreeDir;  { call the Tree Directory Code. put report in the buffer }
  1236.        left:=0;       { reset left ctr to zero }
  1237.        DrawScreen;    { draw the main screen }
  1238.      end;
  1239.  
  1240.    Write_Data(0, 0, -1);  { write data to the CRT }
  1241.    PutAttr(0, 1, BARCOLOR, 80);
  1242.  
  1243.   { ------------------------------ Main Loop --------------------------------- }
  1244.    while (key <> _ESC) AND (key <> _X) do  { loop till the Esc key is pressed }
  1245.      begin
  1246.        raw:=getscode;    { get current key codes      }
  1247.        key:=hi(raw);     { extract the scan key code  }
  1248.        asc:=byte(raw);   { extract the ascii key code }
  1249.  
  1250.        { -------------------------- Case Block ---------------------------- }
  1251.        case (key) of  { begin case }
  1252.             _PGUP:   { PageUp key }
  1253.                      begin
  1254.                        star:=star - PAGESIZE;
  1255.                        acty:=acty - PAGESIZE;
  1256.  
  1257.                        if (star < 0) then
  1258.                          begin
  1259.                            star:=0;
  1260.                            acty:=0;
  1261.                            cury:=1;
  1262.                            AdjustCursor;
  1263.                          end;
  1264.  
  1265.                      refresh:=TRUE;
  1266.                      ShowColRow;
  1267.                      end;
  1268.             _PGDN:   { PageDown key }
  1269.                      begin
  1270.                        star:=star + PAGESIZE;
  1271.                        acty:=acty + PAGESIZE;
  1272.  
  1273.                        if ( (star + PAGESIZE) > max) then
  1274.                          begin
  1275.                            star:=max - PAGESIZE;
  1276.                            acty:=max;
  1277.                            cury:=22;
  1278.                            AdjustCursor;
  1279.                          end;
  1280.  
  1281.                      refresh:=TRUE;
  1282.                      ShowColRow;
  1283.                      end;
  1284.             _UPAR:   { UpArrow key }
  1285.                      begin
  1286.  
  1287.                        if (cury > 1) then
  1288.                          begin
  1289.                            PutAttr(0, cury, color, 80);
  1290.                            dec(cury);
  1291.                            AdjustCursor;
  1292.                            PutAttr(0, cury, BARCOLOR, 80);
  1293.                          end
  1294.                        else if (cury = 1) then
  1295.                          begin
  1296.  
  1297.                            if (star > 0) then
  1298.                              begin
  1299.                                dec(star);
  1300.                                refresh:=TRUE;
  1301.                              end;
  1302.  
  1303.                          end;
  1304.  
  1305.                        if (acty > 0) then
  1306.                          begin
  1307.                            dec(acty);
  1308.                            ShowColRow;
  1309.                          end;
  1310.  
  1311.                      end;
  1312.             _DNAR:   { Down Arrow key }
  1313.                      begin
  1314.  
  1315.                        if (cury < 22) then
  1316.                          begin
  1317.                            PutAttr(0, cury, color, 80);
  1318.                            inc(cury);
  1319.                            AdjustCursor;
  1320.                            PutAttr(0, cury, BARCOLOR, 80);
  1321.                          end
  1322.                        else if (cury = 22) then
  1323.                          begin
  1324.  
  1325.                            if ( (star + PAGESIZE) < max) then
  1326.                              begin
  1327.                                inc(star);
  1328.                                refresh:=TRUE;
  1329.                              end;
  1330.  
  1331.                          end;
  1332.  
  1333.                        if (acty < max) then
  1334.                          begin
  1335.                            inc(acty);
  1336.                            ShowColRow;
  1337.                          end;
  1338.  
  1339.                      end;
  1340.             _RIAR:   { right arrow key }
  1341.                      begin
  1342.  
  1343.                        if (curx < 79) then
  1344.                          begin
  1345.                            inc(curx);
  1346.                          end
  1347.                        else
  1348.                          begin
  1349.                            inc(left);
  1350.                            refresh:=TRUE;
  1351.  
  1352.                            if (left > LEFTMAX) then
  1353.                              begin
  1354.                                left:=0;
  1355.                                curx:=0;
  1356.                                actx:=0;
  1357.                              end;
  1358.  
  1359.                          end;
  1360.  
  1361.                        AdjustCursor;
  1362.                        inc(actx);
  1363.                        ShowColRow;
  1364.                      end;
  1365.             _LEAR:   { left arrow key }
  1366.                      begin
  1367.  
  1368.                        if (curx = 0) and (left > 0) then
  1369.                          begin
  1370.                            dec(left);
  1371.                            refresh:=TRUE;
  1372.                          end
  1373.                        else if (curx < 80) then
  1374.                          begin
  1375.  
  1376.                            if (curx > 0) then
  1377.                              begin
  1378.                                dec(curx);
  1379.                                AdjustCursor;
  1380.                              end;
  1381.  
  1382.                          end;
  1383.  
  1384.                        dec(actx);
  1385.                        if (actx < 1) then actx:=1;
  1386.                        ShowColRow;
  1387.                      end;
  1388.             _END:    { End Key }
  1389.                      begin
  1390.                        actx:=length(buffer[acty]^) + 1;
  1391.  
  1392.                        if (actx < 81) then
  1393.                          begin
  1394.                            left:=0;
  1395.                            curx:=actx - 1;
  1396.                          end
  1397.                        else
  1398.                          begin
  1399.                            left:=actx - 80;
  1400.                            curx:=79;
  1401.                          end;
  1402.  
  1403.                        ShowColRow;
  1404.                        AdjustCursor;
  1405.                        refresh:=TRUE;
  1406.                      end;
  1407.             _HOME:        { Home key }
  1408.                      begin
  1409.                        curx:=0;
  1410.                        actx:=1;
  1411.                        left:=0;
  1412.                        ShowColRow;
  1413.                        AdjustCursor;
  1414.                        refresh:=TRUE;
  1415.                      end;
  1416.             _CTRL_PGUP:   { Ctrl PageUp key }
  1417.                      begin
  1418.  
  1419.                        ASM                { save 28 bytes by doing assignments in ASM }
  1420.                         xor ax,ax
  1421.                         mov word ptr star,ax
  1422.                         mov word ptr acty,ax
  1423.                         mov word ptr left,ax
  1424.                         mov word ptr curx,ax
  1425.                         mov al,01h
  1426.                         mov word ptr cury,ax
  1427.                         mov word ptr actx,ax
  1428.                         mov byte ptr refresh,al
  1429.                        end;
  1430.  
  1431.                        ShowColRow;
  1432.                        AdjustCursor;
  1433.                      end;
  1434.             _CTRL_PGDN :   { Ctrl PageDown key }
  1435.                      begin
  1436.  
  1437.                        if (max >= PAGESIZE) then
  1438.                          begin
  1439.                            star:=max - PAGESIZE;
  1440.                          end
  1441.                        else
  1442.                          begin
  1443.                            star:=0;
  1444.                          end;
  1445.  
  1446.                        refresh:=TRUE;
  1447.                        acty:=max;
  1448.                        ShowColRow;
  1449.                        cury:=22;
  1450.                        AdjustCursor;
  1451.                      end;
  1452.             _F9,_F8  :   { string search keys }
  1453.                      begin
  1454.                        find:=String_Search(key, refresh, star); { Ascii String Search }
  1455.                      end;
  1456.             _F1:     { 'h' key HELP Screen }
  1457.                      begin
  1458.                        help; { show help screen }
  1459.                      end;
  1460.             _F2:     { save file key }
  1461.                      begin
  1462.                        if (SysMode = TREEDIRMODE) then Write_File('treedir.tmp');
  1463.                      end;
  1464.             _F3:     { print file key }
  1465.                      begin
  1466.                        Write_File('LPT1');
  1467.                      end;
  1468.             _F4:     { call CO.COM to work on the selected DIR }
  1469.                      begin
  1470.                       if (SysMode = TREEDIRMODE) then ExecFileManager( acty );
  1471.                      end;
  1472.             _RET:    { Exit into the selected DIR }
  1473.                      begin
  1474.                       if (SysMode = TREEDIRMODE) then ExitToSelect( acty );
  1475.                      end;
  1476.  
  1477.             end;      { end case }
  1478.        { -------------------------- Case Block ---------------------------- }
  1479.  
  1480.         if (refresh) then  { if time to update CRT data }
  1481.           begin
  1482.             refresh:=FALSE;               { toggle to avoid doing too much CRT stuff }
  1483.             Write_Data(star, left, find); { write data to the CRT }
  1484.             PutAttr(0, cury, BARCOLOR, 80);
  1485.           end;
  1486.  
  1487.      end;    { end while loop }
  1488.   { ------------------------------ Main Loop --------------------------------- }
  1489.  
  1490.   ExitToDos(NORMALEXIT,NORMAL);
  1491. end.
  1492. { ------------------------- End Main --------------------------------------- }
  1493.  
  1494.