|
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.
' For more information on the original functions please refer to http://www.allapi.net
Public Function GetLargePrivateProfileString(ByVal lpApplicationName As String, ByVal lpkeyname As String, ByVal lpDefault As String, lpReturnedString As String, ByVal nSize As Long, ByVal lpfilename As String)
' Procedure : GetLargePrivateProfileString
' Description: Locate a section/key within an INI file string, read the string.
' Copyright: Chris Greaves Inc.
' Inputs: STRINGS file data, section, key.
' 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.
' result = -6 ==> file does not exist.
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 lngLengthFile > 32767 Then ' way too big for us
intResult = -3
Close intFile
Else
Dim lpfilenameString As String
lpfilenameString = String$(lngLengthFile, " ") ' create buffer for GET routine
Get #intFile, 1, lpfilenameString
Close intFile
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)
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
lpReturnedString = Mid$(lpfilenameString, lngKeyValueStart + 1, lngKeyEnd - lngKeyValueStart - 1)
Else ' strange error
intResult = -4
End If
Else ' strange error
intResult = -5
End If
Else ' we did not find the key
intResult = -1
End If
Else ' we did not find the section
intResult = -2
End If
End If
GoTo FileFound
FileNotFound:
intResult = -6
FileFound:
If intResult < 0 Then
lpReturnedString = ""
Else
End If
'Sub TESTGetLargePrivateProfileString()
'
'Dim strReturnedString As String
'Dim nSize As Long
'
'Dim strFileName As String
'
'Dim strSection As String
'strSection = "windows"
'strSection = "Desktop"
'
'Dim strKeyName As String
'strKeyName = "PDF"
'
'strFileName = "[:\Greaves\Products\IniUt\Fakewin.ini"
'MsgBox GetLargePrivateProfileString(strSection, strKeyName, "default", strReturnedString, nSize, strFileName) ' file does not exist
'
'strFileName = "D:\Greaves\Products\IniUt\Fakewin.ini"
'MsgBox GetLargePrivateProfileString(strSection, strKeyName, "default", strReturnedString, nSize, strFileName) ' normal result
'
'strKeyName = "="
'MsgBox GetLargePrivateProfileString(strSection, strKeyName, "default", strReturnedString, nSize, strFileName) ' can't find key
'
'strSection = "["
'MsgBox GetLargePrivateProfileString(strSection, strKeyName, "default", strReturnedString, nSize, strFileName) ' can't find section
'
'strFileName = "d:\greaves\products\untitled.bmp"
'MsgBox GetLargePrivateProfileString(strSection, strKeyName, "default", strReturnedString, nSize, strFileName) ' file too big
'
'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 |