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.
How to Convert string in to Byte array that contain &H81 in first index if the byte array mybyte(0) with
i need to check in my byte array
Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" (Destination As Any, _
Source As Any, _
ByVal Length As Long)
Private Sub cmdCommand1_Click()
Dim str As String
Dim BT() As Byte
BT() = StrToByte(tbMsg.Text)
If BT(0) = &H81 Then
'MyCode
End If
End Sub
the If mybyte(0) = &H81 Then condition is allays getting false
and currently i'm using this string to byte converting method
Public Function StrToByte(strInput As String) As Byte()
Dim lPntr As Long
Dim bTmp() As Byte
Dim bArray() As Byte
If Len(strInput) = 0 Then Exit Function
ReDim bTmp(LenB(strInput) - 1) 'Memory length
ReDim bArray(Len(strInput) - 1) 'String length
CopyMemory bTmp(0), ByVal StrPtr(strInput), LenB(strInput)
For lPntr = 0 To UBound(bArray)
If bTmp(lPntr * 2 + 1) > 0 Then
bArray(lPntr) = Asc(Mid$(strInput, lPntr + 1, 1))
Else
bArray(lPntr) = bTmp(lPntr * 2)
End If
Next lPntr
StrToByte = bArray
End Function
A typo I think, it should be:
If BT(0) = &H81 Then
Not
If mybyte(0) = &H81 Then
Your code seems to be converting the double byte unicode string into a single byte representation of the string, this will result in garbage for any character with a codepoint > 255.
If thats ok your code is equivalent to the built in:
BT() = StrConv(strInput, vbFromUnicode)
I am having trouble converting from a Byte Array to a Signed Integer in VB6. This would be simple to do with BitConverter in .NET but I'm not sure what to do with VB6.
Thanks
Unfortunately no built in function, you need to write one. Here is a quick sample to get you started.
Private Function BArrayToInt(ByRef bArray() As Byte) As Integer
Dim iReturn As Integer
Dim i As Integer
For i = 0 To UBound(bArray) - LBound(bArray)
iReturn = iReturn + bArray(i) * 2 ^ i
Next i
BArrayToInt = iReturn
End Function
CopyMemory
Air code (may crash your PC, cause dinosaur attack, etc).
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, _ source As Any, ByVal bytes As Long)
Dim a() As Byte
Dim n As Integer
'get the bytes somehow into a()
CopyMemory n, a(0), 2
I want to list all the IP Address connected LAN into a listbox in VB6. Ive visited this. But I want to do this in VB6. I've no idea about how to do this. Any help is appreciated.
Using a WinSock control (wsck) purely for being a way to get the local IP address, use this code:
Option Explicit
Private Type IPAddr
s_b1 As Byte
s_b2 As Byte
s_b3 As Byte
s_b4 As Byte
End Type
Private Type IPAddrCompat
ul As Long
End Type
Private Type MacAddress
s_b1 As Byte
s_b2 As Byte
s_b3 As Byte
s_b4 As Byte
s_b5 As Byte
s_b6 As Byte
unused As Integer
End Type
Private Declare Function SendARP Lib "Iphlpapi.dll" ( _
ByVal DestIP As Long, _
ByVal SrcIP As Long, _
ByRef pMacAddr As MacAddress, _
ByRef PhyAddrLen As Long _
) As Long
Private Sub cmdGetIPs_Click()
Dim nIndex As Long
Dim vasLocalIP As Variant
Dim uIPAddr As IPAddr
Dim uIPAddrCompat As IPAddrCompat
Dim uMacAddr As MacAddress
Dim nMacAddrLen As Long
vasLocalIP = Split(wsck.LocalIP, ".")
uIPAddr.s_b1 = CByte(vasLocalIP(0))
uIPAddr.s_b2 = CByte(vasLocalIP(1))
uIPAddr.s_b3 = CByte(vasLocalIP(2))
' Iterate through all valid addresses in the final quartet.
For nIndex = 1 To 254
uIPAddr.s_b4 = CByte(nIndex)
LSet uIPAddrCompat = uIPAddr ' Convert 4 bytes into 1 long.
nMacAddrLen = 8 ' Indicate that we are allocating a buffer with 8 bytes.
' Try to find the MAC address for this IP.
If SendARP(uIPAddrCompat.ul, 0&, uMacAddr, nMacAddrLen) = 0 Then
' MAC addresses are 6 bytes long.
If nMacAddrLen = 6 Then
vasLocalIP(3) = CStr(nIndex)
Debug.Print Join(vasLocalIP, "."), MacAddrString(uMacAddr, nMacAddrLen)
End If
End If
Next nIndex
End Sub
' Returns the MAC address as a six byte hex string.
Private Function MacAddrString(ByRef the_uMacAddr As MacAddress, ByVal the_nMacAddrLen) As String
With the_uMacAddr
MacAddrString = Hex2(.s_b1) & ":" & Hex2(.s_b2) & ":" & Hex2(.s_b3) & ":" & Hex2(.s_b4) & ":" & Hex2(.s_b5) & ":" & Hex2(.s_b6)
End With
End Function
' Returns the byte as a two digit hex string.
Private Function Hex2(ByVal the_byt As Byte) As String
Hex2 = Hex$(the_byt)
If Len(Hex2) = 1 Then
Hex2 = "0" & Hex2
End If
End Function
I'd like to store the contents of a data structure, a few arrays, and a dozen or so variables in a file that can be saved and reloaded by my software as well as optionally edited in a text editor by a user reloaded. For the text editing, I need the data to be clearly labeled, like in a good ole .ini file:
AbsMaxVoltage = 17.5
There's a GUI, and one could argue that the user should just load and save and modify from the GUI, but the customer wants to be able to read and modify the data as text.
It's easy enough to write code to save it and reload it (assuming all the labels are in the same place and only the data has changed). With more work (or using some of the INI R/W code that's already out there I could pay attention to the label so if a line gets deleted or moved around the variables still get stuffed correctly, but both of these approaches seem pretty old-school. So I'm interested in how the brightest minds in programming would approach this today (using decade-old VB6 which I have to admit I still love).
Disclaimer: I'm an electrical engineer, not a programmer. This isn't my day job. Well maybe it's a few % of my day job.
Cheers!
Lots of people will recommend XML to you. The problem is XML is still so trendy, some people use it everywhere without really thinking about it.
Like Jeff Atwood said, it's hard for non-programmers to read XML and particularly to edit it. There are too many rules, like escaping special characters and closing the tags in the correct order. Some experts recommend you treat XML as a binary format, not a text format at all.
I recommend using INI files, provided the maximum size limit of 32K is not a problem. I've never reached that limit in many similar situations in my own VB6. INI files are easy for ordinary folk to edit, and it's easy to read and write them from VB6. Just use some of the excellent drop-in code freely available on the web.
I'm sure the class Jay Riggs
provided in his answer is excellent, because
it's from VBAccelerator.
I would also recommend this class,
because anything by Karl Peterson
will be excellent too.
A couple of other points to think about:
Have you considered which directory to put the files into?
You mentioned "Unicode-friendly" in the question. INI files aren't Unicode, but that doesn't matter in practise. Unless you want to store characters that aren't supported on the current code page - like Chinese on an English computer - an unusual requirement, and one that will cause you other problems in a VB6 program anyway.
Legendary Windows guru Raymond Chen described the advantages of XML configuration files over INI files. Many of them rely on the XML file being read-only. The one legitimate advantage is if the data is highly structured - class heirarchies or the like. From your description that doesn't apply.
Consider using XML. It's completely standard, many text editors will highlight/manage it properly, every programming language and script language on Earth has good support for reading it, and it handles Unicode perfectly.
For simple name/value pairs as you suggest, it's quite readable. But you have the added advantage that if someday you need something more complex -- e.g. multi-lined values or a list of distinct values -- XML provides natural, easy ways of representing that.
P.S. Here's how to read XML in VB6.
Back in the olden days this class helped me use INI files with my VB6 programs:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "cInifile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' =========================================================
' Class: cIniFile
' Author: Steve McMahon
' Date : 21 Feb 1997
'
' A nice class wrapper around the INIFile functions
' Allows searching,deletion,modification and addition
' of Keys or Values.
'
' Updated 10 May 1998 for VB5.
' * Added EnumerateAllSections method
' * Added Load and Save form position methods
' =========================================================
Private m_sPath As String
Private m_sKey As String
Private m_sSection As String
Private m_sDefault As String
Private m_lLastReturnCode As Long
#If Win32 Then
' Profile String functions:
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
Private Declare Function GetPrivateProfileString Lib "KERNEL32" Alias
"GetPrivateProfileStringA" (ByVal lpApplicationName As Any, ByVal
lpKeyName As Any, ByVal lpDefault As Any, ByVal lpReturnedString As
String, ByVal nSize As Long, ByVal lpFileName As String) As Long
#Else
' Profile String functions:
Private Declare Function WritePrivateProfileString Lib "Kernel" (ByVal
lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As
Any, ByVal lpFileName As String) As Integer
Private Declare Function GetPrivateProfileString Lib "Kernel" (ByVal
lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As
Any, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal
lpFileName As String) As Integer
#End If
Property Get LastReturnCode() As Long
LastReturnCode = m_lLastReturnCode
End Property
Property Get Success() As Boolean
Success = (m_lLastReturnCode <> 0)
End Property
Property Let Default(sDefault As String)
m_sDefault = sDefault
End Property
Property Get Default() As String
Default = m_sDefault
End Property
Property Let Path(sPath As String)
m_sPath = sPath
End Property
Property Get Path() As String
Path = m_sPath
End Property
Property Let Key(sKey As String)
m_sKey = sKey
End Property
Property Get Key() As String
Key = m_sKey
End Property
Property Let Section(sSection As String)
m_sSection = sSection
End Property
Property Get Section() As String
Section = m_sSection
End Property
Property Get Value() As String
Dim sBuf As String
Dim iSize As String
Dim iRetCode As Integer
sBuf = Space$(255)
iSize = Len(sBuf)
iRetCode = GetPrivateProfileString(m_sSection, m_sKey, m_sDefault, sBuf,
iSize, m_sPath)
If (iSize > 0) Then
Value = Left$(sBuf, iRetCode)
Else
Value = ""
End If
End Property
Property Let Value(sValue As String)
Dim iPos As Integer
' Strip chr$(0):
iPos = InStr(sValue, Chr$(0))
Do While iPos <> 0
sValue = Left$(sValue, (iPos - 1)) & Mid$(sValue, (iPos + 1))
iPos = InStr(sValue, Chr$(0))
Loop
m_lLastReturnCode = WritePrivateProfileString(m_sSection, m_sKey, sValue,
m_sPath)
End Property
Public Sub DeleteKey()
m_lLastReturnCode = WritePrivateProfileString(m_sSection, m_sKey, 0&,
m_sPath)
End Sub
Public Sub DeleteSection()
m_lLastReturnCode = WritePrivateProfileString(m_sSection, 0&, 0&, m_sPath)
End Sub
Property Get INISection() As String
Dim sBuf As String
Dim iSize As String
Dim iRetCode As Integer
sBuf = Space$(8192)
iSize = Len(sBuf)
iRetCode = GetPrivateProfileString(m_sSection, 0&, m_sDefault, sBuf, iSize,
m_sPath)
If (iSize > 0) Then
INISection = Left$(sBuf, iRetCode)
Else
INISection = ""
End If
End Property
Property Let INISection(sSection As String)
m_lLastReturnCode = WritePrivateProfileString(m_sSection, 0&, sSection,
m_sPath)
End Property
Property Get Sections() As String
Dim sBuf As String
Dim iSize As String
Dim iRetCode As Integer
sBuf = Space$(8192)
iSize = Len(sBuf)
iRetCode = GetPrivateProfileString(0&, 0&, m_sDefault, sBuf, iSize, m_sPath)
If (iSize > 0) Then
Sections = Left$(sBuf, iRetCode)
Else
Sections = ""
End If
End Property
Public Sub EnumerateCurrentSection(ByRef sKey() As String, ByRef iCount As Long)
Dim sSection As String
Dim iPos As Long
Dim iNextPos As Long
Dim sCur As String
iCount = 0
Erase sKey
sSection = INISection
If (Len(sSection) > 0) Then
iPos = 1
iNextPos = InStr(iPos, sSection, Chr$(0))
Do While iNextPos <> 0
sCur = Mid$(sSection, iPos, (iNextPos - iPos))
If (sCur <> Chr$(0)) Then
iCount = iCount + 1
ReDim Preserve sKey(1 To iCount) As String
sKey(iCount) = Mid$(sSection, iPos, (iNextPos - iPos))
iPos = iNextPos + 1
iNextPos = InStr(iPos, sSection, Chr$(0))
End If
Loop
End If
End Sub
Public Sub EnumerateAllSections(ByRef sSections() As String, ByRef iCount As
Long)
Dim sIniFile As String
Dim iPos As Long
Dim iNextPos As Long
Dim sCur As String
iCount = 0
Erase sSections
sIniFile = Sections
If (Len(sIniFile) > 0) Then
iPos = 1
iNextPos = InStr(iPos, sIniFile, Chr$(0))
Do While iNextPos <> 0
If (iNextPos <> iPos) Then
sCur = Mid$(sIniFile, iPos, (iNextPos - iPos))
iCount = iCount + 1
ReDim Preserve sSections(1 To iCount) As String
sSections(iCount) = sCur
End If
iPos = iNextPos + 1
iNextPos = InStr(iPos, sIniFile, Chr$(0))
Loop
End If
End Sub
Public Sub SaveFormPosition(ByRef frmThis As Object)
Dim sSaveKey As String
Dim sSaveDefault As String
On Error GoTo SaveError
sSaveKey = Key
If Not (frmThis.WindowState = vbMinimized) Then
Key = "Maximised"
Value = (frmThis.WindowState = vbMaximized) * -1
If (frmThis.WindowState <> vbMaximized) Then
Key = "Left"
Value = frmThis.Left
Key = "Top"
Value = frmThis.Top
Key = "Width"
Value = frmThis.Width
Key = "Height"
Value = frmThis.Height
End If
End If
Key = sSaveKey
Exit Sub
SaveError:
Key = sSaveKey
m_lLastReturnCode = 0
Exit Sub
End Sub
Public Sub LoadFormPosition(ByRef frmThis As Object, Optional ByRef lMinWidth =
3000, Optional ByRef lMinHeight = 3000)
Dim sSaveKey As String
Dim sSaveDefault As String
Dim lLeft As Long
Dim lTOp As Long
Dim lWidth As Long
Dim lHeight As Long
On Error GoTo LoadError
sSaveKey = Key
sSaveDefault = Default
Default = "FAIL"
Key = "Left"
lLeft = CLngDefault(Value, frmThis.Left)
Key = "Top"
lTOp = CLngDefault(Value, frmThis.Top)
Key = "Width"
lWidth = CLngDefault(Value, frmThis.Width)
If (lWidth < lMinWidth) Then lWidth = lMinWidth
Key = "Height"
lHeight = CLngDefault(Value, frmThis.Height)
If (lHeight < lMinHeight) Then lHeight = lMinHeight
If (lLeft < 4 * Screen.TwipsPerPixelX) Then lLeft = 4 *
Screen.TwipsPerPixelX
If (lTOp < 4 * Screen.TwipsPerPixelY) Then lTOp = 4 * Screen.TwipsPerPixelY
If (lLeft + lWidth > Screen.Width - 4 * Screen.TwipsPerPixelX) Then
lLeft = Screen.Width - 4 * Screen.TwipsPerPixelX - lWidth
If (lLeft < 4 * Screen.TwipsPerPixelX) Then lLeft = 4 *
Screen.TwipsPerPixelX
If (lLeft + lWidth > Screen.Width - 4 * Screen.TwipsPerPixelX) Then
lWidth = Screen.Width - lLeft - 4 * Screen.TwipsPerPixelX
End If
End If
If (lTOp + lHeight > Screen.Height - 4 * Screen.TwipsPerPixelY) Then
lTOp = Screen.Height - 4 * Screen.TwipsPerPixelY - lHeight
If (lTOp < 4 * Screen.TwipsPerPixelY) Then lTOp = 4 *
Screen.TwipsPerPixelY
If (lTOp + lHeight > Screen.Height - 4 * Screen.TwipsPerPixelY) Then
lHeight = Screen.Height - lTOp - 4 * Screen.TwipsPerPixelY
End If
End If
If (lWidth >= lMinWidth) And (lHeight >= lMinHeight) Then
frmThis.Move lLeft, lTOp, lWidth, lHeight
End If
Key = "Maximised"
If (CLngDefault(Value, 0) <> 0) Then
frmThis.WindowState = vbMaximized
End If
Key = sSaveKey
Default = sSaveDefault
Exit Sub
LoadError:
Key = sSaveKey
Default = sSaveDefault
m_lLastReturnCode = 0
Exit Sub
End Sub
Public Function CLngDefault(ByVal sString As String, Optional ByVal lDefault As
Long = 0) As Long
Dim lR As Long
On Error Resume Next
lR = CLng(sString)
If (Err.Number <> 0) Then
CLngDefault = lDefault
Else
CLngDefault = lR
End If
End Function
Would and XML file be acceptable:-
<config>
<someAppPart
AbsMaxVoltage="17.5"
AbsMinVoltage="5.5"
/>
<someOtherAppPart
ForegroundColor="Black"
BackgroundColor="White"
/>
</config>
Its very easy to consume in VB6, you don't need to worry about positioning etc.
The downside is its the user tweaking it can make it unparsable, however thats true if you write your own parser for a config file.
If we can assume your saved settings are simply a set of name/value pairs without a two-level hierarchy requirement (i.e. INI "Keys" within "Sections") you might just persist them as such:
AbsMaxVoltage=17.5
AbsMinVoltage=5.5
For writing the persistence format this is a case where you might consider the FSO, since the access volume is low anyway. The FSO can handle read/writing Unicode text files.
I think I'd do something like read lines and parse them using a Split() on "=" specifying just 2 parts (thus allowing "=" within values as well). For loading these I'd store them into a simple Class instance where the Class has two properties (Name and Value) and add each one to a Collection using Name as the Key. Make Value the default property if desired.
Maybe even implement some form of comment text line too using a generated sequence-numbered special Name value stored as say Name="%1" Value="comment text" with generated unique Names to avoid Collection Key collisions. Blank lines might be similarly preserved.
Then persisting as necessary means simply using a For Each on the Collection and using the FSO to write Name=Value out to disk.
To simulate a hierarchy you could simply use Names like:
%Comment: somAppPart settings
someAppPart.AbsMaxVoltage=17.5
someAppPart.AbsMinVoltage=5.5
%someOtherPart settings
someOtherAppPart.ForegroundColor=Black
someOtherAppPart.BackgroundColor=White
The parsing is cheap, so any probing of the Collection might be preceded by a full reparse (as the INI API calls do). Any changing of values in the program might do a full rewrite to disk (like the INI API calls do).
Some of this can be automated by just wrapping the Collection with some logic in another Class. The result could be syntax like:
Settings("someOtherAppPart", "ForegroundColor") = "Red"
aka
Settings.Value("someOtherAppPart", "ForegroundColor") = "Red"
This would reload the Collection, then probe the Collection for an Item keyed "someOtherAppPart.ForegroundColor" and create it or set its Value to "Red" and then flush the Collection to disk. Or you might eschew frequent rewriting and use distinct Load and Save methods.
Make it as simple or fancy as desired.
In any case, the result is a text file users can hack at with Notepad. The only reason for the FSO is to have an easy way of read/writing Unicode text. One could also screw around with Byte array I/O and explicit conversions (array to String) and line level parsing as required to avoid the FSO. If so just don't forget about the UTF-16LE BOM.