I want to decode a string (which I got via readAsDataUrl()) to bytes.
At first, I remove the data:*/*;base64, then I call the following:
Option Explicit
Private Const CRYPT_STRING_BASE64 As Long = &H1&
Private Declare Function CryptStringToBinaryW Lib "Crypt32.dll" ( _
ByVal pszString As Long, _
ByVal cchString As Long, _
ByVal dwFlags As Long, _
ByVal pbBinary As Long, _
ByRef pcbBinary As Long, _
ByVal pdwSkip As Long, _
ByVal pdwFlags As Long) As Long
Public Function DecodeBase64(ByVal strData As String) As Byte()
Dim Buffer() As Byte
Dim dwBinaryBytes As Long
dwBinaryBytes = LenB(strData)
ReDim Buffer(dwBinaryBytes - 1) As Byte
'within the following call, VB6 crashes:
If CryptStringToBinaryW(StrPtr(strData), LenB(strData), CRYPT_STRING_BASE64, _
VarPtr(Buffer(0)), dwBinaryBytes, 0, 0) Then
ReDim Preserve Buffer(dwBinaryBytes - 1) As Byte
DecodeBase64 = Buffer
End If
Erase Buffer
End Function
Now I call this:
Dim s$
'code to get base64 string
'code to strip for example "data:image/jpeg;base64,"
Dim nBytes() As Byte
nBytes = DecodeBase64(s) 'Here VB6 crashes
Edit:
I am using the following alternative version now, and it works, but I wonder what the error is:
Public Function DecodeBase64(ByVal sBase64Buf As String) As Byte()
Const CRYPT_STRING_BASE64 As Long = 1
Const CRYPT_STRING_NOCRLF As Long = &H40000000
Dim bTmp() As Byte
Dim lLen As Long
Dim dwActualUsed As Long
'Get output buffer length
If CryptStringToBinary(StrPtr(sBase64Buf), Len(sBase64Buf), CRYPT_STRING_BASE64, StrPtr(vbNullString), lLen, 0&, dwActualUsed) = 0 Then
'RaiseEvent Error(Err.LastDllError, CSB, Routine)
GoTo ReleaseHandles
End If
'Convert Base64 to binary.
ReDim bTmp(lLen - 1)
If CryptStringToBinary(StrPtr(sBase64Buf), Len(sBase64Buf), CRYPT_STRING_BASE64, VarPtr(bTmp(0)), lLen, 0&, dwActualUsed) = 0 Then
'RaiseEvent Error(Err.LastDllError, CSB, Routine)
GoTo ReleaseHandles
Else
'm_bData = bTmp
End If
ReleaseHandles:
DecodeBase64 = bTmp
End Function
Edit:
In version 1, dwBinaryBytes is 156080 in this line:
dwBinaryBytes = LenB(strData)
and in version 2, lLen is 58528 in this line:
ReDim bTmp(lLen - 1)
Why the discrepancy, and why didn't the author notice that?
The "CryptStringToBinaryW" requires the number of characters in the string as a parameter. That is returned by the "Len" function. You used the "LenB" function which returns the number of bytes in the string which is larger than the number of characters in the string so the function attempted to access memory past the end of the string which caused the crash.
I am trying to read in a JPG file and convert the file to a base64 encoded string that can be used as an embedded jpeg on a web page. I found two functions on the web for base64 encoding/decoding in VBA that appear to be well-accepted. The encode/decode process yields my original binary string, so the functions appear to be at least somewhat correct. However the base64 string I am getting is no where near what I get when I use an online tool to convert my image to base64.
The base64 string should start: "/9j/4AAQSkZJRgABAQEAUgBSAAD". Instead it is starting with: "Pz8/Pz9BYT8/AD8/Pz8/Pz8/Pz8/Pz8/Pz8". I'm lost as to why I'm not getting the former result and why I'm getting the latter. Am I doing something wrong in my reading of the binary file?
Here is my code:
Sub TestBase64()
Dim bytes, b64
With CreateObject("ADODB.Stream")
.Open
.Type = ADODB.adTypeBinary
.LoadFromFile "c:\temp\TestPic.jpg"
bytes = .Read
.Close
End With
Debug.Print bytes
b64 = Base64Encode(bytes)
Debug.Print vbCrLf + vbCrLf
Debug.Print b64
Debug.Print vbCrLf + vbCrLf
Debug.Print Base64Decode(CStr(b64))
End Sub
' Decodes a base-64 encoded string (BSTR type).
' 1999 - 2004 Antonin Foller, http://www.motobit.com
' 1.01 - solves problem with Access And 'Compare Database' (InStr)
Function Base64Decode(ByVal base64String)
'rfc1521
'1999 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
'remove white spaces, If any
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
'The source must consists from groups with Len of 4 chars
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then
Err.Raise 1, "Base64Decode", "Bad Base64 string."
Exit Function
End If
' Now decode each group:
For groupBegin = 1 To dataLength Step 4
Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
' Each data group encodes up To 3 actual bytes.
numDataBytes = 3
nGroup = 0
For CharCounter = 0 To 3
' Convert each character into 6 bits of data, And add it To
' an integer For temporary storage. If a character is a '=', there
' is one fewer data byte. (There can only be a maximum of 2 '=' In
' the whole string.)
thisChar = Mid(base64String, groupBegin + CharCounter, 1)
If thisChar = "=" Then
numDataBytes = numDataBytes - 1
thisData = 0
Else
thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
End If
If thisData = -1 Then
Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
Exit Function
End If
nGroup = 64 * nGroup + thisData
Next
'Hex splits the long To 6 groups with 4 bits
nGroup = Hex(nGroup)
'Add leading zeros
nGroup = String(6 - Len(nGroup), "0") & nGroup
'Convert the 3 byte hex integer (6 chars) To 3 characters
pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 3, 2))) + _
Chr(CByte("&H" & Mid(nGroup, 5, 2)))
'add numDataBytes characters To out string
sOut = sOut & Left(pOut, numDataBytes)
Next
Base64Decode = sOut
End Function
Function Base64Encode(inData)
'rfc1521
'2001 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, i
'For each group of 3 bytes
For i = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, i, 1)) + _
&H100 * MyASC(Mid(inData, i + 1, 1)) + MyASC(Mid(inData, i + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
That's some lengthy way to encode. I prefer this:
You Need to add reference to Microsoft XML, v6.0 (or v3.0)
Sub TestBase64()
Dim bytes, b64
With CreateObject("ADODB.Stream")
.Open
.Type = ADODB.adTypeBinary
.LoadFromFile "c:\temp\TestPic.jpeg"
bytes = .Read
.Close
End With
Debug.Print bytes
b64 = EncodeBase64(bytes)
Debug.Print vbCrLf + vbCrLf
Debug.Print Left(b64, 100)
' Debug.Print vbCrLf + vbCrLf
' Debug.Print Base64Decode(CStr(b64))
End Sub
Private Function EncodeBase64(bytes) As String
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = bytes
EncodeBase64 = objNode.Text
Set objNode = Nothing
Set objXML = Nothing
End Function
Output (first few characters): /9j/4AAQSkZJRgABAQEAYABgAAD
Windows' GetPrivateProfileXXX functions (used for working with INI files) have some strange rules about dealing with buffer lengths.
GetPrivateProfileString's documentation states:
If [..] the supplied destination buffer is too small to hold the requested string, the string is truncated and followed by a null character, and the return value is equal to nSize minus one.
I read this and I realised that this behaviour makes it impossible to differentiate between two scenarios in-code:
When the value string's length is exactly equal to nSize - 1.
When the nSize value (i.e. the buffer) is too small.
I thought I'd experiment:
I have this in an INI file:
[Bar]
foo=123456
And I called GetPrivateProfileString with these arguments as a test:
// Test 1. The buffer is big enough for the string (16 character buffer).
BYTE* buffer1 = (BYTE*)calloc(16, 2); // using 2-byte characters ("Unicode")
DWORD result1 = GetPrivateProfileString(L"Bar", L"foo", NULL, buffer, 16, fileName);
// result1 is 6
// buffer1 is { 49, 0, 50, 0, 51, 0, 52, 0, 53, 0, 54, 0, 0, 0, 0, 0, ... , 0, 0 }
// Test 2. The buffer is exactly sufficient to hold the value and the trailing null (7 characters).
BYTE* buffer2 = (BYTE*)calloc(7, 2);
DWORD result2 = GetPrivateProfileString(L"Bar", L"foo", NULL, buffer, 7, fileName);
// result2 is 6. This is equal to 7-1.
// buffer2 is { 49, 0, 50, 0, 51, 0, 52, 0, 53, 0, 54, 0, 0, 0 }
// Test 3. The buffer is insufficient to hold the value and the trailing null (6 characters).
BYTE* buffer3 = (BYTE*)calloc(6, 2);
DWORD result3 = GetPrivateProfileString(L"Bar", L"foo", NULL, buffer, 6, fileName);
// result3 is 5. This is equal to 6-1.
// buffer3 is { 49, 0, 50, 0, 51, 0, 52, 0, 53, 0, 0, 0 }
A program calling this code would have no way of knowing for sure if the actual key value is indeed 5 characters in length, or even 6, as in the last two cases result is equal to nSize - 1.
The only solution is to check whenever result == nSize - 1 and recall the function with a larger buffer, but this would be unnecessary in the cases where the buffer is of exactly the right size.
Isn't there a better way?
There is no better way. Just try to make sure the first buffer is large enough. Any method that solves this problem would have to make use of something not described in the documentation and hence would have no guarantee of working.
While I was working on bringing some of my antique code into the future, I found this question regarding buffering and the Private Profile API. After my own experimentation and research, I can confirm the asker's original statement regarding the inability to determine the difference between when the string is exactly nSize - 1 or when the buffer is too small.
Is there a better way? The accepted answer from Mike says there isn't according to the documentation and you should just try to make sure the buffer is large enough. Marc says to grow the buffer. Roman says the check error codes. Some random user says you need to provide a buffer large enough and, unlike Marc, proceeds to show some code that expands his buffer.
Is there a better way? Lets get the facts!
Due to the age of the ProfileString API, because none of the tags to this question regard any particular language and for easy readability, I've decided to show my examples using VB6. Feel free to translate them for your own purposes.
GetPrivateProfileString Documentation
According to the GetPrivateProfileString documentation, these Private Profile functions are provided only for compatibility with 16-bit Windows-based applications. This is great information because it allows us to understand the limitations of what these API functions can do.
A 16 bit signed integer has a range of −32,768 to 32,767 and an unsigned 16 bit integer has a range of 0 to 65,535. If these functions are truly made for use in a 16 bit environment, its highly probable that any numbers we encounter will be restricted to one of these two limits.
The documentation states that every string returned will end with a null character and also says a string which doesn't fit into the supplied buffer will be truncated and terminated with a null character. Therefore, if a string does fit into the buffer the second last character will be null as well as the last character. If only the last character is null then the extracted string is exactly the same length of the supplied buffer - 1 or the buffer was not large enough to hold the string.
In either situation where the second last character is not null, the extracted string being the exact length or too large for the buffer, GetLastError will return error number 234 ERROR_MORE_DATA (0xEA) giving us no way to differentiate between them.
What is the maximum buffer size accepted by GetPrivateProfileString?
While the documentation doesn't state the maximum buffer size, we already know this API was designed for a 16-bit environment. After a little experimentation, I was able to conclude that the maximum buffer size is 65,536. If the string in the file is larger than 65,535 characters long we start to see some strange behaviour while trying to read the string. If the string in the file is 65,536 characters long the retrieved string will be 0 characters long. If the string in the file is 65,546 characters long the retrieved string will be 10 characters long, end with a null character and be truncated from the very beginning of the string contained within the file. The API will write a string larger than 65,535 characters but will not be able to read anything larger than 65,535 characters. If the buffer length is 65,536 and the string in the file is 65,535 characters long, the buffer will contain the string from the file and also end in a single null character.
This provides us with our first, albeit not perfect solution. If you want to always make sure your first buffer is large enough, make that buffer 65,536 characters long.
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Function iniRead(ByVal Pathname As String, ByVal Section As String, ByVal Key As String, Optional ByVal Default As String) As String
On Error GoTo iniReadError
Dim Buffer As String
Dim Result As Long
Buffer = String$(65536, vbNullChar)
Result = GetPrivateProfileString(Section, Key, vbNullString, Buffer, 65536, Pathname)
If Result <> 0 Then
iniRead = Left$(Buffer, Result)
Else
iniRead = Default
End If
iniReadError:
End Function
Now that we know the maximum buffer size, we can use the size of the file to revise it. If the size of your file is less than 65,535 characters long there may be no reason to create a buffer so large.
In the remarks section of the documentation it says a section in the initialization file must have the following form:
[section]key=string
We can assume that each section contains two square brackets and an equal sign. After a small test, I was able to verify that the API will accept any kind of line break between the section and key (vbLf , vbCr Or vbCrLf / vbNewLine). These details and the lengths of the section and key names will allow us to narrow the maximum buffer length and also ensure the file size is large enough to contain a string before we attempt to read the file.
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Function iniRead(ByVal Pathname As String, ByVal Section As String, ByVal Key As String, Optional ByVal Default As String) As String
On Error Resume Next
Dim Buffer_Size As Long
Err.Clear
Buffer_Size = FileLen(Pathname)
On Error GoTo iniReadError
If Err.Number = 0 Then
If Buffer_Size > 4 + Len(Section) + Len(Key) Then
Dim Buffer As String
Dim Result As Long
Buffer_Size = Buffer_Size - Len(Section) - Len(Key) - 4
If Buffer_Size > 65535 Then
Buffer_Size = 65536
Else
Buffer_Size = Buffer_Size + 1
End If
Buffer = String$(Buffer_Size, vbNullChar)
Result = GetPrivateProfileString(Section, Key, vbNullString, Buffer, Buffer_Size, Pathname)
If Result <> 0 Then
iniRead = Left$(Buffer, Result)
Exit Function
End If
End If
End If
iniRead = Default
iniReadError:
End Function
Growing the Buffer
Now that we've tried really hard to make sure the first buffer is large enough and we have a revised maximum buffer size, it still might make more sense for us to start with a smaller buffer and gradually increase the size of the buffer to create a buffer large enough that we can extract the entire string from the file. According to the documentation, the API creates the 234 error to tell us there's more data available. It makes a lot of sense that they use this error code to tell us to try again with a larger buffer. The downside to retrying over and over again is that its more costly. The longer the string in the file, the more tries required to read it, the longer its going to take. 64 Kilobytes isn't a lot for today's computers and today's computers are pretty fast, so you may find either of these examples fit your purposes regardless.
I've done a fair bit of searching the GetPrivateProfileString API, and I've found that typically when someone without extensive knowledge of the API tries to create a large enough buffer for their needs, they choose a buffer length of 255. This would allow you to read a string from the file up to 254 characters long. I'm not sure why anybody started using this but I would assume someone somewhere imagined this API using a string where the buffer length is limited to an 8-bit unsigned number. Perhaps this was a limitation of WIN16.
I'm going to start my buffer low, 64 bytes, unless the maximum buffer length is less, and quadruple the number either up to the maximum buffer length or 65,536. Doubling the number would also be acceptable, a larger multiplication means less attempts at reading the file for larger strings while, relatively speaking, some medium length strings might have extra padding.
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Function iniRead(ByVal Pathname As String, ByVal Section As String, ByVal Key As String, Optional ByVal Default As String) As String
On Error Resume Next
Dim Buffer_Max As Long
Err.Clear
Buffer_Max = FileLen(Pathname)
On Error GoTo iniReadError
If Err.Number = 0 Then
If Buffer_Max > 4 + Len(Section) + Len(Key) Then
Dim Buffer As String
Dim Result As Long
Dim Buffer_Size As Long
Buffer_Max = Buffer_Max - Len(Section) - Len(Key) - 4
If Buffer_Max > 65535 Then
Buffer_Max = 65536
Else
Buffer_Max = Buffer_Max + 1
End If
If Buffer_Max < 64 Then
Buffer_Size = Buffer_Max
Else
Buffer_Size = 64
End If
Buffer = String$(Buffer_Size, vbNullChar)
Result = GetPrivateProfileString(Section, Key, vbNullString, Buffer, Buffer_Size, Pathname)
If Result <> 0 Then
If Buffer_Max > 64 Then
Do While Result = Buffer_Size - 1 And Buffer_Size < Buffer_Max
Buffer_Size = Buffer_Size * 4
If Buffer_Size > Buffer_Max Then
Buffer_Size = Buffer_Max
End If
Buffer = String$(Buffer_Size, vbNullChar)
Result = GetPrivateProfileString(Section, Key, vbNullString, Buffer, Buffer_Size, Pathname)
Loop
End If
iniRead = Left$(Buffer, Result)
Exit Function
End If
End If
End If
iniRead = Default
iniReadError:
End Function
Improved Validation
Depending on your implementation, improving the validation of your pathname, section and key names may prevent you from needing to prepare a buffer.
According to Wikipedia's INI File page, they say:
In the Windows implementation the key cannot contain the characters
equal sign ( = ) or semi colon ( ; ) as these are reserved characters.
The value can contain any character.
and
In the Windows implementation the section cannot contain the character
closing bracket ( ] ).
A quick test of the GetPrivateProfileString API proved this to be only partially true. I had no issues with using a semi colon within a key name so long as the semi colon was not at the very beginning. They don't mention any other limitations in the documentation or on Wikipedia although there might be more.
Another quick test to find the maximum length of a section or key name accepted by GetPrivateProfileString gave me a limit of 65,535 characters. The effects of using a string larger than 65,535 characters were the same as I had experienced while testing the maximum buffer length. Another test proved that this API will accept a blank string for either the section or key name. According to the functionality of the API, this is an acceptable initialization file:
[]
=Hello world!
According to Wikipedia, interpretation of whitespace varies. After yet another test, the Profile String API is definitely stripping whitespace from section and key names so its probably okay if we do it too.
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Function iniRead(ByVal Pathname As String, ByVal Section As String, ByVal Key As String, Optional ByVal Default As String) As String
On Error Resume Next
If Len(Pathname) <> 0 Then
Key = Trim$(Key)
If InStr(1, Key, ";") <> 1 Then
Section = Trim$(Section)
If Len(Section) > 65535 Then
Section = RTrim$(Left$(Section, 65535))
End If
If InStr(1, Section, "]") = 0 Then
If Len(Key) > 65535 Then
Key = RTrim$(Left$(Key, 65535))
End If
If InStr(1, Key, "=") = 0 Then
Dim Buffer_Max As Long
Err.Clear
Buffer_Max = FileLen(Pathname)
On Error GoTo iniReadError
If Err.Number = 0 Then
If Buffer_Max > 4 + Len(Section) + Len(Key) Then
Dim Buffer As String
Dim Result As Long
Dim Buffer_Size As Long
Buffer_Max = Buffer_Max - Len(Section) - Len(Key) - 4
If Buffer_Max > 65535 Then
Buffer_Max = 65536
Else
Buffer_Max = Buffer_Max + 1
End If
If Buffer_Max < 64 Then
Buffer_Size = Buffer_Max
Else
Buffer_Size = 64
End If
Buffer = String$(Buffer_Size, vbNullChar)
Result = GetPrivateProfileString(Section, Key, vbNullString, Buffer, Buffer_Size, Pathname)
If Result <> 0 Then
If Buffer_Max > 64 Then
Do While Result = Buffer_Size - 1 And Buffer_Size < Buffer_Max
Buffer_Size = Buffer_Size * 4
If Buffer_Size > Buffer_Max Then
Buffer_Size = Buffer_Max
End If
Buffer = String$(Buffer_Size, vbNullChar)
Result = GetPrivateProfileString(Section, Key, vbNullString, Buffer, Buffer_Size, Pathname)
Loop
End If
iniRead = Left$(Buffer, Result)
Exit Function
End If
End If
End If
iniRead = Default
End If
End If
End If
End If
iniReadError:
End Function
Static Length Buffer
Sometimes we need to store variables that have a maximum length or a static length. A username, phone number, colour code or IP address are examples of strings where you might want to limit the maximum buffer length. Doing so when necessary will save you time and energy.
In the code example below, Buffer_Max will be limited to Buffer_Limit + 1. If the limit is greater than 64, we will begin with 64 and expand the buffer just as we did before. Less than 64 and we will only read once using our new buffer limit.
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Function iniRead(ByVal Pathname As String, ByVal Section As String, ByVal Key As String, Optional ByVal Default As String, Optional Buffer_Limit As Long = 65535) As String
On Error Resume Next
If Len(Pathname) <> 0 Then
Key = Trim$(Key)
If InStr(1, Key, ";") <> 1 Then
Section = Trim$(Section)
If Len(Section) > 65535 Then
Section = RTrim$(Left$(Section, 65535))
End If
If InStr(1, Section, "]") = 0 Then
If Len(Key) > 65535 Then
Key = RTrim$(Left$(Key, 65535))
End If
If InStr(1, Key, "=") = 0 Then
Dim Buffer_Max As Long
Err.Clear
Buffer_Max = FileLen(Pathname)
On Error GoTo iniReadError
If Err.Number = 0 Then
If Buffer_Max > 4 + Len(Section) + Len(Key) Then
Dim Buffer As String
Dim Result As Long
Dim Buffer_Size As Long
Buffer_Max = Buffer_Max - Len(Section) - Len(Key) - 4
If Buffer_Limit > 65535 Then
Buffer_Limit = 65535
End If
If Buffer_Max > Buffer_Limit Then
Buffer_Max = Buffer_Limit + 1
Else
Buffer_Max = Buffer_Max + 1
End If
If Buffer_Max < 64 Then
Buffer_Size = Buffer_Max
Else
Buffer_Size = 64
End If
Buffer = String$(Buffer_Size, vbNullChar)
Result = GetPrivateProfileString(Section, Key, vbNullString, Buffer, Buffer_Size, Pathname)
If Result <> 0 Then
If Buffer_Max > 64 Then
Do While Result = Buffer_Size - 1 And Buffer_Size < Buffer_Max
Buffer_Size = Buffer_Size * 4
If Buffer_Size > Buffer_Max Then
Buffer_Size = Buffer_Max
End If
Buffer = String$(Buffer_Size, vbNullChar)
Result = GetPrivateProfileString(Section, Key, vbNullString, Buffer, Buffer_Size, Pathname)
Loop
End If
iniRead = Left$(Buffer, Result)
Exit Function
End If
End If
End If
iniRead = Default
End If
End If
End If
End If
iniReadError:
End Function
Using WritePrivateProfileString
To ensure there are no issues reading a string using GetPrivateProfileString, limit your strings to 65,535 or less characters long before using WritePrivateProfileString. Its also a good idea to include the same validations.
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Function iniRead(ByVal Pathname As String, ByVal Section As String, ByVal Key As String, Optional ByVal Default As String, Optional Buffer_Limit As Long = 65535) As String
On Error Resume Next
If Len(Pathname) <> 0 Then
Key = Trim$(Key)
If InStr(1, Key, ";") <> 1 Then
Section = Trim$(Section)
If Len(Section) > 65535 Then
Section = RTrim$(Left$(Section, 65535))
End If
If InStr(1, Section, "]") = 0 Then
If Len(Key) > 65535 Then
Key = RTrim$(Left$(Key, 65535))
End If
If InStr(1, Key, "=") = 0 Then
Dim Buffer_Max As Long
Err.Clear
Buffer_Max = FileLen(Pathname)
On Error GoTo iniReadError
If Err.Number = 0 Then
If Buffer_Max > 4 + Len(Section) + Len(Key) Then
Dim Buffer As String
Dim Result As Long
Dim Buffer_Size As Long
Buffer_Max = Buffer_Max - Len(Section) - Len(Key) - 4
If Buffer_Limit > 65535 Then
Buffer_Limit = 65535
End If
If Buffer_Max > Buffer_Limit Then
Buffer_Max = Buffer_Limit + 1
Else
Buffer_Max = Buffer_Max + 1
End If
If Buffer_Max < 64 Then
Buffer_Size = Buffer_Max
Else
Buffer_Size = 64
End If
Buffer = String$(Buffer_Size, vbNullChar)
Result = GetPrivateProfileString(Section, Key, vbNullString, Buffer, Buffer_Size, Pathname)
If Result <> 0 Then
If Buffer_Max > 64 Then
Do While Result = Buffer_Size - 1 And Buffer_Size < Buffer_Max
Buffer_Size = Buffer_Size * 4
If Buffer_Size > Buffer_Max Then
Buffer_Size = Buffer_Max
End If
Buffer = String$(Buffer_Size, vbNullChar)
Result = GetPrivateProfileString(Section, Key, vbNullString, Buffer, Buffer_Size, Pathname)
Loop
End If
iniRead = Left$(Buffer, Result)
Exit Function
End If
End If
End If
iniWrite Pathname, Section, Key, Default
iniRead = Default
End If
End If
End If
End If
iniReadError:
End Function
Public Function iniWrite(ByVal Pathname As String, ByVal Section As String, ByVal Key As String, ByVal Value As String) As Boolean
On Error GoTo iniWriteError
If Len(Pathname) <> 0 Then
Key = Trim$(Key)
If InStr(1, Key, ";") <> 1 Then
Section = Trim$(Section)
If Len(Section) > 65535 Then
Section = RTrim$(Left$(Section, 65535))
End If
If InStr(1, Section, "]") = 0 Then
If Len(Key) > 65535 Then
Key = RTrim$(Left$(Key, 65535))
End If
If InStr(1, Key, "=") = 0 Then
If Len(Value) > 65535 Then Value = Left$(Value, 65535)
iniWrite = WritePrivateProfileString(Section, Key, Value, Pathname) <> 0
End If
End If
End If
End If
iniWriteError:
End Function
No, unfortunately, there isn't a better way. You have to provide a buffer larger enough. If it is not sufficient, reallocate the buffer. I took a code snippet from here, and adapted to your case:
int nBufferSize = 1000;
int nRetVal;
int nCnt = 0;
BYTE* buffer = (BYTE*)calloc(1, 2);
do
{
nCnt++;
buffer = (BYTE*) realloc (buffer , nBufferSize * 2 * nCnt);
DWORD nRetVal = GetPrivateProfileString(L"Bar", L"foo", NULL,
buffer, nBufferSize*nCnt, filename);
} while( (nRetVal == ((nBufferSize*nCnt) - 1)) ||
(nRetVal == ((nBufferSize*nCnt) - 2)) );
but, in your specific case, a filename cannot have a length greater than MAX_PATH, so (MAX_PATH+1)*2 will always fit.
Maybe, calling GetLastError right after GetPrivateProfileString is a way to go. If the buffer is big enough and there's no other errors, GetLastError returns 0. If the buffer is too small, GetLastError returns 234 (0xEA) ERROR_MORE_DATA.
I know it is a little late, but I came up with an awesome solution. If there is no buffer space left over (return length + 1 = buffer length), then grow the buffer and get the value again. Repeat that process until there is buffer space left over.
The best solution surely is Brogan's, but checking for file size as upper limit for the buffer size is just wrong. Especially when dealing with INI files located in the Windows or system folder, many of the keys where mapped to be read and/or written in the registry.
The mapping structure can be found in:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\IniFileMapping
For a complete explanation on how this works, you can read the Remarks section of the GetPrivateProfileString documentation.
Thus you could have many strings remapped to registry which grow up long enough, but a small INI file on disk. In this case the solution fails reading.
That solution also has another small problem when not using an absolute path to the desired file or when it isn't located in program's current working directory, since the GetPrivateProfileStrings searches for the initialization file in the Windows directory. This operation is not in the FileLen function nor the solution checks for that.
Ended up allocating 64K of memory and accepted this as a limit.