home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BATUTL / BATMAKR2.ZIP / BATMAKER.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1987-12-14  |  14.7 KB  |  393 lines
  1.  
  2.  
  3.  
  4. program BATMAKER;
  5.  
  6. {------------------------------------------------------------------------------
  7.      BATMAKER version 2.00  R.L. Miller
  8.  
  9.      Program to read file names from a disk directory, and put them into a
  10.   batch file called NAMES.BAT.  Several formats are supported: see accompanying
  11.   file, BATMAKER.DOC.
  12.  
  13.      >>> Turbo Database Toolbox needed to compile this program. <<<
  14.  
  15.      BATMAKER uses MSDos to get file names from an IBM formated diskette.
  16.   The function calls used can be found in the DOS Technical Reference Manual.
  17.   This program uses the current Data Transfer Area ( DTA ) in the variables
  18.   DTAseg and DTAofs.
  19.  
  20. ------------------------------------------------------------------------------}
  21. {$I-,U+,C+,V-}
  22.  
  23. const
  24.   Scrful  =  20;
  25.  
  26.  
  27. type                            { TYPE declarations }
  28.   Registers =
  29.     record           { register pack used in MSDos call }
  30.       AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
  31.     end;
  32.   Char80arr     = array [ 1..80 ] of Char;
  33.   String80      = string[ 80 ];
  34.   BigString     = string[255];
  35.   CommandString = string[127];
  36.   sptr          = ^BigString;
  37.  
  38. var                              { VARIABLE declarations }
  39.   DTA : array [ 1..43 ] of Byte;       { Data Transfer Area Buffer }
  40.   DTAseg,                              { DTA Segment before exicution }
  41.   DTAofs,                              { DTA Offset    "        "     }
  42.   SetDTAseg,                           { DTA Segment and Offset set after }
  43.   SetDTAofs,                           { start of program }
  44.   Error,                               { Error return }
  45.   I, J,                                { used as counters }
  46.   Option : Integer;                    { used to specify file types }
  47.   Regs : registers;                    { register pack for the DOS call }
  48.   Buffer,                              { generic Buffer }
  49.   Fname : String80;                     { file name }
  50.   Afn : Char80arr;                    { file Mask: "Ambiguous File Name" }
  51.   Lines : Integer;                     { no. lines on screen already }
  52.   Status: Integer;                     { Status number returned by TurboSort }
  53.   ComLine : CommandString;             { COPY of invoking Command line, for parsing}
  54.   CL      : CommandString absolute CSEG:$80;  {ACTUAL command line string }
  55.   OutFile : text;                      { File handle for NAMES.BAT, the output file}
  56.   Opt     : string[3];                 {Option string}
  57.  
  58.  Delim                             :  string[20];
  59.  FirstWord,NextWord,NewWord        :  string[80];
  60.  FlagWords                         :  string[255];
  61.  start, next                       :    integer;
  62.  strptr                            :  sptr;
  63.  
  64.  
  65. (**************************************************************************)
  66. (*                                                                        *)
  67. (*  NOTICE    NOTICE    NOTICE    NOTICE    NOTICE    NOTICE    NOTICE    *)
  68. (*                                                                        *)
  69. (*    Turbo Database Toolbox needed to compile this program!              *)
  70. (*                                                                        *)
  71. (**************************************************************************)
  72.  
  73. {$ISORT.BOX}
  74.  
  75.  
  76. {-----------------------------------------------------------------------------
  77.      SetLen: sets length of ASCIZ string passed to it as a parameter.
  78. ------------------------------------------------------------------------------}
  79. Procedure SetLen(var ST: bigstring);
  80.  
  81. Const
  82.   MAX              :   Char = #255;
  83. var
  84.   Segment,Offset   :   Integer;
  85.   Terminator       :   Integer;
  86.   Null             :   String[2];
  87.  
  88. Begin
  89.   Null := #0;
  90.   ST[0] := MAX;   { Initially set length to Max }
  91.   Terminator := Pos(null,ST) - 1;
  92.   ST[0] := Chr(Lo(Terminator));
  93. end;  {of proc SetLen}
  94.  
  95. {----------------------------------------------------------------------------
  96.      PrtPath: prints out full path string (including drive name).
  97. -----------------------------------------------------------------------------}
  98. Procedure PrtPath;
  99.  
  100. Const
  101.    Carry = $0001;
  102.  
  103. Var
  104.    Disk  :   String[4];
  105.    Path  :   String[80];
  106.    Ichar :   Integer;
  107.    Pathseg,Pathofs : integer;
  108.  
  109. Begin
  110.   Regs.AX := $1900;  { Set up for "Current Disk" DOS call }
  111.   MSDOS( Regs);
  112.   Ichar := Lo(Regs.AX) + $41;
  113.   Disk := Chr(Ichar);
  114.   Disk := Disk + ':';
  115.   { Now set up for "Return Text of Current Directory" DOS call }
  116.   Regs.DX := 0;
  117.   Regs.AX := $4700;
  118.   Regs.DS := Seg(path);
  119.   Regs.SI := ofs(Path) + 1;
  120.   Pathseg := Regs.DS;
  121.   Pathofs := Regs.SI;
  122.   MSDOS( Regs);
  123.   Error := Regs.Flags and Carry;
  124.     {$V-}
  125.   Setlen(Path);  { Turn path string into something familiar to Turbo }
  126.   Writeln(' Reading Directory of: ',Disk+Buffer);
  127.   Writeln('  (Current directory is: ',Disk+'\'+Path,')');
  128.   Writeln;
  129. End;  {of proc PrtPath}
  130.  
  131.  
  132. {------------------------------------------------------------------------------
  133.      GetDTA is used to get the current Disk Transfer Area ( DTA )
  134. address.  A function code of $2F is stored in the high Byte of the AX
  135. register and a call to the  MSDos INT 21H is made, by using the "Intr"
  136. procedure with a $21 specification for the interrupt.
  137. ------------------------------------------------------------------------------}
  138.  
  139. procedure GetDTA( var Segment, Offset : Integer;
  140.                          var Error : Integer );
  141. begin
  142.   Regs.AX := $2F00;    { Function used to get current DTA address }
  143.                        { $2F00 is used instead of $2F shl 8 to save
  144.                          three assembly instructions.  An idea for
  145.                          optimization. }
  146.   Intr( $21, Regs );       { Execute MSDos function request }
  147.   Segment := Regs.ES;  { Segment of DTA returned by DOS }
  148.   Offset := Regs.BX;   { Offset of DTA returned }
  149.   Error := Regs.AX and $FF;
  150. end; { of proc GetDTA }
  151.  
  152. {------------------------------------------------------------------------------
  153.      GetFirst gets the first directory entry of a particular file Mask.  The
  154. Afn is passed as a parameter 'Afn' and,  the Option was previosly specified
  155. in the SpecifyOption procedure.
  156. ------------------------------------------------------------------------------}
  157.  
  158. procedure GetFirst( Afn : Char80arr; var Fname : String80;
  159.                     Segment, Offset : Integer; Option : Integer;
  160.                     var Error : Integer );
  161. var
  162.   I : Integer;
  163. begin
  164.   Error := 0;
  165.   Regs.AX := $4E00;          { Get first directory entry }
  166.   Regs.DS := Seg( Afn );    { Point to the file Mask }
  167.   Regs.DX := Ofs( Afn );
  168.   Regs.CX := Option;         { Store the Option }
  169.   MSDos( Regs );             { Execute MSDos call }
  170.   Error := Regs.AX and $FF;  { Get Error return }
  171.   strptr := ptr(segment, offset+29);
  172.   setlen( strptr^);
  173.   Fname := strptr^;
  174. end; { of proc GetFirst }
  175.  
  176. {------------------------------------------------------------------------------
  177.      GetNext uses the first bytes of the DTA for the file Mask, and
  178. returns the next file entry on disk corresponding to the file Mask.
  179. ------------------------------------------------------------------------------}
  180.  
  181. procedure GetNext( var Fname : String80; Segment, Offset : Integer;
  182.                         Option : Integer; var Error : Integer );
  183. var
  184.   I : Integer;
  185.  
  186. begin
  187.   Error := 0;
  188.   Regs.AX := $4F00;           { Function used to get the next }
  189.                               { directory entry }
  190.   Regs.CX := Option;          { Set the file option }
  191.   MSDos( Regs );              { Call MSDos }
  192.   Error := Regs.AX and $FF;   { get the Error return }
  193.   strptr := ptr(segment, offset+29);
  194.   setlen( strptr^);
  195.   Fname := strptr^;
  196. end; { of proc GetNext }
  197.  
  198. {===========================================================================
  199.   ABORT procedure: Prints out help message & halts program
  200. =============================================================================}
  201.  
  202. Procedure Abort;
  203.  
  204. begin
  205.   WriteLn('Usage: BATMAKER Filename.Typ -O)ption_Letter');
  206.   Writeln;
  207.   Writeln('Option_Letter  Output                              ');
  208.   Writeln('=============  ======                              ');
  209.   Writeln('  -A            %1 Filename.Typ %2 %3');
  210.   Writeln('  -B            %1 %2 Filename.Typ %3 %4');
  211.   Writeln('  -C            %1 %2Filename.Typ %3 %4');
  212.   Writeln('  -D            %1 <Filename.Typ >%2 %3');
  213.   Writeln('  -E            %1 <Filename.Typ >>%2 %3');
  214.   Writeln('  -F            %1 <Filename.Typ |%2 >%3 %4');
  215.   Writeln('  -G            %1 <Filename.Typ |%2 >>%3 %4');
  216.   Writeln('  -H            -- Prints this help message --');
  217.   Writeln(' -any other     Filename.Typ');
  218.   Writeln;
  219.   Writeln('Output for all options but -H go to file NAMES.BAT in current directory');
  220.   Writeln('Command line can handle paths, e.g.:');
  221.   Writeln('             A>BATMAKER B:\BIN\*.COM -A');
  222.   Writeln;
  223.   HALT;   {Stop program here}
  224. end;   {of procedure ABORT}
  225.  
  226. {============================================================================
  227.  PARSE Procedure: Finds first word in <line> and returns it in <word>.
  228. =============================================================================}
  229.  
  230. procedure Parse(Line:Bigstring; var Word:Bigstring  );
  231. (* Looks for next word in string <Line>, starting at character position *)
  232. (* <start>, returns the substring in <Word>, and position of the trailing *)
  233. (* delimiter in <next>.  Uses global string variable <delim> as the       *)
  234. (* collection of valid delimiters.                                        *)
  235. var
  236.   i,indx,len,len2                :   integer;
  237.   c                              :   char;
  238.   yesno                          :   string[20];
  239.  
  240. procedure geti;  (* a helpful procedure local to Parse *)
  241. begin
  242.   indx := indx + 1;
  243.   c := line[indx];
  244.   i := pos(c,delim);
  245. end; (* geti *)
  246.  
  247. begin      (* Parse procedure body *)
  248.   (* First, move past any leading delimiters: *)
  249.   len := length(line);
  250.   indx := start - 1;
  251.   repeat geti until i=0;
  252.   start := indx;
  253.   (* Now find trailing delimiter: *)
  254.   repeat geti until ((i>0) or (indx>=len));
  255.   next := indx + 1; (* This is the place to start looking for next word *)
  256.   if indx = len then len2 := next-start else len2 := indx-start;
  257.   Word := copy(Line, start, len2);
  258. end;  (* of PARSE *)
  259.  
  260. {============================================================================
  261.   GetBoth procedure:  Looks at 1st 2 words in command line, tries to find one
  262.                       with a leading dash for option string, other for file
  263.                       mask.
  264. ============================================================================}
  265.  
  266. Procedure GetBoth(var Opt,Buffer,ComLine:BigString);
  267. var
  268.   Word1,Word2  :  Bigstring;
  269. begin
  270.   start := 1;
  271.   Parse(ComLine,Word1);
  272.   start := next;
  273.   If Length(ComLine)<>0 then Parse(Comline,Word2) else Word2:='';
  274.   If Pos('-',Word1)=1 then begin  {Word1 contains option string}
  275.     Opt:=Copy(Word1,2,1);
  276.     Buffer:=Word2;
  277.     end
  278.   else if Pos('-',Word2)=1 then begin  {Word2 contains option string}
  279.     Opt:= Copy(Word2,2,1);
  280.     Buffer:=Word1;
  281.     end
  282.   else Abort;  {Abort if no option string present}
  283. end;   {of Procedure GetBoth}
  284.  
  285.  
  286. {============================================================================
  287.     Routines needed by Turbo Sort
  288. =============================================================================}
  289.  
  290. procedure inp;
  291. begin
  292. GetFirst( Afn, Fname, SetDTAseg, SetDTAofs, Option, Error );
  293.   if ( Error = 0 ) then begin            { Get the first directory entry }
  294.     SortRelease( Fname )
  295.   end;
  296.   while ( Error = 0 ) do begin
  297.     GetNext( Fname, SetDTAseg, SetDTAofs, Option, Error );
  298.     if ( Error = 0 ) then begin
  299.     SortRelease( Fname );
  300.     end;
  301.    end;
  302. end;
  303.  
  304.  
  305. function less;
  306. var
  307.   String1 : String80 absolute X;
  308.   String2 : String80 absolute Y;
  309. begin
  310.  less:=String1<String2;
  311. end;
  312.  
  313. Procedure OutP;
  314. var
  315.   Prestring,Poststring  : string[15];
  316. begin
  317.   PrtPath;
  318.   case Opt of
  319.     'a','A' : begin Prestring:='%1 ';     PostString:=' %2 %3';        end;
  320.     'b','B' : begin Prestring:='%1 %2 ';  Poststring:=' %3 %4';        end;
  321.     'c','C' : begin Prestring:='%1 %2';   Poststring:=' %3 %4';        end;
  322.     'd','D' : begin Prestring:='%1 <';    Poststring:=' >%2 %3';       end;
  323.     'e','E' : begin Prestring:='%1 <';    Poststring:=' >>%2 %3';      end;
  324.     'f','F' : begin Prestring:='%1 <';    Poststring:=' |%2 >%3 %4';   end;
  325.     'g','G' : begin Prestring:='%1 <';    Poststring:=' |%2 >>%3 %4';  end;
  326.     'h','H' : Abort;
  327.   else
  328.               begin Prestring:='';        Poststring:='';              end;
  329.   end;
  330.   repeat
  331.     SortReturn(Fname);
  332.     WriteLn( OutFile,Prestring,Fname,Poststring );
  333.   until SortEOS;
  334. end;
  335.  
  336.  
  337. {****************************************************************************
  338. *****************************************************************************
  339.  
  340.               main body of program BATMAKER
  341.  
  342. *****************************************************************************
  343. *****************************************************************************
  344. }
  345.  
  346. begin
  347.   ComLine:=CL; {Read the commandline immediately}
  348.   WRITELN;
  349.   WriteLn( 'BATMAKER version 2.00 R.L. Miller' );
  350.   WriteLn;
  351.   delim := ' '^I'';
  352.   If Length(ComLine)=0 then Abort;
  353.   GetBoth(Opt,Buffer,ComLine);  {Parse command line into option & file mask}
  354.   If UpCase(Opt)='H' then Abort;  {If H)elp option, abort right away..}
  355.     for I := 1 to 80 do begin         { Initialize the Afn and }
  356.       Afn[ I ] := Chr( 0 );        { file name buffers }
  357.       Fname[ I ] := Chr( 0 );
  358.     end;
  359.   Fname[ 0 ] := Chr( 0 );              { Set the file name length to 0 }
  360.   GetDTA( DTAseg, DTAofs, Error );  { Get the current DTA address }
  361.   if ( Error <> 0 ) then begin             { Check for errors }
  362.     WriteLn( 'Unable to get current DTA' );
  363.     WriteLn( 'Program aborting.' );         { and abort. }
  364.     Halt;                                   { end program now }
  365.   end;
  366.   SetDTAseg := DTAseg;
  367.   SetDTAofs := DTAofs;
  368.   Error := 0;
  369.   Option:=1;       {Handle only standard files for now...}
  370.   if ( length( Buffer ) = 0 ) then              { if nothing was entered }
  371.     Buffer := '????????.???';                  { then use global search }
  372.   for I := 1 to length( Buffer ) do       { Assign Buffer to Afn }
  373.     Afn[ I ] := Buffer[ I ];
  374.   Assign (Outfile,'NAMES.BAT');
  375.   Rewrite(Outfile);
  376.   Writeln('Sorting...');
  377.   Status := TurboSort(14);
  378.   Write('Status = ');
  379.   case Status of
  380.      0 : Writeln('OK');
  381.      3 : Writeln('ERROR: Insufficient memory');
  382.      8 : Writeln('ERROR: Illegal item length');
  383.      9 : Writeln('ERROR: More than ',Maxint,' files');
  384.      10: Writeln('ERROR: During sorting. Bad or full disk.');
  385.      11: Writeln('ERROR: During read of directory. Probable bad disk.');
  386.      12: Writeln('ERROR: Unable to create temporary file');
  387.   else Writeln(' +++ Unknown ERROR');
  388.   end;
  389.   Close(Outfile);
  390. end. { end Main }
  391.  
  392.  
  393.