vbdotnetcommon
These are common chunks of code I use in VB.Net to read binary streams into variables.
Enjoy!
Public Function ReadUInt16_LE(Arr() As Byte, Offset As Int32) As UInt16 Dim V As UInt16 = 0 V = CByte(Arr(Offset + 0)) V = V Or (CUShort(Arr(Offset + 1)) << 8) Return V End Function Public Function ReadInt16_LE(Arr() As Byte, Offset As Int32) As Int16 Dim V As Int16 = 0 V = CByte(Arr(Offset + 0)) V = V Or (CShort(Arr(Offset + 1)) << 8) Return V End Function Public Function ReadInt32_LE(Arr() As Byte, Offset As Int32) As Int32 Dim V As Int32 = 0 V = CByte(Arr(Offset + 0)) V = V Or (CInt(Arr(Offset + 1)) << 8) V = V Or (CInt(Arr(Offset + 2)) << 16) V = V Or (CInt(Arr(Offset + 3)) << 24) Return V End Function Public Function ReadUInt32_LE(Arr() As Byte, Offset As Int32) As UInt32 Dim V As UInt32 = 0 V = CByte(Arr(Offset + 0)) V = V Or (CUInt(Arr(Offset + 1)) << 8) V = V Or (CUInt(Arr(Offset + 2)) << 16) V = V Or (CUInt(Arr(Offset + 3)) << 24) Return V End Function Public Sub WriteUInt16_BE(Arr() As Byte, Offset As Int32, Value As UInt16) Arr(Offset + 1) = CByte(Value And 255US) Value = Value >> 8 Arr(Offset) = CByte(Value And 255US) End Sub Public Sub WriteUInt16_LE(Arr() As Byte, Offset As Int32, Value As UInt16) Arr(Offset) = CByte(Value And 255US) Value = Value >> 8 Arr(Offset + 1) = CByte(Value And 255US) End Sub Public Sub WriteUInt32_BE(Arr() As Byte, Offset As Int32, Value As UInt32) For I As Integer = 3 To 0 Step -1 Arr(Offset + I) = CByte(Value And 255) Value = Value >> 8 Next End Sub Public Sub WriteUInt32_LE(Arr() As Byte, Offset As Int32, Value As UInt32) For I As Integer = 0 To 3 Arr(Offset + I) = CByte(Value And 255) Value = Value >> 8 Next End Sub Friend Function ReadAsciiZ(Arr() As Byte, Offset As Int32, Count As Int32) As String Dim RetStr As New System.Text.StringBuilder(Count) Dim Pos As Int32 = 0 Dim B As Byte While Pos < Count B = Arr(Offset + Pos) If B = 0 Then Exit While RetStr.Append(Chr(B)) Pos += 1 End While 'If Pos < Count Then RetStr = RetStr.Substring(0, Pos) Return RetStr.ToString End Function While True If Console.KeyAvailable Then Select Case Console.ReadKey.KeyChar Case "q"c : Exit While End Select End If ' Do stuff?? System.Threading.Thread.Sleep(100) End While Public Function StreamCopyToEnd(ByVal StrmTo As System.IO.Stream, ByVal StrmFrom As System.IO.Stream) As Int64 ' Assumes streams already in their proper spots, and length is ok Const BufferSize As Int32 = 1024 * 64 ' 64K Dim Buffer(0 To (BufferSize - 1)) As Byte ' Dim BytesCopied As Int64 = 0 Dim BytesRead As Int32 = 1 ' While BytesRead > 0 BytesRead = StrmFrom.Read(Buffer, 0, BufferSize) StrmTo.Write(Buffer, 0, BytesRead) BytesCopied += BytesRead End While ' Return BytesCopied End Function
Signed / Unsigned conversions
<System.Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Explicit)> _ Structure UInt8_Union <System.Runtime.InteropServices.FieldOffset(0)> Public I As SByte <System.Runtime.InteropServices.FieldOffset(0)> Public U As Byte End Structure <System.Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Explicit)> _ Structure UInt16_Union <System.Runtime.InteropServices.FieldOffset(0)> Public I As Int16 <System.Runtime.InteropServices.FieldOffset(0)> Public U As UInt16 End Structure <System.Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Explicit)> _ Structure UInt32_Union <System.Runtime.InteropServices.FieldOffset(0)> Public I As Int32 <System.Runtime.InteropServices.FieldOffset(0)> Public U As UInt32 End Structure <System.Runtime.InteropServices.StructLayout(Runtime.InteropServices.LayoutKind.Explicit)> _ Structure UInt64_Union <System.Runtime.InteropServices.FieldOffset(0)> Public I As Int64 <System.Runtime.InteropServices.FieldOffset(0)> Public U As UInt64 End Structure
XML!
- XMLGeneric.vb
Option Explicit On Option Strict On Module XMLGeneric Public Sub AddAttribute(ByVal Elm As System.Xml.XmlElement, ByVal Name As String, ByVal Value As String) Dim Attr As System.Xml.XmlAttribute = Elm.OwnerDocument.CreateAttribute(Name) Attr.Value = Value Elm.Attributes.Append(Attr) End Sub Public Sub AddAttribute(ByVal Elm As System.Xml.XmlElement, ByVal Name As String, ByVal Value As Object) Dim Attr As System.Xml.XmlAttribute = Elm.OwnerDocument.CreateAttribute(Name) If Value Is Nothing Then Attr.Value = "" Else Attr.Value = Value.ToString End If Elm.Attributes.Append(Attr) End Sub Public Function AddElement(ByVal Elm As System.Xml.XmlElement, ByVal Name As String) As System.Xml.XmlElement Dim E As System.Xml.XmlElement = Elm.OwnerDocument.CreateElement(Name) Elm.AppendChild(E) Return E End Function Public Function AddValueElement(ByVal Elm As System.Xml.XmlElement, ByVal Name As String, ByVal Value As String) As System.Xml.XmlElement Dim E As System.Xml.XmlElement = Elm.OwnerDocument.CreateElement(Name) Elm.AppendChild(E) E.InnerText = Value Return E End Function 'Private Sub OutputXML(ByVal XmlDoc As System.Xml.XmlDataDocument) ' Dim S As New System.Xml.XmlWriterSettings() ' S.Indent = True ' S.IndentChars = " " ' S.NewLineChars = vbCrLf ' S.NewLineHandling = System.Xml.NewLineHandling.Replace ' S.Encoding = Response.ContentEncoding ' Dim W As System.Xml.XmlWriter = System.Xml.XmlWriter.Create(Response.OutputStream, S) ' XmlDoc.Save(W) ' W.Close() 'End Sub Public Sub SaveXML(ByVal XmlDoc As System.Xml.XmlDataDocument, FilePathName As String) Dim S As New System.Xml.XmlWriterSettings() S.Indent = True S.IndentChars = " " S.NewLineChars = vbCrLf S.NewLineHandling = System.Xml.NewLineHandling.Replace 'S.Encoding = System.Text.ASCIIEncoding.ASCII S.Encoding = System.Text.UTF8Encoding.UTF8 Dim W As System.Xml.XmlWriter = System.Xml.XmlWriter.Create(FilePathName, S) XmlDoc.Save(W) W.Close() End Sub Public Sub SaveXML(ByVal XmlDoc As System.Xml.XmlDataDocument, Stm As System.IO.Stream) Dim S As New System.Xml.XmlWriterSettings() S.Indent = True S.IndentChars = " " S.NewLineChars = vbCrLf S.NewLineHandling = System.Xml.NewLineHandling.Replace 'S.Encoding = System.Text.ASCIIEncoding.ASCII S.Encoding = System.Text.UTF8Encoding.UTF8 Dim W As System.Xml.XmlWriter = System.Xml.XmlWriter.Create(Stm, S) XmlDoc.Save(W) W.Close() End Sub Public Function XMLNodeTryGetAttr(N As System.Xml.XmlNode, AttrName As String, ByRef S As String) As Boolean S = Nothing Dim XMLAttr As System.Xml.XmlAttribute = N.Attributes(AttrName) If XMLAttr Is Nothing Then Return False S = XMLAttr.Value Return True End Function Public Function GetValFromXPath(ByVal nav As System.Xml.XPath.XPathNavigator, ByVal XPath As String) As String If XPath.Length = 0 Then Return "" ' no go End If ' try to resolve this one to a value Try Dim o As Object = nav.Evaluate(XPath) If TypeOf o Is String Then Return CStr(o) ElseIf TypeOf o Is Boolean Then Return CStr(o) ElseIf TypeOf o Is Double Then Return CStr(o) ElseIf TypeOf o Is System.Xml.XPath.XPathNodeIterator Then For Each XPN As System.Xml.XPath.XPathNavigator In CType(o, System.Xml.XPath.XPathNodeIterator) If XPN.Value <> "" Then Return XPN.Value Next Else Debug.Print(" !GetValFromXPath: Unexpected Type: {0}", o.GetType.ToString) End If Catch ex As Exception Debug.Print(" !GetValFromXPath: Exception: {0}", ex.Message + vbCrLf + ex.StackTrace) End Try ' should not be here Return "" End Function Public Function GetValFromXPath(ByVal nav As System.Xml.XPath.XPathNavigator, ByVal XPath1 As String, ByVal XPath2 As String) As String Dim XPathVal As String XPathVal = GetValFromXPath(nav, XPath1) If XPathVal = "" Then XPathVal = GetValFromXPath(nav, XPath2) ' try again End If Return XPathVal End Function Public Function GetNodeFromXPath(ByVal nav As System.Xml.XPath.XPathNavigator, ByVal XPath As String) As System.Xml.XPath.XPathNavigator If XPath.Length = 0 Then Return Nothing ' no go End If ' try to resolve this one to a value Try Return nav.SelectSingleNode(XPath) Catch ex As Exception Debug.Print(" !GetNodeFromXPath: Exception: {0}", ex.Message + vbCrLf + ex.StackTrace) End Try ' should not be here Return Nothing End Function Public Function GetNodeFromXPath(ByVal nav As System.Xml.XPath.XPathNavigator, ByVal XPath As Xml.XPath.XPathExpression) As System.Xml.XPath.XPathNavigator If XPath Is Nothing Then Return Nothing ' no go End If ' try to resolve this one to a value Try Return nav.SelectSingleNode(XPath) Catch ex As Exception Debug.Print(" !GetNodeFromXPath: Exception: {0}", ex.Message + vbCrLf + ex.StackTrace) End Try ' should not be here Return Nothing End Function End Module
vbdotnetcommon.txt · Last modified: 2024/11/13 16:47 by srbios