IniReadWrite




'Windows API/Global Declarations for :

'.INI read/write routines

'****************************************************************

Declare Function GetPrivateProfileString Lib "Kernel" _
(ByVal lpApplicationName As String, lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Integer, ByVal lpFileName As String) _
As Integer

Declare Function WritePrivateProfileString% Lib "Kernel" _
(ByVal lpApplicationName$, ByVal lpKeyName As Any, _
ByVal lpString As Any, ByVal lpFileName$)

Function mfncGetFromIni (strSectionHeader As String, strVariableName As
String, strFileName As String) As String
'*** DESCRIPTION:Reads from an *.INI file strFileN

' ame (full path &

file name)
'*** RETURNS:The string stored in [strSectionHeade

' r], line

beginning strVariableName=
' '*** NOTE: Requires declaration of API call

GetPrivateProfileString
' 'Initialise variable

Dim strReturn As String
' 'Blank the return string

strReturn = String(255, Chr(0))
'Get requested information, trimming the returned

' string

mfncGetFromIni = Left$(strReturn,
GetPrivateProfileString(strSectionHeader, ByVal strVariableName, "",
strReturn, Len(strReturn), strFileName))
End Function

Function mfncParseString (strIn As String, intOffset As Integer,
strDelimiter As String) As String
'*** DESCRIPTION:Parses the passed string, returni

' ng the value

indicated
'***by the offset specified, eg: the string "Hello

' ,

World ","
' '***offset 2 = "World".

' '*** RETURNS:See description.

'*** NOTE: The offset starts at 1 and the delimite

' r is the

Character
' '***which separates the elements of the string.

' 'Trap any bad calls

If Len(strIn) = 0 Or intOffset = 0 Then
mfncParseString = ""
Exit Function
End If
' 'Declare local variables

Dim intStartPos As Integer
ReDim intDelimPos(10) As Integer
Dim intStrLen As Integer
Dim intNoOfDelims As Integer
Dim intCount As Integer
Dim strQuotationMarks As String
Dim intInsideQuotationMarks As Integer
strQuotationMarks = Chr(34) & Chr(147) & Chr(148)
intInsideQuotationMarks = False
For intCount = 1 To Len(strIn)
'If character is a double-quote then toggle the In

' Quotation flag

If InStr(strQuotationMarks, Mid$(strIn, intCount, 1)) <> 0 Then
intInsideQuotationMarks = (Not intInsideQuotationMarks)
End If
If (Not intInsideQuotationMarks) And (Mid$(strIn, intCount, 1) =
strDelimiter) Then
intNoOfDelims = intNoOfDelims + 1
'If array filled then enlarge it, keeping existing

' contents

If (intNoOfDelims Mod 10) = 0 Then
ReDim Preserve intDelimPos(intNoOfDelims + 10)
End If
intDelimPos(intNoOfDelims) = intCount
End If
Next intCount
' 'Handle request for value not present (over-run)

If intOffset > (intNoOfDelims + 1) Then
mfncParseString = ""
Exit Function
End If
' 'Handle boundaries of string

If intOffset = 1 Then
intStartPos = 1
End If
' 'Requesting last value - handle null

If intOffset = (intNoOfDelims + 1) Then
If Right$(strIn, 1) = strDelimiter Then
intStartPos = -1
intStrLen = -1
mfncParseString = ""
Exit Function
Else
intStrLen = Len(strIn) - intDelimPos(intOffset - 1)
End If
End If
'Set start and length variables if not handled by

' boundary check above

If intStartPos = 0 Then
intStartPos = intDelimPos(intOffset - 1) + 1
End If
If intStrLen = 0 Then
intStrLen = intDelimPos(intOffset) - intStartPos
End If
' 'Set the return string

mfncParseString = Mid$(strIn, intStartPos, intStrLen)
End Function

Function mfncWriteIni (strSectionHeader As String, strVariableName As
String, strValue As String, strFileName As String) As Integer
'*** DESCRIPTION:Writes to an *.INI file called st

' rFileName (full

path & file name)
'*** RETURNS:Integer indicating failure (0) or suc

' cess (other)

to write
' '*** NOTE: Requires declaration of API call

WritePrivateProfileString
' 'Call the API

mfncWriteIni = WritePrivateProfileString(strSectionHeader,
strVariableName, strValue, strFileName)
End Function











( inireadwrite.html )- by Paolo Puglisi - Modifica del 17/12/2023