PROGRAM ApplicationStatistic;
{-- ***************************************************************************
 -- ** Descr. : Extracts summaries for all type of objects. This is usefuel if
 -- **          you ever wanted to know for example how many screens (canvases)
 -- **          your application has or how many program units totally are used
 -- **          in your application. This script could also be very easily
 -- **          tweaked little bit to for example assess the complexity of
 -- **          a given formsmodule automatically.
 -- **
 -- ** MINVERS: requires FormsAPI Master 1.0 Build 230 and up and forms6i and up
 -- **          it also run's on lower builds but the doesn't count statistic
 -- **          for modules (this bug has been fixed in built 230!)  
 -- ***************************************************************************
 -- ** 31/12/01 1.001.00 Initial Creation, muellers@orcl-toolbox.com
 -- ** 02/01/02 1.002.00 added olb to file selection on parameterscreen, muellers@orcl-toolbox.com
 -- ***************************************************************************}

CONST
  C_MAXSUBTYPES  = 20;    //maximum number of types an object can have

{*Global Variable Declaration*}
VAR
  v_filename   : varchar2;
  i,j          : number;
  s            : varchar2;
  frm          : number;
  files        : TStringList;
  itemtyp      : number;
  itemsubtyp   : number;
  items        : TStringList;
  ps           : TParamScreen;
  pb           : TParamBoard;
  objcnt_array : array[D2FFO_MIN .. D2FFO_MAX , 0..C_MAXSUBTYPES] of number;


{*Main Program Block*}
BEGIN
    //build together a nice parameter screen ...
    ps := TParamScreen.create;
    pb := ps.AddBoard('Modules',picModules);
    pb.addparam(parFiles,'SRC','Source Files','','Oracle Source Modules (*.fmb;*.mmb;*.pll;*.olb)|*.fmb;*.mmb;*.pll;*.olb|'+
                                                 'Forms Modules (*.fmb)|*.fmb|'+
                                                 'Menu Modules (*.mmb)|*.mmb|'+
                                                 'Object Libraries (*.olb)|*.olb|'+
                                                 'Library Modules (*.pll)|*.pll');
    pb.addparam(parSaveFilename,'MYOUTPUT','Output Filename','c:\appstatistic.txt','Text File (*.txt)|*.txt|All Files (*.*)|*.*');

    //show the parameter screen and wait for inputs
    if ps.ShowParamScreen('Application Statistics ...') then
    begin

      //initalize the counters for all objects and their subtypes
      for i := D2FFO_MIN to D2FFO_MAX do
        for j := 0 to C_MAXSUBTYPES do
          objcnt_array[i,j] := 0;

      //delete the output file
      DeleteFile(ps.paramvalue('MYOUTPUT'));

      //get the selected files from the parameter screen
      files := tstringlist.create;
      files.text := ps.ParamValue('SRC');

      //now loop through the file list
      for j := 0 to files.count-1 do
      begin
        v_filename := files.strings[j];
        logadd('extracting '+to_char(j+1)+'/'+to_char(files.count)+' '+v_filename);
        try
          //load the formsmodule
          frm := API_LoadModule(v_filename);

          //get all objects of the loaded module in a list
          items := API_GetAllObjects(frm);
          //loop trough the list and count all different object types
          for i := 0 to items.count-1 do
          begin
            //get the type (one of the d2ffo constants!) of the object
            itemtyp := generic_querytype(items.objects[i]);
            //only count the object when it's a valid one
            if (itemtyp>=D2FFO_MIN) and (itemtyp<=D2FFO_MAX) then
            begin
              //for some objecttypes we want to seperate it on subtypes ...
              case itemtyp of
                D2FFO_MENU_ITEM : itemsubtyp := D2FP_COM_TYP;
                D2FFO_CANVAS    : itemsubtyp := D2FP_CNV_TYP;
                D2FFO_ALERT     : itemsubtyp := D2FP_ALT_STY;
                D2FFO_BLOCK     : itemsubtyp := D2FP_QRY_DAT_SRC_TYP;
                D2FFO_ITEM      : itemsubtyp := D2FP_ITM_TYP;
                D2FFO_PROG_UNIT : itemsubtyp := D2FP_PGU_TYP;
                D2FFO_LIB_PROG_UNIT : itemsubtyp := D2FP_PGU_TYP;
                D2FFO_REC_GROUP : itemsubtyp := D2FP_REC_GRP_TYP;
                D2FFO_WINDOW    : itemsubtyp := D2FP_WIN_STY;
              else
                itemsubtyp := -1;
              end;
              //increment the count for the object
              inc(objcnt_array[itemtyp,0]);

              //increment the count for the object subtype if any
              if itemsubtyp >-1 then
              begin
                itemsubtyp := generic_getvalue(items.objects[i],itemsubtyp);
                inc(objcnt_array[itemtyp,itemsubtyp+1]);
              end;

            end;
          end;
          //free the list of objects we extracted from memory
          items.free;

          //now release the module from memory
          API_DestroyModule(frm);
        except
          // ups! an error happened, so just log it and proceed to the next module
          logadd(' =>'+GetError,LogError);
        end;
      end;

      //.. and finally report all the objects
      for i := D2FFO_MIN to D2FFO_MAX do
       //ignore some useless objecttypes
       if     (i <> D2FFO_DAT_SRC_ARG)
          and (i <> D2FFO_DAT_SRC_COL)
          and (i <> D2FFO_COORD)
          and (i <> D2FFO_CMPTXT)
          and (i <> D2FFO_FONT)
          and (i <> D2FFO_POINT)
          and (i <> D2FFO_TEXT_SEG)
          and (i <> D2FFO_COLUMN_VALUE)
          and (i <> D2FFO_TRIG_STEP)
          and (i <> D2FFO_ANY) then
       begin
        for j := 0 to C_MAXSUBTYPES do
        begin
          if j = 0 then
          begin
            //report the real object counts
            s := Generic_GetConstName(i);
            if i=D2FFO_LIB_PROG_UNIT then
              s := 'LIBRARY_PROG_UNIT';
            saveappendstring(rpad(s,30)+' : '+to_char(objcnt_array[i,j])+C_CR,ps.paramvalue('MYOUTPUT'));
          end else
          begin
            //report the subtype of some of the object counts
            case i of
              D2FFO_MENU_ITEM : itemsubtyp := D2FP_COM_TYP;
              D2FFO_CANVAS    : itemsubtyp := D2FP_CNV_TYP;
              D2FFO_ALERT     : itemsubtyp := D2FP_ALT_STY;
              D2FFO_BLOCK     : itemsubtyp := D2FP_QRY_DAT_SRC_TYP;
              D2FFO_ITEM      : itemsubtyp := D2FP_ITM_TYP;
              D2FFO_PROG_UNIT : itemsubtyp := D2FP_PGU_TYP;
              D2FFO_LIB_PROG_UNIT : itemsubtyp := D2FP_PGU_TYP;
              D2FFO_REC_GROUP : itemsubtyp := D2FP_REC_GRP_TYP;
              D2FFO_WINDOW    : itemsubtyp := D2FP_WIN_STY;
            else
              itemsubtyp := -1;
            end;

            if (itemsubtyp >-1) then
            begin
              try
                s := '  '+Property_GetValueName(itemsubtyp,j-1);
                saveappendstring(rpad(s,30)+' : '+to_char(objcnt_array[i,j])+C_CR,ps.paramvalue('MYOUTPUT'));
              except
              end;
            end;

          end;
         end;
        end;

        //show the report in notepad
        host('notepad '+ps.paramvalue('MYOUTPUT'),false);

    end else
    begin
      //user must have pressed cancel on parameterscreen
      logadd('Canceled on parameterscreen!');
    end;

    // free the parameter screen
    ps.free;

END.