Module cIniFile.pkg

     1// cIniFile.pkg
     2// Author: SWB
     3Use LanguageText.pkg
     4Use windows.pkg
     5
     6// it is important that psFileName is defined. If blank, the registry may be accessed. We will check all WritePrivateProfileString
     7// and GetPrivateProfileString to make sure that a file is defined.
     8External_Function WritePrivateProfileString "WritePrivateProfileStringA" Kernel32.dll ;
     9    String sSection String sKeyName String sValue String sFileName Returns Integer
    10
    11External_Function GetPrivateProfileString "GetPrivateProfileStringA" Kernel32.dll ;
    12    Address aSection Address aKeyName Address aDefault Pointer lpsValue Integer nSize String sFileName Returns Integer
    13
    14{ ClassLibrary=Common }
    15{ HelpTopic=cIniFile }
    16Class cIniFile is a cObject
    17    Procedure Construct_Object
    18        Forward Send Construct_Object
    19
    20        { Category=Behavior }
    21        Property String psFileName
    22    End_Procedure
    23
    24    Procedure WriteString String sSection String sKey String sValue
    25        Boolean bSuccess
    26
    27        //Showln "WriteString "
    28        //Showln sSection ' - ' sKey ' - ' (psFileName(self))
    29        //Showln sSection ' - ' sKey ' - ' (ToAnsi(psFileName(self)))
    30        If (trim(psFileName(self))="") Begin
    31            Error DFERR_INI_FILE "Ini file name not defined"
    32            Procedure_return
    33        end
    34        Move (WritePrivateProfileString(ToAnsi(sSection), ToAnsi(sKey), ToAnsi(sValue), ToAnsi(psFilename(self)))) To bSuccess
    35        If (bSuccess = False) Error DFERR_INI_FILE C_$CannotWriteToTheIniFile
    36    End_Procedure
    37
    38    Function ReadString String sSection String sKey String sDefault Returns String
    39        Integer iNumChars iSizeValue
    40        Pointer lpsValue
    41        String sValue
    42
    43        Move (ToAnsi(sSection)) To sSection
    44        Move (ToAnsi(sKey))     To sKey
    45        Move (ToAnsi(sDefault)) To sDefault
    46
    47        Move 2047 to iSizeValue
    48
    49        Pad " " To sValue iSizeValue
    50        GetAddress of sValue to lpsValue
    51
    52        If (trim(psFileName(self))="") Begin
    53            Error DFERR_INI_FILE "Ini file name not defined"
    54            Function_return ''
    55        end
    56        Move (GetPrivateProfileString(AddressOf(sSection), AddressOf(sKey), AddressOf(sDefault), lpsValue, iSizeValue, ToAnsi(psFilename(self)))) To iNumChars
    57        Function_Return  (ToOem(CString(sValue)))
    58    End_Function
    59
    60    Function SectionExists String sSection Returns Boolean
    61        // A section exists only if it has at least one Key. A section with no keys is said not to exist
    62        Handle hoKeys
    63        Integer icKey iKey
    64
    65        Get Create U_ARRAY To hoKeys
    66        Send ReadSection sSection hoKeys
    67        Get Item_Count of hoKeys To icKey
    68        Send Destroy of hoKeys
    69
    70        Function_Return (icKey >0)
    71    End_Function
    72
    73    Procedure ReadSection String sSection Handle hoArray
    74        Integer iNumChars iSizeValue iPos
    75        Pointer lpsKeys
    76        String sKeys sKey
    77
    78        Move 16384 to iSizeValue
    79        Move (Repeat(character(0),  iSizeValue)) To sKeys
    80
    81        GetAddress of sKeys to lpsKeys
    82
    83        Move (ToAnsi(sSection)) To sSection
    84
    85        If (trim(psFileName(self))="") Begin
    86            Error DFERR_INI_FILE "Ini file name not defined"
    87            Procedure_return
    88        end
    89        Move (GetPrivateProfileString(AddressOf(sSection), 0, 0, lpsKeys, Length(sKeys), ToAnsi(psFilename(self)))) To iNumChars
    90        If (iNumChars >0) Begin
    91            Repeat
    92                Pos (Character(0)) in sKeys To iPos
    93                If (iPos >1) Begin
    94                    Left sKeys To sKey (iPos -1)
    95                    Right sKeys To sKeys (Length(sKeys) - iPos)
    96                    Set Value of hoArray (Item_Count(hoArray)) To (ToOem(sKey))
    97                End
    98            Until (iPos <=1)
    99        End
   100    End_Procedure
   101
   102    Procedure ReadSections Handle hoArray
   103        Integer iNumChars iSizeValue iPos
   104        Pointer lpsSections
   105        String sSections sSection
   106
   107        Move 16384 to iSizeValue
   108
   109        Move (Repeat(character(0),  iSizeValue)) To sSections
   110        GetAddress of sSections to lpsSections
   111
   112        If (trim(psFileName(self))="") Begin
   113            Error DFERR_INI_FILE "Ini file name not defined"
   114            Procedure_return
   115        end
   116        Move (GetPrivateProfileString(0, 0, 0, lpsSections, Length(sSections), ToAnsi(psFilename(self)))) To iNumChars
   117        If (iNumChars >0) Begin
   118            Repeat
   119                Pos (Character(0)) in sSections To iPos
   120                If (iPos >1) Begin
   121                    Left sSections To sSection (iPos -1)
   122                    Right sSections To sSections (Length(sSections) - iPos)
   123                    Set Value of hoArray (Item_Count(hoArray)) To (ToOem(sSection))
   124                End
   125            Until (iPos <=1)
   126        End
   127
   128    End_Procedure
   129
   130    Procedure DeleteSection String sSection
   131        //Showln "delete section:"
   132        //Showln sSection ' - ' (psFileName(self))
   133        //Showln sSection ' - ' (ToAnsi(psFileName(self)))
   134
   135        If (trim(psFileName(self))="") Begin
   136            Error DFERR_INI_FILE "Ini file name not defined"
   137            Procedure_return
   138        end
   139        If (WritePrivateProfileString(ToAnsi(sSection), "", "", ToAnsi(psFilename(self))) = 0) Error DFERR_INI_FILE C_$CanNotDeleteSection
   140    End_Procedure
   141
   142    Procedure DeleteKey String sSection String sKey
   143        Integer iVoid
   144        //Showln "delete key:"
   145        //Showln sSection ' - ' sKey ' - ' (psFileName(self))
   146        //Showln sSection ' - ' skey ' - ' (ToAnsi(psFileName(self)))
   147        If (trim(psFileName(self))="") Begin
   148            Error DFERR_INI_FILE "Ini file name not defined"
   149            Procedure_return
   150        end
   151        Move (WritePrivateProfileString(ToAnsi(sSection), ToAnsi(sKey), "", ToAnsi(psFilename(self)))) To iVoid
   152        //Move (WritePrivateProfileString(ToAnsi(sSection), ToAnsi(sKey), "", psFilename(self))) To iVoid
   153    End_Procedure
   154
   155    Function KeyExists String sSection String sKey Returns Boolean
   156        Handle hoKeys
   157        Integer iKey
   158        Boolean bExists
   159
   160        Move (False) To bExists
   161
   162        Move (ToAnsi(Uppercase(sKey))) To sKey
   163
   164        Get Create U_ARRAY To hoKeys
   165
   166        Send ReadSection sSection hoKeys
   167        For iKey from 0 To (Item_Count(hoKeys) -1)
   168            If (sKey = Uppercase(Value(hoKeys, iKey))) Begin
   169                Move (True) To bExists
   170            End
   171        Loop
   172
   173        Send Destroy of hoKeys
   174
   175        Function_Return bExists
   176    End_Function
   177
   178End_Class
   179