changecn.prg

MSComm控件资料,Visual Basic 6.0(以下简称VB) 是一种功能强大、简单易学的程序设计语言。它不但保留了原先Basic语言的全部功能

*--------------------------------------------------
*-- Example of a call to the Change Class Name program
*-- 
*--   =ChangeCN( "EBIZOBJ", "CTBIZOBJ", "CBIZCT", .F. )
*--   =ChangeCN( < cOldClassName >     , ;
*--              < cNewClassName >     , ;
*--              < cClassLibraryName > , ;
*--              < lSkipCompile >        )
*--
*---------------------------------------------------
LPARAMETERS tcOldClassName     , ;
            tcNewClassName     , ;
            tcClassLibraryName , ;
            tlSkipCompile  

LOCAL lcOldSetProc

lcOldSetProc = SET('PROCEDURE')
SET PROCEDURE TO setup.prg   ADDITIVE
SET PROCEDURE TO utility.prg ADDITIVE

IF PCOUNT() = 0
   =DoForm( 'frmChangeClassName' )
ELSE
   =ChangeClassNames( tcOldClassName     , ;
                      tcNewClassName     , ;
                      tcClassLibraryName , ;
                      tlSkipCompile        )
ENDIF

*------------------------------------------
*-- Reset the environment to the way it was
*------------------------------------------
SET PROCEDURE TO &lcOldSetProc
   


*---------------------------------------------------------------------------------------------
FUNCTION ChangeClassNames( tcOldClassName, tcNewClassName, tcClassLibraryName, tlSkipCompile )
*---------------------------------------------------------------------------------------------

   LOCAL lcOriginalProject , ;
         lcProjectFileAlias , ;
         llRetVal
   
   lcProjectFileAlias = ""
   lcOriginalProject  = ""
   llRetVal = GetAuthorizationToContinue()
   

   *===========================================================================*
   *=====                     Main Program Processing                     =====*
   *===========================================================================*
   IF llRetVal
      CLOSE TABLES
      CLOSE DATABASES ALL

      llRetVal = llRetVal AND ;
                 GetProjectFile( @lcProjectFileAlias )

      llRetVal = llRetVal AND ;
                 GetClassLibraryNamesFromProject( lcProjectFileAlias )
                                                      
      llRetVal = llRetVal AND ;
                 MakeClassNameReplacements( tcOldClassName     , ;
                                            tcNewClassName     , ;
                                            tcClassLibraryName , ;
                                            tlSkipCompile        )
      IF !EMPTY( lcOriginalProject )
	     MODIFY PROJECT ( lcOriginalProject ) NOWAIT SAVE
      ENDIF

   ENDIF

   RETURN llRetVal

ENDFUNC

*===========================================================================*
*=====                 Program Processing Functions                    =====*
*===========================================================================*

*============================================
FUNCTION GetProjectFile( tcProjectFileAlias )
*============================================
   LOCAL llRetVal , ;
         lcProjectFile, ;
         lcOriginalProject
   
   lcProjectFile = GETFILE( "PJX", "Project:" )

   IF .NOT. EMPTY( lcProjectFile ) AND ;
      FILE( lcProjectFile )
      llRetVal = .T.
   ELSE
      llRetVal = .F.
   ENDIF
   
   IF llRetVal
      *---------------------------------------------
      *--{CHANGE - PDH - August 02, 1998 - 16:52:44
   	  *   Save the selected project and open it
   	  *   after we're finished...
   	  *---------------------------------------------
	  lcOriginalProject = lcProjectFile

	  *-----------------------------------------------
	  *...and make sure it's closed before using it...
      *-----------------------------------------------
   	  CLOSE ALL
   	  *--}
   	  
      SELECT 0
      USE( lcProjectFile ) ALIAS project
   ENDIF
   
   IF USED( 'project')
      tcProjectFileAlias = "project"
   ELSE
      llRetVal = .F.
   ENDIF
   
   RETURN llRetVal    

ENDFUNC

*=========================================================
FUNCTION GetClassLibraryNamesFromProject( tcProjectAlias )
*=========================================================
   LOCAL llRetVal
   
   SELECT name FROM ( tcProjectAlias ) ;
    WHERE Type = "V"    ;
     INTO CURSOR crsVCX
     
  IF USED( 'crsVCX') AND RECCOUNT( 'crsVCX' ) > 0
     llRetVal = .T.
  ELSE
     llRetVal = .F.
  ENDIF
  
  IF USED( tcProjectAlias )
     USE IN ( tcProjectAlias )
  ENDIF
  
  RETURN llRetVal     
                
ENDFUNC


*======================================================================================================
FUNCTION MakeClassNameReplacements( tcOldClassName, tcNewClassName, tcClassLibraryName, tlSkipCompile )
*======================================================================================================
   LOCAL lcVCX , ;
         loTextLog , ;
         lcLogEntry , ;
         lcNewClassName , ;
         lcOldClassName , ;
         lcClassLibraryName , ;
         llAtLeastOneReplacementTookPlace , ;
         lcVersion

   SELECT crsVCX
   lcNewClassName     = ALLTRIM( LOWER( tcNewClassName     ) )
   lcOldClassName     = ALLTRIM( LOWER( tcOldClassName     ) )
   lcClassLibraryName = ALLTRIM( LOWER( tcClassLibraryName ) )
   
   SET CLASSLIB TO cTextfileUtilities.VCX ADDITIVE
   
   toLog = CREATEOBJ( 'cTextLog', 'CHANGECN.LOG' )
   toLog.MakeEntry( "Change Class Name Utility" + CHR(13) + ;
                    "Run on " + DTOC( DATE() )  + "  " + TIME() + CHR(13) + ;
                    "*----------" )
   
   *-----------------------------------------------------------
   *-- SCAN through each class library file (.VCX) and search
   *-- that file for class library locations that need updating
   *-----------------------------------------------------------
   SCAN
      lcVCX = UPPER(crsVCX.Name)
      WAIT WINDOW "Processing class library ... " + lcVCX NOWAIT
      
      SELECT 0

      IF USED('classlib')
         USE IN classlib
      ENDIF
      
      *----------------------------------------------------------------
      *-- Open the class library file as if it were a reg'ler ol' table
      *-- but only if it exists.
      *----------------------------------------------------------------
      IF .NOT. ( UPPER( "cTextfileUtilities" ) $ UPPER( lcVCX ) ) AND FILE( lcVCX) 
         USE ( lcVCX ) ALIAS classlib
      ELSE
         LOOP
      ENDIF     
      
      IF USED('classlib')
      
         llAtLeastOneReplacementTookPlace = .F.
         *------------------------------------------------------------------
         *-- Find all classes that use the currently specified class library
         *------------------------------------------------------------------
         SCAN FOR lcOldClassName    == ALLTRIM( LOWER( classlib.class    ) ) AND ;
                  lcClassLibraryName $ ALLTRIM( LOWER( classlib.classloc ) )

           *------------------------------------------------------- 
           *-- Update the class library with the new class location
           *------------------------------------------------------- 
           REPLACE classlib.class WITH lcNewClassName

           *--------------------------------------------
           *-- Ensure the class library is recompiled if
           *-- a library file transformation took place
           *--------------------------------------------
           llAtLeastOneReplacementTookPlace = .T.

           *------------------------------------------
           *-- Log the changes made to the application
           *------------------------------------------
           lcLogEntry = PADR( " CLASSLIB: " + LEFT(lcvcx,LEN( ALLTRIM(lcVCX))-1) , 60 ) + ;
                        PADR( " CLASS NAME: " + ALLTRIM( classlib.objname )      , 50 ) + ;
                        PADR( " OLD CN: " + lcOldClassName                       , 30 ) + ;
                        PADR( " NEW CN: " + lcNewClassName                       , 30 )

           toLog.MakeEntry( lcLogEntry )

         ENDSCAN

         IF USED('classlib')
            USE IN classlib
         ENDIF

         *-------------------------------------------------------------
         *-- If any replacements of include files took place, recompile
         *-- the .VCX and it should be ready to go.
         *-------------------------------------------------------------
         IF .NOT. tlSkipCompile AND ;
            llAtLeastOneReplacementTookPlace

            lcVersion = VERSION()

            DO CASE
            CASE "03.00" $ lcVersion
               COMPILE FORM (lcVCX)
            CASE "05.00" $ lcVersion
               COMPILE CLASSLIB (lcVCX)
            OTHERWISE
               *---------------------------------------
               *-- Assume VFP 6 or higher is being used
               *---------------------------------------
               COMPILE CLASSLIB (lcVCX)
            ENDCASE            

         ENDIF
      ELSE &&- Used( 'ClassLib' )
         LOOP
      ENDIF
         
      SELECT crsVCX
      
   ENDSCAN
   
   
   IF USED( 'crsVCX' )
      USE IN crsVCX
   ENDIF
   
   WAIT WINDOW "The Change Class Name utility has completed processing !!!" TIMEOUT 2
   
   WAIT CLEAR
   
ENDFUNC

*------------------------------------
FUNCTION GetAuthorizationToContinue()
*------------------------------------
   LOCAL lnAnswer
   
   lnAnswer = MESSAGEBOX( "HAVE YOU BACKED UP YOUR ENTIRE PROJECT DIRECTORY?", ;
                          16 + 4, "Change Class Library Name Utility Warning" )

   IF lnAnswer <> 6
      =MESSAGEBOX( "Processing cancelled ... very wise move ... please backup your project before running any utility of this nature.", ;
                    64, "Change Class Name Utility Message" )
      RETURN .F.
   ELSE
      RETURN .T.
   ENDIF

ENDFUNC