Option Strict Off
Option Explicit On
Module Module1
	Function StringFirstLetters(ByRef s As String, ByRef n As Integer) As String
        Dim i As Integer = 0
        Dim a As String = ""
		
        Do
            Do Until Asc(s.Substring(i, 1).ToLower) >= Asc("a") And Asc(s.Substring(i, 1).ToLower) <= Asc("z")
                i += 1
            Loop
            a &= s.Substring(i, 1)
            i += 1
        Loop Until Len(a) = n
		
		StringFirstLetters = a
	End Function
	
	' replace all occurrances of string u with string v in s
	Function StringReplace(ByRef s As String, ByRef u As String, ByRef v As String) As String
        If s.IndexOf(u) >= 0 Then
            StringReplace = Left(s, s.IndexOf(u)) & v & StringReplace(s.Substring(s.IndexOf(u) + Len(u)), u, v)
        Else
            StringReplace = s
        End If
	End Function
	
	' return the leftmost n characters of string l
	' string l is left with the remaining characters.
	Function StringTake(ByRef l As String, ByRef n As Integer) As String
        If l.Length > n Then
            StringTake = l.Substring(0, n).Trim
            l = l.Substring(n)
        Else
            StringTake = l.Trim
            l = ""
        End If
	End Function
	
	' return a string with the first letters of words in string a set to upper case
	Function adjustcase(ByRef a As String) As String
        Dim r As Integer = a.Length - 1

        'Debug.Print(a)
		
        If r > 0 Then
            Dim r1, r2, r3, r4 As Integer
            r1 = a.IndexOf(" ")
            r2 = a.IndexOf(".")
            r3 = a.IndexOf(",")
            r4 = a.IndexOf("_")
            If r1 >= 0 Then r = Math.Min(r, r1)
            If r2 >= 0 Then r = Math.Min(r, r2)
            If r3 >= 0 Then r = Math.Min(r, r3)
            If r4 >= 0 Then r = Math.Min(r, r4)
            'Debug.Print(r.ToString)
            If r < 0 Or r = a.Length - 1 Then
                If a.Length > 1 Then
                    adjustcase = a.Substring(0, 1).ToUpper & a.Substring(1).ToLower
                Else
                    adjustcase = a.ToUpper
                End If
            Else
                If r = 0 Then
                    adjustcase = a.Substring(0, 1) & adjustcase(a.Substring(1))
                Else
                    adjustcase = a.Substring(0, 1).ToUpper & a.Substring(1, r).ToLower & adjustcase(a.Substring(r + 1))
                End If
            End If
        Else
            adjustcase = a.ToUpper
        End If
	End Function
	
	Function removechars(ByRef s As String, ByRef ch As String) As String
		Dim i As Short
		
        i = s.IndexOf(ch)
		
        If i < 0 Then
            removechars = s
        ElseIf i = s.Length - 1 Then
            removechars = s.Substring(0, i)
        Else
            removechars = s.Substring(0, i) & removechars(s.Substring(i + 1), ch)
        End If
	End Function
	
	Function noperiod(ByRef s As String) As String
		Dim x As Integer
		
        x = s.IndexOf(".")
        If x >= 0 Then
            noperiod = adjustcase(s.Substring(0, x))
        Else
            noperiod = s
        End If
	End Function
	
    Function LastSlash(ByRef s As String) As String
        If s.IndexOf("/") >= 0 Then
            If s.Length > s.IndexOf("/") Then
                LastSlash = LastSlash(s.Substring(s.IndexOf("/") + 1))
            Else
                LastSlash = ""
            End If
        Else
            LastSlash = s
        End If
    End Function

    Sub U2D(ByRef filename As String)
        Dim fn1 As Integer = FreeFile() : FileOpen(fn1, filename, OpenMode.Binary)
        Dim fn2 As Integer = FreeFile() : FileOpen(fn2, "cx.txt", OpenMode.Binary)

        For i As Integer = 1 To LOF(fn1)
            Dim cr As Byte = Asc(vbCr)
            Dim lf As Byte = Asc(vbLf)

            Dim a, c As Byte
            FileGet(fn1, a)
            If a = lf And c <> cr Then FilePut(fn2, cr)
            If c = cr And a <> lf Then FilePut(fn2, lf)
            FilePut(fn2, a)
            c = a
        Next i

        FileClose(fn1, fn2)
        My.Computer.FileSystem.DeleteFile(filename)
        My.Computer.FileSystem.RenameFile("cx.txt", filename)
    End Sub

    Function XMLTag(ByRef s As String, ByVal tag As String, Optional ByVal discard As Boolean = True) As String
        Dim p1, p2 As Integer
        If s.IndexOf("<" & tag & ">") >= 0 Then
            p1 = s.IndexOf("<" & tag & ">")
            If p1 < 0 Then Throw New ArgumentException("StringFunctions.XMLTag - start tag not found: " & tag)
            p1 += ("<" & tag & ">").Length
            p2 = s.IndexOf("</" & tag & ">")
            If p2 < 0 Then Throw New ArgumentException("StringFunctions.XMLTag - end tag not found: " & tag)
            XMLTag = s.Substring(p1, p2 - p1).Trim
            If discard Then s = s.Substring(p2 + ("</" & tag & ">").Length)
        Else
            XMLTag = ""
            If discard Then s = ""
        End If
        XMLTag = XMLTag.Replace("\\", "\").Replace("\n", Chr(10))
    End Function

    Function XMLEnclose(ByRef s As String, ByRef tag As String) As String
        XMLEnclose = "<" & tag & ">" & s & "</" & tag & ">"
        'XMLEnclose = sprintf("<%s>%s</%s>", tag, s, tag)
    End Function

    Function StringBounded(ByRef s As String, ByVal after As String, ByVal before As String, Optional ByVal discard As Boolean = True) As String
        If IsNothing(s) OrElse s = "" Then Return ""
        Dim s2 As String = s
        If after <> "" Then
            If s2.Contains(after) Then
                s2 = s2.Substring(s2.IndexOf(after) + after.Length)
            Else
                Return ""
                'Throw (New ApplicationException("StringBounded -- start string was not found in the page: " & after))
            End If
        End If
        If before <> "" Then
            If s2.Contains(before) Then
                StringBounded = s2.Substring(0, s2.IndexOf(before))
                s2 = s2.Substring(s2.IndexOf(before) + before.Length)
            Else
                Throw (New ApplicationException("StringBounded -- end string was not found in the page after the start string: " & before))
            End If
        Else
            StringBounded = s2
        End If
        If discard Then s = s2
    End Function

    Public Function StringTemplate(ByVal temp As String, ByVal ParamArray i() As Integer) As String
        Dim s1() As String = temp.Split(New String() {"%1" & Chr(34)}, StringSplitOptions.RemoveEmptyEntries)
        Dim s2() As String = s1(1).Split(Chr(34))
        Dim res As String = s1(0) & i(0).ToString(s2(0)) & s2(1).Split("?")(0)
        Return res
    End Function

    Public Function StringIterationLimits(ByVal temp As String) As Integer()
        Dim s() As String = temp.Split("?"c)
        If s.GetLength(0) > 1 Then
            s = s(1).Split(":"c)
            If s.GetLength(0) > 0 Then
                Return New Integer() {Val(s(0)), Val(s(1))}
            Else
                Return New Integer() {}
            End If
        Else
            Return New Integer() {}
        End If
    End Function

    Public Function InsertEnvironmentVariable(ByVal s As String) As String
        Dim ev As String = StringBounded(s, "%", "%", False)
        If ev <> "" Then
            Return StringReplace(s, "%" & ev & "%", Environ(ev))
        Else
            Return s
        End If
    End Function

    Private directorystack() As String = New String() {}
    Public Sub pushdir(ByVal dir As String)
        Dim l As Integer = directorystack.GetLength(0)
        ReDim Preserve directorystack(l)
        directorystack(l) = My.Computer.FileSystem.CurrentDirectory
        If Not IsNothing(dir) Then
            My.Computer.FileSystem.CurrentDirectory = InsertEnvironmentVariable(dir)
        End If
    End Sub

    Public Sub popdir()
        Dim l As Integer = directorystack.GetLength(0)
        If Not IsNothing(directorystack(l - 1)) Then
            My.Computer.FileSystem.CurrentDirectory = directorystack(l - 1)
        End If
        Select Case l
            Case 1
                directorystack = New String() {}
            Case Else
                ReDim Preserve directorystack(l - 2)
        End Select
    End Sub

    Public Function CFormatting(ByVal s As String, ByVal val As Integer, Optional ByVal padchar As Char = "0"c) As String
        Dim pp As Integer = s.IndexOf("%"c)
        If pp < 0 Then Return s
        Dim sfmt As String = s.Substring(pp)
        Dim p() As Integer = New Integer() {sfmt.IndexOf("d"c), sfmt.IndexOf("h"c), sfmt.IndexOf("x"c), sfmt.IndexOf("o"c)}

        ' find the first format char that is present
        Dim m As Integer = 1000000
        Dim imin As Integer = -1
        For i As Integer = 0 To p.Length - 1
            If p(i) > 0 AndAlso m > p(i) Then
                imin = i
                m = p(i)
            End If
        Next

        ' format string present?
        If imin < 0 Then Return s

        Dim f As String = sfmt.Substring(m, 1)
        Dim prefix As String = s.Substring(0, pp)
        Dim suffix As String
        Try
            suffix = s.Substring(pp + m + 1)
        Catch ex As ArgumentOutOfRangeException
            suffix = ""
        End Try

        ' number in decimal or hex
        Dim res As String
        Select Case f
            Case "d" : res = val.ToString
            Case "h", "x" : res = Format(val, "x")
            Case Else
                Throw New ArgumentException("Scripting.CFormatting - invalid or no formatting character: " & f)
        End Select

        ' whether to add leading zeros to the number string
        Select Case m
            Case 1
            Case Else
                Dim n As Integer = CInt(sfmt.Substring(1, p(imin) - 1))
                res = res.PadLeft(n, padchar)
        End Select

        Return prefix & res & suffix
    End Function

    ''' <summary>An approximation of the C <c>sprintf</c> function.</summary>
    ''' <param name="formatstring">The format string.</param>
    ''' <param name="values">The list of data to be formatted.</param>
    ''' <returns>The string containing the formatted data.</returns>
    ''' <remarks>
    ''' <para>The format characters 'd', 'x', 'o', and 'f' are implemented.
    ''' 'x' has alias 'h', and 'x' and 'h' can be either upper or lower case.
    ''' The format modifier can contain a field width, precision, '+' for a sign character, 
    ''' '-' for left justification, and '0' for zero fill on the left.
    ''' Other features are not implemented.
    ''' No '\%' permitted in the format string, 
    ''' although '\a', '\b', '\c', '\f', '\n', '\t', and '\v' can be used.</para>
    ''' <code>Debug.Print(sprintf("%-12d|%+12d|%+012d|%+-012d", 12, 12, 12, -12))
    ''' Debug.Print(sprintf("%-12x|%+12x|%+012x|%+-012x", 12, 12, 12, 12))
    ''' Debug.Print(sprintf("%-12o|%+12o|%+012o|%+-012o", 12, 12, 12, 12))
    ''' Debug.Print(sprintf(""""": %f|%12.3f|%012.3f", Sqrt(2), Sqrt(71), Sqrt(91)))
    ''' Debug.Print(sprintf("-:    %-f|%-12.3f|%-012.3f", Sqrt(2), Sqrt(71), Sqrt(91)))
    ''' Debug.Print(sprintf("+:    %+f|%+12.3f|%+012.3f", Sqrt(2), Sqrt(71), Sqrt(91)))
    ''' Debug.Print(sprintf("+-:   %+-f|%+-12.3f|%+-012.3f", Sqrt(2), Sqrt(71), Sqrt(91)))
    ''' </code>
    ''' </remarks>
    ''' <exception cref="InvalidCastException">Data type does not match format specifier.</exception>
    Public Function sprintf(ByVal formatstring As String, ByVal ParamArray values() As Object) As String
        ' split the format string by format specifiers
        Dim pp() As String = formatstring.Split("%"c)
        If pp.Length < 2 Then Return formatstring

        ' loop through the format specifiers
        Dim result As String = pp(0)
        For j As Integer = 1 To Math.Min(pp.Length, UBound(values) + 2) - 1
            ' list of the supported format chars
            Static formatchars() As Char = New Char() {"d"c, "i"c, "h"c, "x"c, "H"c, "X"c, "o"c, "s"c, "f"c}

            ' the current format specifier
            Dim s1 As String = pp(j)

            ' find the first format char that is present in the current format specifier
            Dim m As Integer = 1000000
            Dim imin As Integer = -1
            For i As Integer = 0 To formatchars.Length - 1
                Dim x As Integer = s1.IndexOf(formatchars(i))
                If x >= 0 AndAlso m > x Then
                    imin = i
                    m = x
                End If
            Next

            ' format string present?
            If imin < 0 Then Return formatstring

            ' local variables
            Dim formatchar As Char = formatchars(imin)
            Dim modifier As String = Nothing
            Dim sign As Boolean = False
            Dim rightalignment As Boolean = True
            Dim padding As Char = " "c
            Dim fieldwidth As Integer = 1
            Dim precision As Integer = -1

            ' check for format modifier
            If m > 0 Then
                modifier = s1.Substring(0, m)
                ' whether to print sign
                sign = modifier.Contains("+")
                ' whether to align right
                rightalignment = Not modifier.Contains("-")
                ' padding, width, and precision
                Dim field As String = modifier.Replace("+", "").Replace("-", "").Replace(" ", "").Replace("#", "")
                ' padding
                If field.StartsWith("0") Then padding = "0"c
                ' field width
                If field <> "" Then fieldwidth = CInt(Math.Floor(CDbl(field)))
                If sign Then fieldwidth -= 1
                ' precision
                If field.Contains(".") Then precision = field.Substring(field.IndexOf("."c) + 1)
            End If
            Dim s2 As String = s1.Substring(m + 1)

            ' assemble the string
            Dim str As String = ""
            Dim prefix As String = ""
            Select Case formatchar
                Case "d", "i"
                    ' decimal integer
                    str = Math.Abs(CLng(values(j - 1))).ToString
                Case "x"c, "h"c, "X"c, "H"c
                    ' hexadecimal integer
                    str = Hex$(CLng(values(j - 1)))
                    If formatchar = "x"c OrElse formatchar = "h"c Then str = str.ToLower
                    If modifier.Contains("#") Then
                        Select Case formatchar
                            Case "x", "X" : prefix = "0x"
                            Case "h", "H" : prefix = "&h"
                        End Select
                    End If
                Case "o"c
                    ' octal
                    str = Oct$(CInt(values(j - 1)))
                Case "s"c
                    ' string
                    str = CStr(values(j - 1))
                Case "f"c
                    ' floating
                    If modifier Is Nothing Then
                        str = Math.Abs(CDbl(values(j - 1))).ToString("0.000000")
                    Else
                        Dim fmt As String = "0."
                        If precision > 0 Then
                            Dim dec As Integer = CInt(modifier.Substring(modifier.IndexOf("."c) + 1))
                            fmt &= Space(precision).Replace(" "c, "0"c)
                        End If
                        str = Math.Abs(CDbl(values(j - 1))).ToString(fmt)
                    End If
                Case Else
            End Select

            ' force pad left if zero filled
            If padding = "0"c Then str = str.PadLeft(fieldwidth, padding)
            ' add prefix
            str = prefix & str
            ' add sign
            If m > 0 Then
                If values(j - 1).GetType.Name = "String" Then
                Else
                    If values(j - 1) < 0 Then
                        str = "-" & str
                    Else
                        If sign AndAlso CDbl(values(j - 1)) >= 0 Then str = "+" & str
                    End If
                End If
            End If

            ' padding if pad char is not '0'
            If padding <> "0"c Then
                If rightalignment Then
                    str = str.PadLeft(fieldwidth)
                Else
                    str = str.PadRight(fieldwidth)
                End If
            End If

            result &= str & s2
        Next

        ' replace escape chars
        Static specialchars() As String = New String() {"\a", "\b", "\f", "\n", "\c", "\t", "\v", "\p"}
        Static replacements() As String = New String() {Chr(7), vbBack, vbFormFeed, vbNewLine, vbCr, vbTab, vbVerticalTab, "%"}
        For i As Integer = 0 To specialchars.Length - 1
            If result.Contains(specialchars(i)) Then result = result.Replace(specialchars(i), replacements(i))
        Next

        Return result
    End Function

    Public Sub printf(ByVal formatstring As String, ByVal ParamArray data() As Object)
        Debug.Print(sprintf(formatstring, data))
    End Sub

    'Public Sub d2u(ByVal filename As String)
    '    Dim i As Long, filnam As String
    '    If Command$() = "" Then Exit Sub
    '    Const cr As Char = Chr(13)
    '    Const lf As Char = Chr(10)
    '    Dim a, b, c As Char

    '    Dim x As String = LTrim$(Command$)
    '    Do While x <> ""
    '        If x.Contains(" ") Then
    '            x = x.Substring(x.IndexOf(" ")).TrimStart
    '        Else
    '            x = ""
    '        End If
    '        Dim fn As Integer = FreeFile()
    '        FileOpen(fn, filename, OpenMode.Binary, OpenAccess.ReadWrite, OpenShare.LockReadWrite)
    '        filnam = Left$(Text1, 3) & LTrim$(Str$(Timer))
    '    Open filnam For Binary As 2
    '        For i = 1 To LOF(1)
    '        Get #1, , a
    '            If c = cr Then
    '            Put #2, , lf
    '            If a <> lf And a <> cr Then Put #2, , a
    '            ElseIf a <> cr Then
    '            Put #2, , a
    '            End If
    '            c = a
    '            If i Mod 100 = 0 Then DoEvents()
    '        Next i
    '        Close()
    '        Kill(Text1)
    '    Name filnam As Text1
    '    Loop
    'End Sub

End Module