User Tools

Site Tools


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

Donate Powered by PHP Valid HTML5 Valid CSS Driven by DokuWiki