home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyMacBinary.p < prev    next >
Encoding:
Text File  |  1997-01-06  |  4.4 KB  |  164 lines  |  [TEXT/CWIE]
  1. unit MyMacBinary;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Files;
  7.  
  8.     const
  9.         macbin_folder_ftype = 'fold';
  10.         macbin_folder_creator_start = -1; { Should be OSType(-1), damn TP! }
  11.         macbin_folder_creator_end = -2;
  12.  
  13.     type
  14.         MBpacket = packed array[1..128] of Byte;
  15.  
  16. {$PUSH}
  17. {$ALIGN MAC68K}
  18.  
  19.     type
  20.         MBIIStartHeader = packed record
  21.                 name: Str63;
  22.                 ftype: OSType;
  23.                 fcreator: OSType;
  24.                 flags_high: Byte;
  25.                 zero1: Byte;
  26.                 flocation: Point;
  27.                 windowID: integer; {? - ignore }
  28.                 protected: Byte; { low order bit - ignore}
  29.                 zero2: Byte;
  30.                 dlen: longint;
  31.                 rlen: longint;
  32.                 create_date: UInt32;
  33.                 mod_date: UInt32;
  34.                 clen: integer;
  35.                 flags_low: Byte;
  36.             end;
  37.         MBIIHeader = packed record
  38.                 version: SignedByte;
  39.                 MBIIStart: SignedByte;
  40.                 space: packed array[2..115] of Byte;
  41.                 total_unpack_len: longint;{ignore}
  42.                 second_header_len: integer;{ignore}
  43.                 versionII: Byte;
  44.                 minversionII: Byte;
  45.                 crc: integer;
  46.                 processorID: integer; {ignore}
  47.             end;
  48.         MBIIHeaderPtr = ^MBIIHeader;
  49. {$ALIGN RESET}
  50. {$POP}
  51.  
  52.     type
  53.         packet_type = (PT_None, PT_File, PT_StartBlock, PT_EndBlock);
  54.  
  55.     function ValidateMBHeader (var header: MBIIHeader; handle2plus: boolean): packet_type;
  56.     procedure CatInfo2MBHeader (var pb: CInfoPBRec; var header: MBIIHeader; dtdbr: integer; var comment: Str255);
  57.  
  58. implementation
  59.  
  60.     uses
  61.         MyMemory, MyDesktopDB, CalcCRC;
  62.  
  63.     function ValidateMBHeader (var header: MBIIHeader; handle2plus: boolean): packet_type;
  64.         var
  65.             ocrc: integer;
  66.             typ: packet_type;
  67.             start: MBIIStartHeader;
  68.             i: integer;
  69.     begin
  70.         BlockMoveData(@header.MBIIStart, @start, SizeOf(start));
  71.         typ := PT_None;
  72.         with header do begin
  73.             if (version <= ord(handle2plus)) & (MBpacket(header)[75] = 0) then begin
  74.                 ocrc := 0;
  75.                 CalcMBCRCBlock(@header, 124, ocrc);
  76.                 if ocrc = MBIIHeader(header).crc then begin
  77.                     if (version = 1) & (start.ftype = macbin_folder_ftype) & ((start.fcreator = OSType(macbin_folder_creator_start)) | (start.fcreator = OSType(macbin_folder_creator_end))) then begin
  78.                         if start.fcreator = OSType(macbin_folder_creator_start) then begin
  79.                             typ := PT_StartBlock;
  80.                         end else begin
  81.                             typ := PT_EndBlock;
  82.                         end;
  83.                     end else begin
  84.                         typ := PT_File;
  85.                     end;
  86.                 end else if (version = 0) then begin { Assume its a valid MacBinary I file }
  87.                     MBpacket(header)[101] := 0; { Zero out the flags low_byte }
  88.                     total_unpack_len := 0;
  89.                     second_header_len := 0;
  90.                     versionII := 129;
  91.                     minversionII := 129;
  92.                     crc := 0;
  93.                     processorID := 0;
  94.                     typ := PT_File;
  95.                 end;
  96.             end;
  97.         end;
  98.         if typ = PT_File then begin
  99.             typ := PT_None;
  100.             if (0 <= start.clen) & (start.clen <= 200)
  101.                 & (0 <= start.dlen) & (0 <= start.rlen)
  102.                 & (0 < length(start.name)) & (length(start.name) <= 63) then begin
  103.                 typ := PT_File;
  104.                 for i := 1 to length(start.name) do begin
  105.                     if (start.name[i] = chr(0)) | (start.name[i] = ':') then begin
  106.                         typ := PT_None;
  107.                         leave;
  108.                     end;
  109.                 end;
  110.             end;
  111.         end;
  112.         if typ in [PT_StartBlock, PT_File] then begin
  113.             if (MBpacket(header)[2] < 1) | (MBpacket(header)[2] > 31) then begin
  114.                 typ := PT_None;
  115.             end;
  116.         end;
  117.         ValidateMBHeader := typ;
  118.     end;
  119.  
  120.     procedure CatInfo2MBHeader (var pb: CInfoPBRec; var header: MBIIHeader; dtdbr: integer; var comment: Str255);
  121.         var
  122.             start: MBIIStartHeader;
  123.             fs: FSSpec;
  124.             folder: boolean;
  125.             ocrc: integer;
  126.     begin
  127.         folder := BAND(pb.ioFlAttrib, $10) <> 0;
  128.         MZero( @header, SizeOf(header) );
  129.         MFill(@start, SizeOf(start), 0);
  130.         header.version := ord(folder);
  131.         header.versionII := 129 + ord(folder);
  132.         header.minversionII := 129 + ord(folder);
  133.         start.name := pb.ioNamePtr^;
  134.         start.flags_high := BAND(BSR(pb.ioFlFndrInfo.fdFlags, 8), $FF);
  135.         start.flags_low := BAND(pb.ioFlFndrInfo.fdFlags, $FF);
  136.         start.flocation := pb.ioFlFndrInfo.fdLocation;
  137.         start.windowID := pb.ioFlFndrInfo.fdFldr;
  138.         start.create_date := pb.ioFlCrDat;
  139.         start.mod_date := pb.ioFlMdDat;
  140.  
  141.         if folder then begin
  142.             start.ftype := macbin_folder_ftype;
  143.             start.fcreator := OSType(macbin_folder_creator_start);
  144.             start.dlen := 0;
  145.             start.rlen := 0;
  146.         end else begin
  147.             start.ftype := pb.ioFlFndrInfo.fdType;
  148.             start.fcreator := pb.ioFlFndrInfo.fdCreator;
  149.             start.dlen := pb.ioFlLgLen;
  150.             start.rlen := pb.ioFlRLgLen;
  151.         end;
  152.  
  153.         fs.vRefNum := pb.ioVRefNum;
  154.         fs.parID := pb.ioFlParID;
  155.         fs.name := pb.ioNamePtr^;
  156.         GetDTDBComment(dtdbr, fs, comment);
  157.         start.clen := length(comment);
  158.         BlockMoveData(@start, @header.MBIIStart, SizeOf(start));
  159.         ocrc := 0;
  160.         CalcMBCRCBlock(@header, 124, ocrc);
  161.         header.crc := ocrc;
  162.     end;
  163.  
  164. end.