home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / sysext / fkey / codesuck.cpt / CodeSuckerFKEY / Sources / CodeSuckerFKEY.p < prev    next >
Encoding:
Text File  |  1991-12-12  |  20.4 KB  |  595 lines
  1. {$I-}
  2. {****************************************************}
  3. {CodeSuckerFKEY.p                                                                        }
  4. {}
  5. {Written using Think Pascal v3.0}
  6. {Requires at least System 6 to run}
  7. {}
  8. {Main body for FKEY, a utility that copies active (application) resources to file}
  9. {}
  10. {⌐ 1991  Mike van Kleef    -    All rights Reserved}
  11. {----------------------------------------------------}
  12. {Address (mail & network) until September 1992 : }
  13. {    42 Melford Road, London,  E11-4PS, England}
  14. {    vankleef@uk.ac.qmc.dcs   [Queen Mary College, London] }
  15. {Address after September 1992 :}
  16. {    Flat 5, 4 St. Quintin Ave., London, W10-6NU, England}
  17. {----------------------------------------------------}
  18. {CodeSucker is distributed in the hope that it will be useful , but WITHOUT ANY WARRANTY}
  19. {Absolutely no-one on Earth accepts responsibility for the consequences of using this program}
  20. {Everyone is hereby granted permission to delete, copy, modify & redistribute CodeSucker}
  21. {}
  22. {Version History}
  23. {1/6/91        -    CodeSucker program inception}
  24. {12/6/91    -    v0.9    Normal unsorted lists.}
  25. {                            Creates a local list of open resource files by reading the FCB buffer on startup}
  26. {15/6/91    -    v0.95    Added BubbleSort sorting to Resource types list}
  27. {18/6/91    -    v1.0    Replaced slow BubbleSort with faster QuickSort}
  28. {                            Removed local files list: open resource files now continuously accessed through the FCB buffer}
  29. {                            Cleaned up minor bug that sometimes caused a FONT change in the lists upon scrolling}
  30. {20/6/91    -    v1.01    Added sorting to Resource ID list}
  31. {26/6/91    -    v1.02    Added 'Copy resource flags' option in Save menu}
  32. {Last Change 12/12/91}
  33. {****************************************************}
  34.  
  35. unit CodeSuckerFKEY;
  36.  
  37. interface
  38.  
  39.     uses
  40.         SysEqu,             {Contains System Globals}
  41.         GlobalRoutines,    {Some independent routines: FCB buffer things}
  42.         CodeSuckerList,    {List manager things}
  43.         ResourceBits;    {Routines regarding resource management/Filing etc}
  44.  
  45.     procedure Main;    {Parameterless entry-Point for FKEY}
  46.  
  47. {-----------------------------------------}
  48. implementation
  49.  
  50.     procedure Main;
  51.  
  52.         const
  53. {File Popup menu}
  54.             FileMenuID = 9998;    {ID for the file popUp menu}
  55.             FileMenuTitle = 'File';
  56. {Save Popup menu}
  57.             SaveMenuID = 9999;    {ID for the Save popUp menu}
  58.             SaveMenuTitle = 'Save';
  59.             SaveRsrcFlags = 1;        {Save menu item 1}
  60.             SaveSelected = 3;            {Save menu item 3}
  61.             SaveRID = 4;                {Save menu item 4}
  62.             SaveRType = 5;            {Save menu item 5}
  63. {Miscellaneous}
  64.             programName = 'CodeSucker v1.02';    {Utility name+version}
  65.  
  66.         var
  67.             oldPen: PenState;                {Old Pen}
  68.             oldResFile: Integer;            {Resource file that was current before we started}
  69.             myWindow: WindowPtr;        {Pointer to main window}
  70.             quitControl: ControlHandle;    {Handle to quit button control}
  71.             helpControl: ControlHandle;    {Handle to help button control}
  72.             typeList: ListHandle;            {List of all resources}
  73.             rsrcList: ListHandle;            {List of all resources of a particular type}
  74.             saveMenuHdl: MenuHandle;    {Handle to 'save' PopUp menu}
  75.             saveMenuRect: Rect;            {Rectangle for 'save' PopUp Menu}
  76.             fileMenuHdl: MenuHandle;        {Handle to 'file' PopUp menu}
  77.             fileMenuRect: Rect;            {Rectangle for 'file' PopUp Menu}
  78.             currentFileName: str255;        {Current resource file Name}
  79.             currentFileRef: Integer;        {Current Resource file reference}
  80.             watchHdl: CursHandle;            {Handle to the Watch cursor}
  81.             oldResLoad: Integer;            {Old value of the SetResLoad function on entering this FKEY}
  82.             copyRsrcFlags: Boolean;        {Whether to copy the resource flags when saveing a resource}
  83.  
  84. {-----------------------------------------}
  85. {This routine paints the little down-pointing triangle inside the popup menu}
  86. {h,v=position; size=size of triangle in pixels}
  87.         procedure PaintTriangle (h, v, size: Integer);
  88.             var
  89.                 polyHdl: PolyHandle;    {temporary structure for drawing the triangle}
  90.         begin
  91.             polyHdl := OpenPoly;
  92.             MoveTo(h, v);
  93.             LineTo(h - size, v - size);
  94.             LineTo(h + size, v - size);
  95.             ClosePoly;
  96.             PaintPoly(polyHdl);
  97.             KillPoly(polyHdl);
  98.         end;
  99. {-----------------------------------------}
  100. {Prints the name of the currently selected filename in the window}
  101.         procedure PrintCurrentFile;
  102.             var
  103.                 tmpRect: Rect;    {Area of previouly displayed filename in window}
  104.         begin
  105.             SetRect(tmpRect, 185, 0, 300, 12);
  106.             EraseRect(tmpRect);
  107.             SetFont('Geneva', 9, []);
  108.             MoveTo(185, 10);
  109.             DrawString(currentFileName);
  110.         end;
  111.  
  112. {-----------------------------------------}
  113. {Routine that does the line-drawing in the main window.}
  114. {Framing the 2 lists, and drawing a nice line across the top of the window}
  115.         procedure FrameLists;
  116.             var
  117.                 tmpRect: Rect;    {Rectangle surrounding lists}
  118.         begin
  119.             tmpRect := typeList^^.rView;
  120.             InsetRect(tmpRect, -1, -1);
  121.             FrameRect(tmpRect);
  122.             tmpRect := rsrcList^^.rView;
  123.             InsetRect(tmpRect, -1, -1);
  124.             FrameRect(tmpRect);
  125.             ForeColor(blueColor);
  126.             MoveTo(2, 15);
  127.             LineTo(276, 15);
  128.             ForeColor(blackColor);
  129.         end;
  130.  
  131. {-----------------------------------------}
  132.         procedure DrawPopMenu (tmpRect: Rect; theStr: Str255);
  133.         begin
  134.             EraseRect(tmpRect);
  135.             FrameRect(tmpRect);
  136.             MoveTo(tmpRect.left + 1, tmpRect.bottom);
  137.             LineTo(tmpRect.right, tmpRect.bottom);
  138.             LineTo(tmpRect.right, tmpRect.top + 1);
  139.             SetFont('Chicago', 12, []);
  140.             MoveTo(tmpRect.left + 5, tmpRect.top + 13);
  141.             DrawString(theStr);
  142.             PaintTriangle(tmpRect.left + 42, tmpRect.top + 12, 6);
  143.         end;
  144.  
  145. {-----------------------------------------}
  146. {Redraw the controls in the window (Buttons, Lists & Popup Menus)}
  147.         procedure UpdateControls;
  148.         begin
  149. {Button Controls╔}
  150.             DrawControls(myWindow);
  151. {List Manager bits╔}
  152.             SetFont('Monaco', 9, []);
  153.             LUpdate(myWindow^.visRgn, typeList);
  154.             LUpdate(myWindow^.visRgn, rsrcList);
  155.             FrameLists;
  156. {PopUp menu╔}
  157.             DrawPopMenu(fileMenuRect, FileMenuTitle);
  158.             DrawPopMenu(saveMenuRect, SaveMenuTitle);
  159.         end;
  160.  
  161. {-----------------------------------------}
  162. {Routine to create the PopupMenu}
  163.         procedure MakeSaveMenu (itsRect: Rect);
  164.         begin
  165.             saveMenuHdl := NewMenu(SaveMenuID, SaveMenuTitle);
  166.             AppendMenu(saveMenuHdl, 'Copy resource flags');
  167.             AppendMenu(saveMenuHdl, '-');
  168.             AppendMenu(saveMenuHdl, 'Selected resource ID╒s╔');
  169.             AppendMenu(saveMenuHdl, 'All resource ID╒s╔');
  170.             AppendMenu(saveMenuHdl, 'All resources types╔');
  171.             saveMenuRect := itsRect;
  172.             saveMenuRect.top := saveMenuRect.top + 2;
  173.             CheckItem(saveMenuHdl, SaveRsrcFlags, copyRsrcFlags);
  174.         end;
  175.  
  176. {-----------------------------------------}
  177. {Update the list displaying the occurences of a given resource after either : }
  178. {the selection of a new resource type OR selection of another resource file}
  179.         procedure DoListUpdate;
  180.             var
  181.                 rType: ResType;        {Resource Type}
  182.         begin
  183.             SetFont('Monaco', 9, []);
  184.             rType := GetSelectedRsrcItem(typeList);    {Get the selected resource Type}
  185.             ChangeRInfoList(rType, rsrcList);
  186.         end;
  187.  
  188. {-----------------------------------------}
  189. {Passed in is the command number chosen from the File menu.}
  190.         procedure DoFileMenu (item: Integer);
  191.             var
  192.                 fName: Str255;    {File name}
  193.                 fRef: Integer;        {File reference number}
  194.         begin
  195.             GetRsrcFile(fName, fRef, item);
  196.             if fRef <> -1 then    {if -1 then couldn't access the file properly}
  197.                 begin
  198.                     SetCursor(watchHdl^^);
  199.                     currentFileName := fName;
  200.                     currentFileRef := fRef;
  201.                     PrintCurrentFile;
  202.                     SetFont('Monaco', 9, []);
  203.                     UseResFile(currentFileRef);
  204.                     ChangeTypeList(typeList);    {Update Resource type list}
  205.                     DoListUpdate;                {Update list of resource ID's}
  206.                     CheckOnlyThisItem(fileMenuHdl, item);
  207.                     InitCursor;
  208.                 end
  209.             else
  210.                 SysBeep(0);    {Shouldn't ever get called, as invalid rsrc-file menu-items are disabled}
  211.         end;
  212.  
  213. {-----------------------------------------}
  214. {Called when the user has made a selection in the Save Popup menu}
  215.         procedure DoSaveMenu (item: Integer);
  216.             var
  217.                 rType: ResType;        {Resource Type}
  218.         begin
  219.             rType := GetSelectedRsrcItem(typeList);
  220.             case item of
  221.                 SaveRsrcFlags: 
  222.                     begin
  223.                         copyRsrcFlags := not copyRsrcFlags;
  224.                         CheckItem(saveMenuHdl, SaveRsrcFlags, copyRsrcFlags);
  225.                     end;
  226.                 SaveSelected:     {Save selected resource ID's}
  227.                     DoSave(currentFileRef, currentFileName, rType, ActionSelSave, rsrcList, copyRsrcFlags);
  228.                 SaveRID:             {Save all resource ID's}
  229.                     DoSave(currentFileRef, currentFileName, rType, ActionIDSave, nil, copyRsrcFlags);
  230.                 SaveRType:         {Save all resources}
  231.                     DoSave(currentFileRef, currentFileName, rType, ActionTypeSave, nil, copyRsrcFlags);
  232.                 otherwise
  233.                     ;
  234.             end;
  235.         end;
  236.  
  237. {-----------------------------------------}
  238. {En- or disable certain menu-items in the save menu according to selections}
  239. {made in the resource lists.  Called when user clicks on the Save Popup Menu}
  240.         procedure UpdateSaveMenuItems;
  241.             var
  242.                 start: Integer;    {Cell to start looking from for enabled cell}
  243.                 theCell: Point;        {A selected cell in the LDEF list}
  244.         begin
  245.             start := 0;
  246.             if GetSelectedItem(start, theCell, rsrcList) then
  247.                 EnableItem(saveMenuHdl, SaveSelected)
  248.             else
  249.                 DisableItem(saveMenuHdl, SaveSelected);
  250.             if GetListArea(rsrcList) > 0 then
  251.                 EnableItem(saveMenuHdl, SaveRID)
  252.             else
  253.                 DisableItem(saveMenuHdl, SaveRID);
  254.             if GetListArea(typeList) > 0 then
  255.                 EnableItem(saveMenuHdl, SaveRType)
  256.             else
  257.                 DisableItem(saveMenuHdl, SaveRType);
  258.         end;
  259.  
  260. {-----------------------------------------}
  261. {This routine is called when the user clicks in the area where the popup menu sits}
  262.         procedure DoPopMenu (itsRect: Rect; whichMenu: MenuHandle; whichID: Integer);
  263.             var
  264.                 result: LongInt;        {Result from the Popup menu System call}
  265.                 menuPoint: Point;    {Local coordinate where to place the revealed popUp menu}
  266.         begin
  267.             InsertMenu(whichMenu, -1);
  268.             SetPt(menuPoint, itsRect.left + 1, itsRect.bottom + 1);
  269.             InvertRect(itsRect);
  270.             LocalToGlobal(menuPoint);
  271.             if whichMenu = saveMenuHdl then
  272.                 UpdateSaveMenuItems;
  273.             result := PopUpMenuSelect(whichMenu, menuPoint.v, menuPoint.h, 1);
  274.             if result <> 0 then
  275.                 if whichMenu = saveMenuHdl then
  276.                     DoSaveMenu(LoWord(Result))
  277.                 else if whichMenu = fileMenuHdl then
  278.                     DoFileMenu(LoWord(Result));
  279.             DrawPopMenu(fileMenuRect, FileMenuTitle);
  280.             DrawPopMenu(saveMenuRect, SaveMenuTitle);
  281.             DeleteMenu(whichID);
  282.         end;
  283.  
  284. {-----------------------------------------}
  285. {Routine to create the PopupMenu}
  286.         procedure MakeFileMenu (itsRect: Rect);
  287. {------}
  288.             procedure BuildFileMenu;
  289.                 var
  290.                     loop: Integer;        {loop through all open resource files}
  291.                     fName: str255;        {File Name}
  292.                     fRef: Integer;        {Resource file reference number}
  293.                     setUp: Boolean;        {True= found 1st enabled item in the popup menu, else False}
  294.             begin
  295.                 setUp := False;
  296.                 loop := 0;
  297.                 repeat
  298.                     loop := loop + 1;
  299.                     GetRsrcFile(fName, fRef, loop);
  300.                     if fRef <> 0 then    {File with resource fork found}
  301.                         begin
  302.                             AppendMenu(fileMenuHdl, fName);
  303.                             if (fRef <> -1) and (not SetUp) then    {Let this menu item be the default}
  304.                                 begin
  305.                                     DoFileMenu(loop);
  306.                                     currentFileName := fName;
  307.                                     currentFileRef := fRef;
  308.                                     PrintCurrentFile;
  309.                                     setUp := True;
  310.                                     CheckOnlyThisItem(fileMenuHdl, loop);
  311.                                 end;
  312.                             if fRef = -1 then    {Couldn't open this file's resource fork, so disable menu item}
  313.                                 DisableItem(fileMenuHdl, loop);
  314.                         end;
  315.                 until fRef = 0;
  316.             end;
  317. {------}
  318.         begin
  319.             fileMenuHdl := NewMenu(FileMenuID, FileMenuTitle);
  320.             BuildFileMenu;
  321.             fileMenuRect := itsRect;
  322.             fileMenuRect.top := fileMenuRect.top + 2;
  323.         end;
  324.  
  325. {-----------------------------------------}
  326. {Print the informative text in the window}
  327.         procedure PrintText;
  328.         begin
  329.             SetFont('Geneva', 12, [Bold]);
  330.             MoveTo(2, 10);
  331.             DrawString(programName);
  332.             SetFont('Geneva', 9, []);
  333.             MoveTo(5, 26);
  334.             DrawString('Resource Types');
  335.             MoveTo(107, 26);
  336.             DrawString('ID#           name              size');
  337.             MoveTo(135, 10);
  338.             DrawString('Rsrc File :');
  339.             PrintCurrentFile;
  340.         end;
  341.  
  342. {-----------------------------------------}
  343. {Create the Button controls}
  344.         procedure MakeControls;
  345.             const
  346.                 cTop = 124;    {Control top}
  347.                 cLeft = 84;    {Control left}
  348.                 cWidth = 40;    {Control width}
  349.                 cHeight = 17;    {Control height}
  350.                 cSpacing = 3;    {Control horizontal spacing}
  351.                 lTop = 30;        {List top}
  352.                 lHeight = 88;    {List height}
  353.                 pWidth = 51;    {popmenu width}
  354.             var
  355.                 cntlRect: Rect;    {Rectangle used to initialise list & control sizes}
  356.         begin
  357. {Lists}
  358.             SetFont('Monaco', 9, []);
  359.             SetRect(cntlRect, 4, lTop, 62, lTop + lHeight + 22);
  360.             typeList := BuildList(myWindow, cntlRect, 2, lOnlyOne + lNoNilHilite);
  361.             SetRect(cntlRect, 85, lTop, 260, lTop + lHeight);
  362.             rsrcList := BuildList(myWindow, cntlRect, 1, 0);
  363.             FrameLists;
  364. {Buttons}
  365.             SetRect(cntlRect, cLeft, cTop, cLeft + cWidth, cTop + cHeight);
  366.             helpControl := NewControl(myWindow, cntlRect, 'Help', True, 1, 0, 1, pushButProc, 0);
  367.             with cntlRect do
  368.                 begin
  369.                     left := right + cSpacing;
  370.                     right := left + cWidth;
  371.                 end;
  372.             quitControl := NewControl(myWindow, cntlRect, 'Quit', True, 1, 0, 1, pushButProc, 0);
  373. {Menus}
  374.             with cntlRect do
  375.                 begin
  376.                     left := right + cSpacing;
  377.                     right := left + pWidth;
  378.                     top := top - 2;
  379.                 end;
  380.             MakeFileMenu(cntlRect);
  381.             with cntlRect do
  382.                 begin
  383.                     left := right + cSpacing;
  384.                     right := left + pWidth;
  385.                 end;
  386.             MakeSaveMenu(cntlRect);
  387.         end;
  388.  
  389. {-----------------------------------------}
  390. {Create the main display window}
  391.         procedure MakeWindow;
  392.             const
  393.                 top = 70;                {Top of window}
  394.                 left = 80;                {Left margin of window}
  395.                 bottom = top + 143;    {Bottom margin of window}
  396.                 right = left + 280;    {Right margin of window}
  397.             var
  398.                 windRect: Rect;        {Rectangle to use for window}
  399.         begin
  400.             SetRect(windRect, left, top, right, bottom);
  401.             myWindow := NewWindow(nil, windRect, '', True, dBoxProc, pointer(-1), True, 0);
  402.         end;
  403.  
  404. {-----------------------------------------}
  405. {Redraw the window when an update event occurs}
  406.         procedure DoUpdate;
  407.         begin
  408.             BeginUpdate(myWindow);
  409.             PrintText;
  410.             UpdateControls;
  411.             EndUpdate(myWindow);
  412.         end;
  413.  
  414. {-----------------------------------------}
  415. {Give the user some information. Not very elegant...}
  416.         procedure DoHelp;
  417.             const
  418.                 s1 = '╞ This utility allows you to save resources belonging to a';
  419.                 s2 = '    currently open rsrc file as selected from the File menu.';
  420.                 s3 = '╞ Uses : Program debugging; Saving rsrc that change during';
  421.                 s4 = '    runtime; Breaking of some forms of CODE protection.';
  422.                 s5 = '╞ Instead of copying CODE-0, a cleaned-up $20(A5) jump';
  423.                 s6 = '   table is saved with the original CODE-0 header bytes;';
  424.                 s7 = '╞ Hold [OPTION] to get faster but unsorted lists.';
  425.                 s8 = '╞ Leading ╘Ñ╒ means resource is currently in memory.';
  426.                 s9 = '╞ Try saving resources without flags if you get copy errors';
  427.                 s10 = 'CodeSucker¬, ⌐1991 Michael van Kleef & Think Pascal¬';
  428.                 s11 = '  Comments, bugs, $1 if you think it╒s worth it etc. to :';
  429.                 s12 = '    Flat 5, 4 St.Quintin Ave., London  W10-6NU, England.';
  430.                 hSpacing = 4;        {Horizontal text line start}
  431.                 vSpacing = 10;    {vertical text line spacing}
  432.                 vStart = 16;        {Vertical coord to start text drawing}
  433.             var
  434.                 tmpRect: Rect;    {Rectangle within window which to erase}
  435.                 found: Boolean;    {True=selected cell found in }
  436.         begin
  437.             tmpRect := myWindow^.PortRect;
  438.             tmpRect.Top := tmpRect.top + 16;
  439.             EraseRect(tmpRect);
  440.             SetFont('Geneva', 9, []);
  441.             MoveTo(hSpacing, vStart + (vSpacing * 1));
  442.             DrawString(s1);
  443.             MoveTo(hSpacing, vStart + (vSpacing * 2));
  444.             DrawString(s2);
  445.             MoveTo(hSpacing, vStart + (vSpacing * 3));
  446.             DrawString(s3);
  447.             MoveTo(hSpacing, vStart + (vSpacing * 4));
  448.             DrawString(s4);
  449.             MoveTo(hSpacing, vStart + (vSpacing * 5));
  450.             DrawString(s5);
  451.             MoveTo(hSpacing, vStart + (vSpacing * 6));
  452.             DrawString(s6);
  453.             MoveTo(hSpacing, vStart + (vSpacing * 7));
  454.             DrawString(s7);
  455.             MoveTo(hSpacing, vStart + (vSpacing * 8));
  456.             DrawString(s8);
  457.             MoveTo(hSpacing, vStart + (vSpacing * 9));
  458.             DrawString(s9);
  459.             MoveTo(hSpacing, vStart + (vSpacing * 10));
  460.             DrawString(s10);
  461.             MoveTo(hSpacing, vStart + (vSpacing * 11));
  462.             DrawString(s11);
  463.             MoveTo(hSpacing, vStart + (vSpacing * 12));
  464.             DrawString(s12);
  465.             repeat
  466.             until Button;
  467.             FlushEvents(mDownMask, 0);    {Clear any mouseEvents to stop them interfering with the controls}
  468.             EraseRect(tmpRect);
  469.             InvalRect(tmpRect);
  470.         end;
  471.  
  472. {-----------------------------------------}
  473. {Routine called when a mouse-down event occurs}
  474.         function DoMouse (theEvent: EventRecord): Boolean;
  475.             var
  476.                 whichWindow: WindowPtr;        {Handle to window in which clicked}
  477.                 answer: Integer;                    {Answer from FindWindow}
  478.                 whichControl: ControlHandle;    {Which control clicked in}
  479.                 dummy: Boolean;                    {Unused result from LClick}
  480.         begin
  481.             DoMouse := False;
  482.             answer := FindWindow(theEvent.where, whichWindow);
  483.             if (whichWindow = myWindow) and (answer = inContent) then    {Mousedown within our window}
  484.                 begin
  485.                     SetFont('Monaco', 9, []);            {For the lists}
  486.                     GlobalToLocal(theEvent.where);    {Global mouse coordinate localized to our window}
  487.                     if FindControl(theEvent.where, whichWindow, whichControl) <> 0 then     {Click in a control}
  488.                         begin
  489.                             if whichControl = typeList^^.vScroll then                                {Type list scroll bar}
  490.                                 dummy := LClick(theEvent.where, theEvent.modifiers, typeList)
  491.                             else if whichControl = rsrcList^^.vScroll then                        {ID# list scroll bar}
  492.                                 dummy := LClick(theEvent.where, theEvent.modifiers, rsrcList)
  493.                             else if TrackControl(whichControl, theEvent.where, nil) <> 0 then
  494.                                 if whichControl = quitControl then                                        {Quit button}
  495.                                     DoMouse := True
  496.                                 else if whichControl = helpControl then                                {Help button}
  497.                                     DoHelp
  498.                         end;
  499.                     if ptInRect(theEvent.where, typeList^^.rView) then                            {Type list area}
  500.                         begin
  501.                             dummy := LClick(theEvent.where, theEvent.modifiers, typeList);
  502.                             DoListUpdate;
  503.                         end;
  504.                     if ptInRect(theEvent.where, rsrcList^^.rView) then                            {ID# list area}
  505.                         dummy := LClick(theEvent.where, theEvent.modifiers, rsrcList);
  506.                     if PtInRect(theEvent.where, saveMenuRect) then                                {Save menu area}
  507.                         DoPopMenu(saveMenuRect, saveMenuHdl, SaveMenuID);
  508.                     if PtInRect(theEvent.where, fileMenuRect) then                                {File menu area}
  509.                         DoPopMenu(fileMenuRect, fileMenuHdl, FileMenuID);
  510.                 end
  511.             else
  512.                 SysBeep(0);    {MouseDown outside our window}
  513.         end;
  514.  
  515. {-----------------------------------------}
  516. {Catch bad disks which are inserted whilst we are up and running}
  517.         procedure DiskEvent (whichEvent: EventRecord);
  518.             var
  519.                 diskInitPt: Point;        {Location of Disk initialisation dialog}
  520.                 ignore: integer;        {An ignored result from the format routine}
  521.         begin
  522.             SetPt(diskInitPt, 100, 120);
  523.             if (HiWord(whichEvent.message) <> noErr) then
  524.                 begin    {The disk is bad, and needs (re)formatting}
  525.                     DILoad;
  526.                     ignore := DIBadMount(diskInitPt, whichEvent.message);
  527.                     DIUnload;
  528.                 end;
  529.         end;
  530.  
  531. {-----------------------------------------}
  532. {Main Event loop which will exit only when 'quit'=True.   Sorry, No WaitNextEvent.}
  533.         procedure MainLoop;
  534.             var
  535.                 theEvent: EventRecord;    {Get events}
  536.                 quit: Boolean;                {True=Quit, False=Keep on looping}
  537.         begin
  538.             quit := False;
  539.             repeat
  540.                 SystemTask;
  541.                 if GetNextEvent(everyEvent - keyDownMask, theEvent) then    {Disallow keyboard events}
  542.                                 {Allowing keyDownMask means that all hell breaks loose when multiple}
  543.                                 {copies of CodeSucker are activated.}
  544.                     case theEvent.what of
  545.                         mouseDown: 
  546.                             begin
  547.                                 quit := DoMouse(theEvent);
  548.                                 FlushEvents(mDownMask, 0);    {Stop multiple clicking}
  549.                             end;
  550.                         updateEvt, ActivateEvt: 
  551.                             DoUpdate;
  552.                         diskEvt: 
  553.                             DiskEvent(theEvent);    {Trap bad disks}
  554.                         otherwise
  555.                     end {Case}
  556.             until quit;
  557.         end;
  558.  
  559. {-----------------------------------------}
  560. {As this utility is not an application, we have to release all our own data structures}
  561.         procedure DisposeGlobals;
  562.         begin
  563.             LDispose(typeList);            {release resource type list}
  564.             LDispose(rsrcList);            {release resource ID list}
  565.             DisposeMenu(fileMenuHdl);    {release file popup menu}
  566.             DisposeMenu(saveMenuHdl);    {release save popup menu}
  567.             CloseWindow(myWindow);    {Automatically free's associated Control structures (buttons)}
  568.         end;
  569.  
  570. {-----------------------------------------}
  571.     begin {Main}
  572.         oldResFile := CurResFile;{Save old resource file}
  573.         oldResLoad := IntPtr(ResLoad)^;
  574.         if oldResLoad = 0 then    {Resource loading was disabled, so enable it as we need some system resources (LDEF etc)}
  575.             SetResLoad(True);
  576.         GetPenState(oldPen);
  577.         watchHdl := GetCursor(watchCursor);
  578.         SetCursor(watchHdl^^);
  579.         copyRsrcFlags := True;
  580.         PenNormal;
  581.         MakeWindow;
  582.         SetPort(myWindow);
  583.         MakeControls;
  584.         DoUpdate;
  585.         PenMode(srcCopy);
  586.         InitCursor;
  587.         MainLoop;
  588.         DisposeGlobals;
  589.         SetPenState(oldPen);        {Restore old pen}
  590.         if oldResLoad = 0 then    {Restore Resload global}
  591.             SetResLoad(False);
  592.         useResFile(oldResFile);    {Restore old resource file}
  593.     end;    { main }
  594.  
  595. end.    { unit }