home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
PADOUT16.ZIP
/
PADOUT16.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-07-18
|
6KB
|
226 lines
PROGRAM PadOut;
{ PADOUT Version 1.6 }
{A Turbo Pascal (tm) program to pad out files, such as WordPerfect (tm) files,
with blanks (Hex 00) to the nearest 1024 bytes or 128 bytes, for 'clean'
transfer by Ymodem (1k Xmodem) or Xmodem, respectively. I would like to
thank Michael Reuben, who pointed out the problem of Xmodem padding,
particularly with WordPerfect (tm) files, to me, and motivated me to write
this program. I would particularly like to thank David Seidman, who reviewed
the first version of this program, and suggested major changes both to speed
up operation and to more reliably check for duplicate filenames. With the
suggestions by David Seidman, this program is now more due to his efforts
than to mine!
Program written by Bill Larkins, July 1990. Hereby dedicated to the
public domain.}
USES
Crt,
Dos;
VAR
FileName : String[64];
Switches : String[4];
InFile,
OutFile : String[64];
ValidName : Integer;
StartFile : String[64];
DiffName : Boolean;
XPad : Integer;
XMod : Boolean;
GoodName : Integer;
XIn, XOut : Integer;
PROCEDURE CommandLine;
{Gets Command Line parameters}
BEGIN
ValidName := 1;
FileName := ParamStr(1);
IF Length( FileName ) > 0 THEN
InFile := FileName ELSE ValidName := 0;
FileName := ParamStr(2);
IF Length( FileName ) > 0 THEN
OutFile := FileName ELSE ValidName := 0;
Switches := ParamStr(3);
IF ( ValidName < 1 ) THEN Writeln ( 'Invalid Filenames! Program Halted!');
IF ( ValidName < 1 ) THEN HALT ELSE
END; {CommandLine}
PROCEDURE GetFiles;
BEGIN
Write( 'Input File? ' ); Readln( FileName );
StartFile := FileName;
InFile := FileName;
REPEAT
Writeln( 'Output Filename MUST BE DIFFERENT Than Input Filename' );
Write( 'Output File?' );
Readln( FileName );
OutFile := FileName ;
DiffName := (FileName <> StartFile )
UNTIL DiffName;
Write( 'Type 128 to pad to 128 Bytes, the default is 1024 padding ');
Readln( Switches );
END; {GetFiles }
PROCEDURE CheckNames;
{Needed Variables are InFile, OutFile, and Switches}
VAR
PInFile : PathStr;
POutFile : PathStr;
DInFile : DirStr;
DOutFile : DirStr;
NInFile : NameStr;
NOutFile : NameStr;
EInFile : ExtStr;
EOutFile : ExtStr;
BEGIN
XMod := ( Switches <> '128' );
IF Xmod THEN XPad := 0
ELSE XPad := 1;
PInFile := InFile ;
POutFile := OutFile ;
FSplit(PInFile, DInFile, NInFile, EInFile);
FSplit(POutFile, DOutFile, NOutFile, EOutFile);
GoodName := 0;
IF (EInFile <> EOutFile) THEN GoodName :=1;
IF (NInFile <> NOutFile) THEN GoodName := GoodName + 1;
IF ( GoodName < 1 ) THEN
Write( 'Output Filename must be DIFFERENT than Input Filename!' );
IF (GoodName > 0) THEN Writeln ( 'Valid Filenames-Proceeding') ELSE HALT
END; {CheckNames}
PROCEDURE ProcessX;
VAR
InF, OutF : FILE;
BytesToRead : Integer;
BytesCopied : Integer;
Buffer : Array[1..1024] OF byte;
Padding : Integer;
Ch : Byte;
BytesRead : Integer;
BEGIN
Assign ( InF, InFile );
Reset( InF, 1);
Assign( OutF, OutFile );
Rewrite( OutF, 1);
Padding := 0;
Ch := 00;
BytesCopied := 0;
BytesToRead := 128;
REPEAT
BlockRead(InF, Buffer, BytesToRead, BytesRead);
BlockWrite(OutF,Buffer,BytesRead);
Inc(BytesCopied,BytesRead);
UNTIL (BytesToRead <> BytesRead);
Padding := BytesToRead - BytesRead;
FillChar(Buffer, Padding, #00);
BlockWrite(OutF, Buffer, Padding);
Write(Padding); Write(' padding 00 bytes added');
Writeln;
Close ( InF );
Close ( OutF );
END; {ProcessX}
PROCEDURE ProcessY;
VAR
InF, OutF : FILE;
BytesToRead : Integer;
BytesCopied : Integer;
Buffer : Array[1..1024] OF byte;
Padding : Integer;
Ch : Byte;
BytesRead : Integer;
BEGIN
Assign ( InF, InFile );
Reset( InF, 1);
Assign( OutF, OutFile );
Rewrite( OutF, 1);
Padding :=0;
Ch := 00;
BytesCopied := 0;
BytesToRead := 1024;
REPEAT
BlockRead(InF, Buffer, BytesToRead, BytesRead);
BlockWrite(OutF,Buffer,BytesRead);
Inc(BytesCopied,BytesRead);
UNTIL (BytesToRead <> BytesRead);
Padding := BytesToRead - BytesRead;
FillChar(Buffer, Padding, #00);
BlockWrite(OutF, Buffer, Padding);
Write(Padding);Write(' padding 00 bytes added');
Writeln;
Close ( InF );
Close ( OutF );
END; {ProcessY}
BEGIN
ClrScr;
Writeln( 'PADOUT Version 1.6, July 17, 1990 ');
Writeln( 'Pad a file with Blanks (Hex 00) to the nearest 1024 or 128 bytes');
Writeln( ' for clean 1k Xmodem or 128 Xmodem Transfer' );
Writeln;
Writeln( ' Program written by Bill Larkins, sysop,' );
Writeln( ' Chevy Chase Board BBS (703)549-5574, July 1990' );
Writeln( 'PADOUT per se is hereby released to the Public Domain' );
Writeln( ' (Compiled with Turbo Pascal(tm) 5.5 from Borland ');
Writeln( ' Portions of PADOUT are copyright by Borland International) ');
Writeln;
Writeln( 'Disclaimer: this program is distributed As Is, and has not' );
Writeln( 'been tested on a range of machines. Use at your own risk' );
Writeln;
Writeln( 'You MUST use a valid Output Filename different than the Input ');
Writeln( ' Filename!' );
Writeln;
IF ParamCount <= 1
THEN GetFiles
ELSE CommandLine;
CheckNames;
IF Xpad = 1 THEN ProcessX
ELSE ProcessY;
END.