|
Visual Basic (VB and VBA) |
|
Copyright 1999-2001 Christopher Greaves. All rights reserved. Home Page and email to [email protected] |
| If in doubt, record a macro and inspect the entrails! |
Please read the DISCLAIMER.
Here is an INDEX to all the procedures.
You will probably need one copy of my GLOBAL DECLARATIONS.
Public Function WriteLargePrivateProfileString(ByVal lpApplicationName As String, ByVal lpkeyname As String, ByVal lpString As String, ByVal lpfilename As String) As String
' Procedure : WriteLargePrivateProfileString
' Description: Locate a section/key within an INI file string, write the string.
' Copyright: Chris Greaves Inc.
' Inputs: STRINGS file data, section, key, value.
' Returns: STRING value of key; "" ==> not found, sorry.
' Assumes: None.
' Side Effects: None.
' Tested: By the calls below
' result = 0 ==> found and this is the position
' result = -1 ==> section found, key not found, sorry
' result = -2 ==> section not found, sorry
' result = -3 ==> file too big for me, sorry.
' result = -4 ==> could not find the end of the key value??!, sorry.
' result = -5 ==> could not find the key-value separator??!, sorry.
Dim intResult As Integer
intResult = 0
Dim lngLengthFile As Long
On Error GoTo FileNotFound ' I HATE On Error; VBA provides no way to test for files.
lngLengthFile = FileLen(lpfilename)
On Error GoTo 0
Dim intFile As Integer
intFile = FreeFile
Open lpfilename For Binary As intFile
lngLengthFile = LOF(intFile)
' if the file is longer than the longest stringwe want to hold in memory, too bad.
If lngLengthFile > 32767 Then
intResult = -3
Close intFile
Else
Dim lpfilenameString As String
lpfilenameString = String$(lngLengthFile, " ")
Get #intFile, 1, lpfilenameString
' 2001/11/01 theory is that we DELETE the file every time we prepare to re-write it.
Close intFile
Call doQKill(lpfilename)
DoEvents
Dim lngSectStart As Long
' Look for the section.
' Here I loosely define a section as a CRLF followed by a leading square bracket.
lngSectStart = InStr(1, lpfilenameString, strcSectionStart & lpApplicationName & strcSectionEnd & strcRecordDelimiter)
If lngSectStart > 1 Then ' not the leading section, so test for preceding CRLF
If Mid$(lpfilenameString, lngSectStart - 2, 2) = strcRecordDelimiter Then ' OK, we found one
Else
lngSectStart = 0
End If
Else
End If
If lngSectStart > 0 Then ' we found the section string
' Look for the end of this section.
' Here I loosely define a section end as a closing square-bracket followed by a CRLF.
Dim lngSectEnd As Long
lngSectEnd = InStr(lngSectStart + 2 + Len(lpApplicationName), lpfilenameString, strcSectionEnd & strcRecordDelimiter)
If lngSectEnd = 0 Then ' we are in the last section
lngSectEnd = Len(lpfilenameString) - 1
Else
End If
' Look for the key
' Here I define a key as a CRLF followed by the key name followed by an equals sign.
Dim strSect As String
strSect = Mid$(lpfilenameString, lngSectStart, lngSectEnd - lngSectStart)
Dim lngKeyStart As Long
lngKeyStart = InStr(lngSectStart, lpfilenameString, strcRecordDelimiter & lpkeyname & strcKeySeparator)
If lngKeyStart > 0 Then ' we found the key
Dim lngKeyValueStart As Long
lngKeyValueStart = InStr(lngKeyStart, lpfilenameString, strcKeySeparator)
If lngKeyValueStart > 0 Then ' everything is normal, we found the equals sign
' Look for the key value
' Here I define the key value to be everything from the equals sign to the next CRLF
Dim lngKeyEnd As Long
lngKeyEnd = InStr(lngKeyStart + 1, lpfilenameString, strcRecordDelimiter)
If lngKeyEnd > 0 Then
WriteLargePrivateProfileString = Left$(lpfilenameString, lngKeyStart - 1) & strcRecordDelimiter
WriteLargePrivateProfileString = WriteLargePrivateProfileString & lpkeyname & strcKeySeparator & lpString & strcRecordDelimiter
' Close intFile
WriteLargePrivateProfileString = WriteLargePrivateProfileString & Right$(lpfilenameString, Len(lpfilenameString) - lngKeyEnd - 1)
Else ' strange error
Close intFile
intResult = -4
End If
Else ' strange error
Close intFile
intResult = -5
End If
Else ' we did not find the key
WriteLargePrivateProfileString = Left$(lpfilenameString, lngSectEnd) & lpkeyname & strcKeySeparator & lpString & strcRecordDelimiter
WriteLargePrivateProfileString = WriteLargePrivateProfileString & Right$(lpfilenameString, Len(lpfilenameString) - lngSectEnd - 1)
Close intFile
End If
Else ' we did not find the section
' Append a section header to the file string
WriteLargePrivateProfileString = lpfilenameString & strcSectionStart & lpApplicationName & strcSectionEnd & strcRecordDelimiter
' append a key=value to the file string
WriteLargePrivateProfileString = WriteLargePrivateProfileString & lpkeyname & strcKeySeparator & lpString & strcRecordDelimiter
End If
End If
' If the file was found, we pass a re-constructed string to the write-file routine
GoTo FileFound
FileNotFound: ' we did not find the file
' If the file was not found, we construct a string from scratch.
' Set a section header as the file string
WriteLargePrivateProfileString = strcSectionStart & lpApplicationName & strcSectionEnd & strcRecordDelimiter
' append a key=value to the file string
WriteLargePrivateProfileString = WriteLargePrivateProfileString & lpkeyname & strcKeySeparator & lpString & strcRecordDelimiter
FileFound:
' If the file was found, we killed it after reading.
' If the file was not found, it did not exist.
' Either way we create a new file.
intFile = FreeFile
Open lpfilename For Output As intFile
Close intFile
intFile = FreeFile
Open lpfilename For Binary As intFile
If intResult < 0 Then
WriteLargePrivateProfileString = ""
Else
Put #intFile, 1, WriteLargePrivateProfileString
Close intFile
End If
'Sub TESTWriteLargePrivateProfileString()
'
'Dim strFileName As String
'
'Dim strSection As String
'strSection = "One"
'
'Dim strKeyName As String
'strKeyName = "PDF3"
'strFileName = "d:\Greaves\Products\IniUt\aaFakewin.ini"
'MsgBox WriteLargePrivateProfileString(strSection, strKeyName, str(Time), strFileName) ' file does not exist.
'
'MsgBox WriteLargePrivateProfileString(strSection, strKeyName, str(Time), strFileName) ' normal result
'
'strKeyName = "PDF4"
'MsgBox WriteLargePrivateProfileString(strSection, strKeyName, str(Time), strFileName) ' normal result
'
'strKeyName = "PDF5"
'MsgBox WriteLargePrivateProfileString(strSection, strKeyName, str(Time), strFileName) ' normal result
'
'' test of string greater than 254 characters
'Dim strOut As String
'strOut = String$(254, "0")
'strOut = strOut & "here is an appendage beyond the previous 254 character limit"
'strKeyName = "PDF6"
'MsgBox WriteLargePrivateProfileString(strSection, strKeyName, strOut, strFileName) ' string greater than 254 characters
'Dim strReturnedString As String
'Dim nSize As Long
'MsgBox GetLargePrivateProfileString(strSection, strKeyName, "default", strReturnedString, nSize, strFileName) ' can't find key
'
'End Sub
End Function
| We all knew nothing when we started … |
|
Home Page and Contact Information Send email to [email protected]. This page was last updated Thursday, November 15, 2001 |