home *** CD-ROM | disk | FTP | other *** search
/ Carousel Volume 2 #1 / carousel.iso / mactosh / virus / vcheck40.sit / VCheck.p < prev    next >
Encoding:
Text File  |  1988-07-05  |  196.2 KB  |  7,380 lines  |  [TEXT/TPAS]
  1. program VCheck;
  2. (**************************************************************** 
  3.  
  4. Startup System Test program 
  5.  
  6. by Albert Lunde, Northwestern University 
  7.  
  8. Copyright ⌐ 1988 - All Rights Reserved
  9.  
  10.   See "Terms of Distribution","Use" and "To get started"
  11.   in comments below: 
  12.  
  13. ****************************************************************)
  14.  
  15. {$U-}   {don't use turbo pascal default units}
  16.  
  17. {$R-}   {range check off} 
  18. {**R-}  {these two strings} 
  19. {**R+}  {signal places where range checks are needed in debugging}
  20.  
  21. {$D+}   {debug symbols on} 
  22. {$B-}   {bundle bit not set} 
  23. {$S+}   {segment load on}
  24.  
  25. uses pasInout,memtypes,quickdraw,osintf,toolintf,
  26.      fixmath,packintf,SANE; 
  27.  
  28. const
  29.  
  30.   StartVersion='Vcheck - Version 1.3 '; 
  31.  
  32.   TitleVersion=' 1.3 7/5/88'; 
  33.  
  34.   checksumsaltinc=$00010001;{change this to modify the way
  35.                              checksums are computed}
  36.  
  37. (****************************************************************
  38.  
  39. Startup System Test program 
  40. by Albert Lunde, Northwestern University 
  41. Copyright ⌐ 1988 - All Rights Reserved
  42.  
  43. This is a program to detect software viruses by checking for 
  44. changes in the contents of the active system folder, the boot 
  45. blocks and all applications on connected volumes.  It does 
  46. not prevent viruses from spreading in your system, but can 
  47. alert you to their existence. It is not designed to be 
  48. specific to particular viruses, except for warning of 
  49. "dangerous" resource types when found.
  50.  
  51. Terms of Distribution:
  52.  
  53. Non-commercial distribution is encouraged, with several 
  54. conditions:
  55.  
  56. 1) You must distribute the source code if you distribute the 
  57. compiled program. (The main purpose of this is to make it 
  58. difficult for viruses to spread. Users are encouraged to 
  59. recompile from the source code, since source code cannot 
  60. carry a virus.)
  61.  
  62. 2) If you modify the source code, distribute both the 
  63. original code and the modified code and include the original 
  64. comment headers with copyright notice and remarks in both 
  65. files. List a summary of your changes after the header, and 
  66. add the word "Modified" to the two Version identifiers. You 
  67. may not attach additional restrictions to distribution of the 
  68. modified code.  If I receive useful modifications, I may add 
  69. them to my versions. (Distributing the original source makes 
  70. it clearer what has been changed and may aid support.)
  71.  
  72. 3) You may change a copying fee not to exceed $10 or the cost 
  73. of media whichever is greater.  (The intent is to put 
  74. distribution of the original program and/or modified versions 
  75. into non-profit channels to allow wider distribution)  Normal 
  76. communications and connect charges for downloading software 
  77. are permitted.
  78.  
  79. ***********************************************************
  80.  
  81. New features and changes since version 1.2
  82.  
  83. 1) Checksums may change from earlier versions since the list 
  84. "safe" resources and files has been changed to work better 
  85. with system update 6.0.
  86.  
  87. 2) Added automatic full checksum on applications that have 
  88. changed size - this reduces false alarms on an "Application 
  89. Scan".
  90.  
  91. 3) Fixed a bug which caused named resources with trailing blanks 
  92. in the name to be treated as not equal to themselves.
  93.  
  94.  
  95. New features and changes since version "1.0 Beta":
  96.  
  97. It is easier to keep your checksums file up to date. Features 
  98. have been added to do checksums of new applications and/or 
  99. replace the old checksums file with the new file.
  100.  
  101. It is possible to check other system folders than the 
  102. currently active system.
  103.  
  104. Several options that previously were available only by 
  105. recompiling the program are now specified in a dialog and the 
  106. input file.
  107.  
  108. Checksums may change from the earlier version since the list 
  109. "safe" resources has changed.
  110.  
  111. Four bugs fixed - 
  112.  
  113. 1) a bug affecting the results when an output file was 
  114. written after an application scan. 
  115.  
  116. 2) errors in  folder names on non-boot disk volumes, 
  117.  
  118. 3) a bug causing applications to be falsely declared as "new" 
  119. in some circumstances 
  120.  
  121. 4) a bug causing the program to freeze or bomb just after 
  122. checking the boot blocks.
  123.  
  124. Changes have been made in heap and stack treatment which I 
  125. hope will fix the intermittent errors in previous version (I 
  126. suspect a heap/stack collision during an interrupt handler).
  127.  
  128. ***********************************************************
  129.  
  130. Hardware and Software:
  131.  
  132. Written in Turbo Pascal 1.1 for the Mac (tested on a Mac SE 
  133. and a Mac II) this should run on a Mac Plus,Mac SE or Mac II. 
  134. I am not sure if a Mac 512E has enough memory.  This assumes 
  135. you have HFS and a relatively recent system so it is not 
  136. appropriate for the 128K or 512K Macs with the old 64K ROMs. 
  137. Some versions of the program compiled and ran with Turbo 1.0 
  138. but I haven't tested this much.
  139.  
  140. Use:
  141.  
  142. The program expects to find an input file named 
  143. "OldSystemCheckSum" in either the default folder or the 
  144. system folder.  It will optionally write an output file in 
  145. the same format as the input file.  (Both are text files with 
  146. items separated by tab characters.  The output file is named 
  147. "OldSystemCheckSum" if no input file exists and 
  148. "NewSystemCheckSum" otherwise.)  
  149.  
  150. The program compares the contents of your system folder with 
  151. information in the input file, and tells you about changes. 
  152. It also does a less detailed check of applications. It monitors 
  153. the existence of hidden files.
  154.  
  155. You have the option of replacing the input file with the 
  156. output file after reviewing changes on-screen. 
  157.  
  158. Use of this program does not prevent a virus infecting your 
  159. system, but it may give you an indication that you are 
  160. infected, and thereby prevent infection of your backups. (Yet 
  161. another reason to keep several sets of backups.)
  162.  
  163. When the program starts you are presented with a choice of 
  164. five buttons:
  165.  
  166. "System Only" button:
  167.  
  168.   This does a complete check of the system folder, and does 
  169.   nothing with applications and hidden files elsewhere.
  170.  
  171. "Application Scan" button:
  172.  
  173.   This will start a complete check of the system folder and 
  174.   a check for changes in the sizes the resource forks of 
  175.   applications. After about 10 seconds the Mac will continue as 
  176.   if you had clicked this option. This is faster but less 
  177.   accurate than the "Full Check". Because some applications 
  178.   write preferences information to their own resource fork, 
  179.   checking the size is not an ideal check. When an application 
  180.   appears to have changed size, a full checksum is done on it. 
  181.   This reduces false alarms. However, the size check can still 
  182.   be evaded by a careful virus.
  183.  
  184. "Full Check" button:
  185.  
  186.   This does a complete check of the system folder and a 
  187.   check for changes in resources of applications. Only resource 
  188.   types marked as known to contain executable code are checked 
  189.   in applications and invisible files.  It is recommended that 
  190.   you use "Full Check" periodically, especially before making 
  191.   backups, as it is much more difficult than "Application Scan" 
  192.   for a virus to evade.  It is not the default, because it can 
  193.   take several minutes to run.
  194.  
  195. "Skip It" button:
  196.  
  197.   Halts the program
  198.  
  199. "ShutDown" button:
  200.  
  201.   Flush all drives and do a system shutdown. (similar to 
  202.   the item in the Finder Special Menu).
  203.  
  204. If you press the option key before or while clicking one of 
  205. these buttons, you will be presented with additional options, 
  206. including the option to write an output file and/or to check 
  207. a different system folder than the startup system. (More 
  208. about this below).
  209.  
  210. Key Commands:
  211.  
  212.      (the command key is ignored)
  213.  
  214.  
  215.   "Q"- Quit after closing files 
  216.  
  217.   "F"- same as "Full Check" button 
  218.  
  219.   "A"- same as "System Only" Button 
  220.  
  221.  
  222.   "Y"- same as Yes Button 
  223.  
  224.   "N"- same as No  Button 
  225.  
  226.   "."- Quit immediately 
  227.  
  228.   Return Key - Default button (with bold outline) 
  229.  
  230.   "*"- invoke MacsBug debugger and turn on additional output.
  231.  
  232.        (don't use this command without a debugger) 
  233.  
  234.   "^"- invoke MacsBug debugger
  235.        (don't use this command without a debugger) 
  236.  
  237.   "&"- turn on debugging output 
  238.  
  239.   "#"- turn on debugging output for resource/application detail
  240.        comparison routines
  241.  
  242. After the program starts, at any time you may quit the 
  243. program by clicking the "Halt" button or pressing the "Q" 
  244. key. You may shut down the system with the "Shutdown" button.
  245.  
  246. To get started:
  247.  
  248. Place the compiled program anywhere outside the system folder 
  249. and run it, clicking on "Full Check". It may be necessary to 
  250. increase the memory allowed by MultiFinder using the Get Info 
  251. dialog. (500K is reasonable).
  252.  
  253. The first time you run it, the program will not find the 
  254. input file, and will ask you if you want to specify another 
  255. input file. Click on NO. Click YES when it asks you to 
  256. specify an output file.  You will then see a standard dialog 
  257. to save a file using the name "OldSystemCheckSum". Click on 
  258. the save button.  
  259.  
  260. When the program runs, the output file should contain a 
  261. summary of resources in the system file and of applications 
  262. and hidden files. This checks all connected disk drives, 
  263. optionally excluding floppies and folders on AppleShare file 
  264. servers.
  265.  
  266. Now, whenever you run the program, it will use the file 
  267. "OldSystemCheckSum" as a standard of comparison and inform 
  268. you of changes.  If you want maximum protection, make this 
  269. program your startup application with Set Startup.
  270.  
  271. When you install new software in the system folder or make 
  272. some changes in system settings you may get messages about 
  273. new or changed resources.  You will also get messages when 
  274. you add an application, or move, rename or duplicate an 
  275. application.  If an application writes setup/preferences 
  276. information into itself, it will be listed as a "Safe change 
  277. in size", provided no unsafe resource types are changed.
  278.  
  279. To see how these messages look, move some small application 
  280. into the system folder and re-run the program.
  281.  
  282. These messages reporting changes will continue to appear 
  283. until you create an new output file (default name 
  284. "NewSystemCheckSum") and rename it to  "OldSystemCheckSum". 
  285. You will be offered the option to create an output file and 
  286. later to rename it whenever changes are reported.
  287.  
  288. If you have not done a full checksum, and you choose to write 
  289. an output file the program will recompute checksums for some 
  290. applications, usually new application or applications moved 
  291. between folders. This is a feature designed to keep your 
  292. checksums file up to date. To be safe and informed of all 
  293. changes, however, you should run "FullCheck" periodically, 
  294. and only OK replacing your input file at other times when you 
  295. know the reason for changes in the system or applications.
  296.  
  297. To get a complete check and create a output file, hold down 
  298. the option key while clicking of the "FullCheck" button at 
  299. startup. Running "FullCheck" whenever you write an output 
  300. file gives you the information necessary to do a complete 
  301. comparison later.
  302.  
  303. If changes seem minor (like a moved or new application), you 
  304. can rename the output file within the program and replace the 
  305. input file, or you can compare and or print the input and 
  306. output files with a text editor after running the program, 
  307. then rename the output file with the Finder.
  308.  
  309. In the output file, new or changed resources are flagged 
  310. "new??" or "changed??". Deletions are not marked. 
  311. Applications are marked as "moved/renamed??',"new??", 
  312. "changed??" or "safe changed??". Hidden files are marked as 
  313. "(hidden)" if they are not applications.
  314.  
  315. The output file is first written, then you are asked if you 
  316. want to rename it. If you say yes, the input file is deleted 
  317. and then the output file is moved and renamed to the same 
  318. folder and filename used by the input file.
  319.  
  320. You will not be offered the option to rename the output file 
  321. if it and the input file are on different disk drives.
  322.  
  323. Since the output file is written before deleting the input, 
  324. there must be space on disk for both files. You can quit 
  325. anytime prior to telling the computer to rename the output 
  326. without affecting the input file.
  327.  
  328. Options:
  329.  
  330. Pressing the option key before or while you click on the 
  331. startup dialog buttons will cause the program to offer you a 
  332. number of options.
  333.  
  334. You are asked if you want to write an output file.
  335.  
  336. Several options that control what is checked are collected 
  337. together on a dialog screen.
  338.  
  339. "Check Floppies" is a check box that controls if floppy 
  340. diskettes are checksummed. (no by default)
  341.  
  342. "Check Non-Startup Drives" is a check box that controls if 
  343. disk volumes besides the volume containing the system folder 
  344. being checked are checked.
  345.  
  346. By default the program only looks at the top level of 
  347. AppleShare file Servers, and does not descend into folders 
  348. unless you are the owner. The "Appleshare Access" buttons 
  349. allows you to change this, and search all folders for which 
  350. you have read/write access or "everything in sight" (folders 
  351. for which you have search access). (Using these options can 
  352. place quite a load on Appleshare.)
  353.  
  354. All the options in the dialog screen are stored in the output 
  355. file and default values are read from the input file if any.
  356.  
  357. Specifying a different system to check:
  358.  
  359. If you hold down the options key, another question you are 
  360. asked is if you want to specify another system folder to 
  361. check. If you say yes, you are presented with a file dialog. 
  362. Pick a system folder and select the "System" or any other 
  363. file in the folder.
  364.  
  365. This is useful when checking a system you believe to be 
  366. infected after booting from a floppy disk. 
  367.  
  368. If you want to check the system on a suspect floppy disk, 
  369. turn on "Check Floppies", turn off "Check Non-Startup Drives" 
  370. and then select the system folder on the floppy disk to 
  371. check. (DO NOT BOOT from a suspect disk or run any 
  372. applications on it).
  373.  
  374. More about the Checksums:
  375.  
  376. In order to reduce unnecessary messages and speed processing, 
  377. some resources and some parts of the boot blocks are excluded 
  378. from the checks. Resources types are classified as:
  379.  
  380.      0 "Safe"
  381.  
  382.        (Not containing executable code) 
  383.        for example: 
  384.        "STR#","FONT","ICON"
  385.  
  386.      1 "Unknown"
  387.  
  388.         (Not otherwise classified)
  389.  
  390.      2 "Unsafe"
  391.  
  392.         (Containing executable code) 
  393.         for example:"CODE","INIT" 
  394.         (or sometimes occurring in reported viruses,
  395.         sometimes in normal use)
  396.  
  397.      3 "Dangerous"
  398.  
  399.         (Known only to occur in reported viruses)
  400.  
  401. "Safe" resources are excluded from system folder checksums.
  402.  
  403. Only "unsafe" resources are checked in application and hidden 
  404. files and only a file by file checksum is kept, not a 
  405. resource by resource checksum.
  406.  
  407. A basic list of resource types is in the program, and 
  408. "unknown" resources can be reclassified by changing the input 
  409. file.
  410.  
  411. There is also a list of key phrases which indicate a file in 
  412. the system folder may safely contain changes in "unknown" 
  413. resource types. If one of these keywords is found as a 
  414. substring in the filename both "safe" and "unknown" resources 
  415. are excluded from checksums. This is used to reduce 
  416. unnecessary warnings about changes in the Clipboard, 
  417. Scrapbook, Macro and settings files stored in the system folder.
  418.  
  419. A checksum of checksums is done across resource types.  This 
  420. will change when any contents of the checked resources change 
  421. or when the criteria for what is to be checked change.  This 
  422. will change when resources are deleted, while the resource by 
  423. resource lists of changes only indicate new or changed 
  424. resource.
  425.  
  426. No grand checksum is done for applications. The way that 
  427. applications are identified is by their 4 character creator 
  428. signature and creation date and time.
  429.  
  430. Hidden files are not checked for size on a short check and 
  431. they are only checked for "unsafe" resource type changes on a 
  432. full check. This is because the DeskTop and other normal 
  433. hidden files change size.
  434.  
  435. To make it more difficult to evade checksums, users are 
  436. encouraged to change the value of the constant 
  437. "checksumsaltinc" from $00010001 to some other longword hex 
  438. value containing mostly zeros, but some non-zero digits in 
  439. both the lower and upper half. Changing this value changes 
  440. the non-linearity of the checksums, and changes the results, 
  441. so that a change that would be undetected for one value might 
  442. not be for another.
  443.  
  444. Disclaimers:
  445.  
  446. I do not warrant that this software will alert you to all 
  447. viruses. (It won't.) I don't claim to be an expert in 
  448. eradicating software viruses and can not do long-distance 
  449. consulting on problems with them. I have designed this 
  450. program from general considerations rather than experience 
  451. with particular viruses.
  452.  
  453. I have taken reasonable care that this program do no harm, 
  454. but I cannot assure this.  My main consideration has been to 
  455. put something together quickly to help detect viruses and 
  456. reduce their spread. Getting this out the door in time to be 
  457. useful precludes exhaustive testing.
  458.  
  459. Northwestern University Apple Tech Support is assisting in 
  460. distributing this program, but they do not take 
  461. responsibility for its continued support.
  462.  
  463. Acknowledgements:
  464.  
  465. Thanks to Bob Hablutzel and John Norstad for their advice and 
  466. support during the development of the program.
  467.  
  468. This code owes a lot to a number of sources. My resources 
  469. include:
  470.  
  471. "Inside Macintosh" Volumes I to V
  472.  
  473. (A lot of use is made of the resource section and the Volume 
  474. IV parameter block file system calls}
  475.  
  476. Apple Tech Notes (in particular):
  477.  
  478. 67  Finding the blessed folder 
  479. 68  Searching all Directories on an HFS Volume 
  480. 69  Setting ioFDirIndex in PBGetCatInfo Calls 
  481. 77  HFS ruminations
  482.  
  483. "MacTutor" Magazine 
  484. "Macintosh Revealed" Vol I & II by Stephen Chernicoff 
  485. "How to Write Macintosh Software" by Scott Knaster 
  486. "Macintosh Programming Secrets" by Scott Knaster 
  487. "Programming with Macintosh Programmer's Workshop" by Joel 
  488. West 
  489. "Fundamentals of Data Structures" by Ellis Horowitz and 
  490. Sartaj Sahni 
  491. "Programming Pearls" Jon Bentley
  492.  
  493. MacNosy disassembler/debugger by Steve Jasik
  494.  
  495. Bug Reporting:
  496.  
  497.     I can be reached at:
  498.  
  499. E-Mail
  500.  
  501.         LUNDE@NUACC.BITNET
  502.  
  503.         LUNDE@NUACC.ACNS.NWU.EDU  (Internet)
  504.  
  505. U.S. Mail
  506.  
  507.         Albert Lunde 
  508.         Academic Computing 
  509.         Northwestern University 
  510.         2129 Sheridan Road 
  511.         Evanston, IL 60208
  512.  
  513. Related messages can also be sent to me care of Northwestern 
  514. University Apple Tech Support:
  515.  
  516.         A42 - AppleLink;
  517.  
  518.             or
  519.  
  520.         76474,154   - CompuServe
  521.  
  522. If you get system bombs, record the ID number and what was 
  523. happening prior to the error. If you have Macsbug, use "wh" 
  524. to see where you are in memory. If you have any debugger, 
  525. record the registers. Since this is a non-commercial effort, 
  526. and I am giving out the source code, whatever you can do to 
  527. localize and diagnose bugs will be appreciated.   I do not 
  528. know at this time how much time I can or will spend on 
  529. support and revisions.
  530.  
  531. Notes to Hackers:
  532.  
  533. There is room for improvement here. An assembly language 
  534. checksum function could be faster.  I suggest any checksum 
  535. method should meet a few criteria: Any one bit change should 
  536. be likely to change the checksum.  Transpositions of bytes 
  537. should change the checksum. Any checksum function should be 
  538. non-linear with respect to addition and exclusive or.
  539.  
  540. That is, roughly speaking:
  541.  
  542. F(a xor b)  <>  F(a) xor F(b)
  543.  
  544. F(a + b)    <>  F(a) +   F(b)
  545.  
  546. I think my combination of shifts,xors and sums satisfies 
  547. these conditions.
  548.  
  549. The code was patched together from other projects and has 
  550. odds and ends that are unnecessary for this reason..
  551.  
  552. I would be interested to know of conversion issues going to 
  553. other Pascal compilers. My use of Turbo's "shr" "shift 
  554. right", "xor" and other inline bit manipulation operators for 
  555. speed may cause some localized portability problems.
  556.  
  557. The program is designed over-all to make spreading viruses 
  558. more difficult, not impossible, with trade-offs relative to 
  559. speed and convenience. This is why I do a less elaborate 
  560. checksum on applications. The program does not use custom 
  561. icons or any other resources, so that it will be easier to 
  562. give out in source code form.
  563.  
  564. I am checking the contents of the resource file by reading 
  565. the resource map myself, opening the resource fork as a read-
  566. only file. An earlier version used LoadResource and 
  567. DetachResource, but this had bugs which may come from 
  568. fragmentation of the system heap when resources were 
  569. repeatedly loaded into it.
  570.  
  571. ****************************************************************)
  572.  
  573. {Development versions by Albert Lunde:}
  574.  
  575. {version 22 modified to read resource maps directly}
  576. {this version has some bugs in memory usage that are gradually
  577.  eating up free memory - I suspect open/close - and/or TE 4/1/88} 
  578. {version 23 the size of the TE handle is increasing but the text size is
  579.   stating about the same , also memory allocation is a bit out of balance}
  580. {version 24 rewrite of memory allocation to reduce the change of
  581.   stray handles in the resource reading routines- still has trouble
  582.   with the TE handle size 4/3/88}
  583. {version 25 fix new TE bug by explictly changing 
  584.      the tehandle size when it gets clearly too big 4/4/88}
  585. {version 27 hide debugging code, fix problem with ids, fix problem
  586.      with input/output '*****' flag recognition}
  587. {version 28 hidden "D" key to invoke Macsbug added 4/5/88}
  588. {version 29 added relative positioning in resource reading code to
  589.             allow buffering to work better 4/5/88}
  590. {version 30 reduce minimum memory safety factor, hide debugging
  591.           output 4/5/88}
  592. {version 31 add auto-start after delay}
  593. {version 32 cleanup for distribution, remove zero size handle check,
  594.    add more safe keys, add beep at end  4/8/88}
  595. {version 33 add a bit of debuggging and I/O checking 4/8/88}
  596. {version 34 add application size checks 4/10/88}
  597. {version 36 application checksums/detail output added but buggy 4/10/88}
  598. {version 37 fix bugs,trim blanks before file name comparisions 4/11/88}
  599. {version 38 shift creationdates 4 bits, modify startup interface
  600.             this needs more testing 4/11/88}
  601. {version 39 minor mods to application sort/compare, interface 4/12/88}
  602. {version 40 add check of invisible files 4/14/88}
  603. {version 41 add folder names to info on applications 
  604.             add delay after disk operations to
  605.             fix intermittent bug in SCSI interrupt handler 
  606.             fiddle with user interface 4/14/88}
  607. {version 42 tweak new features and revise comments 4/14/88}
  608. {version 43 add system/only option and tweak startup 4/15/88}
  609. {version 44 bug fix in version 43 mods, add more key abbreviations
  610.             change debugger invocation to "*" to avoid miskeys 4/15/88}
  611. {version 45 modify treatment of application scan output 4/16/88}
  612. {version 46 fix minor bug in % display, clean up comments 
  613.              add PREF to safe types list  4/17/88}
  614. {version 47  add to safe types list - display resource names 4/17/88}
  615. {version 50 begin adding  multi-volume checks 4/18/88}
  616. {version 51 1st version with full multi-volume checks
  617.             seems to be working - 4/18/88}
  618. {version 52 tweak multi-volume checks - 4/19/88}
  619. {release as version 1.0 beta 4/19/88}
  620. {version 53 ** fix bug in copy of checksums from old file to output
  621.             after partial scan 
  622.             ** Add RLRL and ppat to safe resource types
  623.             ** Add DEFAULT to safekeys          5/1/88}
  624. {version 54 ** add recheck of new/changed/moved for output 5/3/88}
  625. {version 55 ** add option to specify another system folder to check 5/3/88}
  626. {version 56 ** add options screen and propagation of options
  627.             through the input file 5/3/88}
  628. {version 57 combine two redundant globals flags to fix a bug
  629.             which showed up after version 53 
  630.             add ^ as escape to debugger 
  631.             add periodic call to doevent in scsi_wait 
  632.             add count to recheck warning  5/6/88}
  633. {version 58 ** add optional rename of output 
  634.             only volume checked always "matches" the only
  635.             old volume in the input file 5/6/88}
  636. {version 59 fix output rename to avoid dup filenames before move
  637.             modify recheck logic to avoid message 
  638.             when nothing is done  
  639.             Improve testing for option keys down 5/7/88}
  640. {version 60 ** use improved code to get folder name and/or path
  641.                                                  5/7/88}
  642. {version 61 fix message on output rename
  643.             revise message about rechecks 
  644.             increase scsi_wait delays 5/7/88}
  645. {version 62 add scsi_wait call in enumeration code
  646.             add UnloadSeg calls and fiddle with segmentation 5/9/88}
  647. {version 63 adjust segmentation to try to increase free memory 
  648.             adjust scsi_wait parameters             5/10/88}
  649. {version 64 put null event and message posting in main segment
  650.             reduce number of unload_all calls    
  651.             to reduce fragmentation due to segments 
  652.             increase stack,decrease heap to reduce chance of collisions 
  653.             add "&" to turn on debug output without macsbug 5/10/88}
  654. {version 65 move allocate_big_mem earlier and put in main
  655.              segment to get blocks it allocates lower in
  656.              the heap. Add stack size monitor to postmem   5/11/88}
  657. {version 66 fix bug in sizes used in allocate_big_mem
  658.             move still earlier, put initialize in blank seg 5/11/88}
  659. {version 67 revise comments for distribution 5/12/88}
  660. {release as version 1.1 - not widely distributed}
  661. {version 68 **fix possible problems in initialization of PBHGetVol file calls 
  662.             may be a bug at the start of the enumerate code from TN68 5/14/88}
  663.  
  664. {version 69 ** add code to skip to end of section in detail comparision if 
  665.               end_on_new before end on_old (avoid false new appls)   5/14/88}
  666. {release as version 1.2}
  667. {version 70 add debugging output "#" hidden key for detail comparisons
  668.             fix problem when resource type names end with a space  6/1/88}
  669.   
  670. {version 71 start adding code to reposition input file if necessary 6/14/88}
  671. {version 72 more work 6/15/88} 
  672. {version 73 ** add code to do full check on size-changed applications 
  673.             if ok list as "safe size changes" 
  674.             ** add WIND to safe resource types 
  675.             ** add MACRO and MAP to safekeys 6/21/88}  
  676. {version 74 remove automatic application check on output 
  677.             consolidate output dialog code 
  678.             add output dialog to over-all checksums
  679.             and boot blocks messages         
  680.             add code to match one new vol to old boot vol 6/22/88} 
  681. {version 75 add code to make output file name "OldSystemCheckSum"
  682.             if no input file to make startup easier
  683.             clean up for distribution 6/29/88}
  684. {release with added comments as release version 1.3 7/5/88}    
  685.  const
  686.     {bytes to add to stack size  and reduce heap size:}
  687.     stack_extra_size=20000;
  688.     {parameters of delay to avoid overloading disk drivers}
  689.     scsi_wait_limit=4{8};{wait after this many disk operations}
  690.     scsi_wait_ticks=2{2};{wait this long}
  691.     
  692.     {periodic calls to event handler for breakout}
  693.     {call postmem,doevent after this many disk ops}
  694.     scsi_wait_doevent_debug=3;{if debug output is on}
  695.     scsi_wait_doevent_normal=100;{otherwise}
  696.     
  697.     {debugging stuff}
  698.     dbaopen=1;
  699.     dbatype=2;
  700.     dbaref=3;
  701.     dbadata=4;
  702.     dbamax=4;
  703.     
  704.  {buttons}
  705.   mbutton=9;
  706.   nodefaultbut=0;
  707.   yesbut=2;
  708.   nobut=4;
  709.   haltbut=1;
  710.   continuebut=3;
  711.   shutdownbut=5;
  712.   
  713.   skipitbut=6; 
  714.   sysonlybut=7;
  715.   shortbut=8;
  716.  fullbut=9;
  717.  
  718.  
  719.     
  720.   startupdefaultbutton=shortbut;
  721.   
  722. {option controls}
  723.   moptcon=5;
  724.  floppyoptcon=1;
  725.  nonstartupoptcon=2;
  726.  owneroptcon=3;
  727.  writeoptcon=4;
  728.  everythingoptcon=5;
  729.  
  730.   startupdelay=10;{seconds}
  731.   
  732.   {limits on what can be checked}
  733.   maxinfo=800;{total resources in system folder }
  734.   maxtype=200;{total resource types in system folder }
  735.   maxsysfiles=100;{total files in system folder}
  736.   maxappl=300;{total applications and hidden files}
  737.   maxvols=16;{volumes}
  738.   maxsafekeywords=20;
  739.   myfilenamesize=31;
  740.   thenamesize=10;
  741.   maxtokens=12;{input scanner limit}
  742.   floppycutoffsize=900;{size limit used to identify
  743.                         floppy drives}
  744.   recheckappllimit=10;{number of new/moved/changed applications to
  745.                        recheck without asking when writing an output file}
  746.   {number of status lines}
  747.   mstatus=7;
  748.  {postions of status lines}
  749.   titleline=1;
  750.   byline=2;
  751.   pathline=3;
  752.   fileline=4;
  753.   errorline=5;
  754.   memline=5;
  755.   AskLine=6;
  756.   resline=6;
  757.   detailbugline=1;
  758.   
  759.   {positions of sections in input file}
  760.   sect_num_header=1;
  761.   sect_num_safe_names=2;
  762.   sect_num_more_checks=3;
  763.   sect_num_volumes=4;
  764.   sect_num_types=5;
  765.   sect_num_res_checks=6;
  766.   sect_num_applications=7;
  767.   
  768.   {rescaling of creation dates by factor of 1/16}
  769.   creationdateshr=4;
  770.   creationdatemask=$0FFFFFFF;
  771.   
  772.   {appleshare access mask values}
  773.   owneraccessmask=$FF;
  774.   readwriteaccessmask=$07;{read,write,search}
  775.   everythingaccessmask=$01;{search}
  776.  
  777.   {constants to control what drives/folders are checked
  778.    by default}
  779.   appleshareaccessmaskdefault=owneraccessmask;
  780.   checkfloppiesdefault=false;
  781.   checknonbootdrivesdefault=true;
  782.   
  783.   {resource match flags}
  784.   fnamemask=$3FFF;{mask off top bits of filename index}
  785.   idmatchmask=$8000;
  786.   exactmatchmask=$4000;
  787.   
  788.   {application match flags}
  789.   applrenamemask=$0100;
  790.   applexactmatchmask=$0200;
  791.   applchangedmask=$0400;
  792.   applsafechangedmask=$0080;
  793.   appldangermask=$0800;
  794.   applbadsizemask=$1000;
  795.   applbadcheckmask=$2000;
  796.   applinvisiblemask=$4000;{flag invisible files}
  797.   applvolumemask=$001F;{subscript of volume}
  798.   notcounted=-9;{flag results of short check in unsafecount}
  799.   
  800.   {grow zone function guard block size:
  801.   This block is released if the heap is full and the
  802.   program stops with a warning. Reducing this would make the program
  803.   run in less memory but if it runs out it would die unpleasantly}
  804.   
  805.   GZguardblocksize=70000;
  806.   
  807.      {stuff from tech note#77}
  808.  
  809.         SysWDProcID    = $4552494B;    {╥ERIK╙}
  810.         BootDrive       = $210;    {address of Low-Mem global BootDrive}
  811.         FSFCBLen    = $3F6;      {address of Low-Mem global to distinguish file systems }
  812.         SysMap        = $A58;    {address of Low-Mem global that contains system map reference number}
  813.  
  814.   type
  815.       myfilenametype=string[myfilenamesize];
  816.       myresnametype=string[thenamesize];{truncated resource names}
  817.             WordPtr = ^Integer;            {Pointer to a word(2 bytes)}
  818.  
  819.       {info on system folder resources}
  820.       resourceinforec  = record
  821.                          thesize:longint;
  822.                          thetype:restype;
  823.                          theid:integer;
  824.                          filenameindex:integer;{also flags in the high bits}
  825.                          checksum:integer;
  826.                          thename:myresnametype;
  827.                          end;
  828.       resourceinfoarray=array[1..maxinfo] of resourceinforec;
  829.       resourceinfoarrayptr=^resourceinfoarray;
  830.       safetype=(safe,unknown,unsafe,dangerous);
  831.       resourcetypeinforec = record
  832.                             thetype:restype;
  833.                             safety:safetype;
  834.                             occurs:integer;
  835.                             oldocurrs:integer;
  836.                             end;
  837.       resourcetypeinfoarray = array[1..maxtype] of resourcetypeinforec;
  838.       tokenstype=array[1..maxtokens] of str255;
  839.       {info on volumes}
  840.       
  841.        myvolumerec= record
  842.                       volrefnum:integer;
  843.                       vcreation:longint;
  844.                       vname:myfilenametype;{change this}
  845.                       vsize:longint;
  846.                       vindex:integer;
  847.                       isboot:boolean;
  848.                       attributes:integer;
  849.                       matchto:integer;
  850.                       checkvol:boolean;
  851.                       end;
  852.                       
  853.        myvolumearraytype=array[1..maxvols] of myvolumerec;
  854.        
  855.       {info on applications and hidden files}
  856.       applinforec=record
  857.                   thesize:longint;
  858.                   creator:OStype;
  859.                   creationdate:longint;{shifted right}
  860.                   dirid:longint;
  861.                   filename:myfilenametype;
  862.                   unsafecount:integer;
  863.                   checksum:integer;
  864.                   checksize:longint;
  865.                   flags:integer;
  866.                   end;
  867.                   
  868.       applinfoarray=array[1..maxappl] of applinforec;
  869.       applinfoarrayptr=^applinfoarray;
  870.       
  871.       {Types for directly reading resource maps}
  872.       
  873. type     
  874.              myresstatustype=(pathbad,pathempty,pathopen,
  875.                               typelistopen,reflistopen);
  876.     
  877.   
  878.              {resource map}
  879.              myresMaptype=record
  880.                                dummy1:array[1..5] of longint;
  881.                                dummy2:integer;
  882.                                res_file_attributes:integer;
  883.                                offset_map_to_typelist:integer;
  884.                                offset_map_to_namelist:integer;
  885.                                end;
  886.  
  887.              {resource type list items}
  888.              myresTypeListitemtype=record
  889.                                thetype:restype;
  890.                                count_minus_one:integer;
  891.                                offset_typelist_to_reflist:integer;
  892.                                end;
  893.  
  894.              myresTypeList=array[0..0] of myresTypeListitemtype;
  895.              myresTypeListptr=^myresTypeList;
  896.              myresTypeListhandle=^myresTypeListptr;
  897.  
  898.              {resource reference list items}
  899.              myresRefListitemtype=record
  900.                                theid:integer;
  901.                                offset_namelist_to_name:integer;
  902.                                attrib_and_offset:longint;
  903.                                dummy1:longint;
  904.                                end;
  905.                                
  906.              myresreflisttype=array[0..0] of myresRefListitemtype;
  907.              myresreflistptr=^myresreflisttype;                                       
  908.              myresreflisthandle=^myresreflistptr; 
  909.                             
  910.              {My "path" to the resource data. This includes
  911.               some redundant information and buffer space}                       
  912.              myresPathtype=record
  913.                          volref:integer;
  914.                          fileref:integer;
  915.                          filename:str255;
  916.                          {absolute offsets}
  917.                          offset_to_res_data:longint;
  918.                          offset_to_res_map:longint;
  919.                          offset_to_typelist:longint;{derived}
  920.                          offset_to_namelist:longint;{derived}
  921.                          map:myresmaptype;
  922.                          typelist:myresTypeListHandle;
  923.                          reflist:myresReflistHandle;
  924.                          resdata:handle;
  925.                          current_type:restype;
  926.                          current_type_subscript:integer;
  927.                          status:myresstatustype;{state of path}
  928.                          ntypes:integer;{number of types}
  929.                          nrefs:integer;{number of references to current type}
  930.                          end;
  931.  
  932. var
  933.     currentsection:integer;{divisions of input file - 
  934.                             number starting with one}
  935.     on_section_boundry:boolean;{true if ***** just read or at start or end}
  936.     abmfail:boolean;
  937.     appleshareaccessmask:integer;
  938.     checkfloppies:boolean;
  939.     checknonbootdrives:boolean;
  940.     scsi_wait_count,scsi_wait_count2:integer;
  941.     scsi_wait_doevent:integer;
  942.     currentvolumesubscript:integer;
  943.     StartupOptionKeyFlag:boolean;
  944.     myRpath:myresPathtype;
  945.     showdebuginfo:boolean;
  946.     detaildebugflag:boolean;
  947.     fastapplcheck:boolean;
  948.     skipapplcheck:boolean;
  949.     dbarray:array[1..dbamax] of longint;{for debug}
  950.     notsafecount:longint;{number of resources not in a safe category}
  951.     safetynames:array[safe..dangerous] of string[10];
  952.     blessed:longint;{dir id of the blessed folder}
  953.     blessedpath:str255;{path name of blessed folder}
  954.     blessedbootvolwd:integer;
  955.     startupwd:integer;{working directory on startup}
  956.     buttons:array[1..mbutton] of controlhandle;
  957.     buttonrects:array[1..mbutton] of rect;
  958.     defaultbutton:integer;
  959.     
  960.     optcons:array[1..mbutton] of controlhandle;
  961.     optconrects:array[1..mbutton] of rect;
  962.     optconorigin:point;
  963.     optioncontrolsactiveflag:boolean;
  964.     
  965.     quitting,finished:boolean;
  966.     bootblockchecksum,oldbootblockchecksum:integer;
  967.     checksumchecksum,oldchecksumchecksum:longint;
  968.     askanswer:boolean;{answer from yes,no buttons}
  969.     askanswered:boolean;{set true when button clicked}
  970.     optionkeyflag:boolean;
  971.  
  972.     {event handler globals}
  973.     theevent:   EventRecord;
  974.     mainwindow:Windowptr;
  975.     wbounds,textbounds,textframe:rect;
  976.     statustext:tehandle;
  977.  
  978.     rcount:longint;{count of resources checked in system folder}
  979.     acount:longint;{count of apps and hidden files}
  980.     oldvcount,vcount:integer;{count of volumes}
  981.     oldvols,newvols:myvolumearraytype;{lists of volumes checked}
  982.     
  983.     {pointers to the two big blocks of memory which are seperately 
  984.      allocated to reduced the total size of globals}
  985.     rinfo:resourceinfoarrayptr;
  986.     ainfo:applinfoarrayptr;
  987.     
  988.     rtypes:resourcetypeinfoarray;
  989.     rtypes_count:integer;
  990.     
  991.     infile,outfile:text;
  992.     inputopen,outputopen,inputnotdefault:boolean;
  993.     inputfile_dirid:longint;
  994.     inputfile_Vrefnum:integer;
  995.     inputfile_filename:str255;
  996.     outputfile_dirid:longint;
  997.     outputfile_Vrefnum:integer;
  998.     outputfile_filename:str255;
  999.  
  1000.     cancel:boolean;
  1001.  
  1002.     sysfiles:array[1..maxsysfiles] of myfilenametype;
  1003.     
  1004.     safekeywords_count:integer;
  1005.     safekeywords:array[1..maxsafekeywords] of myfilenametype;
  1006.     
  1007.     {Mydebug message globals}
  1008.     mydebugport : grafptr;
  1009.  
  1010.     {growzone function stuff}
  1011.     growzoneguardblock:handle;
  1012.     lowmemoryGZflag:boolean;
  1013.  
  1014.   
  1015. {forward procedure declarations, not in any
  1016. particular order}
  1017.  
  1018. procedure recheck_changed(i:integer;
  1019. oldunsafecount:longint;
  1020. oldchecksize:longint;
  1021. oldchecksum:integer);forward;
  1022.  
  1023. function test_end_flag(line:str255):boolean;forward;
  1024. procedure position_to_section(secnum:integer);forward; 
  1025. procedure debugger;inline $A9FF;{invoke macsbug}
  1026. procedure debugStr(str:str255);inline $ABFF;{macsbug with string}
  1027. procedure postmem(linenum:integer);forward;
  1028. procedure halt_on_error(err:oserr;sss:str255);forward;
  1029. procedure detail_appl_check;forward;
  1030. procedure show_appl_detail_changes;forward;
  1031. procedure setup_optioncon;forward;
  1032. procedure draw_optcon_text;forward;
  1033. procedure adjust_option_controls;forward;
  1034.     
  1035. procedure Doevent(dontloop:boolean);forward;
  1036.  
  1037. { ShutDown is new, but works with all machines with new system. }
  1038. PROCEDURE ShutDwnPower;
  1039.     INLINE $3F3C,$0001,$A895;
  1040.  
  1041. procedure check_a_file(index:integer);forward;
  1042. procedure checksum_all_appl;forward;
  1043. procedure checksum_unchecked_appl;forward;
  1044. procedure poststatus(ss:str255;linenum:integer);forward;
  1045. procedure replaceline(ss:str255;linenum:integer);forward;
  1046. procedure dobutton(whichbutton:integer);forward;
  1047. procedure drawbuttons;forward;
  1048. procedure showstatus;forward;
  1049. procedure close_all_and_halt(beep:boolean);forward;
  1050. procedure close_and_flush(var filevar:text;var openflag:boolean);forward;
  1051.  
  1052. procedure folder_info_two(dirid:longint;
  1053.                           volume:integer;
  1054.                       var name:str255;
  1055.                       var path:str255;
  1056.                           findpath:boolean);forward;
  1057.  
  1058. function Ask(question:str255;default:integer):boolean;forward;
  1059. procedure wait_for_buttons(ss:str255;default:integer);forward;
  1060. procedure clear_to_end(linenum:integer);forward;
  1061. procedure summary;forward;
  1062. procedure set_default_blessed;forward;
  1063. procedure set_default_by_id(DirID:longint);forward;
  1064. function checksumHdataOLD(h:handle):integer;forward;
  1065. function checksumHdata(h:handle):integer;forward;
  1066. function checksum_boot_blocks:integer;forward;
  1067. procedure sorttypes(var X:resourcetypeinfoarray;N:integer);forward;
  1068. procedure tabscan(line:str255; var tokens:tokenstype;var ntokens:integer);forward;
  1069. procedure filltype(var tt:restype;ss:str255);forward;
  1070. procedure open_output;forward;
  1071. procedure open_input;forward;
  1072. procedure get_set_blessed;forward;
  1073. {$S start2}
  1074. procedure open_output_dialog(appask:boolean;defbut:integer);
  1075.  
  1076. begin
  1077. if not outputopen then
  1078.    if ask('Do you want to write a new summary output file?',defbut) then 
  1079.       begin
  1080.        open_output;      
  1081.         if outputopen and fastapplcheck  and appask then
  1082.         fastapplcheck:=not Ask('Do you want a full checksum of applications',yesbut);    
  1083.       end;
  1084. end;
  1085. procedure setupmydebug;{setup extra graphics port 
  1086. for drawing direct to the screen without using the window manager}
  1087. const  dbtop=260;
  1088.        dbleft=40;
  1089.        dbwidth=200;
  1090.        dblength=50;
  1091.        
  1092. var    saveport:grafptr;
  1093.        dbrect : rect;
  1094.        begin
  1095.        getport(saveport);{save current port}
  1096.      mydebugport:=grafptr(NewPtr(sizeof(grafport)));
  1097.      {make non-relocatable block}
  1098.      openport(mydebugport); 
  1099.        setorigin(-dbleft,-dbtop); 
  1100.        {set new origin so (0,0) is at (dbleft,dbtop)
  1101.                          on the screen }
  1102.        (*debug_mess('Start Debug');*)
  1103.        setport(saveport);{restore current port}
  1104. end; {of proc mysetup debug}
  1105. {$S         }
  1106. procedure debug_mess(message:str255);
  1107. const  dbtop=260;
  1108.        dbleft=40;
  1109.        dbwidth=200;
  1110.        dblength=50;
  1111.        waitsec=2;
  1112.        
  1113. var    saveport:grafptr;
  1114.        dbrect : rect;
  1115.        waittick,dumm:longint;
  1116. begin
  1117.  
  1118. {---------------------------}
  1119. getport(saveport);{save current port}
  1120. setport(mydebugport);{change to debug port}  
  1121.        setrect(dbrect,0,0,dbwidth,dblength);
  1122.        fillrect(dbrect,Dkgray); {draw a pseudo-window} {make this fancer later}
  1123.        penpat(white);
  1124.        framerect(dbrect);
  1125.        moveto(20,20);
  1126.        TextMode(Srcbic);{white letters}
  1127.        DrawString(message);
  1128.        waittick:=60*waitsec;
  1129.        delay(waittick,dumm);
  1130. setport(saveport);{restore current port}
  1131. {-------------------------}
  1132.  
  1133. end; {of function debug_message}
  1134. procedure debug_long(l:longint;tag:str255);
  1135. var ss:str255;
  1136. begin
  1137. numtostring(l,ss);
  1138. ss:=concat(tag,ss);
  1139. debug_mess(ss);
  1140. end;
  1141.  
  1142. {---memory management tools---}
  1143. function GoodPointer(p:ptr;tag:str255):boolean;
  1144. {check that this is a pointer to non-nil data
  1145. within the application memory area}
  1146. const
  1147.       CurrentA5=$0904;
  1148.       ApplZone=$02AA;
  1149.       Lo3Bytes=$00FFFFFF;
  1150. type
  1151.         lp=^longint;
  1152.         
  1153. var     a:lp;
  1154.         high,low,add:longint;
  1155.         ok:boolean;
  1156. begin
  1157. ok:=false;
  1158.    if p<>nil then
  1159.      begin
  1160.      add:=longint(ord4(p) and Lo3bytes);
  1161.      if not odd(add)then
  1162.         begin
  1163.           {this test is a bit strict/mem-map dependent}
  1164.           a:=pointer(ApplZone);
  1165.           low:=a^;
  1166.           a:=pointer(CurrentA5);
  1167.           high:=a^;
  1168.           if (add>=low) and (add<high) then
  1169.               begin
  1170.                   ok:=true;
  1171.               end
  1172.           else
  1173.               begin
  1174.                  debug_mess('Pointer outside User Memory');
  1175.                 sysbeep(5);sysbeep(5);
  1176.               end;
  1177.         end
  1178.       else
  1179.         begin
  1180.            debug_mess('Pointer With Odd Address');
  1181.         end
  1182.       ;{endif}
  1183.         
  1184.      end;
  1185. if not ok and (p<>nil) then
  1186.      begin
  1187.      debug_mess(concat('GP>',tag));
  1188.      repeat until button;
  1189.      end;
  1190. Goodpointer:=ok;
  1191. end;{goodPointer}
  1192. function GoodHandle(h:handle;tag:str255):boolean;        
  1193. var     a:ptr;
  1194.         ok:boolean;
  1195.        
  1196. begin
  1197. ok:=false;
  1198.    if GoodPointer(ptr(h),concat('GH1:',tag)) then
  1199.         begin
  1200.         if GoodPointer(h^,concat('GH2:',tag)) then
  1201.            begin
  1202.            {if GetHandleSize(h) >0 then}
  1203.                begin;
  1204.                   ok:=true
  1205.                end
  1206.            {else
  1207.               begin
  1208.                 debug_mess('Handle Size<0');
  1209.               end}
  1210.            ;{endif}
  1211.            end
  1212.            
  1213.          else
  1214.            begin
  1215.               debug_mess('Handle^ is bad or nil');
  1216.            end
  1217.          ;{end if}
  1218.          end
  1219.      else
  1220.         begin
  1221.            if h<>nil then
  1222.            debug_mess('Handle is bad');
  1223.         end
  1224.      ;{endif}
  1225.         
  1226. if not ok and (h<>nil) then
  1227.     begin
  1228.     debug_mess(concat('GH>',tag));
  1229.     repeat until button;
  1230.     end;
  1231.       
  1232. GoodHandle:=ok;
  1233. end;{goodhandle}
  1234. {$S          }
  1235. procedure scsi_wait;
  1236. {periodic delays to keep from overwhelming the scsi driver}
  1237. {also doevents to allow breakout}
  1238. var wait,endit:longint;
  1239. begin
  1240. scsi_wait_count:=scsi_wait_count+1;
  1241. scsi_wait_count2:=scsi_wait_count2+1;
  1242. if scsi_wait_count>scsi_wait_limit then
  1243.   begin
  1244.     wait:=scsi_wait_ticks;
  1245.     delay(wait,endit);
  1246.     scsi_wait_count:=0;  
  1247.   end;
  1248. if scsi_wait_count2>scsi_wait_doevent then
  1249.   begin
  1250.     postmem(memline);
  1251.     doevent(true);{don't loop}
  1252.     scsi_wait_count2:=0;  
  1253.   end;
  1254. end;
  1255.  
  1256. procedure read_input(var line:str255);
  1257. {readln(infile,line) with delay added}
  1258. var dummy:boolean;
  1259. begin
  1260. scsi_wait;
  1261. line:='';
  1262. if eof(infile)then
  1263.      begin
  1264.        currentsection:=currentsection+1;
  1265.        on_section_boundry:=true;
  1266.        exit;
  1267.      end;
  1268. readln(infile,line);
  1269. if test_end_flag(line) 
  1270.      then
  1271.      begin 
  1272.         currentsection:=currentsection+1;
  1273.         on_section_boundry:=true;
  1274.      end
  1275.      else
  1276.        begin
  1277.         on_section_boundry:=false;
  1278.        end
  1279. end;{proc}
  1280. procedure read_input_integer(var ii:integer);
  1281. var ss:str255;
  1282.     work:longint;
  1283. begin
  1284. read_input(ss);
  1285. stringtonum(ss,work);
  1286. ii:=work;
  1287. end;{proc}
  1288.  
  1289. procedure read_input_long(var jj:longint);
  1290. var ss:str255;
  1291. begin
  1292. read_input(ss);
  1293. stringtonum(ss,jj);
  1294. end;{proc}
  1295. {$S start2  }
  1296. procedure kill_nil;
  1297. {for debugging}
  1298. {put an odd value in memory location zero to hit nil's early}
  1299. type lptr=^longint;
  1300. var     p:lptr;
  1301. begin
  1302. p:=lptr(Pointer(0));
  1303. P^:=$4E494C21;{NIL!}
  1304. end;
  1305. procedure myteshow;
  1306. var i,nn,jj:integer;
  1307.     ss,ww:str255;
  1308. begin
  1309.     nn:=statustext^^.nlines;
  1310.     ss:='';
  1311.     for i:=0 to nn do
  1312.        begin
  1313.        jj:=statustext^^.linestarts[i];
  1314.       numtostring(jj,ww);
  1315.       ss:=concat(concat(ss,ww),' ');       
  1316.       end;
  1317.       numtostring(statustext^^.telength,ww);
  1318.       ss:=concat(concat(ss,ww),' ');       
  1319.    poststatus(ss,byline);
  1320.  
  1321. end;{proc}
  1322.  
  1323. procedure dbashow;
  1324. var i:integer;
  1325.     ss,nn:str255;
  1326. begin
  1327.    myteshow;
  1328.    ss:='';
  1329.    for i:=1 to dbamax do
  1330.       begin
  1331.       numtostring(dbarray[i],nn);
  1332.       ss:=concat(concat(ss,nn),' ');
  1333.       end;
  1334.       numtostring(statustext^^.nlines,nn);
  1335.       ss:=concat(concat(ss,nn),' ');
  1336.      
  1337.    poststatus(ss,pathline);
  1338. end;{proc}
  1339. {$S startup}
  1340.  
  1341. function option_key_down:boolean;
  1342. const   optionkeycode1=58;
  1343.         optionkeycode2=61;
  1344.         {alternate key codes from inside mac vol 5}
  1345. type keyp=^keymap;
  1346. var 
  1347.     p:keyp;
  1348.     fakekeymap:array[0..7] of integer;
  1349.     i:integer;
  1350. begin
  1351. p:=keyp(@fakekeymap);
  1352. getkeys(p^);
  1353. option_key_down:=BitTst(@fakekeymap,optionkeycode1) 
  1354.               or BitTst(@fakekeymap,optionkeycode2);
  1355. end;{function}
  1356.  
  1357. procedure select_system_folder(var wdrefnum:integer;
  1358.                         var dirid:longint;
  1359.                         var volume:integer;
  1360.                         var cancel:boolean);
  1361. {select a system folder}
  1362. var
  1363.    topleft,center    :point;
  1364.    ShowTypes  : SFTypeList;
  1365.    NTypes     :integer ;
  1366.    theErr     :OSErr;
  1367.    Reply      :SFreply;
  1368.    filename   :string[63];
  1369.    err        : OSErr;  
  1370.       myWDPB     : WDPBRec;
  1371.    dummy      :str255;
  1372.    vserr,ignore       :OSerr;
  1373.    prompt:  str255;
  1374.   oldwd:integer;
  1375.    
  1376. begin
  1377.   {save default wd}
  1378.   ignore:=getvol(nil,oldwd);
  1379.  
  1380.   prompt:='Pick System File';
  1381.   wdrefnum:=0;
  1382.   
  1383.   with center do
  1384.   begin
  1385.   with screenbits.bounds do
  1386.     begin
  1387.       v:=(top+bottom) div 2;
  1388.       h:=(left+right) div 2;
  1389.     end;
  1390.   end;
  1391.  
  1392.   topleft.h:=center.h-170; {position of topleft}
  1393.   topleft.v:=center.v-120;
  1394.  
  1395.   ShowTypes[0]:='ZSYS';
  1396.   ShowTypes[1]:='FNDR';
  1397.   ShowTypes[2]:='TEXT';{for debugging}
  1398.   Ntypes:=2;
  1399.   Cancel:=false;
  1400.   SFGetFile(topleft,prompt,nil,NTypes,ShowTypes,nil,Reply);
  1401.   if Reply.good then
  1402.       begin
  1403.        wdrefnum:=reply.vrefnum;
  1404.       end
  1405.   else
  1406.       begin
  1407.       {may be a cancel or other error}
  1408.       Cancel:=true;
  1409.  
  1410.       end;
  1411. if not cancel then
  1412.   begin
  1413.  
  1414.    {get volume and dirid from wdref number}
  1415.    with mywdpb do
  1416.        begin
  1417.             dummy:='';
  1418.             ioCompletion:= NIL;    
  1419.             ionameptr:=@dummy;
  1420.             iovrefnum:=wdrefnum;
  1421.             iowdindex:=0;
  1422.             iowdprocid:=0;
  1423.        end;
  1424.    scsi_wait;
  1425.    err:=PBgetWDinfo(@mywdpb,false);
  1426.    if err=noerr then
  1427.       begin
  1428.       with mywdpb do
  1429.           begin
  1430.           dirid:=iowddirid;
  1431.           volume:=iowdvrefnum;
  1432.           end;
  1433.       end
  1434.    else
  1435.      begin
  1436.        cancel:=true;
  1437.      end
  1438.  
  1439.   end;
  1440. ignore:=setvol(nil,oldwd);  
  1441. end; {select systemfolder}
  1442. procedure pick_set_blessed;
  1443. {optionally select an alternate system folder to check}
  1444. {this is treated as if it were the startup volume hereafter}
  1445. var wdrefnum:integer;
  1446.     volume:integer;
  1447.     dirid:longint;
  1448.     cancel:boolean;
  1449.     name:str255;
  1450. begin
  1451. if not StartupOptionKeyFlag then exit;
  1452. poststatus(blessedpath,pathline);
  1453. if not ask('Do you want to pick a different system file to check?',nobut) then exit;
  1454. cancel:=true;
  1455. select_system_folder(wdrefnum,dirid,volume,cancel);
  1456. if not cancel then
  1457.     begin
  1458.        blessedbootvolwd:=volume;
  1459.        blessed:=dirid;
  1460.        set_default_blessed;{because folder_info is volume specific}
  1461.        folder_info_two(blessed,blessedbootvolwd,name,blessedpath,true);
  1462.     end
  1463. else
  1464.    begin
  1465.    sysbeep(1);
  1466.    end;
  1467. poststatus(blessedpath,pathline);
  1468. set_default_blessed; 
  1469. end;{proc}
  1470.  
  1471. {$S core}
  1472. procedure write_end_flag(tag:str255);
  1473. var tab:char;
  1474. begin
  1475. if not outputopen then exit;
  1476. tab:=chr(9);
  1477. scsi_wait;
  1478. writeln(outfile,'*****',tab,tag);
  1479. end;{proc}
  1480.  
  1481. function test_end_flag{(line:str255):boolean};
  1482. begin
  1483. test_end_flag:=copy(line,1,5)='*****';
  1484. end;{function}
  1485.  
  1486. procedure position_to_section{(secnum:integer)};
  1487. label 88;
  1488. var skip_count,i:integer;
  1489.     line:str255;
  1490. begin
  1491. if not inputopen then exit;
  1492.  
  1493. if ((currentsection=secnum) and on_section_boundry )then exit;
  1494.  
  1495. if currentsection>=secnum then
  1496.     begin
  1497.       reset(infile);
  1498.       currentsection:=1;
  1499.       on_section_boundry:=true;
  1500.     end;
  1501. poststatus('Reread input',pathline);
  1502.  
  1503. while currentsection<secnum do
  1504.    begin
  1505.    if eof(infile)then exit;
  1506.     read_input(line);
  1507.    end;
  1508. clear_to_end(pathline);
  1509.  
  1510. end;{procedure}
  1511.  
  1512. function filenamecompare(aa,bb:myfilenametype):integer;
  1513. {compare filenames after trimming leading and trailing blanks}
  1514. {and mapping to uppercase}
  1515. {metaphore is sign of aa-bb
  1516.  if aa<bb return -1
  1517.  if aa=bb return 0
  1518.  if aa>bb return 1}
  1519.  label 10,20,30,40;
  1520.  var result:integer;
  1521.      w:str255;
  1522. begin
  1523. if aa=bb then
  1524.    begin
  1525.    filenamecompare:=0;
  1526.    exit
  1527.    end;
  1528. {while loops to trim blanks}
  1529. 10:if aa<>'' then
  1530.      if aa[1]=' ' then
  1531.         begin
  1532.         aa:=copy(aa,2,length(aa)-1);
  1533.         goto 10;
  1534.         end;
  1535. 20:if aa<>'' then
  1536.      if aa[length(aa)]=' ' then
  1537.         begin
  1538.         aa:=copy(aa,1,length(aa)-1);
  1539.         goto 20;
  1540.         end;
  1541. {while loops to trim blanks}
  1542. 30:if bb<>'' then
  1543.      if bb[1]=' ' then
  1544.         begin
  1545.         bb:=copy(bb,2,length(bb)-1);
  1546.         goto 30;
  1547.         end;
  1548. 40:if bb<>'' then
  1549.      if bb[length(bb)]=' ' then
  1550.         begin
  1551.         bb:=copy(bb,1,length(bb)-1);
  1552.         goto 40;
  1553.         end;
  1554. w:=aa;
  1555. uprstring(w,true);
  1556. aa:=w;
  1557. w:=bb;
  1558. uprstring(w,true);   
  1559. bb:=w;     
  1560. if aa=bb then
  1561.     result:=0
  1562. else if aa>bb then
  1563.     result:=1
  1564. else
  1565.     result:=-1;
  1566. filenamecompare:=result;
  1567. end;
  1568.  
  1569. function resnamecompare(aa,bb:myresnametype):integer;
  1570. {compare filenames after trimming leading and trailing blanks}
  1571. {metaphore is sign of aa-bb
  1572.  if aa<bb return -1
  1573.  if aa=bb return 0
  1574.  if aa>bb return 1}
  1575.  label 10,20,30,40;
  1576.  var result:integer;
  1577.      w:str255;
  1578. begin
  1579. if aa=bb then
  1580.    begin
  1581.    resnamecompare:=0;
  1582.    exit
  1583.    end;
  1584.  
  1585. {while loops to trim blanks}
  1586. 10:if aa<>'' then
  1587.      if aa[1]=' ' then
  1588.         begin
  1589.         aa:=copy(aa,2,length(aa)-1);
  1590.         goto 10;
  1591.         end;
  1592. 20:if aa<>'' then
  1593.      if aa[length(aa)]=' ' then
  1594.         begin
  1595.         aa:=copy(aa,1,length(aa)-1);
  1596.         goto 20;
  1597.         end;
  1598. {while loops to trim blanks}
  1599. 30:if bb<>'' then
  1600.      if bb[1]=' ' then
  1601.         begin
  1602.         bb:=copy(bb,2,length(bb)-1);
  1603.         goto 30;
  1604.         end;
  1605. 40:if bb<>'' then
  1606.      if bb[length(bb)]=' ' then
  1607.         begin
  1608.         bb:=copy(bb,1,length(bb)-1);
  1609.         goto 40;
  1610.         end;
  1611. if aa=bb then
  1612.     result:=0
  1613. else if aa>bb then
  1614.     result:=1
  1615. else
  1616.     result:=-1;
  1617. resnamecompare:=result;
  1618. end;
  1619.  
  1620. {$S vols}
  1621. procedure find_vols;
  1622. label 88;
  1623. var 
  1624.   mypb:hparamblockrec;
  1625.   name:str255;
  1626.   err:oserr;
  1627.   index:integer;
  1628.   
  1629. begin
  1630. vcount:=0;
  1631. index:=0;
  1632. repeat
  1633.   index:=index+1;
  1634.   with mypb do
  1635.       begin
  1636.       iocompletion:=nil;
  1637.       name:='';
  1638.       ionameptr:=@name;
  1639.       iovrefnum:=0;
  1640.       iovolindex:=index;
  1641.       end;
  1642.   err:=pbhgetvinfo(@mypb,false);
  1643.  
  1644.   if err=noerr then
  1645.      begin
  1646.      if vcount>=maxvols then goto 88;
  1647.      vcount:=vcount+1;
  1648.      with newvols[vcount] do
  1649.      with mypb do
  1650.          begin
  1651.            volrefnum:=iovrefnum;
  1652.            vindex:=index;
  1653.            vname:=name;
  1654.            {compute size to the nearest K}
  1655.            vsize:=round((float(abs((longint(iovNmAlblks) and $0000FFFF)))*float(ioVAlBlkSiz))/1024);
  1656.            {shifted creation date}
  1657.            vcreation:=(iovcrdate shr creationdateshr) and creationdatemask;
  1658.            isboot:=(blessedbootvolwd=volrefnum);
  1659.            attributes:=iovAtrb;
  1660.            matchto:=0;
  1661.            checkvol:=true;
  1662.            
  1663.            {optionally exclude floppies}
  1664.            {check the blessed/boot drive even if it is a floppy}
  1665.            if (not checkfloppies) and (not isboot) then
  1666.               if vsize<floppycutoffsize then
  1667.                   begin
  1668.                      {skip floppies}
  1669.                      checkvol:=false;
  1670.                   end;
  1671.           if not checknonbootdrives then
  1672.               if not isboot then
  1673.                   begin
  1674.                     {skip non-boot drives}
  1675.                      checkvol:=false;
  1676.            end;
  1677.  
  1678.           end;
  1679.      end;
  1680.      
  1681. until(err<>noerr);
  1682. 88:
  1683. end;{find_vols}
  1684.  
  1685. procedure write_vols;
  1686. var i:integer;
  1687.     tab:string[1];
  1688. begin
  1689. tab:=chr(9);
  1690. if not outputopen then exit;
  1691. for i:=1 to vcount do
  1692.     with newvols[i] do
  1693.       begin
  1694.         scsi_wait;
  1695.         writeln(outfile,vname,tab,vsize,tab,vcreation,tab,ord(isboot));   
  1696.       end;
  1697. write_end_flag('end volumes');
  1698. end;{procedure write_vols}
  1699.  
  1700. procedure read_vols;
  1701. var line:str255;
  1702.     tokens:tokenstype;
  1703.     ntokens:integer;
  1704.     work:longint;
  1705. begin
  1706. oldvcount:=0;
  1707. if not inputopen then exit;
  1708. position_to_section(sect_num_volumes);
  1709. while not eof(infile) do
  1710.     begin
  1711.     read_input(line);
  1712.     if test_end_flag(line) then exit;
  1713.     tabscan(line,tokens,ntokens);
  1714.     if ntokens>=4 then
  1715.        begin
  1716.          oldvcount:=oldvcount+1;
  1717.          with oldvols[oldvcount] do
  1718.             begin
  1719.               vname:=tokens[1];
  1720.               stringtonum(tokens[2],vsize);
  1721.               stringtonum(tokens[3],vcreation);
  1722.               stringtonum(tokens[4],work);
  1723.               isboot:=boolean(ord(work));
  1724.               matchto:=0;
  1725.               {unused stuff}
  1726.                volrefnum:=0;
  1727.                vindex:=0;
  1728.                attributes:=0;
  1729.             end;
  1730.        end;
  1731.     end;
  1732.  
  1733. end;
  1734.  
  1735. procedure match_vols;
  1736. {decide what old volumes match what new volumes}
  1737. {this trys to match in several ways}
  1738. var iold,inew:integer;
  1739.     ccount:integer;
  1740.     ckv:integer;
  1741.     lastckv:integer;
  1742.     oldboot:integer;
  1743.     nomatch:longint;
  1744.     w1,w2:str255;
  1745. begin
  1746. if oldvcount<=0 then exit;
  1747.  
  1748. ckv:=0;{count of new volumes to check}
  1749. lastckv:=0;{last checkable volume found}
  1750. for inew:=1 to vcount do
  1751.    if newvols[inew].checkvol then
  1752.    begin
  1753.       lastckv:=inew;
  1754.       ckv:=ckv+1;
  1755.    end;{for/if}
  1756.    
  1757. if ((oldvcount=1) and (ckv=1)) then
  1758.    begin
  1759.    {if one checkable new and old vol, always match}
  1760.    oldvols[1].matchto:=lastckv;
  1761.    newvols[lastckv].matchto:=1;
  1762.    exit;
  1763.    end; 
  1764.  
  1765. if ((oldvcount=1) and (vcount=1)) then 
  1766.    begin
  1767.    {if one vol, always match}
  1768.    oldvols[1].matchto:=1;
  1769.    newvols[1].matchto:=1;
  1770.    exit;
  1771.    end;
  1772.    
  1773.  
  1774. {check for exact matches first}
  1775. for inew:=1 to vcount do
  1776.    if newvols[inew].matchto=0 then
  1777.    begin
  1778.    for iold:=1 to oldvcount do
  1779.       if oldvols[iold].matchto=0 then
  1780.       begin
  1781.        if (filenamecompare(oldvols[iold].vname,newvols[inew].vname)=0) then
  1782.         if oldvols[iold].vsize=newvols[inew].vsize then
  1783.           if oldvols[iold].vcreation=newvols[inew].vcreation then
  1784.              begin
  1785.              oldvols[iold].matchto:=inew;
  1786.              newvols[inew].matchto:=iold;
  1787.              end;{if match}   
  1788.       end;{for/if}
  1789.    end;{for/if}
  1790.  
  1791. {check for matches ignoring name}
  1792. {this assumes a rename may happen}
  1793. for inew:=1 to vcount do
  1794.    if newvols[inew].matchto=0 then
  1795.    begin
  1796.    for iold:=1 to oldvcount do
  1797.       if oldvols[iold].matchto=0 then
  1798.       begin
  1799.         if oldvols[iold].vsize=newvols[inew].vsize then
  1800.           if oldvols[iold].vcreation=newvols[inew].vcreation then
  1801.              begin
  1802.              oldvols[iold].matchto:=inew;
  1803.              newvols[inew].matchto:=iold;
  1804.              end;{if match}   
  1805.       end;{for/if}
  1806.    end;{for/if}
  1807.       
  1808. {match by name only}
  1809. {this will match a volume that has been reinitialized
  1810.  with the same name}
  1811. for inew:=1 to vcount do
  1812.    if newvols[inew].matchto=0 then
  1813.    begin
  1814.    for iold:=1 to oldvcount do
  1815.       if oldvols[iold].matchto=0 then
  1816.       begin
  1817.        if (filenamecompare(oldvols[iold].vname,newvols[inew].vname)=0) then
  1818.         if oldvols[iold].vsize=newvols[inew].vsize then
  1819.           if oldvols[iold].vcreation=newvols[inew].vcreation then
  1820.              begin
  1821.              oldvols[iold].matchto:=inew;
  1822.              newvols[inew].matchto:=iold;
  1823.              end;{if match}   
  1824.       end;{for/if}
  1825.    end;{for/if}   
  1826.  
  1827. {if only one checkable new volume match to old boot volume}
  1828. {this is to help floppy disk checks}
  1829. if (ckv=1) and (newvols[lastckv].matchto=0) then
  1830.     begin
  1831.     for iold:=1 to vcount do
  1832.        if oldvols[iold].isboot then
  1833.        begin
  1834.           oldboot:=iold;
  1835.        end;{for/if}              
  1836.     oldvols[oldboot].matchto:=lastckv;
  1837.     newvols[lastckv].matchto:=oldboot;      
  1838.     exit;
  1839.     end;
  1840.  
  1841.    
  1842. nomatch:=0;
  1843. ccount:=0;
  1844. for inew:=1 to vcount do
  1845.    if newvols[inew].checkvol then
  1846.     begin
  1847.     ccount:=ccount+1;
  1848.        if newvols[inew].matchto=0 then 
  1849.                   nomatch:=nomatch+1;
  1850.     end;
  1851. if nomatch=0 then exit;
  1852. if not inputopen then exit;
  1853. numtostring(nomatch,w1);
  1854. numtostring(ccount,w2);
  1855. w1:=concat(concat(concat(concat(concat('Note: ',w1),' of '),w2),
  1856. ' mounted disk volumes to be checked do not match any in the input file. '),
  1857.  'No application changes will be reported on these volumes.');
  1858. wait_for_buttons(w1,continuebut);
  1859. end;{procedure}
  1860.  
  1861. {$S vols}  
  1862.         procedure sortnewvols(var X:myvolumearraytype;N:integer);
  1863.         {sort array of volumes in a consistent but arbitrary order}
  1864.         {this is done after matching with old volumes to put the
  1865.         new volumes in the same order, except for mismatches}
  1866.         
  1867. {        HEAP SORT
  1868. C
  1869. C       BASED ON PROGRAMMING PEARLS BY JON BENTLEY P 182
  1870. C       X IS THE ARRAY CONTAINING NX ELEMENTS TO BE SORTED
  1871. C       CALL SWAPX(I,J) SWAPS X(I) WITH X(J)
  1872. C       GEX(X,I,J) IS TRUE IFF X(I) >= X(J)
  1873. C       GTX(X,I,J) IS TRUE IFF X(I) > X(J)
  1874. C}
  1875.  
  1876.  
  1877.        var i: integer;
  1878.        
  1879.        
  1880. procedure SWAPX(I:integer;J:integer);
  1881. var     T:myvolumerec;
  1882. {swap new vols and update matchto fields in new vols}      
  1883. begin
  1884.         T:=X[I];
  1885.         X[I]:=X[J];
  1886.         X[J]:=T;
  1887.         
  1888.         IF X[I].matchto<>0 then
  1889.             oldvols[X[I].matchto].matchto:=I;
  1890.         IF X[J].matchto<>0 then
  1891.             oldvols[X[J].matchto].matchto:=J;
  1892.             
  1893. END; {of procedure swapx}
  1894.  
  1895. FUNCTION GTX(I:integer;J:integer):boolean;
  1896. var filecomp:integer;
  1897. begin
  1898.        {sort by order of matches then index }
  1899.        gtx:=false;
  1900.        
  1901.        if (X[I].matchto>X[J].matchto) then
  1902.           begin
  1903.            gtx:=true
  1904.           end
  1905.        else if (X[I].matchto=X[J].matchto) then
  1906.           begin
  1907.             if (X[I].vindex>X[J].vindex)then
  1908.                 begin
  1909.                     gtx:=true; 
  1910.                 end;
  1911.            end;
  1912.                    
  1913. end;
  1914.         
  1915. FUNCTION GEX(I:integer;J:integer):boolean;
  1916. var filecomp:integer;
  1917. begin
  1918.        {sort by order of matches then index }
  1919.        gex:=false;
  1920.        
  1921.        if (X[I].matchto>X[J].matchto) then
  1922.           begin
  1923.            gex:=true
  1924.           end
  1925.        else if (X[I].matchto=X[J].matchto) then
  1926.           begin
  1927.             if (X[I].vindex>=X[J].vindex)then
  1928.                 begin
  1929.                     gex:=true; 
  1930.                 end;
  1931.            end;
  1932.  
  1933. END;
  1934.        
  1935. procedure siftdown(L:integer;U:integer);
  1936.     label 300,999{return};
  1937.     var
  1938.         i,child:integer;
  1939.         
  1940. begin
  1941.         
  1942. {
  1943. C
  1944. C       BEFORE MAXHEAP(L+1,U)
  1945. C       AFTER  MAXHEAP(L,U)
  1946. }
  1947.         I:=L;
  1948.         
  1949.         {LOOP}
  1950. 300:
  1951. {
  1952. C               INVARIANT: MAXHEAP(L,U) EXCEPT PERHAPS
  1953. C                       BETWEEN I AND ITS (0,1 OR 2) CHILDREN
  1954. C
  1955. }
  1956.                 CHILD:=2*I;
  1957.  
  1958.                 IF CHILD > U  then goto 999;
  1959. {
  1960. C
  1961. C               IF C+1 <= U AND X(C+1) > X(C) THEN C=C+1
  1962. C
  1963. }
  1964.                 IF(CHILD+1 <= U) THEN
  1965.                 IF(GTX(CHILD+1,CHILD))THEN
  1966.                         CHILD:=CHILD+1;
  1967.  
  1968. {                
  1969. C
  1970. C               CHILD IS THE GREATEST CHILD OF I
  1971. C
  1972. C               IF X(I) >= X(CHILD) THEN RETURN
  1973. C
  1974. }
  1975.                 IF(GEX(I,CHILD)) then goto 999;
  1976.                 
  1977. {                
  1978. C
  1979. C               X(I) IS LESS THAN ITS GREATEST CHILD SO SWAP IT DOWNWARD
  1980. C               AND REPEAT LOOP
  1981. C
  1982. }
  1983.                 SWAPX(CHILD,I);
  1984.                 I:=CHILD;
  1985.                 GOTO 300;
  1986.         {END LOOP}
  1987. 999:{return}
  1988. END; {of proc siftdown}
  1989.  
  1990.  
  1991.        
  1992. begin {main body of sortnewvols}
  1993.  
  1994.         for I:=N div 2 downto 1 do
  1995.         begin
  1996.        { echo(i);}
  1997.         SIFTDOWN(I,N);
  1998.         end;
  1999.  
  2000.         {echo(0);}
  2001.  
  2002.         for I:=N downto 2 do
  2003.         begin
  2004.           {  echo(i);}
  2005.                 SWAPX(1,I);
  2006.                 {echo(i);}
  2007.                 SIFTDOWN(1,I-1);
  2008.                { echo(i);}
  2009.          end;
  2010.  
  2011.  
  2012.  
  2013. END; {sortnewvols}
  2014.  
  2015. procedure dovols;
  2016. {multi-volume processing}
  2017. begin
  2018. find_vols;
  2019. read_vols;
  2020. match_vols;
  2021. sortnewvols(newvols,vcount);
  2022. end;
  2023.  
  2024. {$S appl}
  2025. procedure note_application( fname:str255;
  2026.                             pdirID:longint;
  2027.                             index:integer;
  2028.                             mycpb:CInfoPBRec;
  2029.                             hidden:boolean);
  2030.                            
  2031.  (*
  2032.        {info on applications}
  2033.       applinforec=record
  2034.                   thesize:longint;
  2035.                   creator:OStype;
  2036.                   creationdate:longint;
  2037.                   dirid:longint;
  2038.                   filename:myfilenametype;
  2039.                   unsafecount:integer;
  2040.                   checksum:integer;
  2041.                   fileindex:integer;
  2042.                   flags:integer;
  2043.                   end;
  2044.                   
  2045.       applinfoarray=array[1..maxappl] of applinforec;
  2046.       applinfoarrayptr=^applinfoarray;
  2047.  
  2048.  *)
  2049. {add to a list of applications in memory}
  2050. begin
  2051. if acount<maxappl then
  2052.   begin
  2053.      poststatus(fname,fileline);
  2054.      acount:=acount+1;
  2055.      with ainfo^[acount] do
  2056.         begin
  2057.         flags:=currentvolumesubscript and applvolumemask;{save volume}
  2058.         checksum:=0;
  2059.         checksize:=0;
  2060.         if fastapplcheck then 
  2061.            unsafecount:=notcounted
  2062.         else 
  2063.            unsafecount:=0;
  2064.         filename:=fname;
  2065.         dirid:=pdirid;
  2066.         if hidden then
  2067.            begin
  2068.              {make as hidden non-application file}
  2069.               flags:=flags or applInvisiblemask;
  2070.            end;
  2071.         with mycpb do
  2072.           begin
  2073.              thesize:=ioflRLgLen;{logical size of resource fork}
  2074.              creationdate:=(ioflcrdat shr creationdateshr) and creationdatemask;
  2075.              {creation date and time}
  2076.              creator:=ioFlFndrInfo.fdcreator;
  2077.           end;{with}
  2078.         end;{with}
  2079.   end
  2080. else
  2081.   begin
  2082.    poststatus('Max applications exceeded.',errorline);
  2083.   end;
  2084. end;{procedure}
  2085.  
  2086. PROCEDURE EnumerAPPLShell;
  2087. {search applications on current default volume staring with root}
  2088. VAR
  2089.  
  2090.       myCPB: CInfoPBRec;
  2091.       err: OSErr;  
  2092.       myWDPB: WDPBRec;
  2093.    DirIDToSearch:Longint;
  2094.    fname,dummy:str255;
  2095.    p:wordptr;
  2096.    accessrights:integer;
  2097.  
  2098. PROCEDURE EnumerateAPPLCatalog(dirIDToSearch: longint);
  2099.  
  2100. VAR
  2101.   index:    integer;  
  2102.  
  2103.   
  2104.  
  2105. Begin {EnumerateAPPLCatalog}
  2106.  
  2107.     index:= 1;
  2108.  
  2109.     repeat
  2110.  
  2111.         FName:= '';  {nil out name}
  2112.         myCPB.ioFDirIndex:= index;
  2113.         myCPB.ioDrDirID:= dirIDToSearch; {we need to do this every time through}
  2114.   p:=@mycpb.ioflAttrib;{clear word with appleshare permissions in 2nd byte}
  2115.   p^:=0;
  2116.  
  2117.         scsi_wait;
  2118.   err:= PBGetCatInfo(@myCPB,FALSE);
  2119.  
  2120.  
  2121.         If err = noErr then 
  2122.  
  2123.             if BitTst(@myCPB.ioFlAttrib,3) then 
  2124.       Begin 
  2125.        {we have a dir}
  2126.           p:=@mycpb.ioflAttrib;{appleshare permissions are at offset 31}
  2127.           accessrights:=p^ and $00FF;
  2128.           if (accessrights and appleshareaccessmask)=0 then
  2129.              begin
  2130.              {only descend tree if we have specified rights}
  2131.                       EnumerateAPPLCatalog(myCPB.ioDrDirID);
  2132.              end;
  2133.                  err:= 0;  {clear error return on way back}
  2134.             End {if dir}
  2135.          Else 
  2136.       Begin
  2137.         {we have a file}
  2138.         {test if application or invisible file}
  2139.         if (myCPB.ioFlFndrInfo.fdtype='APPL')then
  2140.              begin
  2141.                {It is an application, add it to list in memory}
  2142.                note_application(fname,dirIDToSearch,index,mycpb,false)
  2143.                end
  2144.         else if (myCPB.ioFlFndrInfo.fdflags and fInvisible)<>0 then
  2145.              begin
  2146.                {It is a hidden file add it to list in memory}
  2147.                note_application(fname,dirIDToSearch,index,mycpb,true)
  2148.              end;
  2149.             End; {end if} 
  2150.  
  2151.         index:= index + 1;
  2152.  
  2153. until err <> noErr;
  2154.  
  2155. End;  {EnumerateAPPLCatalog}
  2156.  
  2157.  
  2158.  
  2159. Begin {EnumerAPPLShell}
  2160.  
  2161. DirIDToSearch:=2;{root}
  2162. {add initialize of pb 5/14/88 
  2163.  may not be needed but seems to fix a bug}
  2164.    with mywdpb do
  2165.        begin
  2166.             dummy:='';
  2167.             ioCompletion:= NIL;    
  2168.             ionameptr:=@dummy;
  2169.             iovrefnum:=0;
  2170.             iowdindex:=0;
  2171.        end;
  2172.     err:= PBHGetVol(@myWDPB,FALSE);        {get the default volume}
  2173.  
  2174.     with MyCPB do Begin
  2175.         iocompletion:= Nil;
  2176.         ioNamePtr:= @FName;
  2177.         ioVRefNum:= myWDPB.ioVRefNum;      {for now, default vol, set this to what you want}
  2178.     End;  {with}
  2179.  
  2180.     EnumerateAPPLCatalog(DIRIDTOSEARCH);{DirID 2, is the root level}
  2181.  
  2182. End;  {procedure EnumerAPPLShell}
  2183. {$S sortappl  }
  2184.  
  2185.         procedure sortapplications(var X:applinfoarrayptr;N:integer);
  2186.         {sort array of applications and their checksums}
  2187. {        HEAP SORT
  2188. C
  2189. C       BASED ON PROGRAMMING PEARLS BY JON BENTLEY P 182
  2190. C       X IS THE ARRAY CONTAINING NX ELEMENTS TO BE SORTED
  2191. C       CALL SWAPX(I,J) SWAPS X(I) WITH X(J)
  2192. C       GEX(X,I,J) IS TRUE IFF X(I) >= X(J)
  2193. C       GTX(X,I,J) IS TRUE IFF X(I) > X(J)
  2194. C}
  2195.  
  2196.  
  2197.        var i: integer;
  2198.        
  2199.        
  2200. procedure SWAPX(I:integer;J:integer);
  2201. var     T:applinforec;
  2202.         
  2203. begin
  2204.         T:=X^[I];
  2205.         X^[I]:=X^[J];
  2206.         X^[J]:=T;
  2207. END; {of procedure swapx}
  2208.  
  2209. FUNCTION GTX(I:integer;J:integer):boolean;
  2210. var filecomp:integer;
  2211. begin
  2212.    {sort by creator signature,creation date,filename,volume,dirID}
  2213.    gtx:=false;
  2214.    if (X^[I].creator>X^[J].creator) then
  2215.       begin{1}
  2216.         gtx:=true;
  2217.       end{1}
  2218.    else if (X^[I].creator=X^[J].creator) then
  2219.       begin{2}
  2220.         if (X^[I].creationdate>X^[J].creationdate) then
  2221.            begin{3}
  2222.              gtx:=true;
  2223.            end{3}
  2224.         else if (X^[I].creationdate=X^[J].creationdate) then
  2225.            begin{4}
  2226.              filecomp:=filenamecompare(X^[I].filename,X^[J].filename);
  2227.              if filecomp>0{(X^[I].filename>X^[J].filename)} then
  2228.                 begin{5}
  2229.                   gtx:=true;
  2230.                 end{5}
  2231.              else if filecomp=0{(X^[I].filename=X^[J].filename)} then
  2232.                  begin{6}
  2233.                   if (X^[I].flags and applvolumemask)>(X^[J].flags and applvolumemask) then
  2234.                       begin{7}
  2235.                          gtx:=true;
  2236.                       end{7}
  2237.                   else if (X^[I].flags and applvolumemask)=(X^[J].flags and applvolumemask) then
  2238.                      begin{8}
  2239.                        if (X^[I].dirID>X^[J].dirID) then
  2240.                        begin{9}
  2241.                           gtx:=true;
  2242.                        end;{9}
  2243.                      end;{8}
  2244.                   end;{6}
  2245.               end;{4}
  2246.          end;{2}
  2247.                
  2248. end;
  2249.         
  2250. FUNCTION GEX(I:integer;J:integer):boolean;
  2251. var filecomp:integer;
  2252. begin
  2253.    {sort by creator signature,creation date,filename,volume,dirID}
  2254.    gex:=false;
  2255.    if (X^[I].creator>X^[J].creator) then
  2256.       begin{1}
  2257.         gex:=true;
  2258.       end{1}
  2259.    else if (X^[I].creator=X^[J].creator) then
  2260.       begin{2}
  2261.         if (X^[I].creationdate>X^[J].creationdate) then
  2262.            begin{3}
  2263.              gex:=true;
  2264.            end{3}
  2265.         else if (X^[I].creationdate=X^[J].creationdate) then
  2266.            begin{4}
  2267.              filecomp:=filenamecompare(X^[I].filename,X^[J].filename);
  2268.              if filecomp>0{(X^[I].filename>X^[J].filename)} then
  2269.                 begin{5}
  2270.                   gex:=true;
  2271.                 end{5}
  2272.              else if filecomp=0{(X^[I].filename=X^[J].filename)} then
  2273.                  begin{6}
  2274.                   if (X^[I].flags and applvolumemask)>(X^[J].flags and applvolumemask) then
  2275.                       begin{7}
  2276.                          gex:=true;
  2277.                       end{7}
  2278.                   else if (X^[I].flags and applvolumemask)=(X^[J].flags and applvolumemask) then
  2279.                      begin{8}
  2280.                        if (X^[I].dirID>=X^[J].dirID) then
  2281.                        begin{9}
  2282.                           gex:=true;
  2283.                        end;{9}
  2284.                      end;{8}
  2285.                   end;{6}
  2286.               end;{4}
  2287.          end;{2}
  2288.  
  2289. END;
  2290.        
  2291. procedure siftdown(L:integer;U:integer);
  2292.     label 300,999{return};
  2293.     var
  2294.         i,child:integer;
  2295.         
  2296. begin
  2297.         
  2298. {
  2299. C
  2300. C       BEFORE MAXHEAP(L+1,U)
  2301. C       AFTER  MAXHEAP(L,U)
  2302. }
  2303.         I:=L;
  2304.         
  2305.         {LOOP}
  2306. 300:
  2307. {
  2308. C               INVARIANT: MAXHEAP(L,U) EXCEPT PERHAPS
  2309. C                       BETWEEN I AND ITS (0,1 OR 2) CHILDREN
  2310. C
  2311. }
  2312.                 CHILD:=2*I;
  2313.  
  2314.                 IF CHILD > U  then goto 999;
  2315. {
  2316. C
  2317. C               IF C+1 <= U AND X^(C+1) > X^(C) THEN C=C+1
  2318. C
  2319. }
  2320.                 IF(CHILD+1 <= U) THEN
  2321.                 IF(GTX(CHILD+1,CHILD))THEN
  2322.                         CHILD:=CHILD+1;
  2323.  
  2324. {                
  2325. C
  2326. C               CHILD IS THE GREATEST CHILD OF I
  2327. C
  2328. C               IF X^(I) >= X^(CHILD) THEN RETURN
  2329. C
  2330. }
  2331.                 IF(GEX(I,CHILD)) then goto 999;
  2332.                 
  2333. {                
  2334. C
  2335. C               X^(I) IS LESS THAN ITS GREATEST CHILD SO SWAP IT DOWNWARD
  2336. C               AND REPEAT LOOP
  2337. C
  2338. }
  2339.                 SWAPX(CHILD,I);
  2340.                 I:=CHILD;
  2341.                 GOTO 300;
  2342.         {END LOOP}
  2343. 999:{return}
  2344. END; {of proc siftdown}
  2345.  
  2346.  
  2347.        
  2348. begin {main body of sortapplications}
  2349.  
  2350.         for I:=N div 2 downto 1 do
  2351.         begin
  2352.        { echo(i);}
  2353.         SIFTDOWN(I,N);
  2354.         end;
  2355.  
  2356.         {echo(0);}
  2357.  
  2358.         for I:=N downto 2 do
  2359.         begin
  2360.           {  echo(i);}
  2361.                 SWAPX(1,I);
  2362.                 {echo(i);}
  2363.                 SIFTDOWN(1,I-1);
  2364.                { echo(i);}
  2365.          end;
  2366.  
  2367.  
  2368.  
  2369. END; {sortapplications}
  2370. {$S applout}
  2371. procedure APPLsummary;
  2372. {write summary of info on applications}
  2373. var i:integer;
  2374.     tab:char;
  2375.     tags:str255;
  2376.     dname:str255;
  2377.     dummy:str255;
  2378.     vref:integer;
  2379. begin
  2380. set_default_blessed;
  2381. tab:=chr(9);
  2382. if not outputopen then exit;
  2383. poststatus('Writing Application Summary Output',pathline);
  2384. for i:=1 to acount do
  2385.   with ainfo^[i] do
  2386.      begin
  2387.          dname:='?';
  2388.          vref:=newvols[(flags and applvolumemask)].volrefnum;
  2389.          folder_info_two(dirid,vref,dname,dummy,false);
  2390.          tags:='';
  2391.          if inputopen then
  2392.          begin
  2393.            if (flags and applexactmatchmask)<>applexactmatchmask then
  2394.              begin
  2395.              if (flags and applrenamemask)=applrenamemask then
  2396.                 begin
  2397.                    {moved or renamed or duplicated}
  2398.                    tags:='moved/renamed??';
  2399.                 end
  2400.              else
  2401.                 begin
  2402.                   if (flags and applchangedmask)=applchangedmask then
  2403.                     begin
  2404.                       {changed}
  2405.                       tags:='changed??';
  2406.                     end
  2407.                   else if (flags and applsafechangedmask)=applsafechangedmask then
  2408.                     begin
  2409.                       {safe changed}
  2410.                       tags:='safe size changed??';
  2411.                     end
  2412.                   else
  2413.                     begin
  2414.                        {"new"}
  2415.                        tags:='new??';
  2416.                     end
  2417.                 end;
  2418.             end;
  2419.             if (flags and appldangermask)=appldangermask then
  2420.                 begin
  2421.                    tags:=concat(tags,' Danger??');
  2422.                 end;
  2423.           end;{inputopen}
  2424.           if (flags and applinvisiblemask)<>0 then
  2425.                  begin
  2426.                    tags:=concat(tags,'(hidden)');
  2427.                  end;
  2428.       scsi_wait;
  2429.       write(outfile,creator:4,tab,
  2430.                       creationdate,tab,
  2431.                       filename,tab,
  2432.                       dirid,tab,
  2433.                       (flags and applvolumemask),tab,
  2434.                       thesize,tab,
  2435.                       unsafecount,tab,
  2436.                       checksize,tab,
  2437.                       checksum,tab,
  2438.                       dname);
  2439.       scsi_wait;
  2440.      if tags='' then writeln(outfile) else writeln(outfile,tab,tags);
  2441.      
  2442.      end;{for/with}
  2443.  
  2444. write_end_flag('end applications and hidden files');
  2445. end;{applsummary}
  2446.  
  2447. procedure copyapplsummary;
  2448. {copy old applications summary when no application checks are done}
  2449. label 88;
  2450. var line:str255;
  2451.  
  2452. begin
  2453. if not outputopen then exit;
  2454.  
  2455. if inputopen then
  2456.    begin
  2457.       position_to_section(sect_num_applications);
  2458.       while(not(eof(infile))) do
  2459.          begin
  2460.           read_input(line);
  2461.           if test_end_flag(line) then goto 88;
  2462.           scsi_wait;
  2463.           writeln(outfile,line);
  2464.          end;
  2465.       88:
  2466.    end;
  2467. write_end_flag('end applications and hidden files(copy)');
  2468. end;
  2469. {$S appl     }
  2470. procedure scan_all_vols;
  2471. label 88;
  2472. var i:integer;
  2473.     err:oserr;
  2474. begin
  2475. for i:=1 to vcount do
  2476.    begin
  2477.    if newvols[i].checkvol then 
  2478.       begin
  2479.       err:=setvol(nil,newvols[i].volrefnum);
  2480.       if err=noerr then
  2481.            begin 
  2482.            poststatus(concat('Scan applications and hidden files:',newvols[i].vname),pathline);
  2483.            currentvolumesubscript:=i;
  2484.            enumerAPPLshell;
  2485.            end;
  2486.       end;
  2487.    end;
  2488.  
  2489. set_default_blessed;
  2490. end;
  2491.  
  2492.  
  2493.  
  2494. {$S start2}
  2495. procedure initmypath(var mypath:myresPathtype);
  2496. const bigneg=-16000;
  2497.       startsize=32;
  2498. begin
  2499. with mypath do
  2500.    begin
  2501.    volref:=0;
  2502.    fileref:=0;
  2503.    filename:='';
  2504.    {absolute offsets}
  2505.    offset_to_res_data:=bigneg;
  2506.    offset_to_res_map:=bigneg;
  2507.    offset_to_typelist:=bigneg;{derived}
  2508.    offset_to_namelist:=bigneg;{derived}
  2509.    typelist:=myresTypeListHandle(newhandle(startsize));
  2510.    reflist:=myresReflistHandle(newhandle(startsize));
  2511.    resdata:=newhandle(startsize);
  2512.    current_type:='    ';
  2513.    current_type_subscript:=0;
  2514.    status:=pathbad;{state of path}
  2515.    ntypes:=0;{number of types}
  2516.    nrefs:=0;{number of references to current type}
  2517.    end;
  2518.    
  2519. end;{proc}
  2520. {$S myres}
  2521. function my_openRF_readonly(filename:str255;
  2522.          vrefnum:integer; var refnum:integer):oserr;
  2523.          
  2524. {Open Resource File - as a file - read only}
  2525.  
  2526. var  mypb:Paramblockrec;
  2527.      err:oserr;
  2528. begin
  2529. with mypb do
  2530.   begin
  2531.     iocompletion:=nil;
  2532.     ionameptr:=@filename;
  2533.     ioVrefnum:=vrefnum;
  2534.     iorefnum:=0;{dummy for bad returns}
  2535.     ioVersNum:=0;
  2536.     IoPermssn:=fsRdPerm;{read only}
  2537.     ioMisc:=nil; 
  2538.   end;{with}
  2539. scsi_wait;
  2540. err:=PBOpenRF(@mypb,false);  
  2541. refnum:=mypb.iorefnum;
  2542. my_openRF_readonly:=err;
  2543. end;{proc}
  2544. function setmytype( var mypath:myresPathtype;
  2545.                     index:integer;
  2546.                     var atype:restype
  2547.                     ):boolean;  
  2548. {set the current type, return true if suceeded}
  2549. {eith index (1 to ntypes) or set by type}
  2550. label 99,88,77;
  2551. var offset:longint;
  2552.     ii:integer;
  2553.     rlsize:longint;
  2554.     bcount:longint;
  2555. begin
  2556. with mypath do
  2557.   begin
  2558.   if status<typelistopen then goto 99;
  2559.   if index>0 then
  2560.      begin
  2561.      {pick type by index}
  2562.      if index>ntypes then goto 99;
  2563.       {**R-}
  2564.       current_type:=typelist^^[index-1].thetype;
  2565.       offset:=typelist^^[index-1].offset_typelist_to_reflist;
  2566.       nrefs:=typelist^^[index-1].count_minus_one+1;
  2567.       {**R+}
  2568.       atype:=current_type;
  2569.       current_type_subscript:=index-1;
  2570.      end
  2571.    else
  2572.      begin
  2573.      {pick type by name}
  2574.      for ii:=0 to nrefs-1 do
  2575.         begin
  2576.         {**R-}
  2577.           if typelist^^[ii].thetype=atype then 
  2578.               begin
  2579.                  current_type:=typelist^^[ii].thetype;
  2580.                  offset:=typelist^^[ii].offset_typelist_to_reflist;
  2581.                  nrefs:=typelist^^[ii].count_minus_one+1;
  2582.                  current_type_subscript:=ii;
  2583.                  goto 77;{match}
  2584.               end;
  2585.          {**R+}
  2586.         end;
  2587.       goto 99;{fail}
  2588.      end;
  2589.   77:
  2590.   {load the reference list for this type}
  2591.   Hunlock(handle(reflist));    
  2592.   status:=typelistopen;
  2593.   offset:=offset_to_typelist+offset;{compute absolute offset}
  2594.   
  2595.   {reserve memory}
  2596.   rlsize:=nrefs*12;
  2597.   hunlock(handle(reflist));
  2598.   sethandlesize(handle(reflist),rlsize);
  2599.   if memerror<>noerr then goto 99;
  2600.   
  2601.   Hlock(handle(reflist));
  2602.   {actually do the read}
  2603.    if SetFPos(fileref,fsFromStart,offset)<>noerr then goto 88;
  2604.    bcount:=rlsize;
  2605.    scsi_wait;
  2606.    if FsRead(fileref,bcount,ptr(reflist^))<>noerr then goto 88;
  2607.    if bcount<>rlsize then goto 88;
  2608.    {we've got the reflist "open"}
  2609.    hunlock(handle(reflist));
  2610.    status:=reflistopen;
  2611.   end;{while}  
  2612. setmytype:=true;
  2613. exit;{normal}
  2614.   88:
  2615.   Hunlock(handle(mypath.reflist));
  2616.   mypath.status:=typelistopen;
  2617.   99:
  2618.   setmytype:=false;{failure}
  2619. end;{setmytype}
  2620.  
  2621. Function CopyResData(  var mypath:myresPathtype;
  2622.                             var index:integer;
  2623.                             var id:integer;
  2624.                             var  psize:longint;
  2625.                             var  pattr:integer;
  2626.                             var  pname:str255 ):boolean;
  2627. {copy resource data to handle
  2628.  either index(1 to nrefs) or search for id}
  2629.  const offsetmask=$00FFFFFF;
  2630.        ash=24;
  2631.        amask=$000000FF;
  2632. label 99,88,77,85;
  2633. var offset,noffset:longint;
  2634.     ii:integer;
  2635.     bcount:longint;
  2636.     rdsize:longint;
  2637.     noname:boolean;
  2638.     nsize:integer;
  2639. begin
  2640. psize:=0;
  2641. pname:='';
  2642. pattr:=0;
  2643. with mypath do
  2644.   begin
  2645.   if status<reflistopen then goto 99;
  2646.   hlock(handle(reflist));
  2647.   if index>0 then
  2648.      begin
  2649.      {**R-}
  2650.       offset:=(reflist^^[index-1].attrib_and_offset) and offsetmask;
  2651.       pattr:=((reflist^^[index-1].attrib_and_offset) shr ash) and amask;
  2652.       id:=reflist^^[index-1].theid;
  2653.       noffset:=reflist^^[index-1].offset_namelist_to_name;
  2654.      {**R+}
  2655.      end
  2656.   else
  2657.      begin
  2658.      for ii:=0 to ntypes-1 do
  2659.        begin
  2660.        {**R-}
  2661.         if reflist^^[ii].theid=id then
  2662.            begin
  2663.              offset:=(reflist^^[ii].attrib_and_offset) and offsetmask;
  2664.              pattr:=((reflist^^[ii].attrib_and_offset) shr ash) and amask;
  2665.              noffset:=reflist^^[ii].offset_namelist_to_name;
  2666.              goto 77;
  2667.            end;
  2668.         {**R+}
  2669.        end;{for}
  2670.       hunlock(handle(reflist));
  2671.        goto 88;{fail}
  2672.      77:  
  2673.      end;
  2674.   hunlock(handle(reflist));
  2675.      
  2676.   {convert to absolute offsets}
  2677.   offset:=offset_to_res_data+offset;
  2678.   noname:=(noffset=-1);
  2679.   if not noname then noffset:=noffset+offset_to_namelist;
  2680.   
  2681.    if not noname then
  2682.          begin
  2683.          {get name length}
  2684.          if SetFPos(fileref,fsFromStart,noffset)<>noerr then goto 88;
  2685.          bcount:=2;
  2686.          scsi_wait;
  2687.          if FsRead(fileref,bcount,@nsize)<>noerr then goto 88;
  2688.          if bcount<>2 then goto 88;
  2689.          nsize:=(nsize shr 8) and $00FF;{convert first byte to integer}
  2690.          nsize:=nsize+1;{length of pascal string}
  2691.          {get the whole name}
  2692.          {get name length}{use relative positioning}
  2693.          scsi_wait;
  2694.          if SetFPos(fileref,fsfrommark,-2)<>noerr then goto 88;
  2695.          bcount:=nsize;
  2696.          scsi_wait;
  2697.          if FsRead(fileref,bcount,@pname)<>noerr then goto 88;
  2698.          if bcount<>nsize then goto 88;
  2699.          end;{if name}
  2700.  
  2701.   {get data length} 
  2702.   scsi_wait;
  2703.    if SetFPos(fileref,fsfromstart,offset)<>noerr then goto 88;
  2704.    bcount:=4;
  2705.    scsi_wait;
  2706.    if FsRead(fileref,bcount,@rdsize)<>noerr then goto 88;
  2707.    if bcount<>4 then goto 88;
  2708.     
  2709.    {allocate space for data}
  2710.    hunlock(resdata);
  2711.    sethandlesize(resdata,rdsize);
  2712.    if memerror<>noerr then goto 99;
  2713.       
  2714.    {read in the data}
  2715.    {offset:=offset+4;}{read from mark after data length}
  2716.    {if SetFPos(fileref,fsfromStart,offset)<>noerr then goto 85;}
  2717.    bcount:=rdsize;
  2718.    hlock(resdata);
  2719.    scsi_wait;
  2720.    if FsRead(fileref,bcount,(resdata^))<>noerr then goto 85;
  2721.    hunlock(resdata);
  2722.    if bcount<>rdsize then goto 85;
  2723.    {we have got it}
  2724.    psize:=rdsize+4;{add 4 to size to make consistent with 
  2725.                     result of SIzeResource}
  2726.       
  2727.   end;{with}
  2728.   
  2729. Hunlock(mypath.resdata);  
  2730. copyResData:=true;
  2731. exit;
  2732. {failure}
  2733.   85:
  2734.   88:
  2735.   99:
  2736. Hunlock(mypath.resdata);
  2737. copyResData:=false;
  2738. end;{function}
  2739.               
  2740. procedure closepath(var mypath:myresPathtype);
  2741. var err:oserr;
  2742. begin
  2743.  
  2744. if goodhandle(handle(mypath.reflist),'closepath1') then
  2745.      Hunlock(handle(mypath.reflist))
  2746. else
  2747.      sysbeep(1);
  2748. if goodhandle(handle(mypath.typelist),'closepath2') then
  2749.      Hunlock(handle(mypath.typelist))
  2750. else
  2751.      sysbeep(1);
  2752. if goodhandle(mypath.resdata,'closepath3')then
  2753.      Hunlock(handle(mypath.resdata))
  2754. else
  2755.      sysbeep(1);
  2756.  
  2757. if mypath.reflist<>nil then
  2758.     sethandlesize(handle(mypath.reflist ),32);
  2759. if mypath.typelist<>nil then
  2760.     sethandlesize(handle(mypath.typelist ),32);
  2761. if mypath.resdata<>nil then
  2762.     sethandlesize(handle(mypath.resdata ),32);
  2763. if mypath.status>=pathempty then
  2764.          begin 
  2765.         { dbarray[dbaopen]:=dbarray[dbaopen]-1;}
  2766.          err:=FSclose(mypath.fileref);
  2767.          end;
  2768.          
  2769. mypath.status:=pathbad;
  2770. end;{proc closepath}
  2771.  
  2772. function openpath(var mypath:myresPathtype;pfilename:str255;pvolref:integer):oserr;
  2773. label 99,98;
  2774. const myerr=-999;
  2775.       minimumRFsize=16;
  2776. var err,err2:oserr;
  2777.     lsize:longint;
  2778.     bcount:longint;
  2779.     theeof:longint;
  2780. begin
  2781. err:=myerr;
  2782. with mypath do
  2783.    begin
  2784.       volref:=pvolref;
  2785.       filename:=pfilename;
  2786.       current_type:='    ';
  2787.       ntypes:=0;
  2788.       nrefs:=0;
  2789.       status:=pathbad;
  2790.        
  2791.       {open resource fork}
  2792.       err:=my_openRF_readonly(pfilename,pvolref,fileref); 
  2793.       if err<>noerr then goto 99;
  2794.       {dbarray[dbaopen]:=dbarray[dbaopen]+1;}
  2795.       status:=pathopen;
  2796.       
  2797.       {get Eof to see if this file has a resource fork}
  2798.       err:=geteof(fileref,theeof);
  2799.       if err<>noerr then goto 99;
  2800.       {do a normal exit on an empty resource fork}
  2801.       if theeof<minimumRFsize then
  2802.             begin
  2803.               ntypes:=0;
  2804.               nrefs:=0;
  2805.               status:=pathempty;
  2806.               openpath:=noerr;
  2807.               closepath(mypath);
  2808.               exit;
  2809.            end;
  2810.               
  2811.       
  2812.       
  2813.       {get offsets to data and start}
  2814.       err:=SetFPos(fileref,fsFromStart,0);
  2815.       if err<>noerr then goto 99;
  2816.       bcount:=8;
  2817.       scsi_wait;
  2818.       err:=FsRead(fileref,bcount,@offset_to_res_data);
  2819.       if err<>noerr then goto 99;
  2820.       if bcount<>8 then goto 98;
  2821.  
  2822.       {get resource map}
  2823.       err:=SetFPos(fileref,fsFromStart,offset_to_res_map);
  2824.       if err<>noerr then goto 99;
  2825.       bcount:=sizeof(myresMaptype);
  2826.       scsi_wait;
  2827.       err:=FsRead(fileref,bcount,@map);
  2828.       if err<>noerr then goto 99;
  2829.       if bcount<>sizeof(myresMaptype) then goto 98;
  2830.       
  2831.       {compute absolute offset to type list,name list}
  2832.       offset_to_typelist:=offset_to_res_map+map.offset_map_to_typelist;
  2833.       offset_to_namelist:=offset_to_res_map+map.offset_map_to_namelist;
  2834.    
  2835.       {get number of types}
  2836.       err:=SetFPos(fileref,fsFromStart,offset_to_typelist);
  2837.       if err<>noerr then goto 99;
  2838.       bcount:=2 {sizeof(myresMaptype)};
  2839.       scsi_wait;
  2840.       err:=FsRead(fileref,bcount,@ntypes);
  2841.       if err<>noerr then goto 99;
  2842.       if bcount<>2 {sizeof(myresMaptype)}then goto 98;
  2843.       ntypes:=ntypes+1;
  2844.  
  2845.       {resize handle for type list}
  2846.       lsize:=8*ntypes;
  2847.       Hunlock(handle(typelist));
  2848.       sethandlesize(handle(typelist),lsize);
  2849.       if memerror<>noerr then 
  2850.           begin
  2851.           err:=memerror;
  2852.           goto 99;
  2853.           end;
  2854.           
  2855.       status:=typelistopen;
  2856.       hlock(handle(typelist));
  2857.       
  2858.       {read type list into handle}
  2859.      { err:=SetFPos(fileref,fsfromstart,offset_to_typelist+2);
  2860.       if err<>noerr then goto 99;} {read from mark}
  2861.       bcount:=lsize;
  2862.       scsi_wait;
  2863.       err:=FsRead(fileref,bcount,Ptr(typelist^));
  2864.       hunlock(handle(typelist));     
  2865.       if err<>noerr then goto 99;
  2866.       if bcount<>lsize then goto 98;
  2867.       
  2868.    end;{with mypath}
  2869.  
  2870. openpath:=noerr;
  2871. exit;{normal exit} 
  2872. 98:err:=myerr;
  2873. 99:{error exit}
  2874. closepath(mypath);
  2875. openpath:=err;
  2876. end;{proc openpath}
  2877.  
  2878.  
  2879.  
  2880. {$S        }
  2881. function Mygrowzone(cbneeded:size):longint;
  2882. var dontmove:handle;
  2883.     result:longint;
  2884. begin
  2885.   result:=0;
  2886.   dontmove:=GZsaveHnd;
  2887.   if growzoneguardblock<>nil then
  2888.      if growzoneguardblock<>dontmove then
  2889.       begin
  2890.       result:=GetHandleSize(growzoneguardblock);
  2891.       DisposHandle(growzoneguardblock);
  2892.       growzoneguardblock:=nil;
  2893.       sysbeep(1);
  2894.       end;
  2895.  
  2896. lowmemoryGZflag:=true;
  2897.  
  2898. mygrowzone:=result;
  2899. end;{function}
  2900. procedure setup_mygrowzone;
  2901.  
  2902. begin
  2903. lowmemoryGZflag:=false;
  2904. growzoneguardblock:=newhandle(GZguardblocksize);
  2905. SetGrowZone(@mygrowzone);
  2906.  
  2907. end;
  2908. procedure low_memory_halt;
  2909. {low memory warning - post message in a different way to work better}
  2910. var
  2911.     wait,endit:longint;
  2912. begin
  2913. if rinfo<>nil then 
  2914.   begin
  2915.        DisposPtr(ptr(rinfo));
  2916.        rinfo:=nil;
  2917.    end;
  2918. if ainfo<>nil then 
  2919.   begin
  2920.        DisposPtr(ptr(ainfo));
  2921.        ainfo:=nil;
  2922.    end;
  2923. replaceline('Not enough memory to continue safely',errorline);
  2924. showstatus;
  2925. wait:=120;
  2926. delay(wait,endit);
  2927. close_all_and_halt(true);
  2928. end;
  2929.  
  2930. {$S          }
  2931. procedure allocate_big_memory(var failed:boolean);
  2932. const 
  2933.     safety=150000;{minimum free space}
  2934. var needed:size;
  2935.     wevegot,grow:size;
  2936. begin
  2937. failed:=false;
  2938. needed:=Sizeof(resourceinfoarray)+Sizeof(applinfoarray);
  2939. ResrvMem(needed+safety);
  2940. Wevegot:=MaxMem(grow);
  2941. if wevegot<(needed+safety) then
  2942.      begin
  2943.        failed:=true;
  2944.      end
  2945.  else
  2946.      begin
  2947.        rinfo:=resourceinfoarrayptr(NewPtr(Sizeof(resourceinfoarray)));
  2948.        ainfo:=applinfoarrayptr(NewPtr(Sizeof(applinfoarray)));
  2949.        if (rinfo=nil) or(ainfo=nil) then
  2950.              begin
  2951.                 failed:=true;
  2952.              end
  2953.      end;
  2954.  
  2955. end;
  2956. {$S safekey}
  2957. procedure add_safekey(ss:str255);
  2958. var i:integer;
  2959. begin
  2960. uprString(ss,true);{upper case}
  2961. if safekeywords_count<maxsafekeywords then 
  2962.    begin
  2963.      for i:=1 to safekeywords_count do
  2964.         begin
  2965.           if safekeywords[i]=ss then exit;{already in the list}
  2966.         end;
  2967.      safekeywords_count:=safekeywords_count+1;
  2968.      safekeywords[safekeywords_count]:=ss;
  2969.    end;
  2970. end;{procedure}
  2971.  
  2972. procedure write_safekeys;
  2973. var i:integer;
  2974. begin
  2975. if not outputopen then exit;
  2976.  for i:=1 to safekeywords_count do
  2977.    begin
  2978.    scsi_wait;
  2979.    writeln(outfile,safekeywords[i]);
  2980.    end;
  2981.    write_end_flag('end safe names');
  2982.   
  2983. end;
  2984.  
  2985. procedure read_safekeys;
  2986. {read list of safe keyword file exclusions}
  2987. var line:str255;
  2988.     tokens:tokenstype;
  2989.     ntokens:integer;
  2990. begin
  2991. if not inputopen then exit;
  2992. position_to_section(sect_num_safe_names);
  2993. line:='';
  2994. while not eof(infile) do
  2995.    begin
  2996.    read_input(line);
  2997.    if test_end_flag(line) then exit;
  2998.    tabscan(line,tokens,ntokens);
  2999.    if ntokens>=1 then add_safekey(tokens[1]);
  3000.     end;
  3001. end;
  3002. {$S start2    }
  3003. procedure write_morechecks;
  3004. {write list of additional (boot block?) checksums
  3005.  shell procedure for future expansion}
  3006. var i:integer;
  3007. begin
  3008. if not outputopen then exit;
  3009.   (* write it here *)
  3010.    write_end_flag('end morechecks');
  3011. end;
  3012.  
  3013. procedure read_morechecks;
  3014. {read list of additional (boot block?) checksums
  3015.  shell procedure for future expansion}
  3016. var line:str255;
  3017.     tokens:tokenstype;
  3018.     ntokens:integer;
  3019. begin
  3020. if not inputopen then exit;
  3021. position_to_section(sect_num_more_checks);
  3022. line:='';
  3023. while not eof(infile) do
  3024.    begin
  3025.    read_input(line);
  3026.    if test_end_flag(line) then exit;
  3027.     (* process here *)
  3028.     end;
  3029. end;
  3030.  
  3031. {$S core}
  3032. function filenamesafetylevel(name:str255):safetype;
  3033. {checksum all resources above this level}
  3034. label 99;
  3035. var i:integer;
  3036.     result:safetype;
  3037. begin
  3038. uprString(name,true);{upper case}
  3039.  for i:=1 to safekeywords_count do
  3040.    begin
  3041.    if Pos(safekeywords[i],name)<>0 then
  3042.       begin
  3043.          result:=unknown;
  3044.          goto 99;
  3045.       end;
  3046.    end;   
  3047. result:=safe;
  3048. 99:
  3049. {poststatus(safetynames[result],errorline);}
  3050. filenamesafetylevel:=result;
  3051. end;
  3052.  
  3053. {$S safekey}
  3054. procedure start_safekey;
  3055. {Make list of substrings in file names that 
  3056.  indicate the file is a temporary file or settings file
  3057.  that frequently changes and may contain 
  3058.  "unknown" resource types that are really safe}
  3059. begin
  3060. safekeywords_count:=0;
  3061. add_safekey('Scrapbook');
  3062. add_safekey('Clipboard');
  3063. add_safekey('TEMP');
  3064. add_safekey('WORK');
  3065. add_safekey('SETTING');
  3066. add_safekey('RESUME');
  3067. add_safekey('PREFER');
  3068. add_safekey('OPTION');
  3069. add_safekey('SCRATCH');
  3070. add_safekey('DEFAULT');
  3071. add_safekey('MACRO');
  3072. add_safekey('MAP');
  3073.  
  3074. end;
  3075. {$S start2}
  3076. FUNCTION HFSExists: BOOLEAN;
  3077.  {From Tech note #77}
  3078.  var w:wordptr;
  3079. Begin {HFSExists}
  3080.   w:=WordPtr(Pointer(FSFCBLen));
  3081.         HFSExists := (w^) > 0;
  3082. End;  {HFSExists}
  3083.  
  3084. procedure HFSWarning;
  3085. {Quit if HFS not available}
  3086. var wait,endit:longint;
  3087. begin
  3088. if not HFSexists then
  3089.     begin
  3090.     wait:=180;
  3091.     Poststatus('This program requires the HFS file system',errorline);
  3092.     delay(wait,endit);
  3093.     doevent(false);
  3094.     close_all_and_halt(true);
  3095.     end;
  3096. end; {HFSWarning}
  3097.  
  3098. FUNCTION GetRealBootDrive: INTEGER;
  3099.  {From Tech Note #77}
  3100.     VAR
  3101.          MyHPB         : HParamBlockRec;
  3102.          MyWDPB        : WDPBRec;
  3103.          err         : OSErr;
  3104.    w:wordptr;
  3105.         sysVRef    : integer; {will be the vRefNum of open system╒s vol}
  3106.  
  3107.     Begin {GetRealBootDrive}
  3108.             if HFSExists then Begin        {If we╒re running under HFS... }
  3109.                     
  3110.             {get the VRefNum of the volume that }
  3111.             {contains the open System File      }
  3112.     w:=WordPtr(Pointer(SysMap));
  3113.             err:= GetVRefNum(w^,sysVRef);
  3114.  
  3115.             with MyHPB do Begin          
  3116.             {Get the ╥System╙ vRefNum and ╥Blessed╙ dirID}
  3117.                             ioNamePtr   := NIL;   
  3118.                             ioVRefNum   := sysVRef; {from the GetVrefNum call}
  3119.                             ioVolIndex  := 0;
  3120.                     End; {with}
  3121.                     err := PBHGetVInfo(@MyHPB, FALSE);
  3122.  
  3123.  
  3124.                    with myWDPB do Begin      {Open a working directory there}
  3125.                             ioNamePtr   := NIL;
  3126.                             ioVRefNum   := sysVRef;
  3127.                        ioWDProcID  := SysWDProcID; {Using the system proc ID}
  3128.                             ioWDDirID   := myHPB.ioVFndrInfo[1];{ see TechNote 67}
  3129.                     End; {with}
  3130.             err := PBOpenWD(@myWDPB, FALSE);
  3131.  
  3132.                     GetRealBootDrive := myWDPB.ioVRefNum;
  3133.             {We╒ve got the real WD}
  3134.             End Else {we╒re running MFS}
  3135.                  begin
  3136.                  w:=WordPtr(Pointer(BootDrive));
  3137.                     GetRealBootDrive := w^; 
  3138.                  end;
  3139.             {BootDrive is valid under MFS}
  3140. End;  {GetRealBootDrive}
  3141.  
  3142. {$S core}
  3143. procedure tabscan{(line:str255; var tokens:tokenstype;var ntokens:integer)};
  3144. {Input scanner: breaks a line into tokens separated by tabs}
  3145. {Trims leading and trailing blanks}
  3146. label 99,88;
  3147. var tab,sp:char;
  3148.     i,j,next,last:integer;
  3149. begin
  3150. tab:=chr(9);
  3151. sp:=' ';
  3152.  
  3153. for i:=1 to maxtokens do tokens[i]:='';
  3154.  
  3155. ntokens:=0;
  3156. next:=1;
  3157. last:=length(line);
  3158. while(next<=last) do
  3159.     begin
  3160.     {skip leading blanks}
  3161.     while(line[next]=sp) do
  3162.         begin
  3163.            next:=next+1;
  3164.            if(next>last) then goto 99;
  3165.         end;{while not space}
  3166.         
  3167.     {copy up to tab or end of line}
  3168.     ntokens:=ntokens+1;
  3169.     while(line[next]<>tab) do
  3170.         begin
  3171.            tokens[ntokens]:=concat(tokens[ntokens],line[next]);
  3172.            next:=next+1;
  3173.            if(next>last)then goto 99;
  3174.         end;{while not tab}
  3175.     next:=next+1;{skip tab}
  3176.     end;{while}
  3177. 99:
  3178. {remove trailing spaces}
  3179. for i:=1 to ntokens do
  3180.   begin
  3181.      last:=length(tokens[i]);
  3182.      for j:=length(tokens[i]) downto 1 do
  3183.         begin
  3184.         if tokens[i][j]<>sp then
  3185.             begin
  3186.                last:=j;
  3187.                goto 88;
  3188.             end;
  3189.         end;
  3190.      88:
  3191.        if last>0 then 
  3192.              tokens[i]:=copy(tokens[i],1,last)
  3193.           else
  3194.              tokens[i]:='';
  3195.   end;{for i}
  3196. end;{proc}
  3197.  
  3198.  
  3199. function find_type(atype:restype):integer;
  3200. {find a resource type if it exists.  Return the current supscript or zero
  3201. if it does not exist}
  3202. {binary search}
  3203. var low,high,mid:integer;
  3204. begin
  3205. low:=1;
  3206. high:=rtypes_count;
  3207.    while low<=high do
  3208.      begin
  3209.        mid:=(low+high) div 2;
  3210.        if atype=rtypes[mid].thetype then
  3211.            begin
  3212.              find_type:=mid;
  3213.               exit;
  3214.            end
  3215.         else if atype>rtypes[mid].thetype then
  3216.            begin
  3217.              low:=mid+1;
  3218.            end
  3219.         else
  3220.            begin
  3221.               high:=mid-1;
  3222.            end;
  3223.       end;{while}
  3224. find_type:=0;{no match}
  3225. end;{function}
  3226.  
  3227. function find_and_add_type(atype:restype;howsafe:safetype):integer;
  3228. {find a resource type if it exists, otherwise add it to rtypes in sorted
  3229.  order.  Return the current supscript}
  3230. {binary search and insertion}
  3231. var low,high,mid,ii,at:integer;
  3232.      ss:str255;
  3233. begin
  3234. low:=1;
  3235. high:=rtypes_count;
  3236. at:=low;
  3237.    while low<=high do
  3238.      begin
  3239.        mid:=(low+high) div 2;
  3240.        if atype=rtypes[mid].thetype then
  3241.            begin
  3242.              find_and_add_type:=mid;
  3243.               exit;
  3244.            end
  3245.         else if atype>rtypes[mid].thetype then
  3246.            begin
  3247.              low:=mid+1;
  3248.              at:=mid+1;
  3249.            end
  3250.         else  {atype<rtypes[mid].thetype}
  3251.            begin
  3252.               high:=mid-1;
  3253.               at:=mid;
  3254.            end;
  3255.      
  3256.       end;{while}
  3257.  
  3258. if rtypes_count>=maxtype then
  3259.      begin
  3260.        poststatus('My maximum resource type count exceeded',errorline);
  3261.        find_and_add_type:=0;
  3262.        exit;
  3263.     end;
  3264. for ii:=rtypes_count downto at do
  3265.     begin
  3266.     rtypes[ii+1]:=rtypes[ii]
  3267.     end;
  3268. rtypes[at].thetype:=atype;
  3269. rtypes[at].safety:=howsafe;
  3270. rtypes[at].occurs:=0;
  3271. {wait_for_buttons(concat(atype,safetynames[howsafe],continuebut));}
  3272.  
  3273. rtypes_count:=rtypes_count+1;    
  3274. find_and_add_type:=at;
  3275. end;{function}
  3276. {$S wascore}
  3277. function find_type_old(atype:restype):integer;
  3278. {old version}
  3279. label 99;
  3280. var i:integer;
  3281.     result:integer;
  3282. begin
  3283. result:=0;
  3284.   for i:=1 to rtypes_count do
  3285.      begin
  3286.        with rtypes[i] do
  3287.           begin
  3288.             if thetype=atype then
  3289.                begin
  3290.                   result:=i;
  3291.                   goto 99;
  3292.                end;
  3293.           end;
  3294.      end;
  3295. 99:
  3296. find_type_old:=result;
  3297.  
  3298. end;{find_type}
  3299. {$S core    }
  3300. procedure add_type(atype:restype;howsafe:safetype);
  3301. {add a type and it's classification to the list in memory
  3302. if it does not already exist}
  3303. var ignore:integer;
  3304. begin
  3305. ignore:=find_and_add_type(atype,howsafe);
  3306. end;
  3307. {$S wascore  }
  3308. procedure add_type_old(atype:restype;howsafe:safetype);
  3309. var i,result:integer;
  3310. {add type to tables if it does not already exist}
  3311. {old version}
  3312. begin
  3313. if find_type(atype)=0 then
  3314.     begin
  3315.     if rtypes_count<maxtype then
  3316.         begin
  3317.          rtypes_count:=rtypes_count+1;
  3318.          with rtypes[rtypes_count] do
  3319.            begin
  3320.               thetype:=atype;
  3321.               safety:=howsafe;
  3322.               occurs:=0;
  3323.            end ;{with}
  3324.            sorttypes(rtypes,rtypes_count);
  3325.          end
  3326.      else
  3327.          begin
  3328.            poststatus('My maximum resource type count exceeded',errorline);
  3329.          end;
  3330.          
  3331.      end; 
  3332.  
  3333. end;{add_type}
  3334.  
  3335. {$S appldet}
  3336. procedure detail_appl_check;
  3337. {Compare the checksums in memory with the old checksums on file for applications}
  3338. {This assumes both are sorted by creator,creationdate,filename,dirid}
  3339. {if no checksums were done before, just compare sizes}
  3340.  
  3341. type statetype=(oldgreater,newgreater,
  3342.                checkequality,sizeequality,
  3343.                sameappl,sameapplbadsize,sameapplbadcheck);
  3344. var 
  3345.     jnew:integer;
  3346.     jcreator:ostype;
  3347.     jcreatorstart:integer;
  3348.     jcreatorend:integer;
  3349.     state:statetype;
  3350.     oldfile,newfile:myfilenametype;
  3351.     filecomp:integer;
  3352.     oldcreator,newcreator:OStype;
  3353.     oldcreationdate,newcreationdate:longint;
  3354.     oldsize,newsize:longint;
  3355.     oldunsafecount,newunsafecount:longint;
  3356.     oldchecksize,newchecksize:longint;
  3357.     oldchecksum,newchecksum:integer;
  3358.     olddirid,newdirid:longint;
  3359.     oldvol,newvol:integer;
  3360.     newhidden:boolean;
  3361.     end_on_old,end_on_new:boolean;
  3362.     oid,nid:str255;
  3363.  
  3364. procedure get_next_old;
  3365. label 22;{repeat}
  3366. var line:str255;
  3367.     tokens:tokenstype;
  3368.     ntokens:integer;
  3369.     work:longint;
  3370. begin
  3371. 22:
  3372. ntokens:=0;
  3373. repeat
  3374. if end_on_old then exit; 
  3375. if eof(infile) then
  3376.     begin
  3377.       end_on_old:=true;
  3378.       exit;
  3379.     end;
  3380. read_input(line);
  3381. {treat "*****" as end}
  3382. if test_end_flag(line) then
  3383.     begin
  3384.       end_on_old:=true;
  3385.       exit;
  3386.     end;
  3387. tabscan(line,tokens,ntokens)
  3388.  
  3389. until(ntokens>=9);{ignore short/blank lines}
  3390.  
  3391. {breakdown line as:}
  3392. {creator <tab> creationdate <tab> filename <tab> dirid <tab> volume
  3393. <tab> thesize <tab> unsafecount <tab> checksize <tab> checksum}
  3394.  
  3395. filltype(oldcreator,tokens[1]);{blank fill type}
  3396. stringtonum(tokens[2],oldcreationdate);
  3397. oldfile:=tokens[3];
  3398. stringtonum(tokens[4],olddirid);
  3399. stringtonum(tokens[5],work);
  3400. oldvol:=work;
  3401. stringtonum(tokens[6],oldsize);
  3402. stringtonum(tokens[7],work);
  3403. oldunsafecount:=work;
  3404. stringtonum(tokens[8],oldchecksize);
  3405. stringtonum(tokens[9],work);
  3406. oldchecksum:=work;
  3407. {additional stuff at end of line will be ignored}
  3408. {skip non-matching volumes}
  3409. if oldvol<>0 then
  3410.    if oldvols[oldvol].matchto=0 then goto 22;
  3411. end;{get_next_old}
  3412.  
  3413. procedure get_next_new;
  3414. label 88,22;
  3415. var jj:integer;
  3416. begin
  3417. 22:
  3418. jnew:=jnew+1;
  3419. if jnew>acount then 
  3420.     begin
  3421.       end_on_new:=true;
  3422.       exit;
  3423.     end;
  3424.     (*
  3425.           {info on applications}
  3426.       applinforec=record
  3427.                   thesize:longint;
  3428.                   creator:OStype;
  3429.                   creationdate:longint;
  3430.                   dirid:longint;
  3431.                   filename:myfilenametype;
  3432.                   unsafecount:integer;
  3433.                   checksum:integer;
  3434.                   checksize:longint;
  3435.                   flags:integer;
  3436.                   end;
  3437.  
  3438.     *)
  3439. with  ainfo^[jnew] do
  3440.    begin
  3441.      newcreator:=creator;
  3442.      newcreationdate:=creationdate;
  3443.      newfile:=filename;
  3444.      newsize:=thesize;
  3445.      newunsafecount:=unsafecount;
  3446.      newchecksize:=checksize;
  3447.      newchecksum:=checksum;
  3448.      newdirid:=dirid;
  3449.      {matching old volume if any}
  3450.      if (flags and applvolumemask)=0 then
  3451.               begin
  3452.               newvol:=0
  3453.               end
  3454.      else
  3455.               begin
  3456.               newvol:=newvols[(flags and applvolumemask)].matchto;
  3457.               {skip non-matching volumes}
  3458.               if newvol=0 then goto 22;
  3459.               end;
  3460.          
  3461.      newhidden:=(flags and applinvisiblemask)<>0;
  3462.    end;{with}
  3463.  
  3464. {find last occurance of current signature}   
  3465. if newcreator<>jcreator then
  3466.     begin
  3467.     jcreator:=newcreator;
  3468.     jcreatorstart:=jnew;
  3469.     for jj:=jnew+1 to acount do
  3470.        if ainfo^[jj].creator<>jcreator then
  3471.          begin
  3472.            jcreatorend:=jj-1;
  3473.            goto 88;
  3474.          end;
  3475.      jcreatorend:=acount;
  3476.      88:
  3477.     end;
  3478.  
  3479. end;{get_next_new}
  3480.  
  3481. procedure was_renamed_or_moved;
  3482. label 88;
  3483. {one to many check for current signature}
  3484. {call this if no match and there is more than one occurance}
  3485. {this assumes that an application is OK regardless of name and
  3486.  directory changes if other features match:
  3487.         creationdate
  3488.         checksize
  3489.         checksum
  3490.         unsafecount
  3491.         
  3492.         or if (oldunsafecount=notcounted)           
  3493.            creationdate
  3494.            thesize}
  3495. var 
  3496.     jj:integer;
  3497. begin
  3498. for jj:=jcreatorstart to jcreatorend do
  3499.     with ainfo^[jj] do
  3500.     begin
  3501.       if creationdate=oldcreationdate then
  3502.           if (oldunsafecount=notcounted) or (fastapplcheck) then
  3503.              begin
  3504.              if (oldsize=thesize) then 
  3505.                   begin
  3506.                   flags:=flags or applrenamemask;
  3507.                   end
  3508.              end
  3509.           else
  3510.              begin
  3511.              if oldunsafecount=unsafecount then
  3512.                if oldchecksize=checksize then
  3513.                  if oldchecksum=checksum then;
  3514.                  begin
  3515.                   flags:=flags or applrenamemask;
  3516.                  end;
  3517.              end;
  3518.     end;
  3519. end;{was_moved_or_renamed}
  3520.  
  3521. begin{detail_appl_check}
  3522. jcreator:='$$$$';
  3523. if not inputopen then exit; 
  3524. position_to_section(sect_num_applications);
  3525. jnew:=0;
  3526. end_on_old:=false;
  3527. end_on_new:=false;
  3528. get_next_old;
  3529. get_next_new;
  3530.  
  3531. while not(end_on_old or end_on_new) do
  3532.   begin
  3533.  
  3534.   {debug info}
  3535. if detaildebugflag then
  3536.   begin  
  3537.   poststatus(concat(concat(oldfile,':'),newfile),detailbugline);
  3538.   poststatus(concat(concat(oldcreator,':'),newcreator),detailbugline+1); 
  3539.   numtostring(oldcreationdate,oid);
  3540.   numtostring(newcreationdate,nid);
  3541.   poststatus(concat(concat(oid,':'),nid),detailbugline+2);
  3542.   numtostring(olddirid,oid);
  3543.   numtostring(newdirid,nid);
  3544.   poststatus(concat(concat(oid,':'),nid),detailbugline+3);
  3545.   end;
  3546.  
  3547.   state:=newgreater;
  3548.   
  3549.   {if creator signature matches, check for rename/move on partial match}
  3550.   if oldcreator=newcreator then
  3551.      begin
  3552.        if oldcreationdate=newcreationdate then
  3553.            begin
  3554.           {wait_for_buttons('creation match',continuebut);}
  3555.            filecomp:=filenamecompare(oldfile,newfile);
  3556.            if filecomp=0{equal} then
  3557.               begin
  3558.                {wait_for_buttons('filename match',continuebut);}
  3559.               if oldvol=newvol then
  3560.                 begin
  3561.                   if olddirid=newdirid then
  3562.                      begin
  3563.                      {wait_for_buttons('dir match',continuebut);}
  3564.                         {this is the same file name in the same directory}
  3565.                         state:=sameappl;
  3566.                         {now check for changed vs exact match}
  3567.                        {match on
  3568.                         checksize
  3569.                         checksum
  3570.                         unsafecount
  3571.                         
  3572.                         or if oldunsafecount=notcounted           
  3573.                            thesize}  
  3574.                         if (oldunsafecount=notcounted) or (fastapplcheck) then
  3575.                            begin
  3576.                            if not newhidden then state:=sameapplbadsize;
  3577.                            if (oldsize=newsize) or newhidden then
  3578.                               {less stringent check on non-application
  3579.                                hidden files - Desktop changes size}
  3580.                               state:=sizeequality;
  3581.                            end
  3582.                         else
  3583.                            begin
  3584.                            state:=sameapplbadcheck;
  3585.                            if oldchecksize=newchecksize then
  3586.                            if oldchecksum=newchecksum then
  3587.                            if oldunsafecount=newunsafecount then
  3588.                               state:=checkequality;                       
  3589.                            end;
  3590.                         
  3591.                      end{=dir}
  3592.                   else 
  3593.                      begin
  3594.                      if olddirid>newdirid then
  3595.                          begin
  3596.                          state:=oldgreater;
  3597.                          end;
  3598.                      was_renamed_or_moved;
  3599.                      end{<>dir}
  3600.                 end{=vol}
  3601.               else
  3602.                  begin
  3603.                      if oldvol>newvol then
  3604.                          begin
  3605.                          state:=oldgreater;
  3606.                          end;
  3607.                      was_renamed_or_moved;
  3608.                  end{<>vol}
  3609.               end{=file}
  3610.            else
  3611.               begin
  3612.               if filecomp>0{oldfile>newfile} then
  3613.                  begin
  3614.                    state:=oldgreater;
  3615.                  end;
  3616.                  was_renamed_or_moved;
  3617.               end{<>file}
  3618.            
  3619.            end{=creation date}
  3620.        else
  3621.            begin
  3622.            if oldcreationdate>newcreationdate then
  3623.               begin
  3624.                  state:=oldgreater;
  3625.               end;
  3626.               was_renamed_or_moved;
  3627.            end{<>creation date}
  3628.            
  3629.      end{= creator}
  3630.   else if oldcreator>newcreator then
  3631.       begin
  3632.          state:=oldgreater;
  3633.       end;
  3634.   
  3635.     postmem(memline);
  3636.    {end of compares}     
  3637.     case state of
  3638.     sizeequality:  
  3639.                  begin
  3640.                  {equality on the basis of size - fast check}
  3641.                  ainfo^[jnew].flags:=ainfo^[jnew].flags or applexactmatchmask;
  3642.                  {wait_for_buttons('equal appl',continuebut);}
  3643.                  if fastapplcheck and (oldunsafecount<>notcounted) then
  3644.                       begin
  3645.                          {copy old checksums etc. 
  3646.                           for future reference so that info
  3647.                           is not lost by writing output from
  3648.                           a short check}
  3649.                          with ainfo^[jnew] do
  3650.                            begin
  3651.                            checksum:=oldchecksum;
  3652.                            unsafecount:=oldunsafecount;
  3653.                            checksize:=oldchecksize;
  3654.                            end;
  3655.                       end;  
  3656.                  {moved from above to fix bug in version 53 5/1/88}           
  3657.                  get_next_old;
  3658.                  get_next_new;
  3659.                end;
  3660.     checkequality:  begin
  3661.                  {equality on the basis of all checksums - full check}
  3662.                  ainfo^[jnew].flags:=ainfo^[jnew].flags or applexactmatchmask;
  3663.                  get_next_old;
  3664.                  get_next_new;
  3665.                  {wait_for_buttons('equal appl',continuebut);}             
  3666.                end;
  3667.     sameappl:   begin
  3668.                  ainfo^[jnew].flags:=ainfo^[jnew].flags or applchangedmask;
  3669.                  if detaildebugflag then
  3670.                     wait_for_buttons('same appl no match',continuebut);
  3671.                 get_next_old; 
  3672.                 get_next_new;             
  3673.                end;
  3674.     sameapplbadsize:   begin
  3675.                  ainfo^[jnew].flags:=ainfo^[jnew].flags or applchangedmask;
  3676.                  ainfo^[jnew].flags:=ainfo^[jnew].flags or applbadsizemask;
  3677.                  if detaildebugflag then
  3678.                   wait_for_buttons('same appl no match/bad size',continuebut);
  3679.                  {automatic recheck}
  3680.                  recheck_changed(jnew,oldunsafecount,oldchecksize,oldchecksum);
  3681.                 get_next_old; 
  3682.                 get_next_new;             
  3683.                end;
  3684.     sameapplbadcheck:   begin
  3685.                  ainfo^[jnew].flags:=ainfo^[jnew].flags or applchangedmask;
  3686.                  ainfo^[jnew].flags:=ainfo^[jnew].flags or applbadcheckmask;
  3687.                  if detaildebugflag then
  3688.                   wait_for_buttons('same appl no match/bad check',continuebut);
  3689.                 get_next_old; 
  3690.                 get_next_new;             
  3691.                end;
  3692.     oldgreater:begin
  3693.                  if detaildebugflag then
  3694.                  wait_for_buttons('old greater',continuebut);
  3695.                  get_next_new;                 
  3696.                end;
  3697.     newgreater:begin
  3698.                  if detaildebugflag then
  3699.                     wait_for_buttons('new greater',continuebut);
  3700.                  get_next_old;
  3701.                end;
  3702.     end;{case of state}
  3703.     
  3704.   end;{while not done}
  3705.   
  3706. {skip to end of input for this section}
  3707. while (not end_on_old) do get_next_old;
  3708. if detaildebugflag then clear_to_end(detailbugline);
  3709. end;
  3710. procedure show_APPL_detail_changes;
  3711. {On Screen Summary of Application Changes}
  3712. label 77;
  3713. const
  3714.     chlimit=10;
  3715. var 
  3716.     j:integer;
  3717.     charray:array[1..chlimit] of integer;
  3718.     ch,chcount:integer;
  3719.     filename,dname:str255;
  3720.     work:str255;
  3721.     jtype:integer;
  3722.     dd:longint;
  3723.     newappl:longint;
  3724.     moveorrenamedappl:longint;
  3725.     changedappl:longint;
  3726.     safechangedappl:longint;
  3727.     dangerappl:longint;
  3728.     ans_show,notify:boolean;
  3729.     hidden:boolean;
  3730.     vnum:integer;
  3731.     dummy:str255;
  3732. procedure show_change(mess:str255);
  3733. begin
  3734. folder_info_two(dd,newvols[vnum].volrefnum,dname,dummy,false);
  3735. clear_to_end(fileline);
  3736. PostStatus(newvols[vnum].vname,fileline);
  3737. work:= concat(concat(dname,':'),filename);
  3738. poststatus(work,fileline+1);
  3739.  
  3740. wait_for_buttons(mess,continuebut);
  3741. clear_to_end(fileline);
  3742. end;
  3743.  
  3744. procedure mark_change(jj:integer);
  3745. begin
  3746. notify:=true;
  3747. {keep pointers to the first few changes to speed up display}
  3748. if chcount<chlimit then
  3749.       begin 
  3750.        chcount:=chcount+1;
  3751.        charray[chcount]:=jj;
  3752.       end;
  3753. end;
  3754.  
  3755. begin
  3756. chcount:=0;
  3757. {skip this all if there was no input file}
  3758. if not inputopen then exit;
  3759. {count changes}
  3760. newappl:=0;
  3761. moveorrenamedappl:=0;
  3762. changedappl:=0;
  3763. safechangedappl:=0;
  3764. dangerappl:=0;
  3765. notify:=false;
  3766. for j:=1 to acount do
  3767.   begin
  3768.   {only flag changes to stuff on matched volumes}
  3769.   if newvols[(ainfo^[j].flags and applvolumemask)].matchto<>0 then
  3770.     begin
  3771.        if (ainfo^[j].flags and applexactmatchmask)<>applexactmatchmask then
  3772.          if (ainfo^[j].flags and applrenamemask)=applrenamemask then
  3773.             begin
  3774.                {moved or renamed or duplicated}
  3775.                moveorrenamedappl:=moveorrenamedappl+1;
  3776.                mark_change(j);
  3777.             end
  3778.          else
  3779.             begin
  3780.               if (ainfo^[j].flags and applchangedmask)=applchangedmask then
  3781.                 begin
  3782.                   {changed}
  3783.                   changedappl:=changedappl+1;
  3784.                   mark_change(j);
  3785.                 end
  3786.               else if (ainfo^[j].flags and applsafechangedmask)=applsafechangedmask then
  3787.                  begin
  3788.                  {safe changed - size only}
  3789.                   safechangedappl:=safechangedappl+1;
  3790.                   mark_change(j);
  3791.                  end
  3792.               else
  3793.                 begin
  3794.                    {"new"}
  3795.                     newappl:=newappl+1;
  3796.                     mark_change(j);
  3797.                     
  3798.                 end
  3799.             end;
  3800.      end;
  3801.      if (ainfo^[j].flags and appldangermask)=appldangermask then
  3802.          begin
  3803.          dangerappl:=dangerappl+1;
  3804.          mark_change(j);
  3805.          end;       
  3806.   end;{for}
  3807.  {quick skip to end}
  3808. if chcount<chlimit then
  3809.      begin
  3810.      chcount:=chcount+1;
  3811.      charray[chcount]:=acount+1;
  3812.      end;
  3813.      
  3814. {exit if no changes}
  3815. if not notify then exit;
  3816.  
  3817. {notify of changes and give a chance to see the changes on screen and on disk}
  3818. sysbeep(1);
  3819. clear_to_end(askline-3);
  3820. poststatus('',askline-4);
  3821. poststatus('',askline-5);
  3822. numtostring(safechangedappl,work);
  3823. work:=concat('Safe size changes: ',work);
  3824. poststatus(work,askline-5);
  3825. numtostring(newappl,work);
  3826. work:=concat('New: ',work);
  3827. poststatus(work,askline-4);
  3828. numtostring(moveorrenamedappl,work);
  3829. work:=concat('Renamed/Moved: ',work);
  3830. poststatus(work,askline-3);
  3831. numtostring(changedappl,work);
  3832. work:=concat('Changed: ',work);
  3833. poststatus(work,askline-2);
  3834.  
  3835. if Dangerappl<>0 then
  3836. begin
  3837. numtostring(dangerappl,work);
  3838. work:=concat('Dangerous: ',work);
  3839. poststatus(work,askline-1);
  3840. end;
  3841.  
  3842. work:=
  3843. 'These are differences in the applications or hidden files.  Do you want to see the details on screen?';
  3844. ans_show:=ask(work,nodefaultbut);
  3845. clear_to_end(askline-5);
  3846.  
  3847. open_output_dialog(false,nodefaultbut);
  3848.       
  3849. if not ans_show then exit;
  3850. poststatus('List differences in applications or hidden files:',pathline);
  3851. {loop to show individual changes}
  3852. j:=0;
  3853. ch:=0;
  3854. while(j<=acount)do 
  3855.   begin
  3856.   {faster skip to marked changes}
  3857.   if ch<chcount then
  3858.      begin
  3859.        ch:=ch+1;
  3860.        j:=charray[ch];
  3861.      end
  3862.   else
  3863.      begin
  3864.        j:=j+1;
  3865.      end;
  3866.     if j>acount then goto 77;
  3867.     
  3868.     filename:=ainfo^[j].filename;
  3869.     dd:=ainfo^[j].dirid;
  3870.     vnum:=ainfo^[j].flags and applvolumemask;
  3871.     hidden:=(ainfo^[j].flags and applinvisiblemask)<>0;
  3872.     if newvols[(ainfo^[j].flags and applvolumemask)].matchto<>0 then
  3873.         begin
  3874.         if (ainfo^[j].flags and applexactmatchmask)<>applexactmatchmask then
  3875.           if (ainfo^[j].flags and applrenamemask)=applrenamemask then
  3876.              begin
  3877.                 {moved or renamed or duplicated}
  3878.                 Show_change('was moved, renamed or duplicated')
  3879.              end
  3880.           else
  3881.              begin
  3882.                if (ainfo^[j].flags and applchangedmask)=applchangedmask then
  3883.                  begin
  3884.                    {changed}
  3885.                    if hidden then
  3886.                      Show_change('Changed Invisible File')
  3887.                    else 
  3888.                      Show_change('Changed Application');
  3889.                  end
  3890.                else if (ainfo^[j].flags and applsafechangedmask)=applsafechangedmask then
  3891.                  begin
  3892.                    {safe changed}
  3893.                      Show_change('Application: Safe change in size');
  3894.                  end
  3895.  
  3896.                else
  3897.                  begin
  3898.                    if hidden then
  3899.                      Show_change('New Invisible File')
  3900.                    else 
  3901.                      Show_change('New Application');
  3902.                  end
  3903.              end;
  3904.         end;
  3905.    if (ainfo^[j].flags and appldangermask)=appldangermask then
  3906.        begin
  3907.        Show_change('Infected with a dangerous resource type');
  3908.        end;
  3909.   end;{for}
  3910. 77:
  3911. clear_to_end(pathline);
  3912. end;{proc show_APPL_detail_changes}
  3913.  
  3914. {$S detail}
  3915. procedure detail_resource_check;
  3916. {Compare the checksums in memory with the old checksums on file}
  3917. {This assumes both are sorted by filename,type,id}
  3918. {If there is more than one entry per id the old file is
  3919.  assumed sorted by filename,type,id,size,name and checksum.
  3920.  This is to allow a old checksum file valid for two system
  3921.  versions to be constructed, but this feature is not fully
  3922.  supported}
  3923.  
  3924. type statetype=(oldgreater,newgreater,equality,sameid);
  3925. var 
  3926.     jnew:integer;
  3927.     state:statetype;
  3928.     oldtype,newtype:restype;
  3929.     oldfile,newfile:myfilenametype;
  3930.     oldid,newid:integer;
  3931.     oldsize,newsize:longint;
  3932.     oldchecksum,newchecksum:integer;
  3933.     oldname,newname:myresnametype;
  3934.     end_on_old,end_on_new:boolean;
  3935.     oid,nid:str255;
  3936.     filecomp:integer;
  3937.  
  3938. procedure get_next_old;
  3939. var line:str255;
  3940.     tokens:tokenstype;
  3941.     ntokens:integer;
  3942.     work:longint;
  3943. begin
  3944. ntokens:=0;
  3945. repeat
  3946. if end_on_old then exit; 
  3947. if eof(infile) then
  3948.     begin
  3949.       end_on_old:=true;
  3950.       exit;
  3951.     end;
  3952. read_input(line);
  3953. {treat "*****" as end}
  3954. if test_end_flag(line) then
  3955.     begin
  3956.       end_on_old:=true;
  3957.       exit;
  3958.     end;
  3959. tabscan(line,tokens,ntokens)
  3960.  
  3961. until(ntokens>=6);{ignore short/blank lines}
  3962.  
  3963. {breakdown line as:}
  3964. {type <tab> id <tab> size <tab> checksum <tab> name <tab> filename}
  3965. filltype(oldtype,tokens[1]);{blank fill type}
  3966. stringtonum(tokens[2],work);
  3967. oldid:=work;
  3968. stringtonum(tokens[3],oldsize);
  3969. stringtonum(tokens[4],work);
  3970. oldchecksum:=work;
  3971. oldname:=tokens[5];
  3972. oldfile:=tokens[6];
  3973. {additional stuff at end of line will be ignored}
  3974.  
  3975. end;{get_next_old}
  3976.  
  3977. procedure get_next_new;
  3978.  
  3979. begin
  3980. jnew:=jnew+1;
  3981. if jnew>rcount then 
  3982.     begin
  3983.       end_on_new:=true;
  3984.       exit;
  3985.     end;
  3986. with  rinfo^[jnew] do
  3987.    begin
  3988.      newtype:=thetype;
  3989.      newfile:=sysfiles[(filenameindex and fnamemask)];
  3990.      newid:=theid;
  3991.      newsize:=thesize;
  3992.      newchecksum:=checksum;
  3993.      newname:=thename;  
  3994.    end;
  3995.  
  3996. end;{get_next_new}
  3997. procedure nums(n1,n2,n3,n4:longint;var s:string);
  3998. {build line for debug output}
  3999. var w:str255;
  4000. begin
  4001. numtostring(n1,w);
  4002. s:=w;
  4003. numtostring(n2,w);
  4004. s:=concat(concat(s,' ',w));
  4005. numtostring(n3,w);
  4006. s:=concat(concat(s,':',w));
  4007. numtostring(n4,w);
  4008. s:=concat(concat(s,' ',w));
  4009. end;
  4010.  
  4011. begin{detail_resource_check}
  4012. if not inputopen then exit;
  4013. position_to_section(sect_num_res_checks);
  4014. poststatus('Compare System Folder Resources',fileline);
  4015. jnew:=0;
  4016. end_on_old:=false;
  4017. end_on_new:=false;
  4018. get_next_old;
  4019. get_next_new;
  4020. while not(end_on_old or end_on_new) do
  4021.   begin
  4022.   {debug info}
  4023.   if detaildebugflag then
  4024.     begin
  4025.        poststatus(concat(concat(oldfile,':'),newfile),detailbugline);
  4026.        poststatus(concat(concat(oldtype,':'),newtype),detailbugline+1); 
  4027.        numtostring(oldid,oid);
  4028.        numtostring(newid,nid);
  4029.        poststatus(concat(concat(oid,':'),nid),detailbugline+2);
  4030.        nums(oldsize,oldchecksum,newsize,newchecksum,oid);
  4031.        poststatus(oid,detailbugline+3);
  4032.        poststatus(concat(concat(concat(concat('"',oldname),':'),
  4033.                   newname),'"'),detailbugline+4);
  4034.      end;
  4035.   state:=newgreater;
  4036.   filecomp:=filenamecompare(oldfile,newfile);
  4037.   if filecomp=0{oldfile=newfile} then
  4038.     begin
  4039.     if oldtype=newtype then
  4040.       begin
  4041.       if oldid=newid then
  4042.         begin
  4043.         
  4044.         {---mark new as id level match---
  4045.          since id's are unique this can be used to distingush
  4046.          added resources from changed resources}
  4047.          
  4048.         state:=sameid;
  4049.         rinfo^[jnew].filenameindex:=(rinfo^[jnew].filenameindex or idmatchmask);
  4050.  
  4051.         if oldsize=newsize then
  4052.           begin
  4053.           if resnamecompare(oldname,newname)=0 {oldname=newname} then
  4054.             begin
  4055.             if oldchecksum=newchecksum then
  4056.               begin
  4057.               
  4058.               {---mark exact equality---}
  4059.               
  4060.               state:=equality;
  4061.               rinfo^[jnew].filenameindex:=(rinfo^[jnew].filenameindex or exactmatchmask);
  4062.  
  4063.               end{checksum equal}
  4064.             end{name equal}
  4065.           end{size equal}
  4066.         end{id equal}
  4067.         
  4068.       else if oldid>newid then
  4069.         state:=oldgreater;
  4070.       end{type equal}
  4071.       
  4072.     else if oldtype>newtype then
  4073.       state:=oldgreater;
  4074.     end{file equal}
  4075.     
  4076.   else if filecomp>0{oldfile>newfile} then
  4077.     state:=oldgreater;
  4078.     
  4079.    {end of compares}     
  4080.     case state of
  4081.     equality:  begin
  4082.                  get_next_old;
  4083.                  get_next_new;              
  4084.                end;
  4085.     sameid:    begin
  4086.                  {in case the old file has multiple entries for the same id}
  4087.              if detaildebugflag then 
  4088.                   wait_for_buttons('same id no match',continuebut);
  4089.                 get_next_old;              
  4090.                end;
  4091.     oldgreater:begin
  4092.              if detaildebugflag then
  4093.                   wait_for_buttons('old greater',continuebut);
  4094.                  get_next_new;                 
  4095.                end;
  4096.     newgreater:begin
  4097.              if detaildebugflag then
  4098.                  wait_for_buttons('new greater',continuebut);
  4099.                  get_next_old;
  4100.                end;
  4101.     end;{case of state}
  4102.     
  4103.   end;{while not done}
  4104.  
  4105. {skip to end of input for this section}
  4106. while (not end_on_old) do get_next_old;
  4107. if detaildebugflag then clear_to_end(detailbugline);
  4108. end;
  4109. procedure show_detail_changes;
  4110. {On Screen Summary of Changes}
  4111. {this will show added or changed resources but not
  4112.  deleted resources}
  4113. var jres:integer;
  4114.     new:boolean;
  4115.     filename:str255;
  4116.     safename:str255;
  4117.     id,work,name:str255;
  4118.     jtype:integer;
  4119.     neworchanged:longint;
  4120.     norc:str255;
  4121.     ans_show:boolean;
  4122. procedure show_change(mess:str255);
  4123. begin
  4124. clear_to_end(fileline);
  4125. work:= concat('File: ',filename);
  4126. poststatus(work,fileline);
  4127. work:=concat(concat('Type:',rinfo^[jres].thetype),' (');
  4128. work:=concat(concat(concat(work,safename),') Id:'),id);
  4129. name:=rinfo^[jres].thename;
  4130. if name<>'' then
  4131.     begin
  4132.         work:=concat(concat(work,' Name:'),name);
  4133.     end;
  4134. poststatus(work,errorline);
  4135. wait_for_buttons(mess,continuebut);
  4136. clear_to_end(fileline);
  4137. end;
  4138. begin
  4139. {skip this all if there was no input file}
  4140. if not inputopen then exit;
  4141. {count changes}
  4142. neworchanged:=0;
  4143. for jres:=1 to rcount do
  4144.   begin
  4145.     if (rinfo^[jres].filenameindex and exactmatchmask)<>exactmatchmask then
  4146.       neworchanged:=neworchanged+1;  
  4147.   end;{for}
  4148.  
  4149. {exit if no changes}
  4150. if neworchanged=0 then exit;
  4151.  
  4152. {notify of changes and give a chance to see the changes on screen and on disk}
  4153. sysbeep(1);
  4154. numtostring(neworchanged,norc);
  4155. norc:=concat(concat('There are ',norc),
  4156. ' new or changed resources in the system folder.  Do you want to see the details on screen?');
  4157. ans_show:=ask(norc,nodefaultbut);
  4158.  
  4159. open_output_dialog(true,nodefaultbut);
  4160.       
  4161. if not ans_show then exit;
  4162.  
  4163. {loop to show individual changes}
  4164. for jres:=1 to rcount do
  4165.   begin
  4166.  
  4167.     {test flag to see if exact match}
  4168.     if (rinfo^[jres].filenameindex and exactmatchmask)<>exactmatchmask then
  4169.        begin
  4170.          {test flag to see if new or changed}
  4171.          new:=not ((rinfo^[jres].filenameindex and idmatchmask)=idmatchmask);
  4172.          filename:=sysfiles[(rinfo^[jres].filenameindex and fnamemask)];
  4173.          {name for safety level of type}
  4174.          jtype:=find_type(rinfo^[jres].thetype);
  4175.          if jtype=0 then
  4176.             safename:=safetynames[Unknown]
  4177.          else 
  4178.             begin
  4179.                safename:=safetynames[rtypes[jtype].safety];
  4180.             end;
  4181.          numtostring(rinfo^[jres].theid,id);
  4182.          if new then
  4183.               show_change('This resource is new')
  4184.           else
  4185.               show_change('This resource is changed');
  4186.        end
  4187.      else
  4188.        if rtypes[find_type(rinfo^[jres].thetype)].safety=dangerous then
  4189.          begin
  4190.            show_change('This is a dangerous resource type associated with viruses');        
  4191.          end;
  4192.   end;{for}
  4193.  
  4194.  
  4195. end;{proc show_detail_changes}
  4196. {$S start3    }
  4197. procedure start_types;
  4198. {set up table of some resource types to allow starting without an
  4199. input file and for testing}
  4200. {See Inside Mac Volume V resource manager for a listing
  4201.  of many types}
  4202. begin
  4203. rtypes_count:=0;
  4204. safetynames[Safe]:='Safe';
  4205. safetynames[Unsafe]:='Unsafe';
  4206. safetynames[Unknown]:='Unknown';
  4207. safetynames[Dangerous]:='Dangerous';
  4208. {resource types associated with known viruses}
  4209. add_type('nVIR',Dangerous);
  4210. {Some RESOURCE TYPES KNOWN TO CONTAIN EXECUTABLE CODE}
  4211. {also include types that occur sometimes in known viruses,sometimes
  4212.  in normal use}
  4213. add_type('CODE',unsafe);
  4214. add_type('INIT',unsafe);
  4215. add_type('ROvr',unsafe);
  4216. add_type('ROv#',unsafe);
  4217. add_type('PTCH',unsafe);
  4218. add_type('PACK',unsafe);
  4219. add_type('PDEF',unsafe);
  4220. add_type('ADBS',unsafe);
  4221. add_type('CACH',unsafe);
  4222. add_type('CDEF',unsafe);
  4223. add_type('cdev',unsafe);
  4224. add_type('DRVR',unsafe);
  4225. add_type('FKEY',unsafe);
  4226. add_type('FMTR',unsafe);
  4227. add_type('KCHR',unsafe);
  4228. add_type('LDEF',unsafe);
  4229. add_type('MBDF',unsafe);
  4230. add_type('MDEF',unsafe);
  4231. add_type('MMAP',unsafe);
  4232. add_type('SERD',unsafe);
  4233. add_type('WDEF',unsafe);
  4234. add_type('boot',unsafe);
  4235. add_type('insc',unsafe);
  4236. add_type('XCMD',unsafe);
  4237. add_type('XFNC',unsafe);
  4238. add_type('atpl',unsafe);{used by the "scores" virus}
  4239. add_type('DATA',unsafe);{used by the "scores" virus}
  4240. {RESOURCE TYPES KNOWN NOT TO CONTAIN EXECUTABLE CODE}
  4241. add_type('FONT',safe);
  4242. add_type('ALRT',safe);
  4243. add_type('BNSL',safe);
  4244. add_type('DITL',safe);
  4245. add_type('DLOG',safe);
  4246. add_type('FOND',safe);
  4247. add_type('FONT',safe);
  4248. add_type('ICN#',safe);
  4249. add_type('ICON',safe);
  4250. add_type('MENU',safe);
  4251. add_type('PAT ',safe);
  4252. add_type('PAT#',safe);
  4253. add_type('PICT',safe);
  4254. add_type('PREC',safe);
  4255. add_type('SIZE',safe);
  4256. add_type('STR ',safe);
  4257. add_type('STR#',safe);
  4258. add_type('TEXT',safe);
  4259. add_type('LAYO',safe);{desktop layout}
  4260. add_type('PAPA',safe);{chooser setting}
  4261. add_type('PREF',safe);{print monitor preferences}
  4262. add_type('RLRL',safe);{print monitor settings-such as window position}
  4263. add_type('CNTL',safe);
  4264. add_type('CURS',safe);
  4265. add_type('NFNT',safe);
  4266. add_type('WIND',safe);{Window template - used in system 6.0 DAs}
  4267. add_type('fndr',safe);
  4268. add_type('itl0',safe);{date/time formats no code hooks}
  4269. add_type('scrn',safe);{control panel screen settings}
  4270. add_type('BMLS',safe);{appleshare server settings in Appleshare Prep}
  4271. add_type('clut',safe);
  4272. add_type('clst',safe);
  4273. add_type('mach',safe);
  4274. add_type('nrct',safe);
  4275. add_type('ppat',safe);{pixel pattern}
  4276.  
  4277. {add_type('',safe);}
  4278. end;
  4279. {$S           }
  4280. procedure setdefaultbutton(value:integer);
  4281. {set default button for pauses, questions and force updates}
  4282. var rr:rect;
  4283. begin
  4284. setport(mainwindow);
  4285. if defaultbutton<>0 then
  4286.     begin
  4287.       rr:=buttonrects[defaultbutton];
  4288.       insetrect(rr,-5,-5);
  4289.       Invalrect(rr);
  4290.     end;
  4291. defaultbutton:=value;
  4292. if defaultbutton<>0 then
  4293.     begin
  4294.       rr:=buttonrects[defaultbutton];
  4295.       insetrect(rr,-5,-5);
  4296.       Invalrect(rr);
  4297.     end;
  4298. end;
  4299. {$S event}
  4300. procedure wait_for_buttons{(ss:str255;default:integer)};
  4301. {Wait, display message, and give a chance to:
  4302.     "continue", "halt" or "shutdown"}
  4303. begin
  4304. setdefaultbutton(default);
  4305. askanswered:=false;
  4306. HiLiteControl(buttons[continuebut],0);{active}
  4307. PostStatus(ss,AskLine);
  4308. repeat 
  4309. doEvent(true);
  4310. until askanswered;
  4311. setdefaultbutton(nodefaultbut);
  4312. clear_to_end(askline);
  4313. HiLiteControl(buttons[continuebut],255);{inactive}
  4314. doevent(false);
  4315. end;
  4316. procedure wait_for_options;
  4317. var i:integer;
  4318. begin
  4319. setdefaultbutton(continuebut);
  4320. optioncontrolsactiveflag:=true;
  4321. adjust_option_controls;
  4322. Invalrect(mainwindow^.portrect);
  4323. askanswered:=false;
  4324. HiLiteControl(buttons[continuebut],0);{active}
  4325. for i:=1 to moptcon do Showcontrol(optcons[i]);
  4326. repeat 
  4327. doEvent(true);
  4328. until askanswered;
  4329.  
  4330. setdefaultbutton(nodefaultbut);
  4331. optioncontrolsactiveflag:=false;
  4332. for i:=1 to moptcon do Hidecontrol(optcons[i]);
  4333. Invalrect(mainwindow^.portrect);
  4334. HiLiteControl(buttons[continuebut],255);{inactive}
  4335. doevent(false);
  4336. end;
  4337. procedure wait_for_start(ss:str255;waitsecs:integer);
  4338. {wait, display message and startup buttons:
  4339.     "ShortCheck", "FullCheck", "SkipIt" "Shutdown"}
  4340.     {if a certian time has elapsed, continue}
  4341. var default:integer;
  4342.     wait,waituntil:longint;
  4343.     tag:str255;
  4344. begin
  4345. default:=startupdefaultbutton;;
  4346. wait:=waitsecs*60;
  4347. numtostring(waitsecs,tag);
  4348. tag:=concat(concat('  (Auto start after ',tag), ' sec)');
  4349. setdefaultbutton(default);
  4350. {askanswered:=false;}{set in initialize instead}
  4351. HiLiteControl(buttons[continuebut],0);{active}
  4352. {poststatus(tag,errorline);}
  4353. ss:=concat(ss,tag);
  4354. PostStatus(ss,AskLine);
  4355. doevent(false);
  4356. optionkeyflag:=optionkeyflag or option_key_down;{test option key}
  4357. waituntil:=wait+tickcount;
  4358. repeat 
  4359. optionkeyflag:=optionkeyflag or option_key_down;{test option key}
  4360. doEvent(true);
  4361. until ((askanswered) or (tickcount>waituntil));
  4362. setdefaultbutton(nodefaultbut);
  4363. clear_to_end(errorline);
  4364. FlushEvents(MDownMask,0);
  4365. HiLiteControl(buttons[continuebut],255);{inactive}
  4366. doevent(false);
  4367. end;
  4368.  
  4369. {$S startup}
  4370. procedure offer_to_replace_input;
  4371. var doit:boolean;
  4372.     mess:str255;
  4373.     err:oserr;
  4374.     myhpb:Hparamblockrec;
  4375.     mycmpb:CmovePBrec;
  4376.     work:longint;
  4377.     cr:string[1];
  4378.     now:longint;
  4379.     uname:str255;
  4380. (*
  4381.     infile,outfile:text;
  4382.     inputopen,outputopen,inputnotdefault:boolean;
  4383.     inputfile_dirid:longint;
  4384.     inputfile_Vrefnum:integer;
  4385.     inputfile_filename:str255;
  4386.     outputfile_dirid:longint;
  4387.     outputfile_Vrefnum:integer;
  4388.     outputfile_filename:str255;
  4389.     *)
  4390. begin
  4391. cr:=chr(13);
  4392. if  (inputfile_filename='') or (outputfile_filename='') then exit;
  4393. if inputfile_Vrefnum<>outputfile_vrefnum then exit;
  4394. if inputopen then close_and_flush(infile,inputopen);
  4395. if outputopen then close_and_flush(outfile,outputopen);
  4396. {build unique file name for use in rename}
  4397.  
  4398. getdatetime(now);
  4399. now:=$00FFFFF and now;
  4400. now:=now+((tickcount shl 16) and $00FFFFFF);
  4401. now:=$00FFFFF and now;
  4402. numtostring(now,uname);
  4403. uname:=concat('VcheckTempOut',uname);
  4404.  
  4405. mess:=concat(concat(concat(concat(concat(concat(
  4406.     'Rename Output File:"',outputfile_filename),'" to'),cr),
  4407.     'Replace Input File:"'),inputfile_filename),'"?');
  4408. doit:=ask(mess,nobut);
  4409. if doit then
  4410.    begin
  4411.    
  4412.    err:=setvol(nil,inputfile_vrefnum);
  4413.    if err=noerr then {if set vol ok}
  4414.       begin
  4415.         {Delete input file}
  4416.         with myhpb do
  4417.            begin
  4418.             iocompletion:=nil;
  4419.             ionameptr:=@inputfile_filename;
  4420.             iovrefnum:=inputfile_Vrefnum;
  4421.             ioDirid:=inputfile_dirid;
  4422.            end;{with}
  4423.            
  4424.         err:=PBHDelete(@myhpb,false);
  4425.         
  4426.         if err=noerr then {if delete ok}
  4427.             begin
  4428.              {Rename output file to unique temp name}
  4429.              with myhpb do
  4430.                 begin
  4431.                   iocompletion:=nil;
  4432.                   ionameptr:=@outputfile_filename;
  4433.                   iovrefnum:=outputfile_Vrefnum;
  4434.                   iomisc:=@uname;
  4435.                   iodirid:=outputfile_dirid;
  4436.                 end;{with}
  4437.                 
  4438.             err:=PBHRename(@myhpb,false);
  4439.  
  4440.             if err=noerr then{1st rename ok}
  4441.                  begin
  4442.                  {Move output file}
  4443.                   with mycmpb do
  4444.                     begin
  4445.                       iocompletion:=nil;
  4446.                       ionameptr:=@uname;
  4447.                       iovrefnum:=outputfile_Vrefnum;
  4448.                       ionewname:=nil;
  4449.                       ionewdirid:=inputfile_dirid;
  4450.                       iodirid:=outputfile_dirid;
  4451.                     end;{with}
  4452.                     
  4453.                     err:=PBCATMOVE(@mycmpb,false);
  4454.                    
  4455.                     if err=noerr then{if move ok}
  4456.                       begin
  4457.                          {Rename output file from temp name
  4458.                           to input name}
  4459.                          with myhpb do
  4460.                             begin
  4461.                               iocompletion:=nil;
  4462.                               ionameptr:=@uname;
  4463.                               iovrefnum:=outputfile_Vrefnum;
  4464.                               iomisc:=@inputfile_filename;
  4465.                               iodirid:=inputfile_dirid;
  4466.                             end;{with}
  4467.                             
  4468.                          err:=PBHRename(@myhpb,false);
  4469.                          
  4470.                          if err<>noerr then{if 2nd rename not ok}
  4471.                             begin
  4472.                             numtostring(err,mess);
  4473.                             mess:=concat(concat(concat
  4474.         ('Rename of Output File Failed:',mess),'. Output in:'),uname);
  4475.                             wait_for_buttons(mess,ContinueBut);;        
  4476.                             end;{2nd rename ok}
  4477.                       end{move ok}
  4478.                     else 
  4479.                       begin
  4480.                             mess:=concat(concat(concat
  4481.         ('Move of Output File Failed:',mess),'. Output in:'),uname);
  4482.                             wait_for_buttons(mess,ContinueBut);;        
  4483.                      end;{move not ok}
  4484.                    end{1st rename ok}
  4485.                  else
  4486.                     begin
  4487.                        numtostring(err,mess);
  4488.                        mess:=concat('Rename of Output File Failed:',mess);
  4489.                        wait_for_buttons(mess,ContinueBut);         
  4490.                     end; {1st rename not ok}
  4491.             end{delete ok}
  4492.         else
  4493.             begin
  4494.                numtostring(err,mess);
  4495.                mess:=concat('Delete of Input File Failed:',mess);
  4496.                wait_for_buttons(mess,ContinueBut);         
  4497.             end{delete not ok}  
  4498.       end;{set vol ok}
  4499.    end;{doit}
  4500. end;{proc}
  4501.  
  4502. procedure reset_and_save_info( var filevar:text;filename:str255);
  4503. {replace reset with this in all instances when opening input
  4504.  to save the input directory and filename info}
  4505. var mywdpb:wdpbrec;
  4506.     dummy:str255;
  4507.     err:oserr;
  4508. begin
  4509.    with mywdpb do
  4510.        begin
  4511.             dummy:='';
  4512.             ioCompletion:= NIL;    
  4513.             ionameptr:=@dummy;
  4514.             iovrefnum:=0;
  4515.             iowdindex:=0;
  4516.        end;
  4517.    err:=PBHgetVol(@mywdpb,false);
  4518.    if err=noerr then
  4519.    with mywdpb do
  4520.        begin
  4521.          inputfile_dirid:=iowddirid;
  4522.          inputfile_vrefnum:=ioWDVrefnum;
  4523.          inputfile_filename:=filename;
  4524.        end
  4525.    else
  4526.       begin
  4527.          inputfile_dirid:=2;
  4528.          inputfile_vrefnum:=0;
  4529.          inputfile_filename:='';
  4530.       end; 
  4531.    
  4532.  
  4533. reset(filevar,filename); {do turbo open}
  4534.  
  4535. end;
  4536.  
  4537. procedure rewrite_and_save_info( var filevar:text;filename:str255);
  4538. {replace rewrite with this in all instances when opening output
  4539.  to save the output directory and filename info}
  4540. var mywdpb:wdpbrec;
  4541.     dummy:str255;
  4542.     err:oserr;
  4543. begin
  4544.    with mywdpb do
  4545.        begin
  4546.             dummy:='';
  4547.             ioCompletion:= NIL;    
  4548.             ionameptr:=@dummy;
  4549.             iovrefnum:=0;
  4550.             iowdindex:=0;
  4551.        end;
  4552.    err:=PBHgetVol(@mywdpb,false);
  4553.    if err=noerr then
  4554.    with mywdpb do
  4555.        begin
  4556.          outputfile_dirid:=iowddirid;
  4557.          outputfile_vrefnum:=ioWDVrefnum;
  4558.          outputfile_filename:=filename;
  4559.        end
  4560.    else
  4561.       begin
  4562.          outputfile_dirid:=2;
  4563.          outputfile_vrefnum:=0;
  4564.          outputfile_filename:='';
  4565.       end; 
  4566.    
  4567. outputfile_filename:=filename;
  4568.  
  4569. rewrite(filevar,filename); {do turbo open}
  4570.  
  4571. end;
  4572.  
  4573. procedure mySFold(      Var filevar     : text;
  4574.                         prompt          :str255;
  4575.                         var filepara    :str255;
  4576.                         var cancel:boolean);
  4577. {
  4578.   Do a Standard file open dialog to open an existing TEXT file 
  4579.   as a TURBO PASCAL text file.
  4580.  Use the toolbox to get the file name and set the default vol/folder.
  4581.  Use Reset to do the actual open for Turbo.
  4582.  This may work only on the 128k ROMS
  4583. }
  4584. var
  4585.    topleft,center    :point;
  4586.    ShowTypes  : SFTypeList;
  4587.    NTypes     :integer ;
  4588.    theErr     :OSErr;
  4589.    Reply      :SFreply;
  4590.    filename   :string[63];
  4591.    ScrHres,ScrVres : integer;
  4592.    vol        : integer;
  4593.    vserr       :OSerr;
  4594.   
  4595.    
  4596. begin
  4597.   filepara:='';
  4598.   with center do
  4599.   begin
  4600.   with screenbits.bounds do
  4601.     begin
  4602.       v:=(top+bottom) div 2;
  4603.       h:=(left+right) div 2;
  4604.     end;
  4605.   end;
  4606.  
  4607.   topleft.h:=center.h-170; {position of topleft}
  4608.   topleft.v:=center.v-120;
  4609.  
  4610.   ShowTypes[0]:='TEXT';
  4611.   Ntypes:=1;
  4612.   Cancel:=false;
  4613.   SFGetFile(topleft,prompt,nil,NTypes,ShowTypes,nil,Reply);
  4614.   if Reply.good then
  4615.       begin
  4616.  
  4617.        vol:=reply.vrefnum;
  4618.        filename:=reply.fname;
  4619.        vserr:=SetVol(nil,vol); {change default volume}
  4620.  
  4621.        {SFGetFile does not do an actual open : FSOpen or PBOpen
  4622.         are called to do this in the examples I have seen}
  4623.  
  4624.         reset_and_save_info(filevar,filename); {do turbo open}
  4625.         filepara:=filename;
  4626.       end
  4627.   else
  4628.       begin
  4629.       {may be a cancel or other error}
  4630.       Cancel:=true;
  4631.  
  4632.       end;
  4633.  
  4634. end; {of proc MySFold }
  4635.  
  4636. procedure mySFnew(      Var filevar : text;
  4637.                         prompt      :str255;
  4638.                         orgname     :str255;
  4639.                         Creator     :OStype;
  4640.                         var cancel:boolean);
  4641. {
  4642.   Do a Standard file put dialog to open a new TEXT file as a TURBO PASCAL
  4643.   text file for output.
  4644.   Use the toolbox to get the file name and set the default vol/folder.
  4645.   The use Rewrite to do the actual open for Turbo.
  4646.   This may work only on the 128k ROMS.
  4647. }
  4648. var
  4649.    topleft,center    :point;
  4650.    theErr     :OSErr;
  4651.    Reply      :SFreply;
  4652.    filename   :string[63];
  4653.    ScrHres,ScrVres : integer;
  4654.    vol        :integer;
  4655.    vserr       :OSerr;
  4656.    finderinfo  :finfo;
  4657.    
  4658. begin
  4659.   with center do
  4660.   begin
  4661.   with screenbits.bounds do
  4662.     begin
  4663.       v:=(top+bottom) div 2;
  4664.       h:=(left+right) div 2;
  4665.     end;
  4666.   end;
  4667.  
  4668.   topleft.h:=center.h-170; {position of topleft}
  4669.   topleft.v:=center.v-120;
  4670.  
  4671.   Cancel:=false;
  4672.   SFPutFile(topleft,prompt,orgname,nil,Reply);
  4673.   if Reply.good then
  4674.       begin
  4675.  
  4676.        vol:=reply.vrefnum;
  4677.        filename:=reply.fname;
  4678.  
  4679.        vserr:=SetVol(nil,vol); {change default volume}
  4680.  
  4681.        {SFGetFile does not do an actual open : FSOpen or PBOpen
  4682.         are called to do this in the examples I have seen}
  4683.  
  4684.         rewrite_and_save_info(filevar,filename); {do turbo open}
  4685.         
  4686.         {set file creator}
  4687.         if getFinfo(filename,vol,finderinfo)=NoErr then
  4688.             begin
  4689.                finderinfo.fdCreator:=creator;
  4690.                
  4691.                if setFinfo(filename,vol,finderinfo) <> NoErr then
  4692.                   begin
  4693.                     sysbeep(10);
  4694.                     cancel:=true;
  4695.                   end
  4696.                   ;
  4697.             end
  4698.         else
  4699.             begin
  4700.               sysbeep(10);
  4701.               cancel:=true;
  4702.             end
  4703.         
  4704.       end
  4705.   else
  4706.       begin
  4707.       {may be a cancel or other error}
  4708.       Cancel:=true;
  4709.  
  4710.       end;
  4711.  
  4712. end; {of proc MySFopen }
  4713. {$S start2   }
  4714. procedure open_output;
  4715. {Open Output file}
  4716. var cancel:boolean;
  4717.     name:str255;
  4718. begin
  4719. set_default_blessed;
  4720. if inputopen then
  4721.    begin
  4722.       name:='NewSystemCheckSum';
  4723.    end
  4724. else
  4725.    begin
  4726.       {to make it easier to start from scratch}
  4727.       name:='OldSystemCheckSum';
  4728.    end;
  4729.  
  4730. {default folder to the system folder}
  4731. mySFnew(outfile,'Output File?',name,'EDIT',cancel);
  4732. if not cancel then
  4733.     begin
  4734.     outputopen:=true;
  4735.     end
  4736.  else
  4737.     begin
  4738.     outputopen:=false;
  4739.     end;
  4740. set_default_blessed;    
  4741. end;
  4742. procedure open_input;
  4743. {look for input file 'OldSystemCheckSum' in startup and blessed folder
  4744. if not found ask for it}
  4745. label 99;
  4746. var savewd:integer;
  4747.     err,ierr,ignore:oserr;
  4748.     name:str255;
  4749.     finder:Finfo;
  4750. begin
  4751. name:='OldSystemCheckSum';
  4752. inputnotdefault:=true;
  4753.  
  4754. if inputopen then exit;
  4755. ignore:=getvol(nil,savewd);
  4756. {startup folder}
  4757. ignore:=setvol(nil,startupwd);
  4758. err:=GetFInfo(name,0,finder);
  4759. if err=noerr then
  4760.     begin
  4761.       if finder.fdtype='TEXT' THEN
  4762.           begin
  4763.           reset_and_save_info(infile,name);
  4764.           ierr:=IOResult;{turbo pascal error codes}
  4765.           if Ierr<>0 then halt_on_error(ierr,'Open Input-default folder');
  4766.           inputopen:=true;
  4767.           currentsection:=1;
  4768.           on_section_boundry:=true;
  4769.           inputnotdefault:=false;
  4770.           goto 99;
  4771.           end;
  4772.     end;
  4773. {system folder}
  4774. set_default_blessed;
  4775. err:=GetFInfo(name,0,finder);
  4776. if err=noerr then
  4777.     begin
  4778.       if finder.fdtype='TEXT' THEN
  4779.           begin
  4780.           reset_and_save_info(infile,name);
  4781.           ierr:=IOResult;{turbo pascal error codes}
  4782.           if Ierr<>0 then halt_on_error(ierr,'Open Input-system folder');
  4783.           inputopen:=true;
  4784.           currentsection:=1;
  4785.           on_section_boundry:=true;
  4786.           inputnotdefault:=false;
  4787.           goto 99;
  4788.           end;
  4789.     end;
  4790. poststatus(concat('I can''t find: ',name),errorline);
  4791. if Ask('Do you want to specify another input file?',nodefaultbut) then
  4792.      begin
  4793.        poststatus('',errorline);
  4794.        mySFold(infile,'Old checksums file',name,cancel);
  4795.        if cancel then goto 99;
  4796.        inputopen:=true;
  4797.        currentsection:=1;
  4798.        on_section_boundry:=true;
  4799.        goto 99;
  4800.      end
  4801.      else
  4802.        begin
  4803.          poststatus('',errorline);
  4804.        end;
  4805. 99:
  4806. ignore:=setvol(nil,savewd);
  4807. end;{open_input}
  4808.  
  4809. {$S event}
  4810. procedure close_and_flush{(var filevar:text;var openflag:boolean)};
  4811. {close file and flush default volume}
  4812. var ignore:oserr;
  4813. begin
  4814. if openflag then close(filevar);
  4815. openflag:=false;
  4816. ignore:=FlushVol(nil,0);{flush default volume}
  4817. end;{procedure close_and_flush}
  4818.  
  4819. procedure close_all_and_halt{(beep:boolean)};
  4820. {Close input and output files if open and halt}
  4821. var ignore:oserr;
  4822. begin
  4823. if beep then 
  4824.    begin sysbeep(1);sysbeep(1); end;
  4825. if inputopen then close_and_flush(infile,inputopen);
  4826. if outputopen then close_and_flush(outfile,outputopen);
  4827. closepath(myRpath); 
  4828. ignore:=setvol(nil,startupwd);
  4829. halt;
  4830. end;
  4831. {$S boot}
  4832. function absolute_read(buffer:handle;count:longint;offset:longint):oserr;
  4833. {read data from an absolute position-used to check the boot blocks}
  4834. var pblock:paramBlockRec;
  4835.     mypb:hparamblockrec;
  4836.     vname:str255;
  4837.     err:oserr;
  4838.     drivenum:integer;
  4839.     driver:integer;    
  4840. begin
  4841. {get drive number of default volume}
  4842. with mypb do
  4843.     begin
  4844.     iocompletion:=nil;
  4845.     vname:='';
  4846.     ionameptr:=@vname;
  4847.     iovrefnum:=0;
  4848.     ioVolIndex:=0;
  4849.     end;
  4850. scsi_wait;
  4851. err:=pbhgetvinfo(@mypb,false);
  4852. with mypb do
  4853.     begin
  4854.       drivenum:=iovdrvinfo;
  4855.       driver:=iovdrefnum;
  4856.      end;
  4857.  
  4858. absolute_read:=err;
  4859.  
  4860. if err<>noerr then 
  4861.    begin
  4862.       exit;
  4863.    end;
  4864.    
  4865. {work on reading the data}
  4866. hlock(buffer);
  4867. with pblock do
  4868.      begin
  4869.         iocompletion:=nil;
  4870.         iovrefnum:=drivenum;
  4871.         iorefnum:=driver;
  4872.         iobuffer:=buffer^;
  4873.         ioreqcount:=count;
  4874.         ioPosMode:=FsFromStart;{relative from first sector}
  4875.         ioPosoffset:=offset;         
  4876.      end;
  4877.     scsi_wait;
  4878.     err:=PBRead(@pblock,false);
  4879. hunlock(buffer);
  4880. absolute_read:=err;
  4881. end;{proc absolute_read}
  4882.  
  4883. {$S boot}
  4884. procedure boot_ignore(buffer:handle);
  4885. {zero out fields where boot block changes are safe/common}
  4886. type boots=array[0..511] of integer;
  4887.      bootptr=^boots;
  4888. var i:integer;
  4889.     p:bootptr;
  4890. begin
  4891. hlock(buffer);
  4892. p:=bootptr(buffer^);
  4893. {info that changes on set startup}
  4894. for i:=45 to 52 do p^[i]:=0;
  4895. hunlock(buffer);
  4896. end;
  4897.  
  4898. function checksum_boot_blocks{:integer};
  4899. var count,offset:longint;
  4900.     buffer:handle;
  4901.     err:oserr;
  4902.     result:integer;
  4903. begin
  4904. result:=0;
  4905. count:=1024;{two logical blocks}
  4906. offset:=0;
  4907. buffer:=newhandle(count);
  4908. if buffer<>nil then
  4909.    begin
  4910.       err:=absolute_read(buffer,count,offset);
  4911.       if err=noerr then 
  4912.            begin
  4913.            boot_ignore(buffer);{zero out safe stuff}
  4914.            result:=checksumHdata(buffer);
  4915.            end;
  4916.       disposHandle(buffer);
  4917.    end;
  4918.  
  4919. checksum_boot_blocks:=result;
  4920.  
  4921. end;{proc}
  4922.  
  4923. {$S           }
  4924. procedure tefixup(statustext:tehandle);
  4925. {shrink the size of the TERec if a bug in TE has made the
  4926. linestarts array too big}
  4927. var  base,needed,actual:longint;
  4928. begin
  4929. actual:=gethandlesize(handle(statustext));
  4930. {figure nominal size}
  4931. base:=sizeof(statustext^^)-sizeof(statustext^^.linestarts);
  4932. needed:=(statustext^^.nlines+1)*2+base;
  4933. if actual>needed+64 then
  4934.     begin
  4935.     {reset to needed size plus a bit extra}
  4936.        Hunlock(handle(statustext));
  4937.        sethandlesize(handle(statustext),needed+8);
  4938.     end
  4939. end;{procedure tefixup}
  4940.  
  4941. procedure replaceline{(ss:str255;linenum:integer)};
  4942. {On screen messages}
  4943. {replace a line in the statustext TERec}
  4944. var start,finish:longint;
  4945.     cr:string[1];
  4946. begin
  4947. cr:=chr(13);
  4948. ss:=concat(ss,cr);
  4949. if linenum<statustext^^.nlines then
  4950.    begin
  4951.    start:=statustext^^.linestarts[linenum-1];
  4952.    finish:=statustext^^.linestarts[linenum];
  4953.    end
  4954. else
  4955.    begin
  4956.    start:=0;
  4957.    finish:=0;
  4958.    end;
  4959. TESetSelect(start,finish,statustext);
  4960. TeDeLete(statustext);
  4961. TEInsert(Pointer(ord4(@ss)+1),length(ss),statustext);
  4962. tefixup(statustext);
  4963. TESetSelect(0,0,statustext);
  4964. end;
  4965.  
  4966. procedure clear_to_end{(linenum:integer)};
  4967. {On screen messages}
  4968. {clear lines in the statustext TERec from linenum to end}
  4969. var start,finish:longint;
  4970.     nn:integer;
  4971.     cr:string[1];
  4972.     ss:str255;
  4973. begin
  4974. cr:=chr(13);
  4975. if linenum<statustext^^.nlines then
  4976.    begin
  4977.    start:=statustext^^.linestarts[linenum-1];
  4978.    finish:=statustext^^.telength;
  4979.    end
  4980. else
  4981.    begin
  4982.    start:=0;
  4983.    finish:=0;
  4984.    end;
  4985. {create empty lines as filler}
  4986. ss:=cr;
  4987. for nn:=linenum to mstatus do ss:=concat(cr,ss);
  4988.  
  4989. TESetSelect(start,finish,statustext);
  4990. TeDeLete(statustext);
  4991. TEInsert(Pointer(ord4(@ss)+1),length(ss),statustext);
  4992. TESetSelect(0,0,statustext);
  4993. {replace title and byline}
  4994. if linenum<=byline then
  4995.   begin
  4996. Replaceline(concat('Startup System Check ',TitleVersion),titleline);
  4997.  ReplaceLine('by Albert Lunde, Northwestern University  Copyright ⌐ 1988'
  4998. ,byline);
  4999.   end;
  5000.  
  5001. end;
  5002. {$S            }
  5003. procedure postmem{(linenum:integer)};
  5004. {free memory in heap and approximate stack size}
  5005. const
  5006.    currstackbase=$908;
  5007.    type lp=^longint;
  5008.    
  5009. var ff,kk:str255;
  5010.     p:lp;
  5011. begin
  5012. if not showdebuginfo then exit;
  5013. numtostring(freemem,ff);
  5014. kk:=concat('Free memory: ',ff);
  5015. p:=lp(pointer(currstackbase));{compare global var for base of stack}
  5016. numtostring((p^-ord4(@kk)),ff);
  5017. kk:=concat(kk,' Stack Size:');
  5018. kk:=concat(kk,ff);
  5019. numtostring(currentsection,ff);
  5020. kk:=concat(kk,' Section:');
  5021. kk:=concat(kk,ff);
  5022. poststatus(kk,linenum);
  5023. end;
  5024. {$S           }
  5025. procedure poststatus{(ss:str255;linenum:integer)};
  5026. {On screen messages}
  5027. {post a message on the screen and go into the event
  5028. loop long enought to update the screen or process halt button} 
  5029. var ff,kk:str255;
  5030. begin
  5031. (*
  5032. numtostring(freemem,ff);
  5033. kk:=ff;
  5034. numtostring(gethandlesize(handle(statustext)),ff);
  5035. kk:=concat(kk,concat(' ',ff));
  5036. numtostring(sizeof(resourceinfoarray),ff);
  5037. kk:=concat(kk,concat(' ',ff));
  5038. *)
  5039. replaceline(ss,linenum);
  5040. {replaceline(kk,mstatus);}
  5041. DoEvent(false);
  5042. end; 
  5043. {$S event}
  5044. function Ask{(question:str255;default:integer):boolean};
  5045.  
  5046. begin
  5047. setdefaultbutton(default);
  5048. hidecontrol(buttons[continuebut]);
  5049. hidecontrol(buttons[shutdownbut]);
  5050. hidecontrol(buttons[haltbut]);
  5051. showcontrol(buttons[yesbut]);
  5052. showcontrol(buttons[nobut]);
  5053. askanswered:=false;
  5054. poststatus(question,askline);
  5055. sysbeep(1);
  5056. repeat
  5057. doevent(false);
  5058. until askanswered;
  5059. setdefaultbutton(nodefaultbut);
  5060. clear_to_end(askline);
  5061. showcontrol(buttons[continuebut]);
  5062. showcontrol(buttons[shutdownbut]);
  5063. showcontrol(buttons[haltbut]);
  5064. hidecontrol(buttons[yesbut]);
  5065. hidecontrol(buttons[nobut]);
  5066. ask:=askanswer;
  5067. doevent(true);
  5068. end;
  5069.  
  5070. procedure halt_on_error{(err:oserr;sss:str255)};
  5071. {check for OSerr code}
  5072. var ss:str255;
  5073. begin
  5074. if err=noerr then exit;
  5075. Numtostring(err,ss);
  5076. ss:=concat(concat('Unexpected Error:',ss),sss);
  5077. poststatus(ss,errorline);
  5078. repeat until button;
  5079. close_all_and_halt(true);
  5080. end;
  5081. {$S files}
  5082. procedure folder_info_two{(dirid:longint;
  5083.                           volume:integer;
  5084.                       var name:str255;
  5085.                       var path:str255;
  5086.                           findpath:boolean)};
  5087. {get info (name and/or path) on a directory specified by 
  5088. a 32 bit id directory ID and a volume reference number}
  5089. {revised to used fewer file system calls and to work
  5090.  correctly given on any volume}
  5091. label 99;
  5092. var vname:str255;
  5093.     mywdpb:wdpbrec;
  5094.     mycinfopb:cinfopbrec;
  5095.     err,ignore:oserr;
  5096.     oldwd:integer;
  5097.     tempdirid:longint;
  5098.     tempname:str255;
  5099.     count:integer;
  5100. begin
  5101. {save default wd}
  5102. ignore:=getvol(nil,oldwd);
  5103.   
  5104. {Build path}
  5105. {This is based roughly on C code from
  5106. "Programming with Macintosh Programmer's Workshop" by Joel West
  5107. Page 467-469}
  5108.  
  5109. path:='';
  5110. tempdirid:=dirid;{dir ID for folders along the path}
  5111. tempname:='';
  5112. count:=0;{infinite loop protection}
  5113. repeat 
  5114.   count:=count+1;
  5115.   with mycinfopb do
  5116.        begin
  5117.        {setup for pbgetcatinfo}
  5118.        iocompletion:=nil;
  5119.        ionameptr:=@tempname;
  5120.        iovrefnum:=volume;
  5121.        iodirid:=tempdirid;
  5122.        iofdirindex:=-1;{info about directories only see tn#69}
  5123.        end;
  5124.        scsi_wait;
  5125.        err:=pbgetcatinfo(@mycinfopb,false);
  5126.           if err=noerr then
  5127.             with mycinfopb do
  5128.                 begin
  5129.                 if count=1 then
  5130.                     begin
  5131.                       name:=tempname;
  5132.                       if not findpath then goto 99;
  5133.                     end;
  5134.                 path:=concat(tempname,':',path);
  5135.                 tempdirid:=iodrparid;
  5136.                 end;
  5137.  
  5138. until((count>100) or (tempdirid=fsrtparid) );
  5139.  99: 
  5140. {restore default wd}
  5141. ignore:=setvol(nil,oldwd);  
  5142. end;{folder_info_two}
  5143.  
  5144. {$S files     }
  5145. procedure set_default_blessed;
  5146. {set default volume and folder to the blessed(active system) folder}
  5147. var
  5148.          err: OSErr;  
  5149.          myWDPB: WDPBRec;
  5150.       dummy:str255;
  5151. begin
  5152. {set default folder to dirID}
  5153. with mywdpb do
  5154.     begin
  5155.         {set up for PBHSetVol call}
  5156.          ioCompletion:= NIL;    
  5157.          dummy:='';
  5158.          ioNamePtr:= @dummy;    {initialize may not be needed}
  5159.          ionameptr:=nil;
  5160.          ioWDDirID:=blessed;
  5161.          ioVRefNum:=blessedbootvolwd;
  5162.     end;
  5163. scsi_wait;
  5164. err:=PBHSetVol(@mywdpb,false);
  5165.     
  5166.  halt_on_error(err,'PBsetvol-set_default_blessed');
  5167.  
  5168.  
  5169. end;{procedure}
  5170.  
  5171. procedure set_default_by_id{(DirID:longint)};
  5172. {set default folder by 32 bit DirId}
  5173. var
  5174.          err: OSErr;  
  5175.          myWDPB: WDPBRec;
  5176.       dummy:str255;
  5177. begin
  5178. {set default folder to dirID}
  5179. with mywdpb do
  5180.     begin
  5181.         {set up for PBHSetVol call}
  5182.          ioCompletion:= NIL;    
  5183.          dummy:='';
  5184.          ioNamePtr:= @dummy;    {initialize may not be needed}
  5185.          ionameptr:=nil;
  5186.          ioWDDirID:=dirID;
  5187.          ioVRefNum:=0;
  5188.     end;
  5189. scsi_wait;
  5190. err:=PBHSetVol(@mywdpb,false);
  5191.     
  5192.  halt_on_error(err,'PBsetvol-set_default_by_id');
  5193.  
  5194.  
  5195. end;{procedure}
  5196.  
  5197. PROCEDURE EnumerateCatalog(dirIDToSearch: longint);
  5198.  
  5199. {process all files in a folder but ignore subfolders}
  5200.  
  5201. VAR
  5202.  
  5203.       myCPB: CInfoPBRec;
  5204.  
  5205.       err: OSErr;  
  5206.  
  5207.       myWDPB: WDPBRec;
  5208.  
  5209.       TotalFiles,TotalDirectories: LONGINT;
  5210.    fname,dummy:str255;
  5211.  
  5212.   index:    integer;    
  5213.  
  5214.     ignore:oserr;
  5215.     oldwd:integer;    
  5216.  
  5217. Begin {EnumerateCatalog}
  5218. ignore:=getvol(nil,oldwd);{save old wd}
  5219.  
  5220.  
  5221.  TotalFiles:= 0;
  5222.  
  5223.     TotalDirectories:= 0;
  5224.  
  5225. {add initialize of pb 5/14/88 
  5226.  may not be needed but seems to fix a bug}
  5227.    with mywdpb do
  5228.        begin
  5229.             dummy:='';
  5230.             ioCompletion:= NIL;    
  5231.             ionameptr:=@dummy;
  5232.             iovrefnum:=0;
  5233.             iowdindex:=0;
  5234.        end;
  5235.     err:= PBHGetVol(@myWDPB,FALSE);        {get the default volume}     
  5236.  
  5237.  
  5238.     with MyCPB do Begin
  5239.  
  5240.         iocompletion:= Nil;
  5241.  
  5242.         ioNamePtr:= @FName;
  5243.  
  5244.         ioVRefNum:= myWDPB.ioVRefNum;      {for now, default vol, set this to what you want}
  5245.  
  5246.     End;  {with}
  5247.  
  5248. {set default folder to diridtosearch to allow 
  5249. use of high level calls in called procedures}
  5250.  
  5251.  set_default_by_id(diridtosearch);
  5252.  
  5253. index:= 1;
  5254.  
  5255.     repeat{loop over folder with index}
  5256.  doEvent(false);
  5257.         FName:= '';  {nil out name}
  5258.  
  5259.         myCPB.ioFDirIndex:= index;
  5260.  
  5261.         myCPB.ioDrDirID:= dirIDToSearch; {we need to do this every time through}
  5262.  
  5263.  
  5264.   scsi_wait;
  5265.         err:= PBGetCatInfo(@myCPB,FALSE);
  5266.  
  5267.  
  5268.  
  5269.         If err = noErr then 
  5270.  
  5271.             if BitTst(@myCPB.ioFlAttrib,3) then 
  5272.       Begin {we have a dir}
  5273.                  TotalDirectories:=TotalDirectories+1;
  5274.         {do nothing for directories}
  5275.                  err:= 0;  {clear error return on way back}
  5276.              End {if BitTst}
  5277.         Else 
  5278.       Begin{we have a file}
  5279.  
  5280.             TotalFiles:= TotalFiles + 1;
  5281.  
  5282.     Poststatus(concat('Checking: ',fname),fileline);
  5283.     (* Do_for_file(dirIDToSearch,MyCPB.ioFrefNum,Fname,Totalfiles,MYCPB)*)
  5284.      sysfiles[index]:=fname;
  5285.     check_a_file(index);
  5286.         End; {else} 
  5287.   PostStatus('',fileline);
  5288.         index:= index + 1;
  5289.  
  5290.     until err <> noErr;
  5291.  
  5292. ignore:=setvol(nil,oldwd); {restore WD} 
  5293.  
  5294. End;  {EnumerateCatalog}
  5295. {$S start2}
  5296. procedure get_blessed;
  5297. {get the blessed folder 32 bit dir id,
  5298. given either volume ref or a working directory ref on that volume}
  5299. {this version stores the blessed folder id and the working dir ref
  5300. of the boot volume in global variables}
  5301. CONST
  5302.  
  5303.     FSFCBLen    = $3F6;      {location of low-memory global FSFCBLen}
  5304.         
  5305.  
  5306. VAR
  5307.  
  5308.     myHPB: HParamBlockRec;    {for the PBHGetVInfo call}
  5309.  
  5310.     myWDPB: WDPBRec;        {for the PBHSetVol call}
  5311.  
  5312.     err,ignore: OSErr;  
  5313.  
  5314.     oldVol: integer;
  5315.  
  5316.     vName,fName: str255;
  5317.  
  5318.     HFS: ^integer;        {to check to see if we are running HFS}
  5319.  bootwdptr: ^integer;    {to find the boot drive}
  5320.  oldwd:integer;
  5321.  
  5322. begin
  5323.   {save default wd}
  5324.   ignore:=getvol(nil,oldwd);
  5325.  
  5326.        HFS:= POINTER(FSFCBLen);    {point our variable at the low-memory global}
  5327.  
  5328.     if HFS^ > 0 then Begin     {we're running HFS}
  5329.   
  5330.   blessedbootvolwd:=GetRealBootDrive;  
  5331.   {"working directory reference number" for system startup volume}
  5332.   
  5333.   {change to system startup volume - this is so we always find the
  5334.    blessed folder on the startup device, even when running from a floppy}
  5335.  
  5336.   ignore:=setvol(nil ,blessedbootvolwd);
  5337.   
  5338.         vName:= '';        {initialize this}
  5339.  
  5340.         with myHPB do Begin
  5341.  
  5342.             ioCompletion:= NIL;    
  5343.  
  5344.             ioNamePtr:= @vName;    {initialize}
  5345.  
  5346.             ioVRefNum:= 0;     {0 is get for default volume}
  5347.  
  5348.             ioVolIndex:= 0;    {we're not making indexed calls}
  5349.    
  5350.  
  5351.         End;  {with}
  5352.  
  5353.         
  5354.  
  5355.         err:= PBHGetVInfo(@myHPB,FALSE);
  5356.  
  5357.         if err <> 0 then poststatus('PBHGetVInfo Error',errorline)
  5358.  
  5359.         Else
  5360.  
  5361.  
  5362.     End {if HFS^ > 0}
  5363. ;
  5364. {At this point, the dirID of the blessed folder on the volume}
  5365. blessed:=myHPB.ioVFndrInfo[1];
  5366. {writeln(vname);}
  5367. {restore default wd}
  5368. ignore:=setvol(nil,oldwd);  
  5369.  
  5370.  
  5371. end;{get blessed}
  5372.  
  5373. {$S core}
  5374. procedure filltype{(var tt:restype;ss:str255)};
  5375. {blank fill and convert string to resource type}
  5376. var work:string[8];
  5377. begin
  5378.  work:=concat(ss,'    ');
  5379. tt[1]:=work[1];
  5380. tt[2]:=work[2];
  5381. tt[3]:=work[3];
  5382. tt[4]:=work[4];
  5383. end;{fill type}
  5384.  
  5385. {$S startup}
  5386. procedure parse_options(line:str255);
  5387. {read options line:
  5388.  1st 3 values are resource counts retained
  5389.  for backward compatibility}
  5390. var tokens:tokenstype;
  5391.     ntokens:integer;
  5392.     work:longint;
  5393. begin
  5394. tabscan(line,tokens,ntokens);
  5395. if ntokens<4 then exit;
  5396. stringtonum(tokens[4],work);
  5397. checkfloppies:=(work<>0);
  5398. if ntokens<5 then exit;
  5399. stringtonum(tokens[5],work);
  5400. checknonbootdrives:=(work<>0);
  5401. if ntokens<6 then exit;
  5402. stringtonum(tokens[6],work);
  5403. appleshareaccessmask:=(work and $FF);
  5404. end;
  5405.  
  5406. procedure read_input_header;
  5407. {read beginning of input file before resource types list}
  5408. var ignore,oline:str255;
  5409. begin
  5410. if not inputopen then exit;
  5411. position_to_section(sect_num_header);
  5412. {Mac SE:System Folder: path,date,time,version 
  5413. 12742                  bootblockchecksum
  5414. 789087                 checksumchecksum
  5415. 322 104 322            resource counts
  5416. *****                  end of header}
  5417. if eof(infile) then exit;
  5418. read_input(ignore);{path}
  5419. if eof(infile) then exit;
  5420. oldbootblockchecksum:=0;
  5421. read_input_integer(oldbootblockchecksum);{grand resource checksum}
  5422.  
  5423. if eof(infile) then exit;
  5424. oldchecksumchecksum:=0;
  5425. read_input_long(oldchecksumchecksum);  {boot block checksum}
  5426.  
  5427. if eof(infile) then exit;
  5428. read_input(oline);
  5429. parse_options(oline);
  5430.  
  5431. {skip down to *****}
  5432. repeat
  5433. if eof(infile) then exit;
  5434. read_input(ignore);
  5435. until(test_end_flag(ignore));
  5436.  
  5437. read_safekeys;
  5438. read_morechecks;
  5439. end;{proc}
  5440.  
  5441. procedure readoklist;
  5442. {read a list of resource types/stop at eof or "*****"}
  5443. {each line contains TYPE,safety level,and optional number of occurances}
  5444. label 99;
  5445. var line:str255;
  5446.     ntokens:integer;
  5447.     tokens:tokenstype;
  5448.     atype:restype;
  5449.     howsafe:safetype;
  5450.     work:longint;
  5451. begin
  5452. if not inputopen then exit;
  5453. PostStatus('Reading safe types list',fileline);
  5454. while(not eof(infile)) do
  5455.    begin
  5456.       line:='';
  5457.       read_input(line);
  5458.       {sysbeep(1);
  5459.       poststatus(line,fileline);}
  5460.       if test_end_flag(line) then goto 99;
  5461.       tabscan(line,tokens,ntokens);
  5462.      { poststatus(concat(concat('$',tokens[1]),'$'),errorline);}
  5463.       if ntokens>=2 then
  5464.           begin 
  5465.             filltype(atype,tokens[1]);
  5466.             work:=ord(unknown);
  5467.             stringtonum(tokens[2],work);
  5468.             if (work>3) or (work<0) then
  5469.                  begin
  5470.                  poststatus(concat('Bad input:',line),errorline);
  5471.                  wait_for_buttons(' ',continuebut);
  5472.                  howsafe:=unknown;
  5473.                  end
  5474.             else
  5475.                  howsafe:=safetype(work);
  5476.             add_type(atype,howsafe);
  5477.           end
  5478.       else if ntokens=1 then
  5479.           begin 
  5480.             filltype(atype,tokens[1]);
  5481.             add_type(atype,safe);
  5482.           end;
  5483.                    
  5484.    end;{while}
  5485. 99:
  5486. PostStatus('',fileline);
  5487. end;{readoklist}
  5488.  
  5489. {$S sortres}  
  5490.         procedure sortresources(var X:resourceinfoarrayptr;N:integer);
  5491.         {sort array of resources and their checksums}
  5492. {        HEAP SORT
  5493. C
  5494. C       BASED ON PROGRAMMING PEARLS BY JON BENTLEY P 182
  5495. C       X IS THE ARRAY CONTAINING NX ELEMENTS TO BE SORTED
  5496. C       CALL SWAPX(I,J) SWAPS X(I) WITH X(J)
  5497. C       GEX(X,I,J) IS TRUE IFF X(I) >= X(J)
  5498. C       GTX(X,I,J) IS TRUE IFF X(I) > X(J)
  5499. C}
  5500.  
  5501.  
  5502.        var i: integer;
  5503.        
  5504.        
  5505. procedure SWAPX(I:integer;J:integer);
  5506. var     T:resourceinforec;
  5507.         
  5508. begin
  5509.         T:=X^[I];
  5510.         X^[I]:=X^[J];
  5511.         X^[J]:=T;
  5512. END; {of procedure swapx}
  5513.  
  5514. FUNCTION GTX(I:integer;J:integer):boolean;
  5515. var filecomp:integer;
  5516. begin
  5517.        {sort type,id,size }
  5518.        gtx:=false;
  5519.        
  5520.         filecomp:=filenamecompare(
  5521.             sysfiles[(X^[I].filenameindex and fnamemask)],
  5522.             sysfiles[(X^[J].filenameindex and fnamemask)]);
  5523.             
  5524.         if filecomp>0
  5525.           {(sysfiles[(X^[I].filenameindex and fnamemask)]>
  5526.             sysfiles[(X^[J].filenameindex and fnamemask)])} then
  5527.            begin
  5528.             gtx:=true
  5529.            end
  5530.         else if filecomp=0
  5531.                {((X^[I].filenameindex and fnamemask)=
  5532.                  (X^[J].filenameindex and fnamemask))} then
  5533.              if (X^[I].thetype>X^[J].thetype) then
  5534.                 begin
  5535.                  gtx:=true
  5536.                 end
  5537.              else if (X^[I].thetype=X^[J].thetype) then
  5538.                 begin
  5539.                   if (X^[I].theid>X^[J].theid)then
  5540.                       begin
  5541.                           gtx:=true; 
  5542.                       end
  5543.                   else if (X^[I].theid=X^[J].theid)then
  5544.                       begin
  5545.                         if (X^[I].thesize>X^[J].thesize)then
  5546.                             begin
  5547.                               gtx:=true;
  5548.                             end
  5549.                       end
  5550.                    ;
  5551.                  end
  5552.              ;
  5553.                    
  5554. end;
  5555.         
  5556. FUNCTION GEX(I:integer;J:integer):boolean;
  5557. var filecomp:integer;
  5558. begin
  5559.        {sort type,id,size }
  5560.        gex:=false;
  5561.        
  5562.         filecomp:=filenamecompare(
  5563.             sysfiles[(X^[I].filenameindex and fnamemask)],
  5564.             sysfiles[(X^[J].filenameindex and fnamemask)]);
  5565.             
  5566.        if filecomp>0
  5567.          {(sysfiles[(X^[I].filenameindex and fnamemask)]>
  5568.            sysfiles[(X^[J].filenameindex and fnamemask)])} then
  5569.            begin
  5570.             gex:=true
  5571.            end
  5572.         else if filecomp=0
  5573.                {((X^[I].filenameindex and fnamemask)=
  5574.                  (X^[J].filenameindex and fnamemask))} then             
  5575.            if (X^[I].thetype>X^[J].thetype) then
  5576.               begin
  5577.                gex:=true
  5578.               end
  5579.            else if (X^[I].thetype=X^[J].thetype) then
  5580.               begin
  5581.                 if (X^[I].theid>X^[J].theid)then
  5582.                     begin
  5583.                         gex:=true;
  5584.                     end
  5585.                 else if (X^[I].theid=X^[J].theid)then
  5586.                     begin
  5587.                      if (X^[I].thesize>=X^[J].thesize)then
  5588.                          begin
  5589.                            gex:=true;
  5590.                          end
  5591.                     end
  5592.                  ;
  5593.                end
  5594.            ;
  5595.  
  5596. END;
  5597.        
  5598. procedure siftdown(L:integer;U:integer);
  5599.     label 300,999{return};
  5600.     var
  5601.         i,child:integer;
  5602.         
  5603. begin
  5604.         
  5605. {
  5606. C
  5607. C       BEFORE MAXHEAP(L+1,U)
  5608. C       AFTER  MAXHEAP(L,U)
  5609. }
  5610.         I:=L;
  5611.         
  5612.         {LOOP}
  5613. 300:
  5614. {
  5615. C               INVARIANT: MAXHEAP(L,U) EXCEPT PERHAPS
  5616. C                       BETWEEN I AND ITS (0,1 OR 2) CHILDREN
  5617. C
  5618. }
  5619.                 CHILD:=2*I;
  5620.  
  5621.                 IF CHILD > U  then goto 999;
  5622. {
  5623. C
  5624. C               IF C+1 <= U AND X^(C+1) > X^(C) THEN C=C+1
  5625. C
  5626. }
  5627.                 IF(CHILD+1 <= U) THEN
  5628.                 IF(GTX(CHILD+1,CHILD))THEN
  5629.                         CHILD:=CHILD+1;
  5630.  
  5631. {                
  5632. C
  5633. C               CHILD IS THE GREATEST CHILD OF I
  5634. C
  5635. C               IF X^(I) >= X^(CHILD) THEN RETURN
  5636. C
  5637. }
  5638.                 IF(GEX(I,CHILD)) then goto 999;
  5639.                 
  5640. {                
  5641. C
  5642. C               X^(I) IS LESS THAN ITS GREATEST CHILD SO SWAP IT DOWNWARD
  5643. C               AND REPEAT LOOP
  5644. C
  5645. }
  5646.                 SWAPX(CHILD,I);
  5647.                 I:=CHILD;
  5648.                 GOTO 300;
  5649.         {END LOOP}
  5650. 999:{return}
  5651. END; {of proc siftdown}
  5652.  
  5653.  
  5654.        
  5655. begin {main body of sortresources}
  5656.  
  5657.         for I:=N div 2 downto 1 do
  5658.         begin
  5659.        { echo(i);}
  5660.         SIFTDOWN(I,N);
  5661.         end;
  5662.  
  5663.         {echo(0);}
  5664.  
  5665.         for I:=N downto 2 do
  5666.         begin
  5667.           {  echo(i);}
  5668.                 SWAPX(1,I);
  5669.                 {echo(i);}
  5670.                 SIFTDOWN(1,I-1);
  5671.                { echo(i);}
  5672.          end;
  5673.  
  5674.  
  5675.  
  5676. END; {sortresources}
  5677.  
  5678.         procedure sorttypes{(var X:resourcetypeinfoarray;N:integer)};
  5679.         {sort resource types array}
  5680. {        HEAP SORT
  5681. C
  5682. C       BASED ON PROGRAMMING PEARLS BY JON BENTLEY P 182
  5683. C       X IS THE ARRAY CONTAINING NX ELEMENTS TO BE SORTED
  5684. C       CALL SWAPX(I,J) SWAPS X(I) WITH X(J)
  5685. C       GEX(X,I,J) IS TRUE IFF X(I) >= X(J)
  5686. C       GTX(X,I,J) IS TRUE IFF X(I) > X(J)
  5687. C}
  5688.  
  5689.  
  5690.        var i: integer;
  5691.        
  5692.        
  5693. procedure SWAPX(I:integer;J:integer);
  5694. var     T:resourcetypeinforec; 
  5695.         
  5696. begin
  5697.         T:=X[I];
  5698.         X[I]:=X[J];
  5699.         X[J]:=T;
  5700. END; {of procedure swapx}
  5701.  
  5702. FUNCTION GTX(I:integer;J:integer):boolean;
  5703.  
  5704. begin
  5705.        {sort type,id,size }
  5706.        gtx:=false;
  5707.             if (X[I].thetype>X[J].thetype) then
  5708.                 begin
  5709.                         gtx:=true;
  5710.                  end
  5711.              ;
  5712.                    
  5713. end;
  5714.         
  5715. FUNCTION GEX(I:integer;J:integer):boolean;
  5716.  
  5717. begin
  5718.        {sort type,id,size }
  5719.        gex:=false;
  5720.            if (X[I].thetype>=X[J].thetype) then
  5721.               begin
  5722.                gex:=true
  5723.               end
  5724.  
  5725. END;
  5726.        
  5727. procedure siftdown(L:integer;U:integer);
  5728.     label 300,999{return};
  5729.     var
  5730.         i,child:integer;
  5731.         
  5732. begin
  5733.         
  5734. {
  5735. C
  5736. C       BEFORE MAXHEAP(L+1,U)
  5737. C       AFTER  MAXHEAP(L,U)
  5738. }
  5739.         I:=L;
  5740.         
  5741.         {LOOP}
  5742. 300:
  5743. {
  5744. C               INVARIANT: MAXHEAP(L,U) EXCEPT PERHAPS
  5745. C                       BETWEEN I AND ITS (0,1 OR 2) CHILDREN
  5746. C
  5747. }
  5748.                 CHILD:=2*I;
  5749.  
  5750.                 IF CHILD > U  then goto 999;
  5751. {
  5752. C
  5753. C               IF C+1 <= U AND X(C+1) > X(C) THEN C=C+1
  5754. C
  5755. }
  5756.                 IF(CHILD+1 <= U) THEN
  5757.                 IF(GTX(CHILD+1,CHILD))THEN
  5758.                         CHILD:=CHILD+1;
  5759.  
  5760. {                
  5761. C
  5762. C               CHILD IS THE GREATEST CHILD OF I
  5763. C
  5764. C               IF X(I) >= X(CHILD) THEN RETURN
  5765. C
  5766. }
  5767.                 IF(GEX(I,CHILD)) then goto 999;
  5768.                 
  5769. {                
  5770. C
  5771. C               X(I) IS LESS THAN ITS GREATEST CHILD SO SWAP IT DOWNWARD
  5772. C               AND REPEAT LOOP
  5773. C
  5774. }
  5775.                 SWAPX(CHILD,I);
  5776.                 I:=CHILD;
  5777.                 GOTO 300;
  5778.         {END LOOP}
  5779. 999:{return}
  5780. END; {of proc siftdown}
  5781.  
  5782.  
  5783.        
  5784. begin {main body of sorttypes}
  5785.  
  5786.         for I:=N div 2 downto 1 do
  5787.         begin
  5788.        { echo(i);}
  5789.         SIFTDOWN(I,N);
  5790.         end;
  5791.  
  5792.         {echo(0);}
  5793.  
  5794.         for I:=N downto 2 do
  5795.         begin
  5796.           {  echo(i);}
  5797.                 SWAPX(1,I);
  5798.                 {echo(i);}
  5799.                 SIFTDOWN(1,I-1);
  5800.                { echo(i);}
  5801.          end;
  5802.  
  5803.  
  5804.  
  5805. END; {sorttypes}
  5806. {$S wascore}
  5807. function min(i,j:longint):longint;
  5808. begin
  5809. if i<j then min:=i else min:=j;
  5810. end;
  5811. function rotatelong(i:longint):longint;
  5812. {left circular shift by one bit}
  5813. const leftbitnum=0;
  5814.       rightbitnum=31;
  5815. var j:longint; 
  5816. begin
  5817. j:=BitShift(i,1);{left logical shift one}
  5818. if bittst(@i,leftbitnum) then
  5819.     begin
  5820.     {high bit set in i}
  5821.     bitset(@j,rightbitnum);
  5822.     end
  5823.   ;
  5824. rotatelong:=j;
  5825. end;
  5826.  
  5827. function checksumHdataOLD{(h:handle):integer};
  5828. {OLD version using the toolbox bit manipulation stuff
  5829.  and an intermediate buffer array (abount 10 times slower)}
  5830. {non-standard checksum for virus detection
  5831.  depends on all bits and can detect  transpositions}
  5832. {modified to increase non-linearity 3/29/88}
  5833. const mask=$00FFFFFF;
  5834.       blocklongsize=64;
  5835.       blockbytesize=256;{4x above}
  5836. var size:longint;
  5837.     p:ptr;
  5838.     p0:longint;
  5839.     sum:integer;
  5840.     lsum:longint;
  5841.     offset:longint;
  5842.     longxxxx:longint;
  5843.     j,kk:longint;
  5844.     work:array[1..blocklongsize] of longint;
  5845. begin
  5846. sum:=0;
  5847. lsum:=0;
  5848. longxxxx:=0;
  5849. if h<>nil then
  5850.   if (h^<>nil) then
  5851.      begin
  5852.      size:=GetHandleSize(h);
  5853.      offset:=0;
  5854.      while offset<(size-1) do
  5855.         begin
  5856.         
  5857.         for j:=1 to blocklongsize do work[j]:=0;
  5858.         p0:=bitand(mask,ord4(h^));        
  5859.         p:=pointer(p0+offset);
  5860.         kk:=min(longint(blockbytesize),size-offset);
  5861.         blockmove(p,@work,kk);{copy a block}
  5862.         for j:=1 to (kk+3) div 4 do {do for longints}
  5863.            begin
  5864.               lsum:=bitxor(lsum,work[j]);
  5865.               longxxxx:=longxxxx+checksumsaltinc;
  5866.               {lsum:=bitxor(lsum,longxxxx);}{3/29/88}
  5867.               lsum:=lsum+longxxxx;
  5868.               lsum:=rotatelong(lsum);
  5869.            end;
  5870.         offset:=offset+blockbytesize;
  5871.         end;
  5872.      sum:=loword(bitxor(longint(loword(lsum)),longint(hiword(lsum)) ));
  5873.      end;
  5874.      
  5875. checksumhdataOLD:=sum;
  5876.  
  5877. end;
  5878. {$S core}
  5879. function checksumHdata{(h:handle):integer};
  5880. {faster version using more stuff specific to turbo pascal 3/28/88}
  5881. {non-standard checksum for virus detection
  5882.  depends on all bits and can detect  transpositions}
  5883. {modified to use Turbo's inline code bit masking operators
  5884.  rather than the toolbox bitxor etc}
  5885. {modified to operate directly on the data in the handle
  5886.  rather than copying blocks into a buffer}
  5887. {modified to increase non-linearity 3/29/88}
  5888. const mask=$00FFFFFF;
  5889.       leftbitmask= $80000000;
  5890.       rightbitmask=$00000001;
  5891.       blocklongsize=8000;
  5892.       blockbytesize=32000;{4x above}
  5893. type workblocktype=array[1..blocklongsize] of longint;
  5894.      workptr=^workblocktype;
  5895. var size,realsize,sizeextra:longint;
  5896.     p:ptr;
  5897.     wrk:workptr;
  5898.     p0:longint;
  5899.     sum:integer;
  5900.     lsum:longint;
  5901.     offset:longint;
  5902.     longxxxx:longint;
  5903.     j,kk:longint;
  5904.     shwork:longint;
  5905.     last:longint;
  5906. begin
  5907. sum:=0;
  5908. lsum:=0;
  5909. longxxxx:=0;
  5910. if h<>nil then
  5911.   if (h^<>nil) then
  5912.      begin
  5913.      hlock(h);
  5914.      size:=GetHandleSize(h);
  5915.      realsize:=size;
  5916.      sizeextra:=size mod 4;
  5917.      size:=size-sizeextra;
  5918.      offset:=0;
  5919.      p0:=bitand(mask,ord4(h^));        
  5920.      while offset<(size-1) do
  5921.         begin
  5922.         p:=pointer(p0+offset);
  5923.         kk:=min(longint(blockbytesize),size-offset);
  5924.         wrk:=workptr(p);
  5925.         for j:=1 to (kk+3) div 4 do {do for longints}
  5926.            begin
  5927.               lsum:=(lsum xor wrk^[j]);
  5928.               longxxxx:=longxxxx+checksumsaltinc;
  5929.               {lsum:=(lsum xor longxxxx);}{3/29/88}
  5930.               lsum:=lsum+longxxxx;
  5931.  
  5932.               {simulate a left circular shift of one on lsum}
  5933.               shwork:=lsum shl 1;{left logical shift one}
  5934.               if (lsum and leftbitmask)<>0 then
  5935.                   begin
  5936.                   {high bit set in lsum}
  5937.                   shwork:=shwork or rightbitmask
  5938.                   end;
  5939.                lsum:=shwork;
  5940.                {end shift}
  5941.            end;
  5942.         offset:=offset+blockbytesize;
  5943.         end;
  5944.      if sizeextra<>0 then
  5945.      begin
  5946.      {special case for trailing bytes in last longword}
  5947.      wrk:=workptr(pointer(p0+size));
  5948.      last:=wrk^[1];
  5949.      case sizeextra of
  5950.      1:last:=last and $FF000000;
  5951.      2:last:=last and $FFFF0000;
  5952.      3:last:=last and $FFFFFF00;
  5953.      end;{case}
  5954.            begin{copy of code above except 1st line}
  5955.               lsum:=(lsum xor last);
  5956.               longxxxx:=longxxxx+checksumsaltinc;
  5957.               {lsum:=(lsum xor longxxxx);}{3/29/88}
  5958.               lsum:=lsum+longxxxx;
  5959.  
  5960.               {simulate a left circular shift of one on lsum}
  5961.               shwork:=lsum shl 1;{left logical shift one}
  5962.               if (lsum and leftbitmask)<>0 then
  5963.                   begin
  5964.                   {high bit set in lsum}
  5965.                   shwork:=shwork or rightbitmask
  5966.                   end;
  5967.                lsum:=shwork;
  5968.                {end shift}
  5969.            end;
  5970.      
  5971.      end;{sizeextra non-zero}
  5972.      sum:=loword(bitxor(longint(loword(lsum)),longint(hiword(lsum)) ));
  5973.      hunlock(h);
  5974.      end;
  5975.      
  5976. checksumhdata:=sum;
  5977. end;{function}
  5978.  
  5979. {$S core}
  5980. procedure check_all_types(filename:str255;
  5981.                     fnindex:integer;{index of file name - system folder checks only}
  5982.                     apindex:integer;{subscript of application - application checks only}
  5983.                     SYSTEMFOLDER:boolean);{true for system check, false for application check}
  5984. {This is the routine that checks all types in a given file}
  5985.  {called by check_a_file}
  5986. const
  5987.     applsalt=$1234;{to make application checksum over resources non-linear}                  
  5988. var 
  5989.     j:integer;
  5990.     tt:restype;
  5991.     ok:boolean;
  5992.     err:oserr;
  5993.     index:integer;
  5994.     itt:integer;
  5995.     CHECKIT:BOOLEAN;
  5996.     sl:safetype; 
  5997.     rhand:handle;
  5998.     rid:integer;
  5999.     rsize:longint;
  6000.     rattr:integer;
  6001.     rname:str255;
  6002.     aevent:EventRecord;
  6003.     volref:integer;
  6004. begin
  6005.    {dbashow;}
  6006.    {Open resource fork as a file and load the
  6007.      header info into my own data structures}
  6008.    
  6009.    if systemfolder then
  6010.       begin  
  6011.           sl:=filenamesafetylevel(filename);
  6012.       end
  6013.    else
  6014.       begin
  6015.           sl:=unknown;
  6016.       end;
  6017.    volref:=0;{look in default directory}
  6018.    err:=openpath(myRpath,filename,volref);
  6019.    
  6020.    if err=noerr then
  6021.    with myRpath do
  6022.    begin
  6023.       { ntypes number of resource types in the current resource file}
  6024.      { dbashow;}
  6025.      { wait_for_buttons(' start types',continuebut);}
  6026.       for j:=1 to ntypes do
  6027.       if setmytype(myRpath,j,tt) then
  6028.          begin
  6029.          {nrefs is count of this type}
  6030.            {poststatus(concat(concat('$',tt),'$'),resline);} 
  6031.             if showdebuginfo then poststatus(tt,resline); 
  6032.            
  6033.            if systemfolder then add_type(tt,unknown);{the detailed list of types 
  6034.                                                      is for the system folder only
  6035.                                                      except for "dangerous" types}
  6036.                                                      
  6037.            {decide what types should be checked}
  6038.            itt:=find_type(tt);
  6039.            CHECKIT:=(tt='INIT') or (tt='CODE');
  6040.            if itt<>0 then
  6041.                with rtypes[itt] do
  6042.                   begin
  6043.                     checkit:=safety>sl;{check resources above
  6044.                     safe or unknown depending on file,location}
  6045.                     if (not systemfolder) and (safety=dangerous) then
  6046.                         begin
  6047.                             {record dangerous types in applications}
  6048.                             ainfo^[apindex].flags:= 
  6049.                             ainfo^[apindex].flags or appldangermask
  6050.                         end;
  6051.                     if (systemfolder) or (safety=dangerous) then                   
  6052.                     begin
  6053.                     occurs:=occurs+nrefs;
  6054.                     if checkit then 
  6055.                         notsafecount:=notsafecount+nrefs;
  6056.                     end;
  6057.                   end;
  6058.  
  6059.            if checkit then
  6060.              begin
  6061.              for index:=1 to nrefs do 
  6062.                 begin
  6063.                   {copy resource data and get name and size}
  6064.                   if CopyResData(myRpath,index,
  6065.                          rid,rsize,rattr,rname) then
  6066.                   if systemfolder then
  6067.                     begin
  6068.                     {system folder check}
  6069.                      if rcount<maxinfo then
  6070.                         begin
  6071.                           rcount:=rcount+1; 
  6072.                           with rinfo^[rcount] do
  6073.                             begin
  6074.                               thetype:=tt;
  6075.                               theid:=rid;
  6076.                               filenameindex:=fnindex;
  6077.                               thesize:=rsize;
  6078.                               thename:=rname;
  6079.                               checksum:=0;{in case all else fails}
  6080.                               {dbashow;}
  6081.                               {compute checksums}
  6082.                               checksum:=checksumHdata(resdata);
  6083.                               checksumchecksum:=checksumchecksum+checksum;
  6084.                             end;{with}
  6085.                          end;{rcount<maxinfo/rhand<>nil}
  6086.                     end
  6087.                   else
  6088.                     begin
  6089.                       {application check}
  6090.                        with ainfo^[apindex] do
  6091.                          begin
  6092.                             if unsafecount<0 then unsafecount:=0;
  6093.                             unsafecount:=unsafecount+1;
  6094.                             checksize:=checksize+rsize;
  6095.                             {compute checksums}
  6096.                             checksum:=(checksum xor applsalt)+checksumHdata(resdata);
  6097.                          end;
  6098.                     end
  6099.                   {dbashow;}    
  6100.                   end;{for index}
  6101.               end;{if checkit}
  6102.          {dbashow;}     
  6103.          end;{for types/set ok}
  6104.    end;{if open ok/with mypath}
  6105.        
  6106. closepath(myRpath); 
  6107. {dbashow;}
  6108. end;{proc check_all_types}
  6109.  
  6110.  
  6111.  
  6112. procedure check_a_file{(index:integer)};
  6113.  
  6114. var
  6115.     i:integer;
  6116.     filename:str255;
  6117.     volref:integer;
  6118. begin
  6119. filename:=sysfiles[index];
  6120. postmem(memline);
  6121. check_all_types(filename,index,1,true);
  6122. end;
  6123. {$S appl}
  6124. procedure checksum_all_appl;
  6125. {go back and checksum applications
  6126.  from list in memory}
  6127.  var i:integer;
  6128.      oldvol:integer;
  6129.      ignore:oserr;
  6130.      percent:longint;
  6131.      pct:str255;
  6132.      err:oserr;
  6133.      vr:integer;
  6134. begin
  6135. if fastapplcheck then exit;{skip in fast mode}
  6136. ignore:=getvol(nil,oldvol);
  6137. set_default_blessed;
  6138. for i:=1 to acount do
  6139.     with ainfo^[i] do
  6140.   begin
  6141.      vr:=newvols[flags and applvolumemask].volrefnum;
  6142.      err:=setvol(nil,vr);
  6143.      if err=noerr then
  6144.         begin
  6145.           set_default_by_id(dirid);{set directory} 
  6146.           percent:=i*100;
  6147.           percent:=percent div acount;
  6148.           numtostring(percent,pct);
  6149.           pct:=concat(pct,'%');
  6150.           pct:=concat(concat(filename,' '),pct);
  6151.           poststatus(pct,fileline);
  6152.           check_all_types(filename,1,i,false);
  6153.         end;
  6154.   end;
  6155. clear_to_end(fileline);
  6156. ignore:=setvol(nil,oldvol);
  6157. end;{proc}
  6158. procedure checksum_unchecked_appl;
  6159. {if an output file is to be written, then
  6160.  go back and checksum applications for which
  6161.  a full checksum has not been done or been copied from 
  6162.  the input file}
  6163.  var i:integer;
  6164.      oldvol:integer;
  6165.      ignore:oserr;
  6166.      percent:longint;
  6167.      pct:str255;
  6168.      err:oserr;
  6169.      vr:integer;
  6170.      savefastmode,doit:boolean;
  6171.      jj,mcount:longint;
  6172.      mess:str255;
  6173. begin
  6174. if not outputopen then exit;
  6175. savefastmode:=fastapplcheck;
  6176. ignore:=getvol(nil,oldvol);
  6177. mcount:=0;
  6178. for i:=1 to acount do
  6179.   with ainfo^[i] do
  6180.   begin
  6181.   if unsafecount=notcounted then mcount:=mcount+1;
  6182.   end;
  6183. {do check automatically if a small number of applications are affected}
  6184. doit:=mcount<=recheckappllimit;
  6185. if not doit then
  6186.    begin
  6187.    numtostring(mcount,mess);
  6188.    mess:=concat(concat('Do Full checksum on all ',mess),
  6189.         ' Applications new/changed/moved or not previously checked?');
  6190.    doit:=ask(mess,nobut);
  6191.    end;
  6192. if doit and (mcount>0) then
  6193.   begin
  6194.   set_default_blessed;
  6195.   poststatus('Recheck new/changed/renamed',pathline);
  6196.   jj:=0;
  6197.   for i:=1 to acount do
  6198.       with ainfo^[i] do
  6199.       if unsafecount=notcounted then
  6200.       begin
  6201.          fastapplcheck:=false;
  6202.          unsafecount:=0; 
  6203.          jj:=jj+1;
  6204.          vr:=newvols[flags and applvolumemask].volrefnum;
  6205.          err:=setvol(nil,vr);
  6206.          if err=noerr then
  6207.             begin
  6208.               set_default_by_id(dirid);{set directory} 
  6209.               percent:=jj*100;
  6210.               percent:=percent div mcount;
  6211.               numtostring(percent,pct);
  6212.               pct:=concat(pct,'%');
  6213.               pct:=concat(concat(filename,' '),pct);
  6214.               poststatus(pct,fileline);
  6215.               check_all_types(filename,1,i,false);
  6216.             end;
  6217.       end;
  6218.   end;
  6219. clear_to_end(pathline);
  6220. ignore:=setvol(nil,oldvol);
  6221. fastapplcheck:=savefastmode;
  6222. end;{proc}
  6223.  
  6224.  
  6225. procedure recheck_changed{(i:integer;
  6226. oldunsafecount:longint;
  6227. oldchecksize:longint;
  6228. oldchecksum:integer)};
  6229.  
  6230. {call this procedure immediately after determining that an application has
  6231.  changed size and do a full checksum to reduce false positives}
  6232.  
  6233.  var 
  6234.      oldvol:integer;
  6235.      ignore:oserr;
  6236.      err:oserr;
  6237.      vr:integer;
  6238.      safechange:boolean;
  6239.      savefastmode:boolean;
  6240.  
  6241. begin
  6242. if (ainfo^[i].flags and applchangedmask)=0 then exit;
  6243. postmem(memline);
  6244. savefastmode:=fastapplcheck;
  6245. ignore:=getvol(nil,oldvol); 
  6246. set_default_blessed;
  6247. poststatus('Full check on file whose size has changed',pathline);
  6248. with ainfo^[i] do
  6249.   begin
  6250.   if unsafecount=notcounted then
  6251.      begin
  6252.         fastapplcheck:=false;
  6253.         unsafecount:=0; 
  6254.         vr:=newvols[flags and applvolumemask].volrefnum;
  6255.         err:=setvol(nil,vr);
  6256.         if err=noerr then
  6257.            begin
  6258.              set_default_by_id(dirid);{set directory} 
  6259.              poststatus(filename,fileline);
  6260.              check_all_types(filename,1,i,false);
  6261.            end;
  6262.      end;
  6263.      {check for exact match with new checksums}
  6264.      safechange:=true;
  6265.      if oldchecksize=checksize then
  6266.        if oldchecksum=checksum then
  6267.          if oldunsafecount=unsafecount then
  6268.             begin
  6269.               safechange:=true;                      
  6270.             end;
  6271.             
  6272.      if safechange then
  6273.         begin
  6274.           flags:=(flags and (not applchangedmask)) or applsafechangedmask;
  6275.         end
  6276.      else
  6277.         begin
  6278.           flags:=(flags or applchangedmask);
  6279.         end;        
  6280.  
  6281.   end;
  6282.     
  6283. clear_to_end(pathline);
  6284. poststatus('Compare application sizes',pathline);
  6285. ignore:=setvol(nil,oldvol);
  6286. fastapplcheck:=savefastmode
  6287. end;{recheck_changed}
  6288. {$S core}
  6289. procedure summary;
  6290. {write summary to output file in same format as input file}
  6291. var i:integer;
  6292.     tab:string[1];
  6293.     now:longint;
  6294.     ndate,ntime:str255;
  6295. begin
  6296. if not outputopen then exit;
  6297. {-----------------------------------}
  6298. tab:=chr(9);
  6299. poststatus('Writing System Summary Output',pathline);
  6300.  
  6301. {get time stamp}
  6302. getdatetime(now);
  6303. IUDateString(now,abbrevdate,ndate);
  6304. IUTImeString(now,false,ntime);
  6305. scsi_wait;
  6306. writeln(outfile,blessedpath,tab,ndate,tab,ntime,tab,titleversion);
  6307. scsi_wait;
  6308. writeln(outfile,bootblockchecksum);
  6309. scsi_wait;
  6310. writeln(outfile,checksumchecksum);{grand checksum}
  6311. scsi_wait;
  6312. writeln(outfile,rcount,tab,rtypes_count,tab,notsafecount,
  6313. tab,ord(checkfloppies),tab,ord(checknonbootdrives),
  6314. tab,appleshareaccessmask);
  6315. write_end_flag('end header');
  6316. write_safekeys;
  6317. write_morechecks;
  6318. {end of "header"}
  6319. write_vols;{volumes list}
  6320. for i:=1 to rtypes_count do
  6321.     begin
  6322.     with rtypes[i] do
  6323.        begin
  6324.           scsi_wait;
  6325.           writeln(outfile,thetype,tab,ord(safety),tab,occurs);
  6326.        end;
  6327.     end;
  6328. write_end_flag('end types');
  6329. for i:=1 to rcount do
  6330.     with rinfo^[i] do
  6331.       begin
  6332.      scsi_wait;
  6333.       write(outfile,
  6334.       thetype:4,tab,theid:7,tab,thesize:10,tab,
  6335.       checksum:7,tab,thename,tab,sysfiles[(filenameindex and fnamemask)]);
  6336. if inputopen then
  6337.       begin
  6338.       if (filenameindex and exactmatchmask)=exactmatchmask then
  6339.            begin
  6340.            {normal}
  6341.            writeln(outfile);
  6342.            end
  6343.       else
  6344.          begin
  6345.            if (filenameindex and idmatchmask)=idmatchmask then
  6346.               begin
  6347.               writeln(outfile,tab,'changed??');
  6348.               end
  6349.            else
  6350.               begin
  6351.               writeln(outfile,tab,'new??');
  6352.               end
  6353.          end;
  6354.       end
  6355.       else
  6356.            begin
  6357.            {normal no input file}
  6358.            writeln(outfile)
  6359.            end;
  6360.       
  6361.       end;{for}
  6362. write_end_flag('end res checks');
  6363. end;{proc summary}
  6364.  
  6365. {$S core}
  6366. procedure get_set_blessed;
  6367. {get the blessed folder and make it the default and
  6368. build it's pathname}
  6369. var
  6370.     volume:integer;
  6371.     name:str255;
  6372. begin
  6373. get_blessed;
  6374. set_default_blessed;
  6375. folder_info_two(blessed,blessedbootvolwd,name,blessedpath,true);
  6376. end;{proc}
  6377.  
  6378.  
  6379.  
  6380. {$S event }
  6381. procedure dokeypress; 
  6382. {key events
  6383.   ignore modifier keys
  6384.   Q is quit
  6385.   . is halt
  6386.   F is Full Check on start up
  6387.   A is system only check on startup
  6388.   * is debugger
  6389.   ^ is debugger without extra output
  6390.   & is debug output wutout macsbug
  6391.   Y N are replies to questions Yes and No
  6392.   return is default button if any}
  6393. var
  6394.     whichWindow :   WindowPtr;
  6395.     chcode:integer;
  6396.     ch:str255;
  6397.     menuchoice:longint;
  6398.     
  6399. begin
  6400.    with theevent do
  6401.         begin
  6402.            chcode:=bitand(message,CharCodeMask);
  6403.            ch:=chr(chcode);
  6404.            uprstring(ch,true);   
  6405.            if (ch='Q') then
  6406.               begin
  6407.                quitting:=true;
  6408.               end
  6409.            else if (ch='*') then
  6410.               begin
  6411.                 scsi_wait_doevent:=scsi_wait_doevent_debug;
  6412.                 showdebuginfo:=true;
  6413.                 debugger;{Macsbug}
  6414.               end
  6415.            else if (ch='&') then
  6416.               begin
  6417.                 scsi_wait_doevent:=scsi_wait_doevent_debug;
  6418.                 showdebuginfo:=true;
  6419.               end
  6420.            else if (ch='#') then
  6421.               begin
  6422.                 detaildebugflag:=true;
  6423.               end
  6424.            else if (ch='^') then
  6425.               begin
  6426.                 debugger;{Macsbug}
  6427.               end
  6428.            else if (ch='Y') and (not askanswered) then
  6429.               begin
  6430.                 dobutton(yesbut);
  6431.               end
  6432.            else if (ch='N') and (not askanswered) then
  6433.               begin
  6434.                 dobutton(nobut);
  6435.               end
  6436.            else if (ch='A') and (not askanswered) then
  6437.               begin
  6438.                 dobutton(sysonlybut);
  6439.               end
  6440.            else if (ch='F') and (not askanswered) then
  6441.               begin
  6442.                 dobutton(fullbut);
  6443.               end
  6444.            else if (ch='.') then
  6445.               begin
  6446.                 halt;{emergency exit}
  6447.               end
  6448.             else if (chcode=13) and (not askanswered) then
  6449.               begin
  6450.                  dobutton(defaultbutton);
  6451.               end
  6452.             else
  6453.               begin
  6454.                 sysbeep(1);
  6455.               end
  6456.          end;{with}
  6457.              
  6458. end;
  6459.  
  6460. procedure drawlong(l:longint);
  6461. var s:str255;
  6462. begin
  6463.    NumtoString(l,s);
  6464.    DrawString(concat(s,' '));
  6465. end;
  6466.  
  6467. {$S            }
  6468. procedure drawbuttons;
  6469. {draw buttons and frame around the default}
  6470. var
  6471.    saveport:grafptr;
  6472.    wait,endtick:longint;
  6473.    h,v:integer;
  6474.    ii:integer;
  6475.    rr:rect;
  6476. begin
  6477. getport(saveport);
  6478. setport(mainwindow);
  6479. (*
  6480. {zap invisibles}
  6481. for ii:=1 to mbutton do
  6482.     if buttons[ii]^^.contrlVis<>255 then
  6483.     begin
  6484.      rr:=buttonrects[ii];
  6485.      insetrect(rr,-4,-4);
  6486.      eraseroundrect(rr,22,22);
  6487.     end;
  6488. *)
  6489. {draw visibles}
  6490. for ii:=1 to mbutton do
  6491.     if buttons[ii]^^.contrlVis=255 then
  6492.     begin
  6493.      rr:=buttonrects[ii];
  6494.      if (ii=defaultbutton) then forecolor(blackcolor) else forecolor(whitecolor);
  6495.      insetrect(rr,-4,-4);
  6496.      pensize(2,2);
  6497.      frameroundrect(rr,22,22);
  6498.      pensize(1,1);
  6499.     end;
  6500. forecolor(blackcolor);
  6501. drawcontrols(mainwindow);
  6502. setport(saveport);
  6503. end;
  6504.  
  6505. {$S            }
  6506. procedure showstatus;
  6507. {redraw the status message display and buttons}
  6508. var
  6509.    saveport:grafptr;
  6510.    wait,endtick:longint;
  6511.    h,v:integer;
  6512. begin
  6513. getport(saveport);
  6514. setport(mainwindow);
  6515. EraseRect(mainwindow^.portrect);
  6516. if optioncontrolsactiveflag then
  6517.   begin
  6518.   draw_optcon_text;
  6519.   framerect(textframe);
  6520.   end
  6521. else
  6522.   begin
  6523.   teupdate(textbounds,statustext);
  6524.   framerect(textframe);
  6525.   end;
  6526. drawbuttons;    
  6527. setport(saveport);
  6528. end;
  6529.  
  6530. {$S event }
  6531. procedure  doshutdown;
  6532. {flush drives and do a system shutdown}
  6533. const maxdrive=32;
  6534. var theerr:oserr;
  6535.     volref:integer;
  6536.     freebytes:longint;
  6537.     drive:integer;
  6538.     vname:str255;
  6539. begin
  6540. flushevents(everyevent,0);  {clear out event queue}
  6541. {flush default volume}
  6542. theerr:=FlushVol(nil,0);
  6543. {loop over small drive numbers to try and flush the rest}
  6544.  
  6545. for drive:=1 to maxdrive do begin
  6546.    theerr:=getvinfo(drive,@vname,volref,freebytes);
  6547.    if theerr=noerr then
  6548.       begin
  6549.          {writeln(theerr,' ',vname,' ',drive);}
  6550.          theerr:=FlushVol(nil,drive);
  6551.          {writeln(theerr);}
  6552.          theerr:=eject(nil,drive);
  6553.          {writeln(theerr);}
  6554.       end
  6555.    end;
  6556.    
  6557. ShutDwnPower;
  6558. end;{doshutdown}
  6559.  
  6560. procedure dobutton{(whichbutton:integer)};
  6561. {actions for buttons and default buttons}
  6562. begin
  6563. case whichbutton of
  6564.   nodefaultbut:{do nothing};
  6565.   continuebut:
  6566.                begin
  6567.                    {continue}
  6568.                  askanswered:=true;
  6569.                 end;
  6570.   haltbut:
  6571.                begin 
  6572.                  {halt}              
  6573.                  close_all_and_halt(true);
  6574.                  askanswered:=true;
  6575.                end;
  6576.    skipitbut:
  6577.                begin 
  6578.                  {same as halt}              
  6579.                  close_all_and_halt(true);
  6580.                  askanswered:=true;
  6581.                end;
  6582.  shutdownbut:
  6583.                begin 
  6584.                  {Shutdown}              
  6585.                  doshutdown;
  6586.                  askanswered:=true;
  6587.                end;
  6588.   yesbut:
  6589.                begin 
  6590.                  {yes}              
  6591.                  askanswer:=true;
  6592.                  askanswered:=true;
  6593.                end;
  6594.   nobut:
  6595.                begin 
  6596.                  {no}              
  6597.                  askanswer:=false;
  6598.                  askanswered:=true;
  6599.                end;
  6600.   shortbut:
  6601.                begin 
  6602.                  {short check} 
  6603.                  fastapplcheck:=true;
  6604.                  skipapplcheck:=false;             
  6605.                  askanswered:=true;
  6606.                end;
  6607.   sysonlybut:
  6608.                begin 
  6609.                  {short check} 
  6610.                  fastapplcheck:=true;
  6611.                  skipapplcheck:=true;             
  6612.                  askanswered:=true;
  6613.                end;
  6614.   fullbut:
  6615.                begin 
  6616.                  {full check}              
  6617.                  fastapplcheck:=false;
  6618.                  skipapplcheck:=false;            
  6619.                  askanswered:=true;
  6620.                end;
  6621.     end;{case}
  6622.  
  6623. end;{proc}
  6624. {$S event }
  6625. procedure dooptcom(jjj:integer);
  6626. {do check box and radio button controls on the screen for specifying
  6627.  options}
  6628. var value:integer;
  6629.     bvalue:boolean;
  6630.     i:integer;
  6631. begin
  6632. value:=getctlvalue(optcons[jjj]);
  6633.  
  6634. case jjj of
  6635.  floppyoptcon,nonstartupoptcon:
  6636.  begin
  6637.  {radio buttons}
  6638.  if value=0 then
  6639.    begin
  6640.      setctlvalue(optcons[jjj],1);
  6641.      bvalue:=true;
  6642.    end
  6643.  else
  6644.    begin
  6645.      setctlvalue(optcons[jjj],0);
  6646.      bvalue:=false;
  6647.    end;
  6648.  end;
  6649.  
  6650.  owneroptcon,writeoptcon,everythingoptcon:
  6651.  begin
  6652.  for i:=owneroptcon to everythingoptcon do
  6653.     begin
  6654.     if jjj=i then
  6655.    begin
  6656.      setctlvalue(optcons[i],1);
  6657.    end
  6658.  else
  6659.    begin
  6660.      setctlvalue(optcons[i],0);
  6661.    end; 
  6662.    end;{for}
  6663.  
  6664.  end;
  6665.  otherwise
  6666.  
  6667. end;{case}
  6668.  
  6669. case jjj of
  6670. floppyoptcon:
  6671.     begin
  6672.       checkfloppies:=bvalue;
  6673.     end; 
  6674. nonstartupoptcon:
  6675.     begin
  6676.       checknonbootdrives:=bvalue;
  6677.     end;
  6678. owneroptcon:
  6679.     begin
  6680.       appleshareaccessmask:=owneraccessmask;
  6681.     end;
  6682. writeoptcon:
  6683.     begin
  6684.       appleshareaccessmask:=readwriteaccessmask;
  6685.     end;
  6686. everythingoptcon:
  6687.     begin
  6688.       appleshareaccessmask:=everythingaccessmask;
  6689.     end;
  6690. end;{case}
  6691. end;{proc}
  6692. procedure adjust_option_controls;
  6693. {make control settings consistent with the values}
  6694.  
  6695. procedure setit(ii:integer;bb:boolean);
  6696. begin
  6697. if bb then 
  6698.   setctlvalue(optcons[ii],1) 
  6699.     else
  6700.   setctlvalue(optcons[ii],0)
  6701. end;
  6702.  
  6703. begin
  6704.  
  6705. setit(floppyoptcon,checkfloppies);
  6706. setit(nonstartupoptcon,checknonbootdrives);
  6707. setit(owneroptcon,appleshareaccessmask=owneraccessmask);
  6708. setit(writeoptcon,appleshareaccessmask=readwriteaccessmask);
  6709. setit(everythingoptcon,appleshareaccessmask=everythingaccessmask);
  6710.  
  6711. end;
  6712. procedure DoControls(whichwindow:windowptr;local:point);
  6713. {process hits on controls}
  6714. label 88,99;
  6715. var whichcontrol:controlhandle;
  6716.     part,tresult:integer;
  6717.     wait,endwait:longint;
  6718.     jbut:integer;
  6719. begin
  6720. setport(whichwindow);
  6721. part:=findcontrol(local,whichwindow,whichcontrol);
  6722. if (part<>0) and (whichcontrol<>nil) then
  6723.    begin
  6724.    HiLiteControl(whichcontrol,part);{highlight part}
  6725.    case part of
  6726.    InButton:
  6727.       begin
  6728.         drawbuttons;
  6729.         wait:=30;
  6730.         delay(wait,endwait);
  6731.         if trackcontrol(whichcontrol,local,nil)<>0 then
  6732.           begin
  6733.           for jbut:=1 to mbutton do
  6734.             if whichcontrol=buttons[jbut] then
  6735.                begin
  6736.                  dobutton(jbut);
  6737.                  goto 88;
  6738.                 end;
  6739.           end;
  6740.       88:
  6741.       HiLiteControl(whichcontrol,0);{unhighlight}
  6742.       drawbuttons;
  6743.       end; 
  6744.    InCheckBox:
  6745.       begin
  6746.         if trackcontrol(whichcontrol,local,nil)<>0 then
  6747.           begin
  6748.           for jbut:=1 to moptcon do
  6749.             if whichcontrol=optcons[jbut] then
  6750.                begin
  6751.                  dooptcom(jbut);
  6752.                  goto 99;
  6753.                 end;
  6754.           end;
  6755.       99:
  6756.       HiLiteControl(whichcontrol,0);{unhighlight}
  6757.       end;    
  6758.    end;{case}
  6759.    end;
  6760.  
  6761. end;
  6762.  
  6763. procedure doclick;
  6764. {process mouse down events}
  6765. var whichwindow:windowptr;
  6766.     global,local:point;
  6767.     saveport:grafptr;
  6768.     inwhat:integer;
  6769. begin
  6770. getport(saveport);
  6771.     global:=theEvent.where;
  6772.     inwhat:=findwindow(global,whichwindow);
  6773.     if whichwindow<>nil then
  6774.         begin
  6775.         setport(whichwindow); 
  6776.         end;
  6777.      local:=global;
  6778.      globaltolocal(local);
  6779.      case inwhat of
  6780.          indesk:;
  6781.          inmenubar:;
  6782.          insyswindow:;
  6783.          incontent:
  6784.             begin
  6785.             DoControls(whichwindow,local);
  6786.             end;
  6787.          indrag:;
  6788.          ingrow:;
  6789.          ingoaway:quitting:=true;
  6790.          end;{case}
  6791.  
  6792. setport(saveport);
  6793. end;
  6794. {$S event}
  6795. procedure eventmonitor;
  6796. {for debugging}
  6797. var s1,s2,s3:str255;
  6798. begin
  6799. NumToString(longint(theevent.what),s1);
  6800. case theevent.what of
  6801.     NullEvent:s1:='Null';
  6802.     MouseDown:s1:='MouseDn';
  6803.     MouseUp:s1:='MouseUp';
  6804.     UpdateEvt:s1:='Update';
  6805.     ActivateEvt:begin
  6806.                  if odd(theevent.modifiers) then s1:='Act' else s1:='DeAct';
  6807.                 end;
  6808.     otherwise
  6809.        {pass s1 as is}
  6810. end;{case}
  6811. numtostring(longint(theevent.modifiers),s2);
  6812. s3:=concat(s1, ' ',s2);
  6813. {debug_mess(s3);}
  6814. end;
  6815. {$S          }
  6816. procedure DoNull(dontloop:boolean);
  6817. {background/idle Event processing}
  6818. begin
  6819. if Quitting and (TheEvent.what = NullEvent) then
  6820.      begin
  6821.         finished:=true;
  6822.         close_all_and_halt(true);
  6823.      end {if}
  6824. else if (theevent.what =nullevent)  then
  6825.      begin
  6826.        
  6827.        {showstatus;}
  6828.         if lowmemoryGZflag then low_memory_halt;
  6829.      end;
  6830.  
  6831. end;{DoNull}
  6832. procedure doevent{(dontloop:boolean)};
  6833. {modified event loop for calling with other routines
  6834.  process events till it sees a null event if dontloop is false}
  6835. var 
  6836.     looplimiter:integer;
  6837.     Eventstatus:boolean;{indicates if we should handle this event}
  6838.     oureventmask:integer;
  6839.     savemouse:EventRecord;
  6840.     foundin:integer;
  6841.  begin
  6842.  looplimiter:=0;
  6843.  repeat
  6844.        looplimiter:=looplimiter+1;
  6845.        oureventmask:=EveryEvent;
  6846.        begin
  6847.       systemtask;
  6848.       EventStatus:=GetNextEvent(oureventmask,TheEvent);
  6849.       end;
  6850.       
  6851.     {Event Processing:}
  6852.         if EventStatus then   
  6853.              case TheEvent.what of
  6854.                 MouseDown:
  6855.                     begin
  6856.                    {use mousedown to test option key}
  6857.                    optionkeyflag:=optionkeyflag or
  6858.                        (bitand(theevent.modifiers,optionkey)<>0);
  6859.                     DoClick;
  6860.                     end;
  6861.                 MouseUp:
  6862.                    begin
  6863.                    end;
  6864.                 UpdateEvt:
  6865.                    begin
  6866.                    beginupdate(mainwindow);
  6867.                    drawbuttons;
  6868.                    showstatus;
  6869.                    endupdate(mainwindow);
  6870.                    end;
  6871.                 ActivateEvt:
  6872.                    begin
  6873.                    {use activate to test option key}
  6874.                    optionkeyflag:=optionkeyflag or
  6875.                        (bitand(theevent.modifiers,optionkey)<>0);
  6876.                    end;
  6877.                 KeyDown,AutoKey:
  6878.                    begin
  6879.                    {use keydown to test option key}
  6880.                    optionkeyflag:=optionkeyflag or
  6881.                        (bitand(theevent.modifiers,optionkey)<>0);
  6882.                    Dokeypress;
  6883.                    end;
  6884.                 otherwise
  6885.               end{case}
  6886.            {nullevents:}
  6887.            else if (theevent.what =nullevent) then
  6888.               DoNull(dontloop);
  6889. until((theevent.what=nullevent) or (dontloop) or (looplimiter>20))
  6890.  
  6891. end; {of proc DoEvent}
  6892. {$S startup}
  6893. procedure centerit(var rr:rect;height:integer;width:integer);
  6894. {center a rectangle on the screen}
  6895. var at:point;
  6896. begin
  6897. rr:=screenbits.bounds;
  6898. insetrect(rr,40,40);
  6899. with at do
  6900.   begin
  6901.   with screenbits.bounds do
  6902.     begin
  6903.       v:=(top+bottom) div 2;
  6904.       h:=(left+right) div 2;
  6905.     end;
  6906.   with rr do
  6907.     begin
  6908.       top:=v-(height div 2);
  6909.       bottom:=v+(height div 2);
  6910.       left:=h-(width div 2);
  6911.       right:=h+(width div 2);
  6912.     end; 
  6913.   end;
  6914. end;{proc centerit}
  6915.  
  6916. {$S start2}
  6917. procedure mytextsetup;
  6918. {set up textedit record to display status information}
  6919. var i:integer;
  6920.     ll:integer;
  6921. begin
  6922.  
  6923. {define rect for textedit record for posting messages}
  6924. textbounds:=wbounds;
  6925. globaltolocal(textbounds.topleft);
  6926. globaltolocal(textbounds.botright);
  6927. insetrect(textbounds,10,10);
  6928. textbounds.bottom:=textbounds.bottom-60;
  6929. textframe:=textbounds;
  6930. Insetrect(textframe,-1,-1);
  6931. framerect(textframe);
  6932.  
  6933. {create TE Record}
  6934. statustext:=TENew(textbounds,textbounds);
  6935. {set to centered justification}
  6936. TeSetJust(tejustcenter,statustext);
  6937. {set to wider spacing}
  6938. with statustext^^ do 
  6939.    begin
  6940.      {ll:=lineHeight div 2;}
  6941.      ll:=5;
  6942.      lineheight:=lineheight+ll;
  6943.      fontascent:=fontascent+ll;   
  6944.    end;
  6945. tecaltext(statustext);   
  6946. {insert empty lines}
  6947. for i:=1 to mstatus+1 do replaceline(' ',i);
  6948. {put in startup info}
  6949. Replaceline(concat('Startup System Check ',TitleVersion),titleline);
  6950. ReplaceLine('by Albert Lunde, Northwestern University  Copyright ⌐ 1988'
  6951. ,byline);
  6952. replaceline(startversion,fileline);
  6953. {set inactive to hide insertion point}
  6954. tedeactivate(statustext);
  6955. framerect(textframe);
  6956. end;
  6957.  
  6958. {$S         }
  6959. procedure add_to_stack_size(bytecount:size);
  6960. {decrease the heap and increase the stack}
  6961. begin
  6962. setappllimit(ptr(ord4(getappllimit)-bytecount));
  6963. end;
  6964.  
  6965. procedure initialize;
  6966.  
  6967. var i:integer;
  6968.     ignore:oserr;
  6969. begin
  6970. rinfo:=nil;
  6971. ainfo:=nil;
  6972. rcount:=0;
  6973. acount:=0;
  6974. inputfile_filename:='';
  6975. outputfile_filename:='';
  6976. appleshareaccessmask:=appleshareaccessmaskdefault;
  6977. checkfloppies:=checkfloppiesdefault;
  6978. checknonbootdrives:=checknonbootdrivesdefault;
  6979. scsi_wait_doevent:=scsi_wait_doevent_normal;
  6980.  
  6981. optioncontrolsactiveflag:=false;
  6982. currentvolumesubscript:=0;
  6983. showdebuginfo:=false;
  6984. detaildebugflag:=false;
  6985. scsi_wait_count:=scsi_wait_limit div 2;
  6986. defaultbutton:=startupdefaultbutton;
  6987. askanswered:=false;
  6988. checksumchecksum:=0;
  6989. fastapplcheck:=true;
  6990. skipapplcheck:=false;
  6991. finished:=false;
  6992. quitting:=false;
  6993. mainwindow:=nil;
  6994. inputopen:=false;
  6995. currentsection:=0;
  6996. on_section_boundry:=true;
  6997. outputopen:=false;
  6998. optionkeyflag:=false;
  6999. StartupOptionKeyFlag:=false;
  7000. notsafecount:=0;
  7001.  
  7002. add_to_stack_size(stack_extra_size);
  7003. MaxApplZone;
  7004. MoreMasters;
  7005. MoreMasters;
  7006. MoreMasters;
  7007. MoreMasters;
  7008. FlushEvents(everyevent,0);
  7009. InitGraf(@thePort);
  7010. InitFonts;
  7011. InitWindows;
  7012. InitCursor;
  7013. TEInit;
  7014. for i:=1 to dbamax do dbarray[i]:=0;
  7015. ignore:=getvol(nil,startupwd);
  7016. setup_mygrowzone;{memory management}
  7017. allocate_big_memory(abmfail);
  7018. setupmydebug;
  7019. {setup mainwindow centered on the screen}
  7020. centerit(wbounds,260,470);
  7021.  
  7022. mainwindow:=NewWindow(nil,wbounds,'Startup System Check',true,
  7023.         dboxProc,pointer(-1),false,0);
  7024. setport(mainwindow);
  7025. textfont(0);
  7026.  
  7027. mytextsetup;
  7028. initmypath(myRpath);
  7029. end;
  7030.  
  7031. {$S start2     }
  7032.  
  7033. procedure setup_buttons;
  7034. var i:integer;
  7035.     h,v:integer;
  7036.     cr,cmd:string[1];
  7037.     tag:str255;
  7038. begin
  7039. h:=12;
  7040. v:=210;
  7041. cr:=chr(13);
  7042. cmd:=chr(17);
  7043. for i:=1 to shutdownbut do
  7044.    with buttonrects[i] do
  7045.       begin
  7046.         top:=v;
  7047.         left:=h;
  7048.         right:=h+80;
  7049.         bottom:=v+38;
  7050.         h:=h+91;
  7051.       end;
  7052. h:=12;
  7053. v:=210;
  7054. for i:=shutdownbut+1 to mbutton do
  7055.    with buttonrects[i] do
  7056.       begin
  7057.         top:=v;
  7058.         left:=h;
  7059.         right:=h+80;
  7060.         bottom:=v+38;
  7061.         h:=h+91;
  7062.       end;
  7063.      
  7064. buttons[continuebut]:=NewControl(mainwindow,buttonrects[continuebut],
  7065. 'Continue',false,0,0,1,PushButProc,0);
  7066.  
  7067. buttons[yesbut]:=NewControl(mainwindow,buttonrects[yesbut],'Yes',false,
  7068.              0,0,1,PushButProc,0);
  7069. tag:=concat(concat(concat('Halt',cr),cmd),'Q');
  7070. buttons[haltbut]:=NewControl(mainwindow,buttonrects[haltbut],tag,false,
  7071.              0,0,1,PushButProc,0);
  7072. buttons[nobut]:=NewControl(mainwindow,buttonrects[nobut],'No',false,
  7073.              0,0,1,PushButProc,0);
  7074. tag:=concat(concat('Shut',cr),'Down');
  7075. buttons[shutdownbut]:=NewControl(mainwindow,buttonrects[shutdownbut],tag,true,
  7076.              0,0,1,PushButProc,0);
  7077. tag:=concat(concat(concat(concat('System   ',cr),'   Only  '),cmd),'A');
  7078. buttons[sysonlybut]:=NewControl(mainwindow,buttonrects[sysonlybut],tag,true,
  7079.              0,0,1,PushButProc,0);
  7080. tag:=concat(concat('Application',cr),'Scan');
  7081. buttons[shortbut]:=NewControl(mainwindow,buttonrects[shortbut],tag,true,
  7082.              0,0,1,PushButProc,0);
  7083. tag:=concat(concat('Full    ',cr),concat(concat('Check ',cmd),'F'));
  7084. buttons[Fullbut]:=NewControl(mainwindow,buttonrects[fullbut],tag,true,
  7085.              0,0,1,PushButProc,0);
  7086. tag:=concat(concat(concat('Skip It',cr),cmd),'Q');
  7087. buttons[skipitbut]:=NewControl(mainwindow,buttonrects[skipitbut],tag,true,
  7088.              0,0,1,PushButProc,0);
  7089.  
  7090. end;{proc setup_buttons}
  7091. procedure in_progress_buttons;
  7092. begin
  7093. HiliteControl(buttons[continuebut],255);{make inactive but visible}
  7094. HideControl(buttons[sysonlybut]);
  7095. HideControl(buttons[shortbut]);
  7096. HideControl(buttons[fullbut]);
  7097. HideControl(buttons[skipitbut]);
  7098. ShowControl(buttons[continuebut]);
  7099. ShowControl(buttons[haltbut]);
  7100. ShowControl(buttons[shutdownbut]);
  7101. doevent(true);
  7102. end;
  7103. procedure setup_optioncon;
  7104. var i:integer;
  7105.     vv:integer;
  7106.     cr,cmd:string[1];
  7107.     tag:str255;
  7108.     rr:rect;
  7109.     at:point;
  7110. procedure addit(ii:integer;tag:str255;r:rect;origin:point;pid:integer);
  7111. const
  7112.     visible=false;
  7113. begin
  7114. if ii>moptcon then
  7115.     begin
  7116.       sysbeep(1);
  7117.       exit;
  7118.     end;
  7119. with r do
  7120. with origin do
  7121.    begin
  7122.      top:=top+v;
  7123.      bottom:=bottom+v;
  7124.      right:=right+h;
  7125.      left:=left+h;
  7126.    end;
  7127. optconrects[ii]:=r;
  7128. optcons[ii]:=NewControl(mainwindow,r,tag,visible,0,0,1,Pid,0);
  7129.  
  7130.  
  7131. end;{proc}
  7132.  
  7133. procedure rris(ptop,pleft:integer);
  7134. begin
  7135. with rr do
  7136.   begin
  7137.   top:=ptop;
  7138.   left:=pleft;
  7139.   bottom:=ptop+18;
  7140.   right:=pleft+StringWidth(tag)+20;
  7141.   end;
  7142. end;{proc}
  7143.  
  7144. begin
  7145. at.h:=90;
  7146. at.v:=0;
  7147. optconorigin:=at;
  7148. tag:='Check Floppy Diskettes';
  7149. vv:=55;
  7150. rris(vv, 16);
  7151. addit(floppyoptcon,tag,rr,at,checkboxproc);
  7152.  
  7153. vv:=vv+19;
  7154. tag:='Check Non-Startup Disk Volumes';
  7155. rris(vv,16);
  7156. addit(nonstartupoptcon,tag,rr,at,checkboxproc);
  7157.  
  7158. vv:=125;
  7159. tag:='Only check folders if owner';
  7160. rris(vv,16);
  7161. addit(owneroptcon,tag,rr,at,RadioButProc);
  7162.  
  7163. vv:=vv+19;
  7164. tag:='Only check folders if read/write access';
  7165. rris(vv,16);
  7166. addit(writeoptcon,tag,rr,at,RadioButProc);
  7167.  
  7168. vv:=vv+19;
  7169. tag:='Check everything in sight';
  7170. rris(vv,16);
  7171. addit(everythingoptcon,tag,rr,at,RadioButProc);
  7172.  
  7173. end;{proc}
  7174.  
  7175. procedure draw_optcon_text;
  7176.  
  7177. begin
  7178. with optconorigin do moveto(h,v);
  7179. move(16,30);
  7180. DrawString('Specify Options - What will be checked');
  7181. with optconorigin do moveto(h,v);
  7182. move(35,50);
  7183. DrawString('General:');
  7184. with optconorigin do moveto(h,v);
  7185. move(35,120);
  7186. DrawString('AppleShare Access:');
  7187. end;
  7188. {$S         }
  7189. procedure unload_all;
  7190. {unload seg on most segments}
  7191. var grow,gg:longint;
  7192. begin
  7193. unloadseg(@offer_to_replace_input);{startup}
  7194. unloadseg(@find_vols);{vols}
  7195. unloadseg(@note_application );{appl }
  7196. unloadseg(@setmytype );{myres }
  7197. unloadseg(@checksumHdataOLD);{wascore}
  7198. unloadseg(@detail_resource_check );{detail }
  7199. unloadseg(@dokeypress );{event }
  7200. unloadseg(@absolute_read);{boot }
  7201. unloadseg(@folder_info_two );{files }
  7202. unloadseg(@sortresources );{sortres }
  7203. unloadseg(@write_morechecks );{start2 }
  7204. unloadseg(@sortapplications );{sortappl }
  7205. unloadseg(@applsummary );{applout }
  7206. unloadseg(@add_safekey );{safekey }
  7207. unloadseg(@detail_appl_check );{appldet }
  7208. unloadseg(@start_types );{start3 }
  7209. unloadseg(@write_end_flag);{core}
  7210. postmem(memline);
  7211. end;
  7212. procedure docheck;
  7213. {top level procedure for the section of the program that
  7214. does the work. Note there is no main event loop in the usual sense
  7215. I call DoEvent from all over, mostly when posting progress
  7216. messages on the screen and loop till I get a null event}
  7217.  
  7218. begin
  7219. rcount:=0;
  7220. acount:=0;
  7221. {display the system folder}
  7222. poststatus(blessedpath,pathline);
  7223.  
  7224. {checksum the boot blocks}
  7225. set_default_blessed;
  7226. poststatus('Checking boot blocks',fileline);
  7227. bootblockchecksum:=checksum_boot_blocks;
  7228. clear_to_end(fileline);
  7229.  
  7230. {checksum all resources in the system folder}
  7231. set_default_blessed;
  7232. unload_all;
  7233. enumeratecatalog(blessed);
  7234. unload_all;
  7235.  
  7236. poststatus('Sort Resources',fileline);
  7237. sortresources(rinfo,rcount);
  7238. clear_to_end(fileline);
  7239. {compare over-all checksums}
  7240. if inputopen then
  7241.    begin
  7242.    if bootblockchecksum<>oldbootblockchecksum then
  7243.     begin
  7244.       Wait_for_buttons('The boot blocks appear to have changed',continuebut);
  7245.       open_output_dialog(true,yesbut);
  7246.     end;
  7247.    if checksumchecksum<>oldchecksumchecksum then
  7248.     begin
  7249.       Wait_for_buttons('The over-all checksum of resources has changed',continuebut);
  7250.       open_output_dialog(true,yesbut);
  7251.     end;
  7252.    end;{if inputopen}
  7253. detail_resource_check;
  7254. unload_all;
  7255. show_detail_changes;   
  7256. poststatus('',resline);
  7257.  
  7258. end;{docheck}
  7259.  
  7260. procedure docheck_applications;
  7261.  
  7262. begin
  7263. set_default_blessed;
  7264. acount:=0;
  7265. clear_to_end(pathline);
  7266.  
  7267. unload_all;
  7268. scan_all_vols;
  7269. unload_all;
  7270.  
  7271. clear_to_end(fileline);
  7272. poststatus('Checksum applications',pathline);
  7273.  
  7274. unload_all;
  7275. checksum_all_appl;
  7276. unload_all;
  7277.  
  7278. clear_to_end(pathline);
  7279. Poststatus('Sort Application info',pathline);
  7280.  
  7281. sortapplications(ainfo,acount);
  7282.  
  7283.  
  7284. if fastapplcheck then
  7285.         poststatus('Compare application sizes',pathline)
  7286. else
  7287.         poststatus('Compare application resource checks',pathline);
  7288. clear_to_end(fileline);
  7289.  
  7290. unload_all;
  7291. detail_appl_check;
  7292. unload_all;
  7293.  
  7294. set_default_blessed;
  7295. clear_to_end(pathline);
  7296.  
  7297. show_appl_detail_changes;
  7298.  
  7299. unload_all;
  7300. checksum_unchecked_appl;
  7301. end;{procedure}
  7302. {$S          }
  7303. begin
  7304.  
  7305. initialize;
  7306. kill_nil;
  7307. setup_buttons;
  7308. setup_optioncon;
  7309. if abmfail then low_memory_halt;
  7310. start_types;
  7311. start_safekey;
  7312. doEvent(true);
  7313.  
  7314. HFSwarning;{quit if no HFS}
  7315.  
  7316. get_set_blessed;{set default to system folder}
  7317. Poststatus(blessedpath,pathline);
  7318. postmem(memline);
  7319. optionkeyflag:=optionkeyflag or option_key_down;{test option key}
  7320. wait_for_start(
  7321. 'This will take a minute or two to check the system folder and applications.'
  7322. ,startupdelay); 
  7323. in_progress_buttons;
  7324.  
  7325. StartupOptionKeyFlag:=optionKeyFlag;{get state of option key from 
  7326.                                 button click or activate}
  7327.  
  7328. {look for input file}
  7329. open_input;
  7330. {read header to get options}
  7331. read_input_header;
  7332.  
  7333. if StartupOptionKeyFlag then wait_for_options;
  7334.  
  7335. {ask about output file if option key down or input file not found}
  7336. if StartupOptionKeyFlag or InputNotdefault then
  7337.    begin
  7338.    
  7339.    open_output_dialog(true,yesbut);
  7340.    
  7341.    end
  7342.  else
  7343.     begin
  7344.     poststatus(
  7345.     '(start with option key to write output file or select features)'
  7346.     ,pathline);
  7347.     end;
  7348.  
  7349.  
  7350. {pick alternate system file}
  7351. pick_set_blessed;
  7352.  
  7353. unload_all;
  7354. {enumerate connected volumes}
  7355. dovols;
  7356.  
  7357.  
  7358. readoklist;
  7359. {debugger;}
  7360.  
  7361. unload_all;
  7362. docheck;
  7363. unload_all;
  7364.  
  7365. (* if outputopen then skipapplcheck:=false; *)
  7366.  
  7367. if not skipapplcheck then docheck_applications;
  7368. summary;
  7369. if not skipapplcheck then 
  7370.      APPLsummary
  7371. else
  7372.      copyAPPLSummary;
  7373.  
  7374.  
  7375. offer_to_replace_input;     
  7376. PostStatus('DONE',fileline);
  7377. sysbeep(1);
  7378. close_all_and_halt(false);
  7379. end.{Vcheck main}
  7380.