PROGRAM DB_2_File_References;
{-- ***************************************************************************
 -- ** Descr. : Formsmodules can subclass objects in other Modules from either
 -- **          Database or Filesystem. There is no way to change the subclass
 -- **          information inside FormsBuilder, but the API makes such a thing
 -- **          possible! This script lets you change any references to whichever
 -- **          storage type you prefer.
 -- **
 -- **          See also Oracle Metalink notes 133511.1 and 111812.1
 -- **
 -- **          WARNING! - make sure you have the FormsBuilder Helptables installed
 -- **                     if you switch to DB, or FormsBuilder won't allow you
 -- **                     to access the changed modules anymore and crash
 -- **                     with Dr. Watson!!!  ... Also make sure you have all
 -- **                     referenced modules available in FORMS60_PATH or in
 -- **                     database.
 -- **
 -- ** MINVERS:
 -- **
 -- ***************************************************************************
 -- ** 15/01/02 1.001.00 Initial Creation, muellers@orcl-toolbox.com
 -- ***************************************************************************}


{*Global Variable Declaration*}
VAR
  v_filename       : varchar2;
  i,j              : number;
  frm              : number;
  obj              : number;
  files            : TStringList;
  ol               : TStringList;
  ps               : TParamScreen;
  pb               : TParamBoard;
  par_storagetype  : number;
  reftype          : number;
  refname          : varchar2;

{*Main Program Block*}
BEGIN
    //build together a nice parameter screen ...
    ps := TParamScreen.create;
    pb := ps.AddBoard('Modules',picModules);
    pb.addparam(parLabel,'MYLABEL','This script changes the location of subclassed objects from DB to FileSystem and vice versa.','','');
    pb.addparam(parFiles,'FILES','Source Files','','Forms Modules (*.fmb)|*.fmb|All Files (*.*)|*.*');
    pb.addparam(parPathname,'TRGPATH','Target Path','','');
    pb.addparam(parRadiogroup,'STORAGE','Target Refs','Filesystem','Database'+c_cr+ 'Filesystem');
    pb.addparam(parDatabaseLogon,'MYDATABASE','DB Connection','scott/tiger','');

    //show the parameter screen and wait for inputs
    if ps.ShowParamScreen('DB to Filesystem References ...') then
    begin

      //get all the selected files into a list
      files := tstringlist.create;
      files.text := ps.paramvalue('FILES');

      //check that the target directory is not empty!
      if ps.paramvalue('TRGPATH') = '' then
        RaiseException('Target Path must be filled in!');

      //initalize the use default font scale variable for later use
      if ps.paramvalue('STORAGE') = 'Database'
        then par_storagetype := D2FC_PAMO_DATABASE
        else par_storagetype := D2FC_PAMO_FILESYSTEM ;

      //logon to the database
      api_Connect(ps.ParamValue('MYDATABASE'));

      //loop through the list of selected files
      for j := 0 to files.count-1 do
      begin
        v_filename := files.strings[j];
        logadd('Checking '+to_char(j+1)+'/'+to_char(files.count)+' '+v_filename);
        try
          // load the forms module
          frm := API_LoadModule(files.strings[j]);

          //get a list of all objects in this formsmodule
          ol := API_GetAllObjects(frm);

          //and loop through the whole list
          for i := 0 to ol.count-1 do
          begin
            //read out the object from the list
            obj := ol.objects[i];

            if generic_IsSubclassed(obj) then
            begin
              //get the current storage type (file or db)
              reftype := generic_getvalue(obj,D2FP_PAR_MODSTR);

              //is it unequal the one we want to set ?!
              if reftype <> par_storagetype then
              begin
                 //get the referenced module name
                 refname := generic_getvalue(obj,D2FP_PAR_MODULE);

                 //delete eventually .fmb extension
                 refname := ChangeFileExt(refname,'');

                 //set the new storage type
                 generic_setvalue(obj,d2fp_par_modstr,par_storagetype);

                 //set the new modulename
                 generic_setvalue(obj,d2fp_par_flnam,refname);

                 //log the change
                 logadd('  => '+API_GetObjectPath(obj) );

              end;
            end;
          end;

          //remove the list of object from memory
          ol.free;

          //now modify the filename to point to the new location
          v_filename := ps.ParamValue('TRGPATH') + '\' + ExtractFileName(v_filename);

          //and save it to the new location
          API_SaveModule(frm,v_filename);

          //... and finally 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;

      //free the file list from memory;
      files.free;
    end else
    begin
      //user must have pressed cancel on parameterscreen
      logadd('Canceled on parameterscreen!');
    end;
    // free the parameter screen
    ps.free;

END.