• Home
 · 
• String Manipulation
 · 
• Removes the null characters from a string, allowing binary data to be put into the clipboard, or a

Removes the null characters from a string, allowing binary data to be put into the clipboard, or a

Removes the null characters from a string, allowing binary data to be put into the clipboard, or a textbox, and probably more places. The

Rate Removes the null characters from a string, allowing binary data to be put into the clipboard, or a

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'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