home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / numega / sc501.exe / data1.cab / Examples / DLPHIERR.DPR < prev    next >
Encoding:
Text File  |  1997-11-25  |  27.6 KB  |  747 lines
  1. (*
  2.  * DlphiErr.dpr
  3.  * $Header: /BoundsChecker/Examples/BUGBNCHX/DLPHIERR/DLPHIERR.DPR 7     4/03/97 11:41a Bob $
  4.  *
  5.  * Description:
  6.  *  Defines the interface to the DlphiErr bug module.
  7.  *
  8.  * Notes:
  9.  *  <implementation notes go here>
  10.  *
  11.  ***********************************************************************
  12.  *
  13.  * Nu-Mega Technologies, Inc.
  14.  * P.O. Box 7780
  15.  * Nashua, NH 03060
  16.  *
  17.  * (c) Copyright 1994, 1995 Nu-Mega Technologies, Inc.
  18.  * ALL RIGHTS RESERVED.
  19.  *
  20.  ***********************************************************************
  21.  *
  22.  **********************************************************************)
  23.  
  24. library DlphiErr;
  25.  
  26. uses CommCtrl, Sysutils, Windows;
  27. {$R dlphierr.res}
  28. {$I memory.pas}
  29. {$I apierr.pas}
  30. {$I dlphirsr.pas}
  31. {$I bcerrtyp.pas}
  32.  
  33. (***********************************************************************)
  34. (* DlphiErr Constants                                                  *)
  35. const
  36.    constMaxLParam                = 1024 ;  (* Max number of nodes in the tree           *)
  37.    constNumRootObjects           = 3    ;  (* Max number of root nodes in the tree      *)
  38.    constMaxErrsPerCategory       = 11   ;  (* Max number of errors per category         *)
  39.    constMaxNumErrorFuncs         = 15   ;  (* Max number of leaf nodes in the tree      *)
  40.    constMaxErrsPerType           = 3    ;  (* Max number of errors per root middle node *)
  41.    constNumRandomFuncs           = 5    ;  (* Number of error funcs to call on DoRandom *)
  42.  
  43.    szModName = 'DlphiErr.bug'           ;  (* The name of this module *)
  44.  
  45.    (* The root objects that will be placed in the tree control that define the error
  46.       categories. *)
  47.     g_RootObjects : array[0..constNumRootObjects] of ErrorCategory =
  48.     (
  49.         (
  50.             uiCategory    : IDS_APIANDOLECHECK         ;
  51.             uiDescription : IDS_APIANDOLECHECKDESC
  52.         ) ,
  53.         (
  54.             uiCategory    : IDS_MEMORYCHECK        ;
  55.             uiDescription : IDS_MEMORYCHECKDESC
  56.         ) ,
  57.         (
  58.             uiCategory    : IDS_POINTERANDLEAKCHECK       ;
  59.             uiDescription : IDS_POINTERANDLEAKCHECKDESC
  60.         ) ,
  61.         (
  62.             uiCategory    : 0                      ;
  63.             uiDescription : 0
  64.         )
  65.     ) ;
  66.  
  67.     (* The middle nodes of the tree that describe the type of error *)
  68.     g_ArrayOfTypes : array[0..constNumRootObjects, 0..constMaxErrsPerCategory] of ErrorType =
  69.     (
  70.       (*API and OLE Check Types*)
  71.       (
  72.         ( (* 1 1 *)
  73.            uiError       : IDS_APIFAILWINFUNCFAIL;
  74.            bPersonalDoes : True
  75.         ),
  76.         ( (* 1 2 *)
  77.            uiError       : IDS_INVALIDARGGENERAL;
  78.            bPersonalDoes : True
  79.         ),
  80.         ( (* 1 3 *)
  81.            uiError       : IDS_INVALIDARGBADDESTPTR;
  82.            bPersonalDoes : True
  83.         ),
  84.         ( (* 1 4 *)
  85.            uiError       : IDS_INVALIDARGBADHANDLE;
  86.            bPersonalDoes : True
  87.         ),
  88.         ( (* 1 5 *)
  89.            uiError       : IDS_INVALIDARGBADSRCPTR;
  90.            bPersonalDoes : True
  91.         ),
  92.         ( (* 1 6 *)
  93.            uiError       : IDS_INVALIDARGSTRUCTURE ;
  94.            bPersonalDoes : True
  95.         ),
  96.         ( (* 1 7 *)
  97.            uiError       : IDS_INVALIDARGOUTORANGE;
  98.            bPersonalDoes : True
  99.         ),
  100.         ( (* 1 8 *)
  101.            uiError       : IDS_INVALIDARGCONFLICT;
  102.            bPersonalDoes : True
  103.         ),
  104.         ( (* 1 9 *)
  105.            uiError       : IDS_INVALIDARGUNDEFINED;
  106.            bPersonalDoes : True
  107.         ),
  108.         (  uiError       : 0 ;  bPersonalDoes : False ),
  109.         (  uiError       : 0 ;  bPersonalDoes : False ),
  110.         (  uiError       : 0 ;  bPersonalDoes : False )
  111.       ),
  112.       (* Memory Check Types *)
  113.       (
  114.         ( (* 2 1 *)
  115.             uiError       : IDS_DYNMEMOVERRUN;
  116.             bPersonalDoes : True
  117.         ),
  118.         ( (* 2 2 *)
  119.            uiError       : IDS_INVALIDARGFREEDHANDLELOCK;
  120.            bPersonalDoes : True
  121.         ),
  122.         ( (* 2 3 *)
  123.            uiError       : IDS_INVALIDARGHANDLEUNLOCKED;
  124.            bPersonalDoes : True
  125.         ),
  126.         ( (* 2 4 *)
  127.             uiError       : IDS_STACKMEMOVERRUN;
  128.             bPersonalDoes : True
  129.         ),
  130.         ( (* 2 5 *)
  131.             uiError       : IDS_PTRREFSUNLOCKEDBLOCK;
  132.             bPersonalDoes : True
  133.         ),
  134.         (  uiError       : 0 ;  bPersonalDoes : False ),
  135.         (  uiError       : 0 ;  bPersonalDoes : False ),
  136.         (  uiError       : 0 ;  bPersonalDoes : False ),
  137.         (  uiError       : 0 ;  bPersonalDoes : False ),
  138.         (  uiError       : 0 ;  bPersonalDoes : False ),
  139.         (  uiError       : 0 ;  bPersonalDoes : False ),
  140.         (  uiError       : 0 ;  bPersonalDoes : False )
  141.       ),
  142.       (* Leak and Pointer Check Types *)
  143.       (
  144.         ( (* 3 1 *)
  145.             uiError       : IDS_MEMLEAK;
  146.             bPersonalDoes : True
  147.         ),
  148.         ( (* 3 2 *)
  149.             uiError       : IDS_RESOURCELEAK;
  150.             bPersonalDoes : True
  151.         ),
  152.         (  uiError       : 0 ;  bPersonalDoes : False ),
  153.         (  uiError       : 0 ;  bPersonalDoes : False ),
  154.         (  uiError       : 0 ;  bPersonalDoes : False ),
  155.         (  uiError       : 0 ;  bPersonalDoes : False ),
  156.         (  uiError       : 0 ;  bPersonalDoes : False ),
  157.         (  uiError       : 0 ;  bPersonalDoes : False ),
  158.         (  uiError       : 0 ;  bPersonalDoes : False ),
  159.         (  uiError       : 0 ;  bPersonalDoes : False ),
  160.         (  uiError       : 0 ;  bPersonalDoes : False ),
  161.         (  uiError       : 0 ;  bPersonalDoes : False )
  162.       ),
  163.       (* Sentinel *)
  164.       (
  165.         (  uiError       : 0 ;  bPersonalDoes : False ),
  166.         (  uiError       : 0 ;  bPersonalDoes : False ),
  167.         (  uiError       : 0 ;  bPersonalDoes : False ),
  168.         (  uiError       : 0 ;  bPersonalDoes : False ),
  169.         (  uiError       : 0 ;  bPersonalDoes : False ),
  170.         (  uiError       : 0 ;  bPersonalDoes : False ),
  171.         (  uiError       : 0 ;  bPersonalDoes : False ),
  172.         (  uiError       : 0 ;  bPersonalDoes : False ),
  173.         (  uiError       : 0 ;  bPersonalDoes : False ),
  174.         (  uiError       : 0 ;  bPersonalDoes : False ),
  175.         (  uiError       : 0 ;  bPersonalDoes : False ),
  176.         (  uiError       : 0 ;  bPersonalDoes : False )
  177.       )
  178.     );
  179.  
  180.   g_aOccurArray : array [0..constMaxNumErrorFuncs, 0..constMaxErrsPerType] of ErrorOccurance =
  181.   (
  182.     (* APICheck - API failure: Windows function failed *)
  183.     ( (* 1 1 *)
  184.         (
  185.             uiInstance    : IDS_APIFAILLOADBITMAPINST     ;
  186.             uiDescription : IDS_APIFAILLOADBITMAPDESC     ;
  187.             pFunc         : LoadBitmapFail
  188.         ),
  189.         (
  190.             uiInstance    : IDS_APIFAILLOADMENUINST     ;
  191.             uiDescription : IDS_APIFAILLOADMENUDESC     ;
  192.             pFunc         : LoadMenu_Fail
  193.         ),
  194.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  195.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  196.     ),
  197.     (* APICheck - Invalid argument *)
  198.     ( (* 1 2 *)
  199.         (
  200.             uiInstance    : IDS_APIINVALIDARGGETTEXTCOLORINST   ;
  201.             uiDescription : IDS_APIINVALIDARGGETTEXTCOLORDESC   ;
  202.             pFunc         : GetTextColor_Bad_Param
  203.         ),
  204.         (
  205.             uiInstance    : IDS_APIINVALIDARGDELETEMENUINST   ;
  206.             uiDescription : IDS_APIINVALIDARGDELETEMENUDESC   ;
  207.             pFunc         : DeleteMenu_Bad_Param
  208.         ),
  209.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  210.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  211.     ),
  212.     (* APICheck - Invalid argument: Bad destination pointer *)
  213.     ( (* 1 3 *)
  214.         (
  215.             uiInstance    : IDS_APISTRCOPYBADDESTPTRINST  ;
  216.             uiDescription : IDS_APISTRCOPYBADDESTPTRDESC   ;
  217.             pFunc         : BadDestPtr
  218.         ),
  219.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  220.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  221.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  222.     ),
  223.     (* APICheck - Invalid argument: Bad handle *)
  224.     ( (* 1 4 *)
  225.         (
  226.             uiInstance    : IDS_APIFREEMEMBADHANDLEINST  ;
  227.             uiDescription : IDS_APIFREEMEMBADHANDLEDESC   ;
  228.             pFunc         : BadFreeMem
  229.         ),
  230.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  231.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  232.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  233.     ),
  234.     (* APICheck - Invalid argument: Bad source pointer *)
  235.     ( (* 1 5 *)
  236.         (
  237.             uiInstance    : IDS_APISTRCOPYBADSRCPTRINST  ;
  238.             uiDescription : IDS_APISTRCOPYBADSRCPTRDESC   ;
  239.             pFunc         : BadSourcePointer
  240.         ),
  241.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  242.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  243.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  244.     ),
  245.     (* APICheck - Invalid argument: Structure size field is not initialized *)
  246.     ( (* 1 6 *)
  247.         (
  248.             uiInstance    : IDS_APIGETVERSIONSTRUCTSIZEINST  ;
  249.             uiDescription : IDS_APIGETVERSIONSTRUCTSIZEDESC   ;
  250.             pFunc         : UninitSizeField
  251.         ),
  252.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  253.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  254.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  255.     ),
  256.     (* APICheck - Invalid argument: Out of range *)
  257.     ( (* 1 7 *)
  258.         (
  259.             uiInstance    : IDS_APIOUTOFRANGEINST  ;
  260.             uiDescription : IDS_APIOUTOFRANGEDESC   ;
  261.             pFunc         : OutOfRange_GetKeyState
  262.         ),
  263.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  264.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  265.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  266.     ),
  267.     (* APICheck - Invalid argument: Conflicting combination of flags *)
  268.     ( (* 1 8 *)
  269.         (
  270.             uiInstance    : IDS_APICONFLICTFLAGSGETSTRINGTYPEINST  ;
  271.             uiDescription : IDS_APICONFLICTFLAGSGETSTRINGTYPEDESC   ;
  272.             pFunc         : ConflictingFlags_GetStringType
  273.         ),
  274.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  275.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  276.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  277.     ),
  278.     (* APICheck - Invalid argument: Undefined or illegal flags *)
  279.     ( (* 1 9 *)
  280.         (
  281.             uiInstance    : IDS_APIILLEGALFLAGSAPPENDMENUINST  ;
  282.             uiDescription : IDS_APIILLEGALFLAGSAPPENDMENUDESC   ;
  283.             pFunc         : IllegalFlags_AppendMenu
  284.         ),
  285.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  286.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  287.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  288.     ),
  289.     (* Memory Check - Dynamic memory overrun *)
  290.     ( (* 2 1 *)
  291.         (
  292.             uiInstance    : IDS_WRITEDYNOVERRUNINST   ;
  293.             uiDescription : IDS_WRITEDYNOVERRUNDESC   ;
  294.             pFunc         : DynamicOverrun
  295.         ),
  296.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  297.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  298.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  299.     ),
  300.     (* Memory Check - Freed handle is still locked *)
  301.     ( (* 2 2 *)
  302.         (
  303.             uiInstance    : IDS_APIGLOBALFREELOCKINST   ;
  304.             uiDescription : IDS_APIGLOBALFREELOCKDESC   ;
  305.             pFunc         : HandleLocked
  306.         ),
  307.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  308.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  309.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  310.     ),
  311.     (* Memory Check - Handle is already unlocked *)
  312.     ( (* 2 3 *)
  313.         (
  314.             uiInstance    : IDS_APIGLOBALFREEUNLOCKINST   ;
  315.             uiDescription : IDS_APIGLOBALFREEUNLOCKDESC   ;
  316.             pFunc         : HandleUnlocked
  317.         ),
  318.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  319.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  320.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  321.     ),
  322.     (* Memory Check - Stack memory overrun *)
  323.     ( (* 2 4 *)
  324.         (
  325.            uiInstance    : IDS_WRITESTACKOVERRUNSTRCOPYINST   ;
  326.            uiDescription : IDS_WRITESTACKOVERRUNSTRCOPYDESC   ;
  327.            pFunc         : StackOverrun
  328.         ),
  329.         (
  330.            uiInstance    : IDS_WRITESTACKOVERRUNFILLCHARINST   ;
  331.            uiDescription : IDS_WRITESTACKOVERRUNFILLCHARDESC   ;
  332.            pFunc         : StackOverrun_FillChar
  333.         ),
  334.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  335.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  336.     ),
  337.     (* Memory Check - Pointer references unlocked memory block *)
  338.     ( (* 2 5 *)
  339.         (
  340.             uiInstance    : IDS_PTRREFUNLOCKINST   ;
  341.             uiDescription : IDS_PTRREFUNLOCKDESC   ;
  342.             pFunc         : Ptr_Refs_Unlocked_Block
  343.         ),
  344.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  345.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  346.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  347.     ),
  348.     (* LeakCheck - Memory Leak (Allocate but do not free) *)
  349.     ( (* 3 1 *)
  350.         (
  351.             uiInstance    : IDS_MEMALLOCMEMINST  ;
  352.             uiDescription : IDS_MEMALLOCMEMDESC   ;
  353.             pFunc         : AllocMem_Leak
  354.         ),
  355.         (
  356.             uiInstance    : IDS_MEMSTRALLOCINST ;
  357.             uiDescription : IDS_MEMSTRALLOCDESC ;
  358.             pFunc         : StrAlloc_Leak
  359.         ),
  360.         (
  361.             uiInstance    : IDS_MEMSTRNEWINST ;
  362.             uiDescription : IDS_MEMSTRNEWDESC ;
  363.             pFunc         : MemoryLeak_StrNew
  364.          ),
  365.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  366.     ),
  367.     (* LeakCheck - Resource Leak *)
  368.     ( (* 3 2 *)
  369.         (
  370.             uiInstance    : IDS_RESBITMAPINST  ;
  371.             uiDescription : IDS_RESBITMAPDESC   ;
  372.             pFunc         : BitmapLeak
  373.         ),
  374.         (
  375.            uiInstance    : IDS_RESMENUINST  ;
  376.            uiDescription : IDS_RESMENUDESC   ;
  377.            pFunc         : MenuLeak
  378.         ),
  379.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  ),
  380.         (   uiInstance    : 0; uiDescription : 0;  pFunc : NIL  )
  381.     )
  382.   );
  383.  
  384.  
  385.  
  386. (***********************************************************************)
  387. (* DlphiErr Variables                                                  *)
  388. var
  389.    SaveExit      : Pointer ; (* Required for DLLs                      *)
  390.    g_nLParam     : Integer ; (* The current number of LParamInfo
  391.                                 objects in the array, g_lParamArray    *)
  392.  
  393.    (* The array of LParamInfo objects that will need to be disposed of
  394.       before this DLL is unloaded.                                     *)
  395.    g_lParamArray : array [ 0..constMaxLParam ] of PLParamInfo ;
  396.  
  397.  
  398.  
  399.  
  400.  
  401. (***********************************************************************)
  402. (* GetChildWithName checks the tree control for an item with the name,
  403.    szName under the item hParent.  If it is there, it returns the child
  404.    item.  Otherwise, it returns NIL.                                   *)
  405. function GetChildWithName ( hwnd : HWND; hParent : HTreeItem; szName : PChar ) : HTreeItem ;
  406. var
  407.    hChild      : HTreeItem ;  (* The current child item       *)
  408.    hReturn     : HTreeItem ;  (* The item to be returned      *)
  409.    tviChild    : TTVItem   ;  (* Info about the current child *)
  410.    bFoundIt    : Boolean   ;  (* True if the child is found   *)
  411.  
  412.    (* Name of the current child *)
  413.    szChildText : array [ 0..1023 ] of Char ;
  414. begin
  415.    (* Initialize return value *)
  416.    hReturn := NIL;
  417.  
  418.    (* Loop through the children of hParent.  If a match on
  419.       szName is found, break out of the loop and return
  420.       the child *)
  421.    hChild := TreeView_GetChild ( hWnd , hParent ) ;
  422.    while ( NIL <> hChild ) do
  423.    begin
  424.  
  425.       (* Initialize the info record to just get the text
  426.          associated with the current child item. *)
  427.       tviChild.mask       := TVIF_TEXT or TVIF_HANDLE ;
  428.       tviChild.hItem      := hChild ;
  429.       tviChild.pszText    := @(szChildText[0]) ;
  430.       tviChild.cchTextMax := 1024 ;
  431.  
  432.       (* Get the child item and compare its text to szName. *)
  433.       if ( TreeView_GetItem ( hWnd , tviChild ) ) then
  434.       begin
  435.          if ( 0 = StrComp ( szName , tviChild.pszText ) ) then
  436.          begin
  437.             hReturn := hChild  ;
  438.             Break ;
  439.          end;
  440.       end;
  441.  
  442.       hChild := TreeView_GetNextItem ( hWnd , hChild , TVGN_NEXT ) ;
  443.    end; (* while *)
  444.  
  445.    GetChildWithName := hReturn ;
  446. end; (* Function GetChildWithName *)
  447.  
  448. (***********************************************************************)
  449. (* DlphiErr procedures to support the BugModule DLL interface          *)
  450.  
  451. (* PopulateTree is the only required procedure for the BugModule
  452.    DLL interface.  Given an HWND of a tree control, populate the
  453.    tree with named nodes that do not already exist.  The tree
  454.    must have the ErrorCategories at the roots, ErrorTypes as
  455.    children of ErrorCategories and ErrorOccurances as leaf nodes.
  456.    If any named node exists, don't add it twice. *)
  457. procedure PopulateTree ( hwndTree: HWND ); cdecl;export;
  458. var
  459.    stTVIS          : TTVInsertStruct ; (* General purpose insert structure *)
  460.    hItemLevel1     : HTreeItem       ; (* Current category item            *)
  461.    hItem           : HTreeItem       ; (* Current type or occurence item   *)
  462.    pstEC           : ^ErrorCategory  ; (* Current category record          *)
  463.    i_pstEC         : Integer         ; (* Current category index           *)
  464.    pstET           : ^ErrorType      ; (* Current error type record        *)
  465.    i_pstET         : Integer         ; (* Current error type index         *)
  466.    pstEO           : ^ErrorOccurance ; (* Current error occurence record   *)
  467.    i_pstEO         : Integer         ; (* Current error occurence index    *)
  468.    iCurrTypes      : Integer         ; (* Index to the type array          *)
  469.    iCurrErrorOccur : Integer         ; (* Index to the occurence array     *)
  470.    bLoadedStrings  : Boolean         ; (* True if all resources loaded     *)
  471.    pLPI            : PLParamInfo     ; (* Current LParamInfo record        *)
  472.  
  473.    (* Contains current string loaded from resource table *)
  474.    szBuff : array[0..1024] of Char ;
  475. begin
  476.  
  477.    (* Initialize global array indices *)
  478.    iCurrTypes      := 0 ;
  479.    iCurrErrorOccur := 0 ;
  480.    g_nLParam       := 0 ;
  481.  
  482.    (* Initialize procedural flags *)
  483.    bLoadedStrings := True;
  484.  
  485.    (* Initialize the insert structure to always insert at the end of the
  486.       tree control and only use the text and LPARAM fields. *)
  487.    stTVIS.hParent := NIL ;
  488.    stTVIS.hInsertAfter := TVI_SORT ;
  489.    stTVIS.item.mask := TVIF_TEXT or TVIF_PARAM ;
  490.  
  491.    (* Start with the root objects array. *)
  492.    i_pstEC := 0 ;
  493.    pstEC := @(g_RootObjects[i_pstEC]) ;
  494.  
  495.    (* Loop through the categories, inserting our own root objects only
  496.       if they are not already present (detected with GetChildWithName. *)
  497.    while ( 0 <> pstEC^.uiCategory ) do
  498.    begin
  499.       (* When filling root objects, always force the parent to NIL. *)
  500.       stTVIS.hParent := NIL ;
  501.  
  502.       (* The root object category string is used as the text so
  503.          load it. *)
  504.       if ( 0 = LoadString ( GetModuleHandle ( szModName ) ,
  505.                             pstEC^.uiCategory             ,
  506.                             szBuff                        ,
  507.                             1024                            ) ) then
  508.       begin
  509.          bLoadedStrings := False ;
  510.      Break ;
  511.       end ;
  512.  
  513.       (* Set the text for the item. *)
  514.       stTVIS.item.pszText := szBuff ;
  515.       (* Allocate the structure that we store in the lParam field and
  516.          save it in the global LParamInfo array for later disposal. *)
  517.       New(pLPI) ;
  518.       g_lParamArray[ g_nLParam ] := pLPI ;
  519.       g_nLParam := g_nLParam + 1 ;
  520.  
  521.       (* This is a root object. *)
  522.       pLPI^.iType := 0 ;
  523.       pLPI^.hModule := GetModuleHandle ( szModName ) ;
  524.  
  525.       (* Set the union to the current value. *)
  526.       pLPI^.stEC := pstEC^ ;
  527.       (* Set the lParam and insert it saving off the HTREEITEM. *)
  528.       stTVIS.item.lParam  := LPARAM(pLPI) ;
  529.  
  530.       hItemLevel1 := GetChildWithName ( hwndTree , stTVIS.hParent , szBuff ) ;
  531.  
  532.       if ( NIL = hItemLevel1 ) then
  533.       begin
  534.          hItemLevel1 := TreeView_InsertItem ( hwndTree , stTVIS ) ;
  535.       end;
  536.  
  537.       (* Now fill in the error types for this root object.
  538.          Get the current part of the two dimensional types array and
  539.          loop until we hit the NIL value. *)
  540.       i_pstET := 0 ;
  541.       pstET := @ ( g_ArrayOfTypes[ iCurrTypes ][ i_pstET ] ) ;
  542.       while ( 0 <> pstET^.uiError )    do
  543.       begin
  544.            (* The parent for the current type. *)
  545.            stTVIS.hParent := hItemLevel1 ;
  546.            (* The error string serves as the text for the tree so load it
  547.               and set it. *)
  548.            if ( 0 = LoadString (  GetModuleHandle ( szModName ) ,
  549.                                   pstET^.uiError              ,
  550.                                   szBuff                      ,
  551.                                   1024                         ) ) then
  552.            begin
  553.               bLoadedStrings := False ;
  554.         Break ;
  555.          end ;
  556.  
  557.          stTVIS.item.pszText := szBuff ;
  558.          (* Allocate the structure we set in lParam. *)
  559.          New ( pLPI ) ;
  560.          g_lParamArray[ g_nLParam ] := pLPI ;
  561.      g_nLParam := g_nLParam + 1 ;
  562.  
  563.          (* This is a level one item. *)
  564.          pLPI^.iType := 1 ;
  565.          pLPI^.stET := pstET^ ;
  566.          pLPI^.hModule := GetModuleHandle ( szModName ) ;
  567.          (* Set the lParam and insert it into the tree. *)
  568.          stTVIS.item.lParam := LPARAM(pLPI) ;
  569.  
  570.          hItem := GetChildWithName ( hwndTree , stTVIS.hParent , szBuff ) ;
  571.          if ( NIL = hItem ) then
  572.          begin
  573.             hItem := TreeView_InsertItem ( hwndTree , stTVIS ) ;
  574.          end;
  575.  
  576.          (* Fill in the error occurrences (leaves) for this type.
  577.             Get the current portion of the two dimensional occurrence
  578.             array. *)
  579.      i_pstEO := 0;
  580.          pstEO := @ ( g_aOccurArray[ iCurrErrorOccur ][ i_pstEO ] ) ;
  581.          stTVIS.hParent := hItem ;
  582.  
  583.          while ( 0 <> pstEO^.uiInstance ) do
  584.          begin
  585.             (* The instance serves as the text for the tree.  Load it
  586.                and set it. *)
  587.             if ( 0 = LoadString ( GetModuleHandle ( szModName ) ,
  588.                                     pstEO^.uiInstance        ,
  589.                                     szBuff                   ,
  590.                                     1024  ) ) then
  591.            begin
  592.                bLoadedStrings := False ;
  593.            Break ;
  594.             end ;
  595.  
  596.             stTVIS.item.pszText := szBuff ;
  597.             (* Allocate the structure we put in lParam. *)
  598.             New ( pLPI ) ;
  599.             g_lParamArray[ g_nLParam ] := pLPI ;
  600.         g_nLParam := g_nLParam + 1 ;
  601.  
  602.             (* This is a leaf node. *)
  603.             pLPI^.iType := 2 ;
  604.             pLPI^.stEO := pstEO^ ;
  605.             pLPI^.hModule := GetModuleHandle ( szModName ) ;
  606.  
  607.             (* Set the lParam and insert it. *)
  608.             stTVIS.item.lParam := LPARAM(pLPI) ;
  609.  
  610.             if ( GetChildWithName ( hwndTree , stTVIS.hParent , szBuff ) = NIL ) then
  611.             begin
  612.                TreeView_InsertItem ( hwndTree , stTVIS ) ;
  613.             end;
  614.  
  615.             (* Get the next item in the occurrence array. *)
  616.             i_pstEO := i_pstEO + 1 ;
  617.             pstEO := @ ( g_aOccurArray[ iCurrErrorOccur ][ i_pstEO ] ) ;
  618.          end; (* loop on occurances *)
  619.          (* Get the next error type. *)
  620.          i_pstET := i_pstET + 1 ;
  621.          pstET := @ ( g_ArrayOfTypes[ iCurrTypes ][ i_pstET ] ) ;
  622.  
  623.          (* Bump up the occurrence item index. *)
  624.          iCurrErrorOccur := iCurrErrorOccur + 1 ;
  625.          if ( not bLoadedStrings ) then
  626.             Break ;
  627.          end;
  628.  
  629.          (* Bump up the types item index. *)
  630.          iCurrTypes := iCurrTypes + 1 ;
  631.          (* Get the next category. *)
  632.          i_pstEC := i_pstEC + 1 ;
  633.          pstEC := @(g_RootObjects[i_pstEC]) ;
  634.  
  635.      if ( not bLoadedStrings ) then
  636.         Break ;
  637.    end; (* loop on categories *)
  638.  
  639.    if ( bLoadedStrings ) then
  640.       TreeView_SelectItem ( hwndTree , hItemLevel1 );
  641.  
  642. end;    (* Procedure PopulateTree *)
  643.  
  644. (* An optional BugModule DLL interface procedure used to perform
  645.    clean-up on memory allocated for use by the tree control. *)
  646. procedure DePopulateTree ( hwndTree: HWND ); export;
  647. var
  648.   i : Integer ;
  649. begin
  650.    for i := 0 to g_nLParam do
  651.       Dispose ( g_lParamArray[ i ] ) ;
  652. end;
  653.  
  654. (* An optional BugModule DLL interface procedure used to execute
  655.    random bugs. *)
  656. procedure DoRandomErrors ; export ;
  657. var
  658.   iLoop  : Integer ;
  659.   iType  : Integer ;
  660.   iOccur : Integer ;
  661. begin
  662.    (* Reseed each time. *)
  663.    randomize ;
  664.  
  665.    for  iLoop := 0 to ( constNumRandomFuncs -1 )do
  666.    begin
  667.       (* Pick one of the error types to do. *)
  668.       iType := random ( constMaxNumErrorFuncs );
  669.  
  670.       (* Now pick one of the occurrences for this type.
  671.          Since many have just one item, we will check for that occurrence
  672.          as a special case.  If it does have a single item, then we
  673.          will just call it. *)
  674.       if ( not Assigned ( g_aOccurArray[ iType ][ 1 ].pFunc ) ) then
  675.       begin
  676.          (* Double check that the function is not NULL.  If it is, then
  677.             we will not call it. *)
  678.          if ( Assigned ( g_aOccurArray[ iType ][ 0 ].pFunc ) ) then
  679.          begin
  680.             g_aOccurArray[ iType ][ 0 ].pFunc ( ) ;
  681.          end;
  682.       end
  683.       else
  684.       begin
  685.  
  686.          (*We have one of the rare ones that have multiple functions.
  687.            We will loop looking for a random valid one, then call it. *)
  688.          iOccur := random ( constMaxErrsPerType );
  689.  
  690.          while ( not Assigned ( g_aOccurArray[ iType ][ iOccur ].pFunc ) ) do
  691.          begin
  692.            iOccur := random ( constMaxErrsPerType );
  693.          end;
  694.          g_aOccurArray[ iType ][ iOccur ].pFunc ( ) ;
  695.       end; (* if-then-else *)
  696.    end; (* for *)
  697.  
  698. end; (* Procedure DoRandomErrors *)
  699.  
  700. (* An optional BugModule DLL Interface procedure to execute every bug
  701.    supported by this module. *)
  702. procedure DoAllErrors ;
  703. var
  704.    iType  : Integer ;
  705.    iOccur : Integer ;
  706. begin
  707.  
  708.    (* Loop through all items in g_aOccurArray and if there is a function
  709.       to call, call it. *)
  710.    for iType := 0 to constMaxNumErrorFuncs do
  711.    begin
  712.       for iOccur := 0 to constMaxErrsPerType do
  713.       begin
  714.          if ( not Assigned ( g_aOccurArray[ iType ][ iOccur ].pFunc ) ) then
  715.             break ;
  716.          g_aOccurArray[ iType ][ iOccur ].pFunc ( ) ;
  717.       end;
  718.    end;
  719.  
  720. end ; (* Procedure DoAllErrors *)
  721.  
  722.  
  723. (***********************************************************************)
  724. (* DlphiErr DLL Required procedures                                    *)
  725. procedure LibExit;
  726. begin
  727.    ExitProc := SaveExit;
  728. end;
  729.  
  730.  
  731. (***********************************************************************)
  732. (* DlphiErr exports (to support the BugModule DLL interface)           *)
  733. exports
  734.    PopulateTree   index 1, (* Required for all BugModules              *)
  735.    DePopulateTree index 2, (* Optional BugModule entry point           *)
  736.    DoRandomErrors index 3, (* Optional BugModule entry point           *)
  737.    DoAllErrors    index 4; (* Optional BugModule entry point           *)
  738.  
  739.  
  740. (***********************************************************************)
  741. (* DlphiErr main DLL entrypoint                                        *)
  742. begin
  743.    SaveExit := ExitProc;
  744.    ExitProc := @LibExit;
  745. end.
  746.  
  747.