' Licensed to the .NET Foundation under one or more agreements.

Imports System

Imports System.Globalization

Imports System.Runtime.Versioning

Imports System.Text

Imports Community.VisualBasic.CompilerServices

Imports Community.VisualBasic.CompilerServices.ExceptionUtils

Imports Community.VisualBasic.CompilerServices.Utils

Namespace Global.Community.VisualBasic

Friend NotInheritable Class FormatInfoHolder

Implements IFormatProvider

Friend Sub New(nfi As NumberFormatInfo)

MyBase.New()

Me.nfi = nfi

End Sub

Private ReadOnly nfi As NumberFormatInfo

Private Function GetFormat(service As Type) As Object Implements IFormatProvider.GetFormat

If service Is GetType(NumberFormatInfo) Then

Return nfi

End If

Throw New ArgumentException(SR.InternalError_VisualBasicRuntime)

End Function

End Class

Public Module Strings

'Positive format strings

'0 $n

'1 n$

'2 $ n

'3 n $

Private ReadOnly CurrencyPositiveFormatStrings() As String = {"'$'n", "n'$'", "'$' n", "n '$'"} 'Note, we wrap the $ in the literal symbol to avoid misinterpretation when using the escape character \ as a currency mark

'The negative currency pattern needs to be selected based

' on the criteria provided for parens

'nfi.CurrencyPositivePattern

'Negative format strings

'0 ($n)

'1 -$n

'2 $-n

'3 $n-

'4 (n$)

'5 -n$

'6 n-$

'7 n$-

'8 -n $

'9 -$ n

'10 n $-

'11 $ n-

'12 $- n

'13 n- $

'14 ($ n)

'15 (n $)

Private ReadOnly CurrencyNegativeFormatStrings() As String =

{"('$'n)", "-'$'n", "'$'-n", "'$'n-", "(n'$')", "-n'$'", "n-'$'", "n'$'-",

"-n '$'", "-'$' n", "n '$'-", "'$' n-", "'$'- n", "n- '$'", "('$' n)", "(n '$')"} 'Note, we wrap the $ in the literal symbol to avoid misinterpretation when using the escape character \ as a currency mark

'Value Associated Pattern

'0 (n)

'1 -n

'2 - n

'3 n-

'4 n -

Private ReadOnly NumberNegativeFormatStrings() As String =

{"(n)", "-n", "- n", "n-", "n -"}

Friend Enum FormatType

Number = 0

Percent = 1

[Currency] = 2

End Enum

Private Const CODEPAGE_SIMPLIFIED_CHINESE As Integer = 936

Private Const CODEPAGE_TRADITIONAL_CHINESE As Integer = 950

Private Const STANDARD_COMPARE_FLAGS As CompareOptions = CompareOptions.IgnoreCase Or

CompareOptions.IgnoreWidth Or

CompareOptions.IgnoreKanaType

Private Const NAMEDFORMAT_FIXED As String = "fixed"

Private Const NAMEDFORMAT_YES_NO As String = "yes/no"

Private Const NAMEDFORMAT_ON_OFF As String = "on/off"

Private Const NAMEDFORMAT_PERCENT As String = "percent"

Private Const NAMEDFORMAT_STANDARD As String = "standard"

Private Const NAMEDFORMAT_CURRENCY As String = "currency"

Private Const NAMEDFORMAT_LONG_TIME As String = "long time"

Private Const NAMEDFORMAT_LONG_DATE As String = "long date"

Private Const NAMEDFORMAT_SCIENTIFIC As String = "scientific"

Private Const NAMEDFORMAT_TRUE_FALSE As String = "true/false"

Private Const NAMEDFORMAT_SHORT_TIME As String = "short time"

Private Const NAMEDFORMAT_SHORT_DATE As String = "short date"

Private Const NAMEDFORMAT_MEDIUM_DATE As String = "medium date"

Private Const NAMEDFORMAT_MEDIUM_TIME As String = "medium time"

Private Const NAMEDFORMAT_GENERAL_DATE As String = "general date"

Private Const NAMEDFORMAT_GENERAL_NUMBER As String = "general number"

Friend ReadOnly m_InvariantCompareInfo As CompareInfo = CultureInfo.InvariantCulture.CompareInfo

'This is shared across Cached

Private ReadOnly m_SyncObject As Object = New Object

Private m_LastUsedYesNoCulture As CultureInfo

Private m_CachedYesNoFormatStyle As String

Private ReadOnly Property CachedYesNoFormatStyle() As String

Get

Dim ci As CultureInfo = GetCultureInfo()

SyncLock m_SyncObject

If m_LastUsedYesNoCulture IsNot ci Then

m_LastUsedYesNoCulture = ci

m_CachedYesNoFormatStyle = SR.YesNoFormatStyle

End If

Return m_CachedYesNoFormatStyle

End SyncLock

End Get

End Property

Private m_LastUsedOnOffCulture As CultureInfo

Private m_CachedOnOffFormatStyle As String

Private ReadOnly Property CachedOnOffFormatStyle() As String

Get

Dim ci As CultureInfo = GetCultureInfo()

SyncLock m_SyncObject

If m_LastUsedOnOffCulture IsNot ci Then

m_LastUsedOnOffCulture = ci

m_CachedOnOffFormatStyle = SR.OnOffFormatStyle

End If

Return m_CachedOnOffFormatStyle

End SyncLock

End Get

End Property

Private m_LastUsedTrueFalseCulture As CultureInfo

Private m_CachedTrueFalseFormatStyle As String

Private ReadOnly Property CachedTrueFalseFormatStyle() As String

Get

Dim ci As CultureInfo = GetCultureInfo()

SyncLock m_SyncObject

If m_LastUsedTrueFalseCulture IsNot ci Then

m_LastUsedTrueFalseCulture = ci

m_CachedTrueFalseFormatStyle = SR.TrueFalseFormatStyle

End If

Return m_CachedTrueFalseFormatStyle

End SyncLock

End Get

End Property

Private Function PRIMARYLANGID(lcid As Integer) As Integer

Return (lcid And &H3FF)

End Function

Private Function GetAscChrEncoding() As Encoding

Return Encoding.GetEncoding(GetLocaleCodePage())

End Function

'============================================================================

' Character manipulation functions.

'============================================================================

Public Function Asc([String] As Char) As Integer

'The IConvertible.ToInt32 implementation on Char

' just calls Convert.ToInt32()

Dim CharValue As Integer = Convert.ToInt32([String])

If CharValue < 128 Then

Return CharValue

End If

Try

Dim enc As Encoding

Dim b() As Byte

Dim c() As Char

Dim iByteCount As Integer

enc = GetAscChrEncoding()

c = New Char() {[String]}

If enc.IsSingleByte Then

'SBCS

b = New Byte(0) {}

iByteCount = enc.GetBytes(c, 0, 1, b, 0)

Return b(0)

End If

'DBCS char

b = New Byte(1) {}

iByteCount = enc.GetBytes(c, 0, 1, b, 0)

If iByteCount = 1 Then

Return b(0)

End If

If BitConverter.IsLittleEndian Then

'Swap the bytes since storage is big-endian

Dim byt As Byte

byt = b(0)

b(0) = b(1)

b(1) = byt

End If

Return BitConverter.ToInt16(b, 0)

Catch ex As Exception

Throw ex

End Try

End Function

Public Function Asc([String] As String) As Integer

If ([String] Is Nothing) OrElse ([String].Length = 0) Then

Throw New ArgumentException(SR.Format(SR.Argument_LengthGTZero1, NameOf([String])), NameOf([String]))

End If

Dim ch As Char = [String].Chars(0)

Return Asc(ch)

End Function

#If NOTNEEDED Then

Public Function AscW([String] As String) As Integer

If ([String] Is Nothing) OrElse ([String].Length = 0) Then

Throw New Global.System.ArgumentException(SR.Format(SR.Argument_LengthGTZero1, NameOf([String])), NameOf([String]))

End If

Return AscW([String].Chars(0))

End Function

Public Function AscW([String] As Char) As Integer

Return AscW([String])

End Function

#End If

Public Function Chr(CharCode As Integer) As Char

' Documentation claims that < 0 or > 255 gives an ArgumentException

If CharCode < -32768 OrElse CharCode > 65535 Then

Throw New ArgumentException(SR.Format(SR.Argument_RangeTwoBytes1, NameOf(CharCode)), NameOf(CharCode))

End If

If CharCode >= 0 AndAlso CharCode <= 127 Then

Return Convert.ToChar(CharCode)

End If

Try

Dim enc As Encoding

enc = GetAscChrEncoding()

If enc.IsSingleByte Then

If CharCode < 0 OrElse CharCode > 255 Then

Throw VbMakeException(VbErrors.IllegalFuncCall)

End If

End If

Dim dec As Decoder

Dim CharCount As Integer

Dim c(1) As Char 'Use 2 char array, but only return first Char if two returned

Dim b(1) As Byte

dec = enc.GetDecoder()

If CharCode >= 0 AndAlso CharCode <= 255 Then

b(0) = CByte(CharCode And &HFFS)

CharCount = dec.GetChars(b, 0, 1, c, 0)

Else

'Bytes must be swapped in memory to HI/LO

b(0) = CByte((CharCode And &HFF00I) >> 8)

b(1) = CByte(CharCode And &HFFI)

CharCount = dec.GetChars(b, 0, 2, c, 0)

End If

'VB6 ignored the lobyte if it hibyte was not a valid lead character

'CharCount will be zero if the hibyte was not a lead character

Return c(0)

Catch ex As Exception

Throw ex

End Try

End Function

#If NOTNEEDED Then

Public Function ChrW(CharCode As Integer) As Char

If CharCode < -32768 OrElse CharCode > 65535 Then

Throw New ArgumentException(SR.Format(SR.Argument_RangeTwoBytes1, NameOf(CharCode)), NameOf(CharCode))

End If

Return Global.System.Convert.ToChar(CharCode And &HFFFFI)

End Function

#End If

'============================================================================

' String manipulation functions.

'============================================================================

Public Function Filter(Source() As Object, Match As String, Optional Include As Boolean = True, <Microsoft.VisualBasic.CompilerServices.OptionCompareAttribute()> Optional [Compare] As CompareMethod = CompareMethod.Binary) As String()

Dim Size As Integer = UBound(Source)

Dim StringSource(Size) As String

Try

For i As Integer = 0 To Size

StringSource(i) = CStr(Source(i))

Next i

Catch ex As StackOverflowException

Throw ex

Catch ex As OutOfMemoryException

Throw ex

Catch

Throw New ArgumentException(SR.Format(SR.Argument_InvalidValueType2, NameOf(Source), "String"), NameOf(Source))

End Try

Return Filter(StringSource, Match, Include, [Compare])

End Function

Public Function Filter(Source() As String, Match As String, Optional Include As Boolean = True, <Microsoft.VisualBasic.CompilerServices.OptionCompareAttribute()> Optional [Compare] As CompareMethod = CompareMethod.Binary) As String()

Try

Dim TmpResult() As String

Dim lNumElements As Integer

Dim lSourceIndex As Integer

Dim lResultIndex As Integer

Dim sStringElement As String

Dim iFlags As CompareOptions

Dim CompInfo As CompareInfo

Dim Loc As CultureInfo

'Do error checking

If Source.Rank <> 1 Then

Throw New ArgumentException(SR.Argument_RankEQOne1, NameOf(Source))

End If

If Match Is Nothing OrElse Match.Length = 0 Then

Return Nothing

End If

lNumElements = Source.Length

'up the globalization info

Loc = GetCultureInfo()

CompInfo = Loc.CompareInfo

If [Compare] = CompareMethod.Text Then

iFlags = CompareOptions.IgnoreCase

End If

'Compare each element and build the result array

ReDim TmpResult(lNumElements - 1)

For lSourceIndex = 0 To lNumElements - 1

sStringElement = Source(lSourceIndex)

If (sStringElement Is Nothing) Then

'Skip

ElseIf (CompInfo.IndexOf(sStringElement, Match, iFlags) >= 0) = Include Then

TmpResult(lResultIndex) = sStringElement

lResultIndex += 1

End If

Next lSourceIndex

If lResultIndex = 0 Then

ReDim TmpResult(-1)

Return TmpResult

End If

If lResultIndex = TmpResult.Length Then

'No redim required

Return TmpResult

End If

ReDim Preserve TmpResult(lResultIndex - 1)

Return TmpResult

Catch ex As Exception

Throw ex

End Try

End Function

Public Function InStr(String1 As String, String2 As String, <Microsoft.VisualBasic.CompilerServices.OptionCompareAttribute()> Optional [Compare] As CompareMethod = CompareMethod.Binary) As Integer

If Compare = CompareMethod.Binary Then

Return (InternalInStrBinary(0, String1, String2) + 1)

Else

Return (InternalInStrText(0, String1, String2) + 1)

End If

End Function

Public Function InStr(Start As Integer, String1 As String, String2 As String, <Microsoft.VisualBasic.CompilerServices.OptionCompareAttribute()> Optional [Compare] As CompareMethod = CompareMethod.Binary) As Integer

If Start < 1 Then

Throw New ArgumentException(SR.Format(SR.Argument_GTZero1, NameOf(Start)), NameOf(Start))

End If

If Compare = CompareMethod.Binary Then

Return (InternalInStrBinary(Start - 1, String1, String2) + 1)

Else

Return (InternalInStrText(Start - 1, String1, String2) + 1)

End If

End Function

'THIS FUNCTION IS ZERO BASED

Private Function InternalInStrBinary(StartPos As Integer, sSrc As String, sFind As String) As Integer

Dim SrcLength As Integer

If sSrc IsNot Nothing Then

SrcLength = sSrc.Length

Else

SrcLength = 0

End If

If StartPos > SrcLength OrElse SrcLength = 0 Then

Return -1

End If

If (sFind Is Nothing) OrElse (sFind.Length = 0) Then

Return StartPos

End If

Return m_InvariantCompareInfo.IndexOf(sSrc, sFind, StartPos, CompareOptions.Ordinal)

End Function

Private Function InternalInStrText(lStartPos As Integer, sSrc As String, sFind As String) As Integer

Dim lSrcLen As Integer

If sSrc IsNot Nothing Then

lSrcLen = sSrc.Length

Else

lSrcLen = 0

End If

If lStartPos > lSrcLen OrElse lSrcLen = 0 Then

Return -1

End If

If (sFind Is Nothing) OrElse (sFind.Length = 0) Then

Return lStartPos

End If

Return GetCultureInfo().CompareInfo.IndexOf(sSrc, sFind, lStartPos, STANDARD_COMPARE_FLAGS)

End Function

Public Function InStrRev(StringCheck As String, StringMatch As String, Optional Start As Integer = -1, <Microsoft.VisualBasic.CompilerServices.OptionCompareAttribute()> Optional [Compare] As CompareMethod = CompareMethod.Binary) As Integer

Try

Dim lStrLen As Integer

If Start = 0 OrElse Start < -1 Then

Throw New ArgumentException(SR.Format(SR.Argument_MinusOneOrGTZero1, NameOf(Start)), NameOf(Start))

End If

If StringCheck Is Nothing Then

lStrLen = 0

Else

lStrLen = StringCheck.Length

End If

If Start = -1 Then

Start = lStrLen

End If

If (Start > lStrLen) OrElse (lStrLen = 0) Then

Return 0

End If

If StringMatch Is Nothing Then

GoTo EmptyMatchString

End If

If StringMatch.Length = 0 Then

Return Start

End If

If [Compare] = CompareMethod.Binary Then

Return (m_InvariantCompareInfo.LastIndexOf(StringCheck, StringMatch, Start - 1, Start, CompareOptions.Ordinal) + 1)

Else

Return (GetCultureInfo().CompareInfo.LastIndexOf(StringCheck, StringMatch, Start - 1, Start, STANDARD_COMPARE_FLAGS) + 1)

End If

Catch ex As Exception

Throw ex

End Try

End Function

Public Function Join(SourceArray() As Object, Optional Delimiter As String = " ") As String

Dim Size As Integer = UBound(SourceArray)

Dim StringSource(Size) As String

Dim i As Integer

Try

For i = 0 To Size

StringSource(i) = CStr(SourceArray(i))

Next i

Catch ex As StackOverflowException

Throw ex

Catch ex As OutOfMemoryException

Throw ex

Catch

Throw New ArgumentException(SR.Format(SR.Argument_InvalidValueType2, "SourceArray", "String"))

End Try

Return Join(StringSource, Delimiter)

End Function

Public Function Join(SourceArray() As String, Optional Delimiter As String = " ") As String

Try

If IsArrayEmpty(SourceArray) Then

'EmptyArray returns empty string

Return Nothing

End If

If SourceArray.Rank <> 1 Then

Throw New ArgumentException(SR.Format(SR.Argument_RankEQOne1))

End If

Return System.String.Join(Delimiter, SourceArray)

Catch ex As Exception

Throw ex

End Try

End Function

Public Function LCase(Value As String) As String

Try

If Value Is Nothing Then

Return Nothing

Else

Return Threading.Thread.CurrentThread.CurrentCulture.TextInfo.ToLower(Value)

End If

Catch ex As Exception

Throw ex

End Try

End Function

Public Function LCase(Value As Char) As Char

Try

Return Threading.Thread.CurrentThread.CurrentCulture.TextInfo.ToLower(Value)

Catch ex As Exception

Throw ex

End Try

End Function

Public Function Len(Expression As Boolean) As Integer

If Expression Then

End If

Return 2

End Function

<CLSCompliant(False)>

Public Function Len(Expression As SByte) As Integer

If Expression <> 0 Then

End If

Return 1

End Function

Public Function Len(Expression As Byte) As Integer

If Expression <> 0 Then

End If

Return 1

End Function

Public Function Len(Expression As Int16) As Integer

If Expression <> 0 Then

End If

Return 2

End Function

<CLSCompliant(False)>

Public Function Len(Expression As UInt16) As Integer

If Expression <> 0 Then

End If

Return 2

End Function

Public Function Len(Expression As Int32) As Integer

If Expression <> 0 Then

End If

Return 4

End Function

<CLSCompliant(False)>

Public Function Len(Expression As UInt32) As Integer

If Expression <> 0 Then

End If

Return 4

End Function

Public Function Len(Expression As Int64) As Integer

If Expression <> 0 Then

End If

Return 8

End Function

<CLSCompliant(False)>

Public Function Len(Expression As UInt64) As Integer

If Expression <> 0 Then

End If

Return 8

End Function

Public Function Len(Expression As Decimal) As Integer

'This must return the length for VB6 Currency

If Expression <> 0 Then

End If

Return 8

End Function

Public Function Len(Expression As Single) As Integer

If Expression <> 0 Then

End If

Return 4

End Function

Public Function Len(Expression As Double) As Integer

If Expression <> 0 Then

End If

Return 8

End Function

Public Function Len(Expression As DateTime) As Integer

If Expression <> DateTime.MinValue Then

End If

Return 8

End Function

Public Function Len(Expression As Char) As Integer

If Expression <> " "c Then

End If

Return 2

End Function

Public Function Len(Expression As String) As Integer

If Expression Is Nothing Then

Return 0

End If

Return Expression.Length

End Function

Public Function Len(Expression As Object) As Integer

If Expression Is Nothing Then

Return 0

End If

Dim ValueInterface As IConvertible = TryCast(Expression, IConvertible)

If ValueInterface IsNot Nothing Then

Select Case ValueInterface.GetTypeCode()

Case TypeCode.Boolean

Return 2

Case TypeCode.SByte

Return 1

Case TypeCode.Byte

Return 1

Case TypeCode.Int16

Return 2

Case TypeCode.UInt16

Return 2

Case TypeCode.Int32

Return 4

Case TypeCode.UInt32

Return 4

Case TypeCode.Int64

Return 8

Case TypeCode.UInt64

Return 8

Case TypeCode.Decimal

Return 16

Case TypeCode.Single

Return 4

Case TypeCode.Double

Return 8

Case TypeCode.DateTime

Return 8

Case TypeCode.Char

Return 2

Case TypeCode.String

Return Expression.ToString().Length

Case TypeCode.Object

'Fallthrough to below

End Select

Else

Dim CharArray As Char() = TryCast(Expression, Char())

If CharArray IsNot Nothing Then

Return CharArray.Length

End If

End If

If TypeOf Expression Is ValueType Then

Dim Length As Integer = StructUtils.GetRecordLength(Expression, 1)

Return Length

End If

Throw VbMakeException(VbErrors.TypeMismatch)

End Function

Public Function Replace(Expression As String, Find As String, Replacement As String, Optional Start As Integer = 1, Optional Count As Integer = -1, <Microsoft.VisualBasic.CompilerServices.OptionCompareAttribute()> Optional [Compare] As CompareMethod = CompareMethod.Binary) As String

Try

'Validate Parameters

If Count < -1 Then

Throw New ArgumentException(SR.Format(SR.Argument_GEMinusOne1, "Count"))

End If

If Start <= 0 Then

Throw New ArgumentException(SR.Format(SR.Argument_GTZero1, "Start"))

End If

If (Expression Is Nothing) OrElse (Start > Expression.Length) Then

Return Nothing

End If

If Start <> 1 Then

Expression = Expression.Substring(Start - 1)

End If

If Find Is Nothing Then

GoTo EmptyFindString

End If

If Find.Length = 0 OrElse Count = 0 Then

Return Expression

End If

If Count = -1 Then

Count = Expression.Length

End If

Return ReplaceInternal(Expression, Find, Replacement, Count, [Compare])

Catch ex As Exception

Throw ex

End Try

End Function

Private Function ReplaceInternal(Expression As String, Find As String, Replacement As String, Count As Integer, [Compare] As CompareMethod) As String

System.Diagnostics.Debug.Assert(Expression <> "", "Expression is empty")

System.Diagnostics.Debug.Assert(Find <> "", "Find is empty")

System.Diagnostics.Debug.Assert(Count > 0, "Number of replacements is 0 or less")

System.Diagnostics.Debug.Assert([Compare] = CompareMethod.Text Or [Compare] = CompareMethod.Binary, "Unknown compare.")

Dim ExpressionLength As Integer = Expression.Length

Dim FindLength As Integer = Find.Length

Dim Start As Integer

Dim FindLocation As Integer

Dim Replacements As Integer

Dim Comparer As CompareInfo

Dim CompareFlags As CompareOptions

Dim Builder As StringBuilder = New StringBuilder(ExpressionLength)

If [Compare] = CompareMethod.Text Then

Comparer = GetCultureInfo().CompareInfo

CompareFlags = STANDARD_COMPARE_FLAGS

Else

Comparer = m_InvariantCompareInfo

CompareFlags = CompareOptions.Ordinal

End If

'We build the new string (with the replacements) by walking through Expression, searching for the

'Find, and appending sections of Expression or Replacement as we go. For example, if

'Expression = "This is a test.", Find = "is" and Replacement = "YYY" then we would append

'"Th" to the new string, then "YYY" then " " then "YYY" and finally " a test."

While Start < ExpressionLength

If Replacements = Count Then

'We've made all the replacements the caller wanted so append the remaining string

Builder.Append(Expression.Substring(Start))

Exit While

End If

FindLocation = Comparer.IndexOf(Expression, Find, Start, CompareFlags)

If FindLocation < 0 Then

'We didn't find the Find string append the rest of the string

Builder.Append(Expression.Substring(Start))

Exit While

Else

'Append to our string builder everything up to the found string, then

'append the replacement

Builder.Append(Expression.Substring(Start, FindLocation - Start))

Builder.Append(Replacement)

Replacements += 1

'Move the start of our search past the string we just replaced

Start = FindLocation + FindLength

End If

End While

Return Builder.ToString()

End Function

Public Function Space(Number As Integer) As String

If Number >= 0 Then

Return New String(ChrW(32), Number)

End If

Throw New ArgumentException(SR.Format(SR.Argument_GEZero1, "Number"))

End Function

Public Function Split(Expression As String, Optional Delimiter As String = " ", Optional Limit As Integer = -1, <Microsoft.VisualBasic.CompilerServices.OptionCompareAttribute()> Optional [Compare] As CompareMethod = CompareMethod.Binary) As String()

Try

'Use String.Split

Dim aList() As String

Dim iDelLen As Integer

If Expression Is Nothing Then

GoTo EmptyExpression

End If

If Expression.Length = 0 Then

ReDim aList(0)

aList(0) = ""

Return aList

End If

If Limit = -1 Then

Limit = Expression.Length + 1

End If

If Delimiter Is Nothing Then

iDelLen = 0

Else

iDelLen = Delimiter.Length

End If

If iDelLen = 0 Then

ReDim aList(0)

aList(0) = Expression

Return aList

End If

'Not handled: LIGATURE expansion

Return SplitHelper(Expression, Delimiter, Limit, [Compare])

Catch ex As Exception

Throw ex

End Try

End Function

Private Function SplitHelper(sSrc As String, sFind As String, cMaxSubStrings As Integer, [Compare] As Integer) As String()

Dim cSubStrings As Integer

Dim iIndex As Integer

Dim iFindLen As Integer

Dim iSrcLen As Integer

Dim asSubstrings() As String

Dim sSubString As String

Dim iLastIndex As Integer

Dim cDelimPosMax As Integer

Dim cmpInfo As CompareInfo

Dim flags As CompareOptions

If sFind Is Nothing Then

iFindLen = 0

Else

iFindLen = sFind.Length

End If

If sSrc Is Nothing Then

iSrcLen = 0

Else

iSrcLen = sSrc.Length

End If

If iFindLen = 0 Then

ReDim asSubstrings(0)

asSubstrings(0) = sSrc

Return asSubstrings

End If

If iSrcLen = 0 Then

ReDim asSubstrings(0)

asSubstrings(0) = sSrc

Return asSubstrings

End If

cDelimPosMax = 20

If cDelimPosMax > cMaxSubStrings Then

cDelimPosMax = cMaxSubStrings

End If

ReDim asSubstrings(cDelimPosMax)

If [Compare] = CompareMethod.Binary Then

flags = CompareOptions.Ordinal

cmpInfo = m_InvariantCompareInfo

Else

cmpInfo = GetCultureInfo().CompareInfo

flags = STANDARD_COMPARE_FLAGS

End If

Do While (iLastIndex < iSrcLen)

iIndex = cmpInfo.IndexOf(sSrc, sFind, iLastIndex, iSrcLen - iLastIndex, flags)

If (iIndex = -1) OrElse (cSubStrings + 1 = cMaxSubStrings) Then

'Just put the remainder of the string in the next element

sSubString = sSrc.Substring(iLastIndex)

If sSubString Is Nothing Then

sSubString = ""

End If

asSubstrings(cSubStrings) = sSubString

Exit Do

Else

'Put the characters between iLastIndex and iIndex into the next element

sSubString = sSrc.Substring(iLastIndex, iIndex - iLastIndex)

If sSubString Is Nothing Then

sSubString = ""

End If

asSubstrings(cSubStrings) = sSubString

iLastIndex = iIndex + iFindLen

End If

cSubStrings += 1

If (cSubStrings > cDelimPosMax) Then

cDelimPosMax += 20

If cDelimPosMax > cMaxSubStrings Then

cDelimPosMax = cMaxSubStrings + 1

End If

ReDim Preserve asSubstrings(cDelimPosMax)

End If

'Must Initialize to empty string, otherwise it looks like an object

asSubstrings(cSubStrings) = ""

If cSubStrings = cMaxSubStrings Then

sSubString = sSrc.Substring(iLastIndex)

If sSubString Is Nothing Then

sSubString = ""

End If

asSubstrings(cSubStrings) = sSubString

Exit Do

End If

Loop

If cSubStrings + 1 = asSubstrings.Length Then

Return asSubstrings

End If

ReDim Preserve asSubstrings(cSubStrings)

Return asSubstrings

End Function

'============================================================================

' Fixed-length string functions.

'============================================================================

Public Function LSet(Source As String, Length As Integer) As String

If (Length = 0) Then

Return ""

ElseIf (Source Is Nothing) Then

Return New String(" "c, Length)

End If

If Length > Source.Length Then

Return Source.PadRight(Length)

Else

Return Source.Substring(0, Length)

End If

End Function

Public Function RSet(Source As String, Length As Integer) As String

If (Length = 0) Then

Return ""

ElseIf Source Is Nothing Then

Return New String(" "c, Length)

End If

If Length > Source.Length Then

Return Source.PadLeft(Length)

Else

Return Source.Substring(0, Length)

End If

End Function

Public Function StrDup(Number As Integer, Character As Object) As Object

Dim s As String

Dim SingleChar As Char

If Number < 0 Then

Throw New ArgumentException(SR.Format(SR.Argument_InvalidValue1, "Number"))

End If

If Character Is Nothing Then

Throw New ArgumentNullException(SR.Format(SR.Argument_InvalidNullValue1, "Character"))

End If

s = TryCast(Character, String)

If s IsNot Nothing Then

If s.Length = 0 Then

Throw New ArgumentException(SR.Format(SR.Argument_LengthGTZero1, "Character"))

End If