2004-04-28 21:00

'
' =============================================================================
' QFileAssociation           April 2004                     by Jacques PHILIPPE
'
'             Association of an Executable to a File Extension
'                 with Possibility to restore the Old one
' Component                                                  Version 0.0.1 beta
' =============================================================================
'        *****  WITH NO WARRANTY. USE AT YOUR OWN RISK. I USE IT  *****
' =============================================================================
     CONST SFA_HKEY_CLASSES_ROOT = &H80000000
' ---- SFA ERRORS LIST
     CONST SFA_SET_RESTORABLE_ALL_OK = 1
     CONST SFA_SIMPLE_SET_ALL_OK = 2
     CONST SFA_RESTORE_ALL_OK = 4
     CONST SFA_SHOW_RELATED_VALUE_ALL_OK = 8
'
     CONST SFA_ERROR_INVALID_OPENTYPE_OPEN_SET = 16
     CONST SFA_ERROR_NO_EXTENSION_DESCRIPTOR_DEFINED = 32
     CONST SFA_ERROR_BACK_UP_OLD_ALREADY_EXISTS = 64
     CONST SFA_ERROR_EXTENSION_NOT_YET_DEFINED_CANT_SAVE_OLD_DESCRIPTOR = 128
'
     CONST SFA_ERROR_FILE_ASSOCIATION_BUSY = 256
     CONST SFA_ERROR_EXTENSION_IS_AN_NULLTRING = 512
'
     CONST SFA_ERROR_RESTORE_NEW_AND_OR_OLD_DESCRIPTOR_MISSING_CANT_RESTORE = 1024
     CONST SFA_ERROR_RESTORE_EXTENSION_KEY_DONT_EXIST = 2048
     CONST SFA_ERROR_RESTORE_FA_KEY_MISSING_CANT_RESTORE = 4096
'
     CONST SFA_SHOW_RELATED_VALUE_EXTENSION_DONT_EXIST = 8192
     CONST SFA_ERROR_EXTENSION_MORE_THAN_FOUR_CHARACTERS = 16384
' ---- END OF SFA ERROR LIST
' =============================================================================
     TYPE QFileAssociation EXTENDS QOBJECT
Private:
      Busy AS LONG
      regFA AS QREGISTRY
'        BU_Prefix As String   ' set it 'once for all' : uncomment this line
Public:
      NewDefaultDescriptorValue AS STRING
      DefaultIcon AS STRING
      OpenType AS STRING
      OPEN AS STRING
      BU_Prefix AS STRING    ' set it 'once for all' : comment this line
      CONSTRUCTOR
       Busy = 0
       DefaultIcon = ""
       OpenType = "Open"
       OPEN = ""
       BU_Prefix = "YOUR_MARK"       ' Set here you Registry Back up mark ; IE  "JDOE"
       NewDefaultDescriptorValue = ""
       regFA.RootKey = SFA_HKEY_CLASSES_ROOT
      END CONSTRUCTOR
      WITH QFileAssociation
' -----------------------------------------------------------------------------
Private:
       SUB ResetProperties
        .Busy = 0
        .DefaultIcon = ""
        .OpenType = "Open"
        .OPEN = ""
        .NewDefaultDescriptorValue = ""
        .regFA.RootKey = SFA_HKEY_CLASSES_ROOT
       END SUB
' -----------------------------------------------------------------------------
       FUNCTION RenameKey (sOldName AS STRING, sNewName AS STRING, iDeleteOld AS LONG) AS LONG
        DEFINT iValCount, iKeyCount, iSubKeyCount, iIndex, N, P
        DEFSTR sValueName, sValueData, sKeyRead, sKeyWrite
        IF (.regFA.KeyExists (sOldName) = 0 AND sOldName <> "" AND sNewName <> "") THEN
         Result = 0
         EXIT FUNCTION
        END IF
        DIM slKey_2 AS QSTRINGLIST
        slKey_2.Clear
        .regFA.CreateKey (sNewName)
        .regFA.OpenKey (sOldName, 0)
        iValCount = .regFA.ValueItemCount - 1
        iKeyCount = .regFA.KeyItemCount - 1
        .regFA.CloseKey
'       VALUES
        FOR N = 0 TO iValCount
         .regFA.OpenKey (sOldName, 0)
         sValueName = .regFA.ValueItem(N)
         sValueData = .regFA.ReadString (sValueName)
         .regFA.CloseKey
         .regFA.OpenKey (sNewName, 0)
         IF sValueData <> "" THEN .regFA.WriteString (sValueName, sValueData)
         .regFA.CloseKey
        NEXT N
'       READ SUB KEYS AND SAVE THEM IN slKey_2
        FOR N = 0 TO iKeyCount
         .regFA.OpenKey (sOldName, 0)
         slKey_2.AddItems (sOldName & "\\" & .regFA.KeyItem(N))
         .regFA.CloseKey
        NEXT N
'
        iIndex = 0
        WHILE iIndex < slKey_2.ItemCount
         sKeyRead = slKey_2.Item(iIndex)
         .regFA.OpenKey(sKeyRead, 0)
         iSubKeyCount = .regFA.KeyItemCount - 1
         FOR P = 0 TO iSubKeyCount
          slKey_2.InsertItem (iIndex + P + 1, sKeyRead & "\\" & .regFA.KeyItem(P))
         NEXT P
         iValCount = .regFA.ValueItemCount - 1
         .regFA.closeKey
'
         sKeyWrite = sNewName & MID$(sKeyRead, INSTR(sKeyRead, "\\"))
         .regFA.CreateKey (sKeyWrite)
         FOR N = 0 TO iValCount
          .regFA.OpenKey (sKeyRead, 0)
          sValueName = .regFA.ValueItem(N)
          sValueData = .regFA.ReadString (sValueName)
          .regFA.CloseKey
          .regFA.OpenKey (sKeyWrite, 0)
          IF sValueData <> "" THEN .regFA.WriteString (sValueName, sValueData)
          .regFA.CloseKey
         NEXT N
         INC iIndex
        WEND
        IF iDeleteOld = 1 THEN .regFA.DeleteKey (sOldName)
        Result = 1
       END FUNCTION
' -----------------------------------------------------------------------------
Public:
       FUNCTION SetFileAssociation (sFileExtension AS STRING, sCommand AS STRING) AS LONG
        DEFSTR sDescriptor, sFileExt
        IF .Busy = 1 THEN
         Result = SFA_ERROR_FILE_ASSOCIATION_BUSY
         GOTO ENDOFSET
        END IF
        .Busy = 1
        ' Check If File Extension is not Empty
        IF sFileExtension = "" THEN
         Result = SFA_ERROR_EXTENSION_IS_AN_NULLTRING
         GOTO ENDOFSET
        END IF
        ' Check that there is a DOT most left ".Bas" and not "Bas", if missing, I add it.
        IF LEFT$(sFileExtension, 1) <> "." THEN
         sFileExt = "." & sFileExtension
        ELSE
         sFileExt = sFileEXtension
        END IF
        ' Maximum four characters plus the dot "."
        IF LEN(sFileExt) > 5 THEN
         Result = SFA_ERROR_EXTENSION_MORE_THAN_FOUR_CHARACTERS
         GOTO ENDOFSET
        END IF
        sDescriptor = (sFileExt - ".") & "_File"
        IF .regFA.KeyExists (sDescriptor) THEN
         .regFA.DeleteKey (sDescriptor)
         DOEVENTS
        END IF
        .regFA.OpenKey (sFileExt, 1)
        .regFA.WriteString ("", sDescriptor)
        .regFA.CloseKey
        .regFA.OpenKey(sDescriptor & "\\Shell\\Open\\Command", 1)
        .regFA.WriteString ("", sCommand)
        .regFA.CloseKey
ENDOFSET:
        .ResetProperties
        .Busy = 0
       END FUNCTION
' -----------------------------------------------------------------------------
       FUNCTION SetFileAssociationAndSaveOld (sFileExtension AS STRING, sCommand AS STRING) AS LONG
        DEFSTR sBU_OldDescrValue, sBU_NewDescrValue, sFileExt
        DEFSTR sNewDescrValue
        DEFSTR sBU_OldDescrName = .BU_Prefix & "_OLD"      ' IE : "YOUR_MARK" & "_OLD"   ' Old Descriptor Back Up, to UNDO
        DEFSTR sBU_NewDescrName = .BU_Prefix & "_NEW"      ' IE : "YOUR_MARK" & "_NEW"
        IF .Busy = 1 THEN
         Result = SFA_ERROR_FILE_ASSOCIATION_BUSY
         GOTO ENDOFSETRESTORE
        END IF
        .Busy = 1
        ' Check If File Extension is not Empty
        IF sFileExtension = "" THEN
         Result = SFA_ERROR_EXTENSION_IS_AN_NULLTRING
         GOTO ENDOFSETRESTORE
        END IF
        ' Check that there is a DOT most left ".Bas" and not "Bas", if missing, I add it.
        IF LEFT$(sFileExtension, 1) <> "." THEN
         sFileExt = "." & sFileExtension
        ELSE
         sFileExt = sFileEXtension
        END IF
        ' Set sNewDescr if sFileDescriptor = ""
        IF .NewDefaultDescriptorValue <> "" THEN
         sNewDescrValue = .NewDefaultDescriptorValue
        ELSE
         sNewDescrValue = (sFileExt - ".") & "_File"     ' Default Name Set to  IE : "Bas_File"
        END IF
        ' Maximum four characters plus the dot "."
        IF LEN(sFileExt) > 5 THEN
         Result = SFA_ERROR_EXTENSION_MORE_THAN_FOUR_CHARACTERS
         GOTO ENDOFSETRESTORE
        END IF
        sBU_NewDescrValue = sNewDescrValue
        Result = SFA_SET_RESTORABLE_ALL_OK                  ' Reset the Error Flag
        IF .regFA.KeyExists(sFileExt) THEN                        ' Key IE ".Bas" already exists
            ' Get Extension 'Old' Descriptor Name : IE  "BAS_File" for ".Bas"
         .regFA.OpenKey (sFileExt, 0)
         sBU_OldDescrValue = .regFA.ReadString ("")
         .regFA.CloseKey
         IF (.NewDefaultDescriptorValue <> "" AND .regFA.KeyExists(sBU_OldDescrValue)) THEN   ' If "" no Store/restore
                ' Rename Old Extension Descriptor to save It
          .regFA.OpenKey (sFileExt, 0)
          IF .regFA.ValueExists ("") = 1 THEN                               ' If a default Descriptor already defined
           IF .regFA.ValueExists(sBU_OldDescrName) = 0 THEN              ' If _OLD dont defined Yet
            .regFA.RenameValue ("", sBU_OldDescrName)
            .regFA.WriteString (sBU_OldDescrName, sBU_OldDescrValue & "_Save")
            .regFA.WriteString ("", sNewDescrValue)                   ' Set the new default FA descriptor
            .regFA.WriteString (sBU_NewDescrName, sBU_NewDescrValue)  ' Used by restore to delete this new FA
            .regFA.CloseKey
                        ' MoveKey Sets not defined ValueData to Empty string ... may cause problems ???
                        ' .regFA.MoveKey (sBU_OldDescrValue, sBU_OldDescrValue & "_Save", 0) ' Rename "Bas_File" >> "Bas_File_Save" and Delete "Bas_File"
            .RenameKey(sBU_OldDescrValue, sBU_OldDescrValue & "_Save", 1) ' Rename "Bas_File" >> "Bas_File_Save" and Delete "Bas_File"
           ELSE
                    ' If YOUR_MARK_OLD Already Exists
            Result = Result OR SFA_ERROR_BACK_UP_OLD_ALREADY_EXISTS
            .regFA.CloseKey
           END IF
          ELSE                                                ' If NO default Descriptor defined
           Result = Result OR SFA_ERROR_NO_EXTENSION_DESCRIPTOR_DEFINED
           .regFA.CloseKey
          END IF
         ELSE
          .regFA.OpenKey (sFileExt, 0)
          .regFA.WriteString ("", sNewDescrValue)
          .regFA.CloseKey
         END IF
        ELSE
            ' Create Extension Descriptor   IE  "BAS_File" for ".Bas"
         .regFA.OpenKey (sFileExt, 1)
         .regFA.WriteString ("", sNewDescrValue)
         .regFA.CloseKey
         Result = Result OR SFA_ERROR_EXTENSION_NOT_YET_DEFINED_CANT_SAVE_OLD_DESCRIPTOR
        END IF
        ' Creates New Key Name Pointed by NewDescriptor if dont exist and Give it default Value (not necessary)
        IF .regFA.KeyExists (sNewDescrValue) = 0 THEN ' Create Key
         .regFA.OpenKey (sNewDescrValue, 1)
         IF sNewDescrValue <> "" THEN .regFA.WriteString ("", sNewDescrValue)
         .regFA.CloseKey
        ELSE              ' Dont Create Key
         .regFA.OpenKey (sNewDescrValue, 0)
         IF sNewDescrValue <> "" THEN .regFA.WriteString ("", sNewDescrValue)
         .regFA.CloseKey
        END IF
        ' Create DefaultIcon = defines an Default Icon linked to that extension
        IF .DefaultIcon <> "" THEN
         .regFA.OpenKey (sNewDescrValue & "\\DefaultIcon", 1)
         .regFA.WriteString ("", .DefaultIcon)
         .regFA.CloseKey
        END IF
        ' Create Shell = define how to 'Shell' that extension. Can be "Open", "Print", "Explore"
        ' see API ShellExecute Doc
        .regFA.OpenKey (sNewDescrValue & "\\Shell", 1)
        SELECT CASE LCASE$(.OpenType)
        CASE ""
         .regFA.WriteString ("", "Open")       ' "Open" if OpenType = ""
        CASE "open", "print", "explore"
         .regFA.WriteString ("", .OpenType)
        CASE ELSE
         .regFA.WriteString ("", "Open")
         Result = Result & SFA_ERROR_INVALID_OPENTYPE_OPEN_SET
        END SELECT
        .regFA.CloseKey
        ' Create Open = ????  ... parent key for Command :)
        .regFA.OpenKey (sNewDescrValue & "\\Shell\\Open", 1)
        IF .OPEN <> "" THEN .regFA.WriteString ("", .OPEN)     ' let it with no value
        .regFA.CloseKey
        ' Create Command = the Path\application to run for that Extension
        .regFA.OpenKey (sNewDescrValue & "\\Shell\\Open\\Command", 1)
        .regFA.WriteString ("", sCommand)
        .regFA.CloseKey
ENDOFSETRESTORE:
        .ResetProperties
        .Busy = 0
       END FUNCTION
' -----------------------------------------------------------------------------
       FUNCTION RestoreOldFA (sFileExtension AS STRING) AS LONG
        DEFSTR sFileExt, sOldDescrName, sNewDescrName, sTmp, sNewDescrValue, sOldDescrValue, sDefaultValue
        sOldDescrName = .BU_Prefix & "_OLD"
        sNewDescrName = .BU_Prefix & "_NEW"
        Result = SFA_RESTORE_ALL_OK
        IF .Busy = 1 THEN
         Result = SFA_ERROR_FILE_ASSOCIATION_BUSY
         GOTO ENDOFRESTORE
        END IF
        .Busy = 1
        ' Check If File Extension is not Empty
        IF sFileExtension = "" THEN
         Result = SFA_ERROR_EXTENSION_IS_AN_NULLTRING
         GOTO ENDOFRESTORE
        END IF
        IF LEFT$(sFileExtension, 1) <> "." THEN
         sFileExt = "." & sFileExtension
        ELSE
         sFileExt = sFileExtension
        END IF
        ' Maximum four characters plus the dot "."
        IF LEN(sFileExt) > 5 THEN
         Result = SFA_ERROR_EXTENSION_MORE_THAN_FOUR_CHARACTERS
         GOTO ENDOFRESTORE
        END IF
        IF .regFA.KeyExists(sFileExt) <> 0 THEN
         .regFA.OpenKey (sFileExt, 0)
         IF (.regFA.ValueExists (sOldDescrName) <> 0 AND .regFA.ValueExists(sNewDescrName) <> 0) THEN
          sNewDescrValue = .regFA.ReadString (sNewDescrName)
          sOldDescrValue = .regFA.ReadString (sOldDescrName)        ' Read Old Descriptor to restore
          .regFA.WriteString("", sOldDescrValue - "_Save")          ' Set Old Descriptor value as Default Value
          .regFA.DeleteValue (sOldDescrName)                        ' Delete OldDescriptor
          .regFA.DeleteValue (sNewDescrName)
          .regFA.CloseKey
          IF (.regFA.KeyExists (sOldDescrValue) AND .regFA.KeyExists(sNewDescrValue)) THEN
           IF .regFA.KeyExists (sOldDescrValue - "_Save") THEN .regFA.DeleteKey (sOldDescrValue - "_Save")
           DOEVENTS    ' .RenameKey refuses to overwrite, wait key deleted
                        ' .regFA.MoveKey (sOldDescrValue, sOldDescrValue - "_Save", 1) ' restore Rename sOldDescrValue
           .RenameKey (sOldDescrValue, sOldDescrValue - "_Save", 1) ' restore Rename sOldDescrValue
           .regFA.DeleteKey (sNewDescrValue)                            ' Delete NewValue
          ELSE
           Result = Result OR SFA_ERROR_RESTORE_FA_KEY_MISSING_CANT_RESTORE
          END IF
         ELSE
          Result = Result OR SFA_ERROR_RESTORE_NEW_AND_OR_OLD_DESCRIPTOR_MISSING_CANT_RESTORE
          .regFA.CloseKey
          GOTO ENDOFRESTORE
         END IF
        ELSE
         Result = Result OR SFA_ERROR_RESTORE_EXTENSION_KEY_DONT_EXIST
        END IF
ENDOFRESTORE:
        .ResetProperties
        .Busy = 0
       END FUNCTION
' -----------------------------------------------------------------------------
       FUNCTION GetFileAssociationErrorAsString (iError AS LONG) AS STRING
        Result = ""
        IF iError = SFA_SHOW_RELATED_VALUE_ALL_OK THEN Result = "      *** SFA_SHOW_RELATED_VALUE_ALL_OK":EXIT FUNCTION
        IF iError = SFA_SET_RESTORABLE_ALL_OK THEN Result = "      *** SFA_SET_RESTORABLE_ALL_OK":EXIT FUNCTION
        IF iError = SFA_SIMPLE_SET_ALL_OK THEN Result = "      *** SFA_SIMPLE_SET_ALL_OK":EXIT FUNCTION
        IF iError = SFA_RESTORE_ALL_OK THEN Result = "      *** SFA_RESTORE_ALL_OK":EXIT FUNCTION
        IF (iError AND SFA_ERROR_BACK_UP_OLD_ALREADY_EXISTS) <> 0 THEN
         IF Result = "" THEN
          Result = "      *** SFA_ERROR_BACK_UP_OLD_ALREADY_EXISTS"
         ELSE
          Result = Result & "\n  and *** SFA_ERROR_BACK_UP_OLD_ALREADY_EXISTS"
         END IF
        END IF
        IF  (iError AND SFA_ERROR_NO_EXTENSION_DESCRIPTOR_DEFINED) <> 0 THEN
         IF Result = "" THEN
          Result = "      *** SFA_ERROR_NO_EXTENSION_DESCRIPTOR_DEFINED"
         ELSE
          Result = Result & "\n  and *** SFA_ERROR_NO_EXTENSION_DESCRIPTOR_DEFINED"
         END IF
        END IF
        IF (iError AND SFA_ERROR_EXTENSION_NOT_YET_DEFINED_CANT_SAVE_OLD_DESCRIPTOR) <> 0 THEN
         IF Result = "" THEN
          Result = "      *** SFA_ERROR_EXTENSION_NOT_YET_DEFINED_CANT_SAVE_OLD_DESCRIPTOR"
         ELSE
          Result = Result & "\n  and *** SFA_ERROR_EXTENSION_NOT_YET_DEFINED_CANT_SAVE_OLD_DESCRIPTOR"
         END IF
        END IF
        IF (iError AND SFA_ERROR_INVALID_OPENTYPE_OPEN_SET) <> 0 THEN
         IF Result = "" THEN
          Result = "      *** SFA_ERROR_INVALID_OPENTYPE_OPEN_SET"
         ELSE
          Result = Result & "\n  and *** SFA_ERROR_INVALID_OPENTYPE_OPEN_SET"
         END IF
        END IF
        IF (iError AND SFA_ERROR_RESTORE_NEW_AND_OR_OLD_DESCRIPTOR_MISSING_CANT_RESTORE) <> 0 THEN
         IF Result = "" THEN
          Result = "      *** SFA_ERROR_RESTORE_NEW_AND_OR_OLD_DESCRIPTOR_MISSING_CANT_RESTORE"
         ELSE
          Result = Result & "\n  and *** SFA_ERROR_RESTORE_NEW_AND_OR_OLD_DESCRIPTOR_MISSING_CANT_RESTORE"
         END IF
        END IF
        IF (iError AND SFA_ERROR_RESTORE_EXTENSION_KEY_DONT_EXIST) <> 0 THEN
         IF Result = "" THEN
          Result = "      *** SFA_ERROR_RESTORE_EXTENSION_KEY_DONT_EXIST"
         ELSE
          Result = Result & "\n  and *** SFA_ERROR_RESTORE_EXTENSION_KEY_DONT_EXIST"
         END IF
        END IF
        IF (iError AND SFA_ERROR_RESTORE_FA_KEY_MISSING_CANT_RESTORE) <> 0 THEN
         IF Result = "" THEN
          Result = "      *** SFA_ERROR_RESTORE_FA_KEY_MISSING_CANT_RESTORE"
         ELSE
          Result = Result & "\n  and *** SFA_ERROR_RESTORE_FA_KEY_MISSING_CANT_RESTORE"
         END IF
        END IF
        IF (iError AND SFA_ERROR_FILE_ASSOCIATION_BUSY) <> 0 THEN
         IF Result = "" THEN
          Result = "      *** SFA_ERROR_FILE_ASSOCIATION_BUSY"
         ELSE
          Result = Result & "\n  and *** SFA_ERROR_FILE_ASSOCIATION_BUSY"
         END IF
        END IF
        IF (iError AND SFA_ERROR_EXTENSION_IS_AN_NULLTRING) <> 0 THEN
         IF Result = "" THEN
          Result = "      *** SFA_ERROR_EXTENSION_IS_AN_NULLTRING"
         ELSE
          Result = Result & "\n  and *** SFA_ERROR_EXTENSION_IS_AN_NULLTRING"
         END IF
        END IF
        IF (iError AND SFA_ERROR_EXTENSION_MORE_THAN_FOUR_CHARACTERS) <> 0 THEN
         IF Result = "" THEN
          Result = "      *** SFA_ERROR_EXTENSION_MORE_THAN_FOUR_CHARACTERS"
         ELSE
          Result = Result & "\n  and *** SFA_ERROR_EXTENSION_MORE_THAN_FOUR_CHARACTERS"
         END IF
        END IF
       END FUNCTION
      END WITH
' -----------------------------------------------------------------------------
      FUNCTION ShowRelatedKeysAndValues (sFileExt AS STRING) AS STRING
       DEFINT N, P, iValCount, iSubKeyCount, iIndex, iDegree
       DEFSTR sValueName, sValueData, sTmp, sTmp1, sKey, sHeader, sResult = ""
       DIM regFA1 AS QREGISTRY
       DIM slKey AS QSTRINGLIST
       slKey.Clear
       sResult = ""
       WITH regFA1
        .RootKey = SFA_HKEY_CLASSES_ROOT
        IF .KeyExists (sFileExt) = 0 THEN
         Result = CHR$(10) & "key " & CHR$(34) & sFileExt & CHR$(34) & " Dont Exist"
         EXIT FUNCTION
        ELSE
         sResult = CHR$(10) & "key : " & CHR$(34) & sFileExt & CHR$(34)
        END IF
        .OpenKey (sFileEXt, 0)
        iValCount = .ValueItemCount - 1
        FOR N = 0 TO iValCount
         sValueName = .ValueItem(N)
         sValueData = .ReadString (sValueName)
         sTmp = SPACE$ (25)
         sTmp = REPLACE$(sTmp,"      value : " & CHR$(34) & sValueName & CHR$(34), 1)
         sTmp1 = SPACE$ (100)
         sTmp1 = REPLACE$ (sTmp1, " = " & CHR$(34) & sValueData & CHR$(34), 1)
         sResult = sResult & CHR$(10) & sTmp & RTRIM$(sTmp1)
         slKey.AddItems (sValueData)
        NEXT N
        .CloseKey
        iIndex = 0
        WHILE iIndex < slKey.ItemCount
         sKey = slKey.Item(iIndex)
         IF .KeyExists (sKey) THEN
          sResult = sResult & CHR$(10) & "key : " & CHR$(34) & sKey & CHR$(34)
          .OpenKey(sKey, 0)
          iSubKeyCount = .KeyItemCount - 1
          FOR P = 0 TO iSubKeyCount
           slKey.InsertItem (iIndex + P + 1, sKey & "\\" & .KeyItem(P))
          NEXT P
          iValCount = .ValueItemCount - 1
          FOR N = 0 TO iValCount
           sValueName = .ValueItem(N)
           sValueData = .ReadString (sValueName)
           sTmp = SPACE$ (25)
           sTmp = REPLACE$(sTmp,"      value : " & CHR$(34) & sValueName & CHR$(34), 1)
           sTmp1 = SPACE$ (25)
           sTmp1 = REPLACE$ (sTmp1, " = \"" & sValueData & "\"", 1)
           sTmp1 = REPLACE$ (sTmp1, " = " & CHR$(34) & sValueData & CHR$(34), 1)
           sResult = sResult & CHR$(10) & sTmp & RTRIM$(sTmp1)
          NEXT N
          .closeKey
         END IF
         INC iIndex
        WEND
       END WITH
       Result = sResult
      END SUB
     END TYPE
'
' =============================================================================
'

2004-04-28 21:00