home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TURBO4IO.ZIP / UC.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1988-03-17  |  6.7 KB  |  194 lines
  1. {$I-}                                   {IO checking off}
  2. {$R-}                                   {Range checking off}
  3. {$S-}                                   {Stack checking off}
  4. {$V-}                                   {Bounds checking off}
  5.                                         { = faster}
  6. {
  7.  
  8. -------------------------------------------------------------------
  9.  
  10. Mike Bailey
  11. Madison, WI
  12. March 1988
  13.  
  14. The purpose of this program is to convert a text file
  15. into all uppercase alphabetic characters.  Input is in
  16. the form of a command line, with wild cards allowed. A
  17. temporary file is made then deleted during the conversion
  18. process.
  19.  
  20. -------------------------------------------------------------------
  21.  
  22. }
  23.  
  24. program UC;
  25.  
  26. Uses
  27.   Crt,
  28.   Dos;
  29.  
  30. type
  31.   Fstring = string[12];
  32.   Fnames = string[12];
  33.   
  34. const
  35.   OffBar = $07;                         {normal video}
  36.   OnBar = $70;                          {reverse video highlight}  
  37.  
  38. var
  39.   DatFile : array[1..400] of Fnames;
  40.   FileIn,FileOut,F1,F2 : file;
  41.   words,bufferin,bufferout : string[255];
  42.   NextFile : Fstring;
  43.   Buf : array[0..32767] of char;
  44.   FileN1,FileN2 : string[128];
  45.   DInfo : SearchRec;                    {record for directory info}
  46.   Ndx : word;                                 {index for array}
  47.   DMax : word;                                {maximum file number}
  48.   Regs : registers;
  49.   RealCurs : integer;
  50.  
  51. procedure LightBar(WStr : Fnames;Attr: byte);
  52. { WStr = string to write to screen.
  53.   Attr = $07 if normal video
  54.          $70 if reverse video
  55.          $FF if blinking reverse video
  56.          $F0 if blinking reverse video line
  57.   Uses BIOS calls $03 : get current cursor location
  58.                   $09 : write char & attribute
  59.                   $02 : move cursor to new position
  60.   Column must be incremented before call to move cursor.}
  61. var
  62.   Index : integer;
  63.   Column, Row : byte;
  64. begin
  65.   for Index := 1 to length(WStr) do     {write each character}
  66.     begin
  67.       with Regs do                      {use Regs set}
  68.         begin
  69.           AX := $0300;                  {function to save current cursor pos.}
  70.           BX := 0;                      {page 0}
  71.           Intr($10,Regs);               {BIOS call}
  72.           Row := DX shr 8;              {row return*ed in DH}
  73.           Column := (DX mod 256) + 1;   {column returned in DL,inc and store}
  74.           AX := $0900 + ord(WStr[Index]);{function to write char & attribute}
  75.           BX := Attr;                   {BL gets attribute}
  76.           CX := $01;                    {do only one character}
  77.           Intr($10,Regs);               {BIOS call}
  78.           AX := $0200;                  {function to set cursor position}
  79.           DX := Row shl 8 + Column;     {DH gets row, DL gets column}
  80.           Intr($10,Regs);               {BIOS call}
  81.         end;
  82.     end;
  83. end;
  84.  
  85. procedure OrgCursor;
  86. { Capture the original value of the cursor upon entry.}
  87. begin
  88.   Regs.AX := $0300;                     {read cursor function}
  89.   Regs.BX := $00;                       {assume page 0}
  90.   Intr($10,Regs);                       {call BIOS int 10h}
  91.   RealCurs := Regs.CX;                  {cursor val returned in CX}
  92. end;
  93.  
  94. procedure Cursor;
  95. { Turns the cursor on using BIOS int 10h.
  96.   The cursor captured upon program initiation is used.}
  97. begin
  98.   Regs.AX := $0100;
  99.   Regs.CX := RealCurs;
  100.   Intr($10,Regs);
  101. end;
  102.  
  103. procedure NoCursor;
  104. { Turns the cursor off using BIOS int 10h.
  105.   Bit 5 of CH when high turns off the cursor.}
  106. begin
  107.   Regs.AX := $0100;
  108.   Regs.CX := $2000;                    {turn off original cursor}
  109.   Intr($10,Regs);
  110. end;
  111.  
  112. procedure DoDwn(RFile : Fstring);
  113. { Inputs file name to open, read and convert all upper case
  114.   characters to lower case.}
  115. var
  116.   ReadIn,WroteOut,Ndx : word;
  117.   FileOk : boolean;
  118. begin
  119.   FileOk := true;
  120.   FileN2 := RFile;                            {get file name}
  121.   FileN1 := FileN2;                           {store in another string}
  122.   if Pos('.',FileN2) <> 0 then                {look for extension}
  123.     FileN2 := Copy(FileN2,1,Pos('.',FileN2) - 1) + '.BAK'
  124.   else FileN2 := FileN2 + '.BAK';             {delete if any, add 'bak'}
  125.   Assign(FileIn,FileN1);                      {try to open file}
  126.   Reset(FileIn,1);
  127.   If IOResult <> 0 then                       {if unsuccessful give err msg}
  128.     begin
  129.       LowVideo;
  130.       Write('Unable to access ---> ');
  131.       HighVideo;
  132.       Write(FileN1);
  133.       FileOk := false;                        {error, exit procedure}
  134.     end;
  135.   LowVideo;
  136.   if FileOk then
  137.     begin
  138.       Write('Upper case conversion ---> ');
  139.       LightBar(FileN1,OnBar);
  140.       Assign(FileOut,FileN2);                     {open file to write}
  141.       Rewrite(FileOut,1);
  142.       repeat                                      {read until EOF}
  143.         BlockRead(FileIn,Buf,SizeOf(Buf),ReadIn); {read up to buffer size}
  144.         for Ndx := 0 to Readin do
  145.           if ((Buf[Ndx] <= 'z') and (Buf[Ndx] >= 'a')) then
  146.            ord(Buf[Ndx]) := ord(Buf[Ndx]) - $20;        
  147.         BlockWrite(FileOut,Buf,ReadIn,WroteOut);  {write it to other file}
  148.       until (ReadIn = 0) or (WroteOut <> ReadIn); {until EOF}
  149.       close(FileIn);                              {close both files}
  150.       close(FileOut);
  151.       Assign(F1,FileN2);                          {get file named *.bak}
  152.       Rename(F1,'TMPADZ');                        {temporarily rename}
  153.       Assign(F2,FileN1);                          {get original file}
  154.       Erase(F2);                                  {delete it}
  155.       Assign(F1,'TMPADZ');                        {get altered file}
  156.       Rename(F1,FileN1);                          {rename it original name}
  157.     end;
  158. end;
  159.  
  160. procedure ReadDat;
  161. { Uses the command line with the DOS file name(s)
  162.     to alter.}
  163. var
  164.   FileOk : boolean;
  165. begin
  166.   Ndx := 1;                                   {start real info}
  167.   FindFirst(ParamStr(1),AnyFile,DInfo);       {use DOS file records}
  168.   while DosError = 0 do                       {while not no more files}
  169.     begin
  170.       DatFile[Ndx] := DInfo.Name;             {file the array}
  171.       FindNext(DInfo);                        {get next file name}
  172.       Inc(Ndx);                               {increment array pointer}
  173.     end;
  174.   DMax := Ndx - 1;                            {get number of files}
  175.   for Ndx := 1 to DMax do
  176.     begin
  177.       DoDWn(DatFile[Ndx]);{make lower case}
  178.       if Ndx < DMax then Writeln;
  179.     end;
  180. end;
  181.  
  182. begin
  183.   OrgCursor;                            {get original cursor}
  184.   NoCursor;                             {turn cursor off} 
  185.   if paramcount <> 1 then
  186.       begin
  187.       lowvideo;
  188.       write('Usage: UC [Filenames] - wildcards * and ? acceptable ');
  189.     end
  190.   else
  191.     ReadDat;
  192.   HighVideo;
  193.   Cursor;                               {restore cursor}
  194. end.