File: Microsoft\VisualBasic\CompilerServices\VB6BinaryFile.vb
Web Access
Project: src\runtime\src\libraries\Microsoft.VisualBasic.Core\src\Microsoft.VisualBasic.Core.vbproj (Microsoft.VisualBasic.Core)
' Licensed to the .NET Foundation under one or more agreements.
' The .NET Foundation licenses this file to you under the MIT license.

Imports System
Imports Microsoft.VisualBasic.CompilerServices.ExceptionUtils
Imports Microsoft.VisualBasic.CompilerServices.Utils
Imports System.Runtime.Versioning
Imports System.Diagnostics.CodeAnalysis

Namespace Microsoft.VisualBasic.CompilerServices

    <System.ComponentModel.EditorBrowsableAttribute(System.ComponentModel.EditorBrowsableState.Never)>
    Friend NotInheritable Class VB6BinaryFile

        '============================================================================
        ' Declarations
        '============================================================================

        Inherits VB6RandomFile

        '============================================================================
        ' Constructor
        '============================================================================
        Public Sub New(ByVal FileName As String, ByVal access As OpenAccess, ByVal share As OpenShare)
            MyBase.New(FileName, access, share, -1)
        End Sub

        ' the implementation of Lock in base class VB6RandomFile does not handle m_lRecordLen=-1
        <UnsupportedOSPlatform("ios")>
        <UnsupportedOSPlatform("macos")>
        <UnsupportedOSPlatform("tvos")>
        Friend Overloads Overrides Sub Lock(ByVal lStart As Long, ByVal lEnd As Long)
            If lStart > lEnd Then
                Throw New ArgumentException(SR.Format(SR.Argument_InvalidValue1, "Start"))
            End If

            Dim absRecordLength As Long
            Dim lStartByte As Long
            Dim lLength As Long

            If m_lRecordLen = -1 Then
                ' if record len is -1, then using absolute bytes
                absRecordLength = 1
            Else
                absRecordLength = m_lRecordLen
            End If

            lStartByte = (lStart - 1) * absRecordLength
            lLength = (lEnd - lStart + 1) * absRecordLength

            m_file.Lock(lStartByte, lLength)
        End Sub

        ' see Lock description
        <UnsupportedOSPlatform("ios")>
        <UnsupportedOSPlatform("macos")>
        <UnsupportedOSPlatform("tvos")>
        Friend Overloads Overrides Sub Unlock(ByVal lStart As Long, ByVal lEnd As Long)
            If lStart > lEnd Then
                Throw New ArgumentException(SR.Format(SR.Argument_InvalidValue1, "Start"))
            End If

            Dim absRecordLength As Long
            Dim lStartByte As Long
            Dim lLength As Long

            If m_lRecordLen = -1 Then
                ' if record len is -1, then using absolute bytes
                absRecordLength = 1
            Else
                absRecordLength = m_lRecordLen
            End If

            lStartByte = (lStart - 1) * absRecordLength
            lLength = (lEnd - lStart + 1) * absRecordLength
            m_file.Unlock(lStartByte, lLength)
        End Sub

        Public Overrides Function GetMode() As OpenMode
            Return OpenMode.Binary
        End Function

        Friend Overloads Overrides Function Seek() As Long
            'm_file.position is the last read byte as a zero based offset
            'Seek returns the position of the next byte to read
            Return (m_position + 1)
        End Function

        Friend Overloads Overrides Sub Seek(ByVal BaseOnePosition As Long)
            If BaseOnePosition <= 0 Then
                Throw VbMakeException(vbErrors.BadRecordNum)
            End If

            Dim BaseZeroPosition As Long = BaseOnePosition - 1

            m_file.Position = BaseZeroPosition
            m_position = BaseZeroPosition

            If Not m_sr Is Nothing Then
                m_sr.DiscardBufferedData()
            End If
        End Sub

        Friend Overrides Function LOC() As Long
            Return m_position
        End Function

        Friend Overrides Function CanInput() As Boolean
            Return True
        End Function

        Friend Overrides Function CanWrite() As Boolean
            Return True
        End Function

        <RequiresUnreferencedCode("Implementation of Vb6InputFile is unsafe.")>
        Friend Overloads Overrides Sub Input(ByRef Value As Object)
            Value = InputStr()
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As String)
            Value = InputStr()
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As Char)
            Dim s As String = InputStr()

            If s.Length > 0 Then
                Value = s.Chars(0)
            Else
                Value = ControlChars.NullChar
            End If
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As Boolean)
            Value = BooleanType.FromString(InputStr())
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As Byte)
            Value = ByteType.FromObject(InputNum(VariantType.Byte))
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As Short)
            Value = ShortType.FromObject(InputNum(VariantType.Short))
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As Integer)
            Value = IntegerType.FromObject(InputNum(VariantType.Integer))
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As Long)
            Value = LongType.FromObject(InputNum(VariantType.Long))
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As Single)
            Value = SingleType.FromObject(InputNum(VariantType.Single))
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As Double)
            Value = DoubleType.FromObject(InputNum(VariantType.Double))
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As Decimal)
            Value = DecimalType.FromObject(InputNum(VariantType.Decimal))
        End Sub

        Friend Overloads Overrides Sub Input(ByRef Value As Date)
            Value = DateType.FromString(InputStr(), GetCultureInfo())
        End Sub

        Friend Overloads Overrides Sub Put(ByVal Value As String, Optional ByVal RecordNumber As Long = 0, Optional ByVal StringIsFixedLength As Boolean = False)
            ValidateWriteable()

            PutString(RecordNumber, Value)
        End Sub

        Friend Overloads Overrides Sub [Get](ByRef Value As String, Optional ByVal RecordNumber As Long = 0, Optional ByVal StringIsFixedLength As Boolean = False)
            ValidateReadable()

            Dim ByteLength As Integer
            If Value Is Nothing Then
                ByteLength = 0
            Else
                Diagnostics.Debug.Assert(Not m_Encoding Is Nothing)
                ByteLength = m_Encoding.GetByteCount(Value)
            End If
            Value = GetFixedLengthString(RecordNumber, ByteLength)
        End Sub

        Protected Overrides Function InputStr() As String
            Dim lChar As Integer

            ' The NullReferenceException is for compatibility with VB6 which threw a NullReferenceException when
            ' reading from a file that was write-only. The inner exception was added to provide more context.
            If (m_access <> OpenAccess.ReadWrite) AndAlso (m_access <> OpenAccess.Read) Then
                Dim JustNeedTheMessage As New NullReferenceException ' We don't have access to the localized resources for this string.
                Throw New NullReferenceException(JustNeedTheMessage.Message, New IO.IOException(SR.FileOpenedNoRead))
            End If

            ' read past any leading spaces or tabs
            'Skip over leading whitespace
            lChar = SkipWhiteSpaceEOF()

            If lChar = lchDoubleQuote Then
                lChar = m_sr.Read()
                m_position += 1
                InputStr = ReadInField(FIN_QSTRING)
            Else
                InputStr = ReadInField(FIN_STRING)
            End If

            SkipTrailingWhiteSpace()
        End Function

    End Class

End Namespace