home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / PADOUT16.ZIP / PADOUT16.PAS < prev   
Pascal/Delphi Source File  |  1990-07-18  |  6KB  |  226 lines

  1. PROGRAM PadOut;
  2. {                    PADOUT Version 1.6      }
  3.  
  4. {A Turbo Pascal (tm) program to pad out files, such as WordPerfect (tm) files,
  5. with blanks (Hex 00) to the nearest 1024 bytes or 128 bytes, for 'clean'
  6. transfer by Ymodem (1k Xmodem) or Xmodem, respectively. I would like to
  7. thank Michael Reuben, who pointed out the problem of Xmodem padding,
  8. particularly with WordPerfect (tm) files, to me, and motivated me to write
  9. this program. I would particularly like to thank David Seidman, who reviewed
  10. the first version of this program, and suggested major changes both to speed
  11. up operation and to more reliably check for duplicate filenames. With the
  12. suggestions by David Seidman, this program is now more due to his efforts
  13. than to mine!
  14.  
  15. Program written by Bill Larkins, July 1990. Hereby dedicated to the
  16. public domain.}
  17.  
  18. USES
  19.     Crt,
  20.     Dos;
  21. VAR
  22.      FileName  : String[64];
  23.      Switches  : String[4];
  24.      InFile,
  25.      OutFile   : String[64];
  26.      ValidName  : Integer;
  27.      StartFile : String[64];
  28.      DiffName  : Boolean;
  29.      XPad : Integer;
  30.      XMod : Boolean;
  31.      GoodName : Integer;
  32.      XIn, XOut : Integer;
  33.  
  34. PROCEDURE CommandLine;
  35.  
  36. {Gets Command Line parameters}
  37.  
  38. BEGIN
  39.      ValidName := 1;
  40.      FileName := ParamStr(1);
  41.      IF Length( FileName ) > 0 THEN
  42.      InFile := FileName ELSE ValidName := 0;
  43.      FileName := ParamStr(2);
  44.      IF Length( FileName ) > 0 THEN
  45.      OutFile := FileName ELSE ValidName := 0;
  46.      Switches := ParamStr(3);
  47.      IF ( ValidName < 1 ) THEN Writeln ( 'Invalid Filenames! Program Halted!');
  48.      IF ( ValidName < 1 ) THEN HALT ELSE
  49. END; {CommandLine}
  50.  
  51.  
  52.  
  53. PROCEDURE GetFiles;
  54.  
  55. BEGIN
  56.    Write( 'Input File? ' ); Readln( FileName );
  57.    StartFile := FileName;
  58.    InFile := FileName;
  59.    REPEAT
  60.        Writeln( 'Output Filename MUST BE DIFFERENT Than Input Filename' );
  61.        Write( 'Output File?' );
  62.        Readln( FileName );
  63.        OutFile := FileName ;
  64.        DiffName := (FileName <> StartFile )
  65.     UNTIL DiffName;
  66.  
  67.     Write( 'Type 128 to pad to 128 Bytes, the default is 1024 padding  ');
  68.     Readln( Switches );
  69.  
  70. END; {GetFiles }
  71.  
  72.  
  73. PROCEDURE CheckNames;
  74.  
  75. {Needed Variables are InFile, OutFile, and Switches}
  76.  
  77. VAR
  78.      PInFile : PathStr;
  79.      POutFile : PathStr;
  80.      DInFile : DirStr;
  81.      DOutFile : DirStr;
  82.      NInFile : NameStr;
  83.      NOutFile : NameStr;
  84.      EInFile : ExtStr;
  85.      EOutFile : ExtStr;
  86.  
  87. BEGIN
  88.  
  89.     XMod := ( Switches <> '128' );
  90.     IF Xmod THEN XPad := 0
  91.             ELSE XPad := 1;
  92.  
  93.     PInFile := InFile ;
  94.     POutFile := OutFile ;
  95.  
  96.      FSplit(PInFile, DInFile, NInFile, EInFile);
  97.  
  98.      FSplit(POutFile, DOutFile, NOutFile, EOutFile);
  99.  
  100.      GoodName := 0;
  101.  
  102.      IF (EInFile <> EOutFile) THEN GoodName :=1;
  103.      IF (NInFile <> NOutFile) THEN GoodName := GoodName + 1;
  104.  
  105.     IF ( GoodName < 1 ) THEN
  106.     Write( 'Output Filename must be DIFFERENT than Input Filename!' );
  107.     IF (GoodName > 0) THEN Writeln ( 'Valid Filenames-Proceeding') ELSE HALT
  108.  
  109. END; {CheckNames}
  110.  
  111. PROCEDURE ProcessX;
  112.  
  113. VAR
  114.     InF, OutF : FILE;
  115.     BytesToRead : Integer;
  116.     BytesCopied : Integer;
  117.     Buffer : Array[1..1024] OF byte;
  118.     Padding : Integer;
  119.     Ch : Byte;
  120.     BytesRead : Integer;
  121.  
  122. BEGIN
  123.      Assign ( InF, InFile );
  124.      Reset( InF, 1);
  125.      Assign( OutF, OutFile );
  126.      Rewrite( OutF, 1);
  127.      Padding := 0;
  128.      Ch := 00;
  129.  
  130.     BytesCopied := 0;
  131.     BytesToRead := 128;
  132.    REPEAT
  133.  
  134.     BlockRead(InF, Buffer, BytesToRead, BytesRead);
  135.     BlockWrite(OutF,Buffer,BytesRead);
  136.     Inc(BytesCopied,BytesRead);
  137.  
  138.    UNTIL (BytesToRead <> BytesRead);
  139.  
  140.    Padding := BytesToRead - BytesRead;
  141.  
  142.    FillChar(Buffer, Padding, #00);
  143.    BlockWrite(OutF, Buffer, Padding);
  144.  
  145.      Write(Padding); Write(' padding 00 bytes added');
  146.      Writeln;
  147.      Close ( InF );
  148.      Close ( OutF );
  149. END; {ProcessX}
  150.  
  151. PROCEDURE ProcessY;
  152.  
  153.  
  154. VAR
  155.     InF, OutF : FILE;
  156.     BytesToRead : Integer;
  157.     BytesCopied : Integer;
  158.     Buffer : Array[1..1024] OF byte;
  159.     Padding : Integer;
  160.     Ch : Byte;
  161.     BytesRead : Integer;
  162.  
  163. BEGIN
  164.      Assign ( InF, InFile );
  165.      Reset( InF, 1);
  166.      Assign( OutF, OutFile );
  167.      Rewrite( OutF, 1);
  168.      Padding :=0;
  169.      Ch := 00;
  170.  
  171.     BytesCopied := 0;
  172.     BytesToRead := 1024;
  173.    REPEAT
  174.  
  175.     BlockRead(InF, Buffer, BytesToRead, BytesRead);
  176.     BlockWrite(OutF,Buffer,BytesRead);
  177.     Inc(BytesCopied,BytesRead);
  178.  
  179.    UNTIL (BytesToRead <> BytesRead);
  180.  
  181.    Padding := BytesToRead - BytesRead;
  182.  
  183.    FillChar(Buffer, Padding, #00);
  184.    BlockWrite(OutF, Buffer, Padding);
  185.  
  186.      Write(Padding);Write(' padding 00 bytes added');
  187.      Writeln;
  188.      Close ( InF );
  189.      Close ( OutF );
  190.  
  191. END; {ProcessY}
  192.  
  193.  
  194.  
  195. BEGIN
  196.    ClrScr;
  197.    Writeln( 'PADOUT Version 1.6, July 17, 1990 ');
  198.    Writeln( 'Pad a file with Blanks (Hex 00) to the nearest 1024 or 128 bytes');
  199.    Writeln( '          for clean 1k Xmodem or 128 Xmodem Transfer' );
  200.    Writeln;
  201.    Writeln( '     Program written by Bill Larkins, sysop,' );
  202.    Writeln( ' Chevy Chase Board BBS (703)549-5574, July 1990' );
  203.    Writeln( 'PADOUT per se is hereby released to the Public Domain' );
  204.    Writeln( ' (Compiled with Turbo Pascal(tm) 5.5 from Borland ');
  205.    Writeln( ' Portions of PADOUT are copyright by Borland International) ');
  206.    Writeln;
  207.    Writeln( 'Disclaimer: this program is distributed As Is, and has not' );
  208.    Writeln( 'been tested on a range of machines. Use at your own risk' );
  209.    Writeln;
  210.    Writeln( 'You MUST use a valid Output Filename different than the Input ');
  211.    Writeln(  ' Filename!' );
  212.      Writeln;
  213.  
  214.   IF ParamCount <= 1
  215.         THEN GetFiles
  216.         ELSE CommandLine;
  217.  
  218.     CheckNames;
  219.  
  220.     IF Xpad = 1 THEN ProcessX
  221.                 ELSE ProcessY;
  222.  
  223. END.
  224.  
  225.  
  226.