I've got the need to escape any possible ascii escapes in a file. I've written this, and thought it was working well but just noticed that for some reason, there is a bunch of extra bytes at the end of the file now. There is probably a better way to do this, so here I am :) What's the best way to find bytes, and add a byte next to it?
Dim imageData() As Byte = File.ReadAllBytes(f_imagePath)
'Escape any ascii escapes
For i As Int32 = 0 To imageData.Length
If imageData(i) = &H1B Then
ReDim Preserve imageData(imageData.Length + 1)
'shift entire array
Dim arrCopy(imageData.Length + 1) As Byte
Array.Copy(imageData, 0, arrCopy, 0, i)
arrCopy(i) = &H1B
Array.Copy(imageData, i, arrCopy, i + 1, imageData.Length - i)
imageData = arrCopy
i = i + 1
End If
Next
Using a list...
Dim imageData() As Byte = File.ReadAllBytes(f_imagePath)
Dim newIMGData As New List(Of Byte)
'Escape any ascii escapes
For i As Int32 = 0 To imageData.Length
If imageData(i) = &H1B Then
'not sure about this,
newIMGData.Add(imageData(i)) 'add the &H1B
newIMGData.Add(&H0) 'add the other character
Else
newIMGData.Add(imageData(i))
End If
Next
imageData = newIMGData.ToArray
Related
I want to join selected line in RichTextBox and separate those two lines with specific character.
The situation is dire
But momma raised up a fighter
It's all come down to the wire
But the come-up is higher
result:
The situation is dire - But momma raised up a fighter
or
It's all come down to the wire - But the come-up is higher
The new line generated should replace the existing lines in the Control.
Try this:
Dim StartSelection As Integer = RichTextBox1.SelectionStart
Dim EndSelection As Integer = RichTextBox1.SelectionStart + RichTextBox1.SelectionLength
Dim StartLine As Integer = 0
Dim EndLine As Integer = 0
Dim Position As Integer = 0
Dim Pos As Integer = 0
Dim Index As Integer = 0
For i = 0 To RichTextBox1.Lines.Length - 1
Position += RichTextBox1.Lines(i).Length
If StartSelection <= Position Then
StartLine = i
Exit For
End If
Next
Position = 0
For i = 0 To RichTextBox1.Lines.Length - 1
Position += RichTextBox1.Lines(i).Length
If Position >= EndSelection Then
EndLine = i
Exit For
End If
Next
If EndLine = 0 Then
EndLine = RichTextBox1.Lines.Length - 1
Else
EndLine -= 1
End If
If Not StartLine = EndLine Then
Do
Pos += RichTextBox1.Lines(Index).Length
If Index = StartLine Then
Exit Do
Else
Index += 1
End If
Loop
Pos -= RichTextBox1.Lines(Index).Length
For i = StartLine To EndLine - 1
If i = StartLine Then
RichTextBox1.Text = RichTextBox1.Text.Remove(Pos + RichTextBox1.Lines(Index).Length + i, 1).Insert(Pos + RichTextBox1.Lines(Index).Length + i, " - ")
RichTextBox1.Refresh()
Else
RichTextBox1.Text = RichTextBox1.Text.Remove(Pos + RichTextBox1.Lines(Index).Length + StartLine, 1).Insert(Pos + RichTextBox1.Lines(Index).Length + StartLine, " - ")
RichTextBox1.Refresh()
End If
Next
End If
I recommend placing the code in the mouse-up event of the Textbox or RichTextbox.
An example using both string.Join() and LINQ's Aggregate() methods, to fill a StringBuilder that acts as an accumulator for the lines of text.
A StringBuilder object is a convenient storage when dealing with strings, it can limit the number of strings that will need garbage collection after use.
LINQ's Skip() and Take() method are also used to Skip the specified number of elements in a collection and Take a specified number of elements.
Note that Take() doesn't overflow: if the number of elements to take is more than what's available, it just takes what it can find.
I've mixed string.Join() and Aggregate() to show their use, you can actually perform all actions using one or the other.
Using Aggregate(), the last chars in the StringBuilder are determined by Environment.NewLine and need to be removed.
Note that the StringBuilder.ToString() method allows to generate a sub-string of the content.
If you use String.Join() instead, you don't need to strip the trailing chars.
You can call the MergeLines() method as:
RichTextBox1.Text = MergeLines(RichTextBox1.Text, 1, 4)
to merge 4 the lines of text in a RichTextBox, from line 1 to line 4.
If you have 6 lines and you want to merge all, then specify:
RichTextBox1.Text = MergeLines(RichTextBox1.Text, 0, 5)
The method checks whether the starting and ending lines specified express line values that are compatible with the content of the text.
Imports System.Linq
Imports System.Text
Private Function MergeLines(text As String, lineStart As Integer, lineEnd As Integer) As String
Dim lines = text.Split(ControlChars.Lf)
If lines.Length < 2 OrElse (lineStart < 0 OrElse lineEnd >= lines.Length) Then Return text
Dim sb = lines.Take(lineStart).
Aggregate(New StringBuilder(), Function(s, ln) s.AppendLine(ln))
sb.AppendLine(String.Join(" - ", lines.Skip(lineStart).Take(lineEnd - lineStart + 1)))
lines.Skip(lineEnd + 1).Aggregate(sb, Function(s, ln) s.AppendLine(ln))
Return sb.ToString(0, sb.Length - Environment.NewLine.Length)
End Function
Description of the first line of code that aggregates string elements to a StringBuilder:
Dim sb = lines.
Take(lineStart).
Aggregate(New StringBuilder(),
Function(s, ln) s.AppendLine(ln)
Using the lines collection:
Take lineStart number of lines. lineStart is the first line to merge: if lineStart = 2 - the third line - then take 2 lines, thus lines 0 and 1).
Aggregate in a new StringBuilder object each line taken. The StringBuilder appends each line plus Environment.NewLine.
The result of the aggregation is a filled StringBuilder object.
C# version:
private string MergeLines(string text, int start, int end)
{
var lines = text.Split('\n'); ;
if (lines.Length < 2 || (start < 0 || end >= lines.Length)) return text;
var sb = lines.Take(start).Aggregate(new StringBuilder(), (s, ln) => s.AppendLine(ln));
sb.AppendLine(string.Join(" - ", lines.Skip(start).Take(end - start + 1)));
lines.Skip(end + 1).Aggregate(sb, (s, ln) => s.AppendLine(ln));
return sb.ToString(0, sb.Length - Environment.NewLine.Length);
}
I am trying to write an encryption program. The problem I am facing is that I am converting the text to ascii and then adding on the offset. However when it goes past the letter 'z' I want it to warp back to 'a' and go from there.
Sub enc()
Text = TextBox1.Text
finalmessage = ""
letters = Text.ToCharArray
offset = ComboBox1.SelectedItem
For x = LBound(letters) To UBound(letters)
finalmessage = finalmessage + Chr(Asc(letters(x)) + offset)
Next
TextBox2.Text = finalmessage
End Sub
I guess to make it easy to decode afterwards, you should to it somewhat in the line of base64 encoding, first encoding everything to a normalized binary string, then encode in the range you want (since using binary, it has to be something that fits with 2^X).
To match your range, i used a baseset of 32, and a simple encoding decoding example (a bit more verbose that it should be, perhaps)
Module Module1
Dim encodeChars As String = "abcdefghijklmnopqrstuvwxyzABCDEF" ' use 32 as a base
Function Encode(text As String) As String
Dim bitEncoded As String = ""
Dim outputMessage As String = ""
For Each ch As Char In text.ToCharArray()
Dim i As Integer = Convert.ToByte(ch)
bitEncoded &= Convert.ToString(i, 2).PadLeft(8, "0"c)
Next
While bitEncoded.Length Mod 5 <> 0
bitEncoded &= "0"
End While
For position As Integer = 0 To bitEncoded.Length - 1 Step 5
Dim range As String = bitEncoded.Substring(position, 5)
Dim index As Integer = Convert.ToInt32(range, 2)
outputMessage &= encodeChars(index).ToString()
Next
Return outputMessage
End Function
Function Decode(encodedText As String) As String
Dim bitEncoded As String = ""
Dim outputMessage As String = ""
For Each ch In encodedText
Dim index As Integer = encodeChars.IndexOf(ch)
If index < 0 Then
Throw New FormatException("Invalid character in encodedText!")
End If
bitEncoded &= Convert.ToString(index, 2).PadLeft(5, "0"c)
Next
' strip the extra 0's
While bitEncoded.Length Mod 8 <> 0
bitEncoded = bitEncoded.Substring(0, bitEncoded.Length - 1)
End While
For position As Integer = 0 To bitEncoded.Length - 1 Step 8
Dim range As String = bitEncoded.Substring(position, 8)
Dim index As Integer = Convert.ToInt32(range, 2)
outputMessage &= Chr(index).ToString()
Next
Return outputMessage
End Function
Sub Main()
Dim textToEncode As String = "This is a small test, with some special characters! Just testing..."
Dim encodedText As String = Encode(textToEncode)
Dim decodedText As String = Decode(encodedText)
Console.WriteLine(textToEncode)
Console.WriteLine(encodedText)
Console.WriteLine(decodedText)
If Not String.Equals(decodedText, textToEncode) Then
Console.WriteLine("Encoding / decoding failed!")
Else
Console.WriteLine("Encoding / decoding completed succesfully!")
End If
Console.ReadLine()
End Sub
End Module
this then gives the following output?
This is a small test, with some special characters! Just testing...
krugsCzanfzsayjaonwwcBdmebAgkCBufqqhoAlunaqhgBBnmuqhgCdfmnuwcBbamnugcCtbmnAgkCtteeqeuDltoqqhizltoruwCzzofyxa
This is a small test, with some special characters! Just testing...
Encoding / decoding completed succesfully!
I need a way to read from a FileStream every single char. Char by Char.
Every time I read a char, I need to increment the FileStream.Position.
I am trying the code snippet, but it returns more than one char:
Dim bytes(1) As Byte
Dim nBytes As Integer = oFile.Read(bytes, 0, bytes.Length)
Dim nChars As Integer = decoder8.GetCharCount(bytes, 0, nBytes)
Dim chars(nChars - 1) As Char
nChars = decoder8.GetChars(bytes, 0, nBytes, chars, 0)
Return New String(chars, 0, nChars)
You could use a StreamReader and it's Read method instead, couldn't you?
Using rd = New StreamReader("path", Encoding.UTF8)
While rd.Peek() >= 0
Dim c As Char = Chr(rd.Read())
Console.WriteLine("Next character: " & c)
End While
End Using
StreamReader.Read
Reads the next character from the input stream and advances the
character position by one character.
Assuming that oFile is of type FileStream then
Dim nBytes As Integer = oFile.ReadByte()
should work.
This is in Word for MAC VBA. I want to save the Unicode character from a text box to text file. For example this character "⅛".
I use this code.
Dim N as Long
N = FreeFile
Dim strText as String
strText = Textbox1.Text 'This is what is in the textbox "⅛"
Open <file path> For Output As N
Print #N, strText
Close N
It does not save the Unicode character. I understand I have to change the text encoding format. How do I do that?
Likewise, how to read the text file with the Unicode format?
I hope this will fit VBA for Word on Mac as well, but on Windows I have the CreateTextFile method of the FileSystemObject (see MSDN doc). There I can define to create a unicode text file.
Set fsObject = CreateObject("Scripting.FileSystemObject")
Set xmlFile = fsObject.CreateTextFile("path/filename.txt", True, True) 'the second "true" forces a unicode file.
xmlFile.write "YourUnicodeTextHere"
xmlFile.close
VBA can't code text in UTF-8 this way. Use ADODB - yes, for text, not for database.
'ensure reference is set to Microsoft ActiveX DataObjects library
'(the latest version of it) under "tools/references"
Sub AdoTest()
Dim adoStream As ADODB.Stream
Set adoStream = New ADODB.Stream
'Unicode coding
adoStream.Charset = "Unicode" 'or any string listed in registry HKEY_CLASSES_ROOT\MIME\Database\Charset
'open sream
adoStream.Open
'write a text
adoStream.WriteText "Text for testing: ěšč", StreamWriteEnum.stWriteLine
'save to file
adoStream.SaveToFile "D:\a\ado.txt"
adoStream.Close
End Sub
Reading is simplier, see my answer here:
Unicode and UTF-8 with VBA
Edited: I've inserted complete example.
Edited 2: Added refernce to list of coding in the registry
The question is for VBA on Mac, and I'm afraid none of the answers work on a Mac.
The question is about Unicode which comes in many flavours. I'll address the UTF-16 aspect of it. UTF-8 follows a different path, but it isn't difficult too. AFAIU, your question is about UTF-16 string.
The code below has no error handling, I'll let you take care of that.
Function writeUnicodeTextToFile(filePathName As String, myText As String)
`Dim myFileNumber As Long, I As Long, byteArray() As Byte
myFileNumber = FreeFile()
Open filePathName For Binary As #myFileNumber
ReDim byteArray(1)
' Create a BOM for your Unicode flavour
' (CHOOSE! one of the two, programmatically, or hard-code it)
' => Little Endian
byteArray(0) = 255: byteArray(1) = 254
' => Big Endian
'byteArray(0) = 254: byteArray(1) = 255
' now write the two-byte BOM
Put myFileNumber, 1, byteArray
' redimension your byte array
' note it works even if you don't Redim (go figure) but it's more elegant
I = (LenB(myText) / 2) - 1
ReDim byteArray(I)
' populate the byte array...
byteArray = myText
' ... and write you text AFTER the BOM
Put myFileNumber, 3, byteArray
Close #myFileNumber
End Function
Here is a VBA routine that takes a string as input (your text), and fills an array of bytes. Then you write that array to disk in binary mode, making sure you start writing it after the first three bytes (BOM).
You'll need those Public variables:
byteArray() As Byte, regexUTF8 As String
Sub testing()
' creating the BOM
Dim bom(2) As Byte, someFile As Long
bom(0) = 239: bom(1) = 187: bom(2) = 191
' Writing something as utf-8
UTF16toUTF8 "L'élève de l'école"
someFile = FreeFile()
Open "MacDisk:test.txt" For Binary As #someFile
' first, the BOM
Put #someFile, 1, bom
' then the utf-8 text
Put #someFile, 4, byteArray1
Close #someFile
End Sub
Sub UTF16toUTF8(theString As String)
' by Yves Champollion
' Transforms a VB/VBA string (they're all 16-bit) into a byteArray1, utf-8 compliant
If isStringUTF8(theString) Then Exit Sub
Dim iLoop As Long, i As Long, k As Long
k = 0
ReDim byteArray1(Len(theString) * 4)
For iLoop = 1 To Len(theString)
i = AscW(Mid$(theString, iLoop, 1))
If i < 0 Then i = i + 65536
If i > -1 And i < 128 Then
byteArray1(k) = i
k = k + 1
ElseIf i >= 128 And i < 2048 Then
byteArray1(k) = (i \ 64) Or 192
byteArray1(k + 1) = (i And 63) Or 128
k = k + 2
ElseIf i >= 2048 And i < 65536 Then
byteArray1(k) = (i \ 4096) Or 224
byteArray1(k + 1) = ((i \ 64) And 63) Or 128
byteArray1(k + 2) = (i And 63) Or 128
k = k + 3
Else
byteArray1(k) = (i \ 262144) Or 240
byteArray1(k + 1) = (((i \ 4096) And 63)) Or 128
byteArray1(k + 2) = ((i \ 64) And 63) Or 128
byteArray1(k + 3) = (i And 63) Or 128
k = k + 4
End If
Next
ReDim Preserve byteArray1(k - 1)
End Sub
Function isStringUTF8(theString As String) As Boolean
Dim i As Integer, j As Integer, k As Integer
' Prime the regex argument
If Len(regexUTF8) <> 66 Then
regexUTF8 = "*[" + Space$(62) + "]*"
For i = 192 To 253
Mid(regexUTF8, i - 189, 1) = Chr(i)
Next
End If
' First quick check: any escaping characters?
If Not theString Like regexUTF8 Then Exit Function
'longer check: are escaping characters followed by UTF-8 sequences?
For i = 1 To Len(theString) - 3
If Asc(Mid(theString, i, 1)) > 192 Then
k = Asc(Mid(theString, i, 1))
If k > 193 And k < 220 Then
If (Asc(Mid(theString, i + 1, 1)) And 128) Then
isStringUTF8 = True
Exit Function
End If
End If
If k > 223 Then
If (Asc(Mid(theString, i + 1, 1)) And 128) And (Asc(Mid(theString, i + 2, 1)) And 128) Then
isStringUTF8 = True
Exit Function
End If
End If
j = j + 1
If j > 100 Then Exit For
End If
Next
End Function
I am trying to convert VB5 to .NET and cannot get a binary read to work. My VB.NET decode only reads the first two characters correctly.
The (VB5->VB.NET) encode is
' Open file
x = Rnd(-mKeyValue)
filenum = FreeFile()
Try
FileOpen(filenum, Filename, OpenMode.Binary)
Catch ex As IO.IOException
MsgBox(ex.ToString, MsgBoxStyle.Critical, "File opening error")
Exit Sub
End Try
' write data
filecontents = ""
For i = 1 To Len(stringdate)
charnum = Asc(Mid(stringdate, i, 1))
randomint = Int(256 * Rnd())
charnum = charnum Xor randomint
singlechar = Chr(charnum)
FilePut(filenum, singlechar, i)
filecontents = filecontents & singlechar
Next i
And the (VB5->VB.NET) decode is
x = Rnd(-mKeyValue)
filenum = FreeFile()
FileOpen(filenum, Filename, OpenMode.Binary)
For i = 1 To LOF(filenum)
'To VB.NET
FileGet(filenum, singlechar, i)
charnum = Asc(singlechar)
Debug.Print("VB5 singlechar = " & singlechar)
randomint = Int(256 * Rnd())
charnum = charnum Xor randomint
singlechar = Chr(charnum)
Next i
My VB.NET code which fails (cannot read the file correctly) is;
Using reader As New BinaryReader(File.Open(Filename, FileMode.Open))
' Loop through length of file.
Dim pos As Integer = 0
Dim length As Integer = reader.BaseStream.Length
While pos < length
' Read the integer.
singlechar = reader.ReadChar()
charnum = Asc(singlechar) 'singlechar is type Char
randomint = Int(256 * Rnd())
charnum = charnum Xor randomint
singlechar = Chr(charnum)
i += 1
End While
End Using
Can anyone help me with translation from VB5 to .NET?
In VB.Net everything is a bit shorter ;)
' get a string from an encrypted file file:
Dim b() As Byte = IO.File.ReadAllBytes("path")
For i = 0 To b.Length - 1
b(i) = b(i) Xor (256 * Rnd())
Next
Dim s As String = System.Text.Encoding.ASCII.GetString(b)
Why read byte by byte (no sense to read 'char' anyway, since you only want the 8bit ASCII code), when .Net can read it at once? Your file is not larger > 100 MB, I assume? Then after getting the array, you simply XOR each element with your "random" value. If you dont need to be compatible to old versions, you might better use Random. Or maybe even better ... USE REAL ENCRYPTION (in .Net it's built-in!)
' put a string into a file
Dim c() As Byte = System.Text.Encoding.ASCII.GetBytes("The String you want to store encrypted")
For i = 0 To c.Length - 1
c(i) = c(i) Xor (256 * Rnd())
Next
IO.File.WriteAllBytes("another path", c)
Same for "encrypting". Convert the string to an array of byte (=ASCII values), XOR it and then write it back in ONE operation.
See the dangers of Unicode:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
' Beware of UNICODE ... !!!
Using sw As New FileStream("foo.foo", FileMode.OpenOrCreate, FileAccess.Write)
' with old VB you effectively wrote BYTE data
sw.Write({65, 192}, 0, 2)
End Using
Using br As New BinaryReader(File.Open("foo.foo", FileMode.Open, FileAccess.Read))
' You are telling. Net that you expect a CHAR, which is not ASCII, but UNICODE
Dim c As Char = br.ReadChar
Dim d As Char = br.ReadChar
Dim cc = Asc(c)
Dim dd = Asc(d)
Debug.Print("65 -> {0}, 192 -> {1}", cc, dd)
End Using
End Sub
The output is 65 -> 65, 192 -> 63