spallett@andromeda.RUTGERS.EDU (Carl Spalletta) (07/22/86)
This is a MacPascal version of BINHEX for the long suffering followers
of this newsgroup. It is known to be compatible with thin Mac and MacPascal
version 1.0 but should work with any of either ..
program BinHex;
{ Version 1.3(128K) BH128K.PAS }
{ corrected and uploaded by Carl Spalletta}
{}
{}
{}
{}
{}
{}
{ Select "Go" from "Run" menu. }
{}
{}
{}
{}
{}
{}
{}
{}
{}
const
noErr = 0;
bdNamErr = -60;
dupFNErr = -48;
dirFulErr = -33;
dskFulErr = -34;
ioErr = -36;
mFulErr = -41;
vLckdErr = -46;
wPrErr = -44;
fLckdErr = -45;
PBCreate = $A008;
PBOpenRF = $A00A;
PBWrite = $A003;
PBGetFInfo = $A011;
PBSetFInfo = $A00D;
PBClose = $A001;
PBDelete = $A009;
PBFlshVol = $A013;
type
Ptr = ^char;
ProcPtr = Ptr;
StringPtr = Ptr;
OSErr = integer;
OSType = packed array[1..4] of char;
ParamBlkType = (ioParam, fileParam);
FInfo = record
fdType : OSType;
fdCreator : OSType;
fdFlags : integer;
fdLocation : Point;
fdFldr : integer;
end;
ParamBlockRec = record
FileMgrStuff : array[0..5] of integer;
ioCompletion : ProcPtr;
ioResult : OSErr;
ioNamePtr : StringPtr;
ioVRefNum : integer;
ioRefNum : integer;
ioVersNumPermissn : packed array[0..1] of char;
case ParamBlkType of
ioParam : (
ioMisc : Ptr;
ioBuffer : Ptr;
ioReqCount : Longint;
ioActCount : Longint;
ioPosMode : integer;
ioPosOffset : LongInt
);
fileParam : (
ioFDirIndex : integer;
ioFlAttribVersNum : packed array[0..1] of char;
ioFlFndrInfo : FInfo;
MiscFileParam : array[0..15] of integer
);
end;
var
HexFile : text;
HexFileName, BinFileName : string[63];
HexLine : string;
TextRect : rect;
FileType, FileCreator : OSType;
FinderFlags : integer;
Success, Error, BinOpen : boolean;
Param : ParamBlockRec;
CheckSum : longint;
function Convert (index : integer) : boolean;
const
StuffHex = $A866;
var
HexLen, i : integer;
Error : boolean;
Temp : string[64];
begin
HexLen := length(HexLine) - index + 1;
Error := odd(HexLen) or (HexLen > 64);
for i := index to length(HexLine) do
Error := Error or not (HexLine[i] in ['0'..'9', 'A'..'F']);
if not Error then
begin
Temp := copy(HexLine, index, HexLen);
InlineP(StuffHex, @HexLine[index], @Temp);
end;
Convert := not Error;
end;
procedure GetHexLine;
begin
readln(HexFile, HexLine);
if length(HexLine) > 0 then
if HexLine[1] < ' ' then
delete(HexLine, 1, 1);
end;
function GetFinderData : boolean;
var
GotIt : boolean;
begin
HexLine := '';
while (not eof(HexFile)) and (pos('#', HexLine) <> 1) do
GetHexLine;
GotIt := (not eof(HexFile)) and (pos('$', HexLine) = 10);
GotIt := GotIt and (length(HexLine) = 14);
if Gotit then
begin
FileType := copy(HexLine, 2, 4);
FileCreator := copy(HexLine, 6, 4);
GotIt := Convert(11);
if GotIt then
FinderFlags := ord(HexLine[11]) * 256 + ord(HexLine[12]);
end;
if not GotIt then
writeln('Couldn''t find start of valid data in ', HexFileName);
GetFinderData := GotIt;
end;
function PBtrap (TrapCode : integer) : boolean;
var
RegRcd : record
A : array[0..4] of longint;
D : array[0..7] of longint
end;
begin
PBtrap := false;
RegRcd.A[0] := ord(@Param);
generic(TrapCode, RegRcd);
case loword(RegRcd.D[0]) of
noErr :
PBtrap := true;
dupFNerr :
begin
if PBtrap(PBDelete) then
PBtrap := PBtrap(PBCreate);
end;
bdNamErr :
writeln('Bad file name.');
dirFulErr :
writeln('Output disk''s directory is full.');
dskFulErr :
writeln('Output disk has too little free space.');
ioErr :
writeln('Disk I/O error.');
mFulErr :
writeln('Insufficient memory.');
vLckdErr :
writeln('Output disk is locked.');
wPrErr :
writeln('Output disk is write protected.');
fLckdErr :
writeln('Old BinHex file is locked, can''t replace it.');
otherwise
write('File Manager unexpected error code = ', loword(RegRcd.D[0]));
end;
end;
function OpenBin : boolean;
const
fsRdWrPerm = 3;
begin
Param.ioNamePtr := @BinFileName;
Param.ioVersNumPermissn[0] := chr(0);
if PBtrap(PBCreate) then
begin
Param.IoMisc := nil;
Param.ioVersNumPermissn[1] := chr(fsRdWrPerm);
OpenBin := PBtrap(PBOpenRF);
end
else
OpenBin := false;
end;
procedure CloseBin;
var
IoOK : boolean;
begin
if Success then
if PBtrap(PBGetFInfo) then
begin
with Param.ioFlFndrInfo do
begin
fdType := FileType;
fdCreator := FileCreator;
fdFlags := FinderFlags;
end;
Success := PBtrap(PBSetFInfo);
end
else
Success := false;
IoOK := PBtrap(PBClose);
Success := Success and IoOK;
if not Success then
IoOK := PBtrap(PBDelete);
IoOK := PBtrap(PBFlshVol);
Success := Success and IoOK;
end;
function Translate : boolean;
var
Done, Error : boolean;
i : integer;
begin
Param.ioPosMode := 0;
Param.ioPosOffset := 0;
Param.ioBuffer := Pointer(ord(@HexLine) + 1);
Done := false;
GetHexLine;
repeat
if Convert(1) then
begin
Param.ioReqCount := length(HexLine) div 2;
for i := 1 to Param.ioReqCount do
CheckSum := CheckSum + ord(HexLine[i]);
Error := not PBtrap(PBWrite);
end
else
begin
writeln('Input file contains invalid hex data.');
Error := true;
end;
if not Error then
begin
GetHexLine;
Done := pos('***END OF DATA', HexLine) = 1;
end;
until eof(HexFile) or Done or Error;
Translate := not Error;
end;
function CheckSumMatch : boolean;
var
Match : boolean;
begin
if Convert(13) and (length(HexLine) <= 14) then
begin
Match := ord(HexLine[13]) = (CheckSum mod 256);
if not Match then
begin
writeln('Checksum in hex file does not match calculated checksum...');
writeln('Probable cause: bad download of hex file.');
end;
CheckSumMatch := Match;
end
else
begin
writeln('Checksum line in file is improperly formatted.');
ChecksumMatch := false;
end;
end;
begin
HideAll;
SetRect(TextRect, 0, 20, 528, 342);
SetTextRect(TextRect);
ShowText;
Success := false;
Error := false;
BinOpen := false;
CheckSum := 0;
HexFileName := OldFileName('Select a HEX file...');
Error := HexFileName = '';
if not Error then
begin
BinFileName := NewFileName('Convert to...');
Error := BinFileName = '';
end;
if not Error then
begin
open(HexFile, HexFileName);
if not eof(HexFile) then
begin
writeln;
writeln('Working...');
Error := not GetFinderData;
end
else
begin
writeln(HexFileName, ' is empty.');
Error := true;
end;
end;
if not Error then
begin
while not (eof(HexFile) or Success or Error) do
begin
GetHexLine;
if pos('***', HexLine) = 1 then
case pos(copy(HexLine, 4, 9), 'DATA FORKRESOURCE COMPRESSECHECKSUM:') of
0 :
;
1 :
begin
write('Hex file contains a data fork,');
writeln(' which this program does not handle.');
Error := true;
end;
10 :
if OpenBin then
begin
BinOpen := true;
Error := not Translate
end
else
Error := true;
19 :
begin
writeln('This program does not handle COMPRESSED hex (.HCX) files.');
Error := true;
end;
28 :
begin
Success := CheckSumMatch;
Error := not Success;
end
end;
end;
if eof(HexFile) and not Error and not Success then
writeln(HexFileName, ' ends prematurely.');
if BinOpen then
CloseBin;
end;
if Success then
write(HexFileName, ' successfully converted to ', BinFileName)
else
write('No binary file was created');
writeln('.');
writeln('To exit: "Quit" from "File" menu; to rerun: "Go" from "Run" menu.');
end.