Date: Fri, 23 Sep 88 19:20:26 -0700 Subject: Here is a Turbo Pascal make-binhex From: Alastair Milne This is a version of BinHex4.Pas, modified for Turbo Pascal 1.1 . Consider it a small thank-you for the several useful things I've acquired from the info-mac repository. As the important parts of Binhex4.pas are undocumented, I had some guessing to do about the function of the non-Turbo constructs; but my guesses appear to have been correct, as I now have a working BinHex4, and have decoded many an HQX file with it. I regret that this does not conform will to Mac interface standards, but it is so brief and simple (in its appearance anyway) that it wouldn't make much difference. Anybody who wants to put in the time to cover the remaining distance is more than welcome to do so. I wrote it on a Mac II under Multifinder, where both it and BinHex seem to work fine. The program uses 3 Mac units, but these are built into the Turbo compiler, so this source and a runing Turbo 1.1 should be all you need to create BinHex4 Enjoy. Alastair Milne ----------------------------- cut here ------------------------------- program Make_Binhex4; { Generates the application BinHex4. So far it has always placed BinHex in the current folder. } { Requires at least 512K } { MakeMakers, by Steve Brecher, generated this program on 7/6/85 } { This version adapted for Turbo Pascal 1.1, September 1988, by Alastair Milne. It runs on the Mac II; it hasn't yet been tested on any other Mac. It works with no apparent problem under MultiFinder. (Note that, when compiling with Turbo under Multifinder, compiles to memory should be avoided, as Turbo starts to screw up badly. Compiling to disk, then running the newly compiled file with Turbo suspended, works fine; and is in fact somewhat safer, since an accidental crash won't cost you the running code.) As each launch of this program simply generates BinHex, then quits, I have contented myself with Turbo Pascal's default, menuless startup window, and not attempted to make it more conventional for the Mac. Though it would improve the appearance to install proper windowing and menus, I doubt it would make any difference to the operation. Anybody who wishes to polish it a bit is more than welcome to do so.} USES Memtypes, QuickDraw,OSIntf; {} {} {} {} {} {} { Select "Go" from "Run" menu. } {} {} {} {} {} {} {} const DataLines = 167; CodeWords = 129; {} var TextRect : rect; D : array[1..DataLines] of string[66]; Code : array[1..CodeWords] of integer; {} procedure InitDataArray; var i : integer; begin for i := 1 to DataLines do D[i] := ''; {set all values in case any lines were dropped} D[1] := '4E56FF80204E42A0BFC865FA41EEFFB043FA00E221490012316100186620A008'; D[2] := '670C0C40FFD0660EA009660A60F0117C0003001BA00A660000A632A80018222E'; D[3] := '000867000062214F0020703021400024224172001219E4495341244F76287000'; D[4] := '7403ED889711801951CAFFF815400002E0481540000148401480564A51C9FFE0'; D[5] := '705A244F722FE318141AB50051C9FFF812199203E54997118211B00167047201'; D[6] := '6034A0036038217C00001D81001CA012662242A8001CA00C661A700180290002'; D[7] := '43F1000345E8002024FC4150504C24D93491A00D3200A0014A41670230013200'; D[8] := '6704A009A0134E5E205F584F225F32814ED000000742696E68657834426E4871'; D[9] := '2000'; D[10] := '((()((((/*D(()TO((()>N1M0.5WCOAMDO9MA*)_B?9P0,1QCLIMF*a0A?HQ+8PKc+'; D[11] := '8=)8;,1V:/,L4K(X4(\22JPR 64) and ((Count <> 9) or (i <> 4)); if not Error then begin (*InlineP(StuffHex, @Code[CodeIndex], @D[Count]); -- incompatible with Turbo*) Stuffer( Code[CodeIndex], D[Count]); { -- replaced the InlineP call} CodeIndex := CodeIndex + 16; end; end; if not Error then begin Check := 0; for CodeIndex := 1 to CodeWords do Check := Check + Code[CodeIndex]; Error := Check <> 883868; end; if Error then BadDownload; DataToCode := not Error; end; {DataToCode} {} function WriteAppl : boolean; const JsrIndirectA0 = $4E90; PopIntoA0 = $205F; {MOVEA.L (SP)+,A0} noErr = 0; DataErr = 1; dirFulErr = -33; dskFulErr = -34; ioErr = -36; mFulErr = -41; fLckdErr = -45; vLckdErr = -46; wPrErr = -44; type GeneralPointer = ^integer; { A free pointer type is needed (such as Turbo 4.0 has); the type pointed to is immaterial. } var i, j, Result : integer; procedure Apply( Result, Arg: GeneralPointer; var TargetRoutine); inline PopIntoA0, { Assume TargetRoutine is on top of the stack. Pop it into A0 for JSR to use. } JsrIndirectA0; { Applies the TargetRoutine to the 2 parameters whose addresses are in Result and Arg. This replaces the Glue array construct of the original. NOTE: order of parameters on stack is essential. Apply assumes they are pushed in the order they appear. NOTE: ObjPointer is used to allow NIL to be passed where necessary. Otherwise I consider typeless VAR parameters preferable, since they advertise that the code is escaping type checks. } begin i := 10; repeat j := length(D[i]); Result := ord((j <> 66) and ((i <> DataLines) or (j <> 26))); if Result = noErr then begin (*generic(JsrIndirectA0, RegRcd); -- though undocumented, this appears to work by stuffing the registers with their equivalently-named fields from RegRcd, then executing the first parameter as an instruction. RegRcd was set to point A0 to the Code array, and A1 and A2 to its parameters (Result and D). The JSR called the Glue array, which pushed the necessary register values onto the stack, and jumped to the Code array. *) Apply( @Result, @D[i], Code[1]); {-- used instead of the Generic routine. Placing @Result and @D[i] on the stack is apparently adequate; placing them in the registers was only intermediate. } end; i := i + 1; until (i > DataLines) or (Result <> noErr); if Result = noErr then begin (*generic(JsrIndirectA0, RegRcd);*) Apply( @Result, nil, Code[1]); { -- see notes above. Note the NIL Arg parameter -- this appears to be essential to have the generation of BinHex finished correctly. } end; case Result of DataErr : BadDownLoad; noErr : ; dirFulErr : writeln('Output disk''s directory is full.'); dskFulErr : writeln(' Output disk has too little free space.'); fLckdErr : writeln('Old "Binhex4" file is locked, can''t replace it.'); ioErr : writeln('Disk I/O error.'); mFulErr : writeln('Insufficient memory.'); vLckdErr : writeln('Output disk is locked.'); wPrErr : writeln('Output disk is write protected.'); otherwise write('File Manager returned unexpected error code = ', Result); end; WriteAppl := Result = noErr; end; {WriteAppl} {} begin {program} { I assume this init. code was to establish a window and menu. Only SetRect appears to be known to Turbo -- though I haven't gone looking through all the interfaces to find the others. The very simple arrangement that the current code produces seems to be satisfactory for producing BinHex4. } (*HideAll; SetRect(TextRect, 0, 20, 528, 342); SetTextRect(TextRect); ShowText;*) Writeln('Processing -- please wait...'); InitDataArray; if DataToCode then begin if WriteAppl then writeln('Done!') else writeln('Sorry, nothing was accomplished.'); writeln('To exit, press the "return" key.'); end; readln; end.