by Ralph Barton (5 Submissions)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 20th July 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Removes the null characters from a string, allowing binary data to be put into the clipboard, or a textbox, and probably more places. The
VBcoders
'and put it into a format that is more portable.
'It can then change it back, and the string will be back how it started,
'without any data loss.
'The program has quite good error checking, but I haven't done much testing on,
'the code yet. In the 'Form Click' event, there is an example of how to use the
'code with the clipboard, I haven't tried it with a 'Textbox' yet, but don't see,
'why it wouldn't work. This would be good for DDE.
'At the moment the code probably only supports strings with 255 or less,
'null characters, this is stored in the byte just after the header tag.
'Feel free to use the code in any way you like. I may make a better version later on.
'While the same thing can be done by copying the data to the clipboard,
'in number form, this would take up 1 to 3 bytes for each byte,
'and another byte for each delimiter. This is over twice its normal,
'length, and wouldn't be suitable for a larger program.
'If you have any ideas, comments, or questions, you are welcome to send them.
Private Sub Form_Click()
Dim InpStr As String
Dim TmpStr As String
Dim InpArr() As Byte
Dim TmpBag As PropertyBag
Dim Cnt As Integer
On Error GoTo DatErr
Set TmpBag = New PropertyBag 'Clears the property bag.
TmpBag.WriteProperty "Test", "The data is correct." 'Adds the data that will be processed.
InpArr = TmpBag.Contents 'Extracts the data, in byte form.
'Changes the data into string form, as that is the only form my program can use.
'Note that the 'Join' command doesn't like byte data.
For Cnt = LBound(InpArr) To UBound(InpArr)
InpStr = InpStr & Chr$(InpArr(Cnt))
Next Cnt
'Allows the user to see an example of each method, and the results of each.
If MsgBox("Click yes, to use my code to copy a property bag to the clipboard and back, or no to try the normal method", vbYesNo + vbInformation, "The Test") = vbYes Then
'Changes the data to the right format.
InpStr = BinToTxt(InpStr)
End If
Clipboard.SetText (InpStr) 'Puts the data into the clipboard.
'Clears all the variables, making it easy to see
'that the clipboard is the only way the data can get back to the program.
Cnt = 0
TmpStr = ""
InpStr = ""
Set TmpBag = New PropertyBag
ReDim InpArr(0)
'Gets the data back from the clipboard.
TmpStr = Clipboard.GetText
If TmpStr Like "//BinDat\\*" Then 'Checks for the header.
TmpStr = TxtToBin(TmpStr) 'Changes the data back how it was.
End If
'Changes the data back into byte form.
For Cnt = 1 To Len(TmpStr)
ReDim Preserve InpArr(Cnt - 1)
InpArr(Cnt - 1) = Asc(Mid$(TmpStr, Cnt, 1))
Next Cnt
'Puts the data back into the property bag.
'If the data is incorrect, there will be an error.
TmpBag.Contents = InpArr
'If it gets to this point, then it was a success.
MsgBox (TmpBag.ReadProperty("Test")) 'Displays the data.
Exit Sub
DatErr:
'This means the data was corrupted, by the clipboard.
MsgBox ("The data is corrupt.")
End Sub
Public Function BinToTxt(InpStr As String) As String
Dim BadChr As String 'This is what the program removes from the string.
Dim OutStr As String 'This is the output of the corrected string.
Dim NullChr() As Integer 'This stores the places of the null characters, minus one.
BadChr = vbNullChar 'Tells the program, what we want to get rid of. Note that vbNullChar, is the same as chr$(0).
ErrHan InpStr, BadChr 'A quick check for problems.
OutStr = "//BinDat\\" 'Adds a header tag, so the user, and program knows that it should attempt to convert it back later. This is a good way to try and avoid errors later on.
NullChr = FindChrs(InpStr, BadChr) 'Finds the null characters.
OutStr = OutStr & MaxToNum(255, NullChr) 'Makes sure there are no bytes that have a value more than 255.
OutStr = OutStr & Replace(InpStr, BadChr, "") 'Removes the null characters from the string.
BinToTxt = OutStr 'Puts out the new data.
End Function
Public Function ChkErr(InpStr As String, BadChr As String) As Byte
Dim Cnt As Integer
'This makes sure that the data isn't just a string of null characters,
'there may not be a problem with this, but it is pointless anyway.
'This is the code behind error number 4.
For Cnt = 1 To Len(InpStr)
If Mid$(InpStr, Cnt, 1) <> BadChr Then
Cnt = 0
Exit For
End If
Next Cnt
If Len(InpStr) = 0 Then 'The string can't be 0 length.
ChkErr = 1
ElseIf Len(BadChr) <> 1 Then 'The length of BadChr must be 1.
ChkErr = 2
ElseIf InStr(1, InpStr, BadChr) = 0 Then 'The string doesn't need to be changed.
ChkErr = 3
ElseIf Cnt <> 0 Then 'The string must have some text that doesn't need to be changed.
ChkErr = 4
ElseIf InpStr Like BadChr & "*" Then 'The string can't start with a null character, as this would put a null character in the header.
ChkErr = 5
Else 'The string has no errors, and will now be changed.
ChkErr = 6
End If
End Function
Public Function ErrTxt(ErrVal As Byte) As String
'These are the error messages that are returned.
ErrTxt = Choose(ErrVal, "The string can't be 0 length.", "The length of BadChr must be 1.", "The string doesn't need to be changed.", "The string must have some text that doesn't need to be changed.", "The string can't start with a null charcter.", "The string has no errors, and will now be changed.")
End Function
Public Function InsTxt(MainStr As String, AddTxt As String, AfterChr As Integer) As String
'This function adds text in the middle of a string.
'Makes sure the insert postion is in range of the main string.
If AfterChr < 0 Then
AfterChr = 0
ElseIf AfterChr > Len(MainStr) Then
AfterChr = Len(MainStr)
End If
InsTxt = Mid$(MainStr, 1, AfterChr) 'Adds the first bit of the string.
InsTxt = InsTxt & AddTxt 'Adds the text to add.
InsTxt = InsTxt & Mid$(MainStr, AfterChr + 1, Len(MainStr) - AfterChr) 'Adds the last bit of the string.
End Function
Public Function ErrHan(InpStr As String, BadChr As String)
Dim ErrVal As Byte ' This stores the value of the error, that has been found in the input string.
Dim ErrStr As String 'This stores the error message, so the user knows what they did wrong.
Dim MsgIcon As Byte 'This stores the icon that will be appear on the message box.
MsgIcon = vbCritical 'Default to error icon.
ErrVal = ChkErr(InpStr, BadChr) 'Checks for errors in the input string.
ErrStr = ErrTxt(ErrVal) 'Changes the findings from above, into user readable form.
If ErrVal = 3 Or ErrVal = 6 Then MsgIcon = IIf(ErrVal = 3, vbExclamation, vbInformation) 'Changes the icon to suit the message.
MsgBox ErrStr, MsgIcon 'Displays the findings.
If ErrVal <> 6 Then End 'The program will only continue if it can.
End Function
Public Function FindChrs(InpStr As String, ChrTxt As String) As Variant
Dim TmpPos As Integer
Dim StrLen As Integer
Dim ChrPos() As Integer
ReDim ChrPos(0)
'This loop records the places of all the null characters.
Do
DoEvents
TmpPos = TmpPos + 1
TmpPos = InStr(TmpPos, InpStr, ChrTxt)
If TmpPos <> 0 Then
'A null character was found.
ReDim Preserve ChrPos(UBound(ChrPos) + 1)
ChrPos(UBound(ChrPos)) = TmpPos - 1
Else
'There are no more.
Exit Do
End If
Loop
FindChrs = ChrPos
End Function
Public Function MaxToNum(CutOff As Byte, CutDat() As Integer) As String
Dim Cnt As Integer
Dim TmpVal As Integer
Dim TmpStr As String
MaxToNum = MaxToNum & Chr$(UBound(CutDat)) '
'This loop makes sure that all the bytes are no more than 255.
For Cnt = 1 To UBound(CutDat)
TmpVal = CutDat(Cnt)
Do
If TmpVal > (CutOff - 1) Then
TmpVal = TmpVal - (CutOff - 1)
TmpStr = TmpStr & Chr$(CutOff) '
Else
MaxToNum = MaxToNum & (IIf(TmpStr <> "", TmpStr, "") & Chr$(TmpVal)) '
Exit Do
End If
Loop
Next Cnt
End Function
Public Function TxtToBin(InpStr As String) As String
Dim BadChr As String
Dim OutStr As String
Dim NullChr() As Integer
Dim Cnt As Integer
BadChr = vbNullChar
'Makes sure that the string did come from this program in the first place.
If Not InpStr Like "//BinDat\\*" Then
MsgBox "Unknown format.", vbOKOnly + vbCritical
Exit Function
End If
'Removes the header tag.
OutStr = Replace(InpStr, "//BinDat\\", "")
'Finds the bytes normal values.
NullChr = NumToMax(255, OutStr)
'Adds the null characters back into the string.
For Cnt = 1 To (UBound(NullChr) - 1)
OutStr = InsTxt(OutStr, BadChr, NullChr(Cnt))
Next Cnt
'Returns the data.
TxtToBin = OutStr
End Function
Public Function NumToMax(CutOff As Byte, CutDat As String) As Variant
Dim Cnt As Integer
Dim NullNum As Integer
Dim CutArr() As Integer
Dim TmpVal As Integer
Dim ArrPos As Integer
Dim NullCnt As Integer
'I don't think I will be able to comment on this bit sorry, as I didn't even think it would work.
'But basically it is the opposite to the 'MaxToNum' function.
ArrPos = 1
NullNum = Asc(Mid$(CutDat, 1, 1))
ReDim CutArr(NullNum + 1)
For Cnt = 2 To Len(CutDat)
TmpVal = Asc(Mid$(CutDat, Cnt, 1))
If TmpVal = CutOff Then
CutArr(ArrPos) = CutArr(ArrPos) + (CutOff - 1)
Else
If CutArr(ArrPos) = 0 Then
CutArr(ArrPos) = TmpVal
ArrPos = ArrPos + 1
If NullCnt = NullNum Then
Exit For
Else
NullCnt = NullCnt + 1
End If
Else
CutArr(ArrPos) = CutArr(ArrPos) + TmpVal
ArrPos = ArrPos + 1
If NullCnt = NullNum Then
Exit For
Else
NullCnt = NullCnt + 1
End If
End If
End If
Next Cnt
'Removes the header from the string, by changing the input of the function.
CutDat = Mid$(CutDat, Cnt, Len(CutDat))
'Returns the data.
NumToMax = CutArr
End Function
No comments have been posted about Removes the null characters from a string, allowing binary data to be put into the clipboard, or a . Why not be the first to post a comment about Removes the null characters from a string, allowing binary data to be put into the clipboard, or a .
