Attribute VB_Name = "mString"
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Funções de string em geral
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Guarda o nome do modulo
Private Const ST_MY_NAME As String = "mString"

' Instância da classe antiga de tratamento de strings
Private obj_OLD As cStrings


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Tenta carregar a nova instância
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub tryLoadStringsDLL()
    On Error GoTo ErrTreat:
    
    ' Se for win9x
    If (bl_Win9x) Then
    
        ' Cria instancia da antiga
        Set obj_OLD = New cStrings
        
        ' Seta para usar a antiga
        bl_StringDLL = False
    Else
        
        ' Cria instancia da nova
        Set obj_StringDLL = New cStringsDLL
    
        ' Seta para usar nova instância
        bl_StringDLL = True
    End If

    Exit Sub
ErrTreat:

    ' Cria instancia da antiga
    Set obj_OLD = New cStrings
    
    ' Seta para usar a antiga
    bl_StringDLL = False
    
    ' Gravando sobre erro
    LogErrMessage "Can't load LyrikStrings (Framework) library, using old functions instead." + vbCrLf + "Reason: " + Err.Description, ST_MY_NAME + ".tryLoadStringsDLL"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte HTML para Texto
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub htmlTOtext(stInput As String)
    
    ' Se deve usar código novo
    If (bl_StringDLL) Then
        obj_StringDLL.htmlTOtext stInput
    Else
        obj_OLD.htmlTOtext stInput
    End If
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte quebras CRLF em somente CR
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function CRLFtoCR(stInput As String)
    Dim stAux As String
    On Error Resume Next
    
    ' Converte
    stAux = Replace(stInput, vbCrLf, vbCr)
    
    ' Retorna
    CRLFtoCR = stAux
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte UTF8 para wide-string (antiga convUTF8)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function utf8TOwstring(stInput As String) As String
    
    ' Se deve usar código novo
    If (bl_StringDLL) Then
        utf8TOwstring = obj_StringDLL.utf8TOwstring(stInput)
    Else
        utf8TOwstring = obj_OLD.utf8TOwstring(stInput)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma wide-string em utf8
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function wstringTOutf8(stInput As String) As String
    
    ' Se deve usar código novo
    If (bl_StringDLL) Then
        wstringTOutf8 = obj_StringDLL.wstringTOutf8(stInput)
    Else
        wstringTOutf8 = obj_OLD.wstringTOutf8(stInput)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma wide-string em utf8-html
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function wstringTOutf8html(stInput As String) As String
    
    ' Se deve usar código novo
    If (bl_StringDLL) Then
        wstringTOutf8html = obj_StringDLL.wstringTOutf8html(stInput)
    Else
        wstringTOutf8html = obj_OLD.wstringTOutf8html(stInput)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma wide-string em utf8-html (sem caracteres minusculos)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function wstringTOutf8uhtml(stInput As String, lnLimit As Long) As String
    
    ' Se deve usar código novo
    If (bl_StringDLL) Then
        wstringTOutf8uhtml = obj_StringDLL.wstringTOutf8uhtml(stInput, lnLimit)
    Else
        wstringTOutf8uhtml = obj_OLD.wstringTOutf8uhtml(stInput, lnLimit)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retira todos os caracteres especiais usados pela engine do lyric
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub filterString(stInput As String)
    
    ' Substitui caracteres de leitura de tempo
    While (InStr(1, stInput, ST_OPEN_TIME_SEP) > 0)
        stInput = Replace(stInput, ST_OPEN_TIME_SEP, ST_OPEN_COMMON)
    Wend
    While (InStr(1, stInput, ST_CLOSE_TIME_SEP) > 0)
        stInput = Replace(stInput, ST_CLOSE_TIME_SEP, ST_CLOSE_COMMON)
    Wend
    While (InStr(1, stInput, ST_OPEN_WORD_TIME_SEP) > 0)
        stInput = Replace(stInput, ST_OPEN_WORD_TIME_SEP, ST_OPEN_COMMON)
    Wend
    While (InStr(1, stInput, ST_CLOSE_WORD_TIME_SEP) > 0)
        stInput = Replace(stInput, ST_CLOSE_WORD_TIME_SEP, ST_CLOSE_COMMON)
    Wend
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retira espaçamentos iniciais e finais da string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function selectString(stInput As String) As String
    Dim lnAux(1) As Long
    Dim blInit As Boolean
    Dim lnI As Long
    On Error GoTo ErrTreat:
    
    ' Inicia valores
    lnAux(0) = 1
    lnAux(1) = 0
    blInit = True
    
    ' Varre a string
    For lnI = 1 To Len(stInput)
        
        ' Seleciona o caracter atual
        Select Case Mid(stInput, lnI, 1)
        
        ' Se for um caracter de espaço
        Case ST_SEP
        
            ' Se estiver nos caracteres iniciais ainda
            If blInit Then
                
                ' Incrementa posição inicial
                lnAux(0) = lnI + 1
            End If
            
        ' Se for outros caracteres
        Case Else
            
            ' Se estiver nos caracteres iniciais ainda
            If blInit Then
                
                ' Seta que não está nos caracteres iniciais mais
                blInit = False
            End If
            
            ' Incrementa posição final
            lnAux(1) = lnI
        End Select
    Next lnI
    
    ' Se completou uma string válida
    If (lnAux(0) <= lnAux(1)) Then
        
        ' Retorna string
        selectString = Mid(stInput, lnAux(0), lnAux(1) - lnAux(0) + 1)
    Else
        
        ' Retorna inválido
        selectString = ST_INVALID_VALUE
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".selectString", stInput
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retira caracteres finais da string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function retString(stInput As String) As String
    Dim lnAux As Long
    On Error GoTo ErrTreat:
    
    ' Localiza final da string
    lnAux = InStr(1, stInput, Chr(0))
    
    ' Seleciona caso
    Select Case lnAux
    
    ' Se não encontrou o final
    Case 0
        
        ' Retorna a entrada
        retString = stInput
        
    ' Se é a primeira posição
    Case 1
        
        ' Retorna vazio
        retString = ST_INVALID_VALUE
    
    ' Outros casos
    Case Else
        
        ' Retorna string até ao final
        retString = Mid(stInput, 1, lnAux - 1)
    End Select
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".retString"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retira espaçamentos duplicados, iniciais e finais
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function unspaceString(stInput As String) As String
    Dim lnI As Long
    Dim lnJ As Long
    Dim itAux As Integer
    Dim lnSize As Long
    Dim stAux As String
    Dim blSpace As Boolean
    On Error GoTo ErrTreat:
    
    ' Inicia variáveis
    blSpace = True
    stAux = ST_INVALID_VALUE
    lnI = 1
    lnJ = 1
    
    ' Recupera tamanho da string
    lnSize = Len(stInput)
    
    ' Se for um tamanho válido
    If (lnSize > 0) Then
    
        ' Cria string auxiliar
        stAux = String(lnSize, 0)
        
        ' Varre string
        While (lnI <= lnSize)
            
            ' Recupera caracter
            itAux = AscW(Mid(stInput, lnI, 1))
            
            ' Se for espaço
            If (itAux = IT_SEP) Then
                
                ' Se não tiver espaço anterior
                If Not blSpace Then
                    
                    ' Seta que há espaço anterior
                    blSpace = True
                    
                    ' Copia caracter
                    Mid(stAux, lnJ) = ChrW(itAux)
                    
                    ' Incrementa posição no auxiliar
                    lnJ = lnJ + 1
                End If
            
            ' Não é espaço
            Else
                
                ' Seta que não há espaço anterior
                blSpace = False
                
                ' Copia caracter
                Mid(stAux, lnJ) = ChrW(itAux)
                
                ' Incrementa posição no auxiliar
                lnJ = lnJ + 1
            End If
            
            ' Incrementa posição de leitura
            lnI = lnI + 1
        Wend
        
        ' Reseta variável
        blSpace = True
        lnJ = lnJ - 1
        
        ' Enquanto encontrar espaços finais
        While blSpace And (lnJ > 0)
            
            ' Recupera caracter
            itAux = AscW(Mid(stAux, lnJ, 1))
            
            ' Se for espaço
            If (itAux = IT_SEP) Then
                
                ' Elimina espaço
                Mid$(stAux, lnJ) = ChrW(0)
                
                ' Decrementa posição
                lnJ = lnJ - 1
            Else
                
                ' Não possui espaços
                blSpace = False
            End If
        Wend
    End If
    
    ' Retorna auxiliar
    unspaceString = stAux
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".unspaceString"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retira caracteres finais da string (charW)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function retCharW(stInput As String) As String
    Dim lnI As Long
    On Error GoTo ErrTreat:
    
    ' Inicia variáveis
    lnI = 1
    
    ' Enquanto não chegar ao final da string
    While (lnI < Len(stInput))
        
        ' Se os dois próximos caracteres forem 0
        If ((Asc(Mid(stInput, lnI, 1)) = 0) And (Asc(Mid(stInput, lnI + 1, 1)) = 0)) Then
            
            ' Retorna string até ao final
            retCharW = Mid(stInput, 1, lnI - 1)
            
            ' Sai do laço
            Exit Function
        End If
        
        ' Incrementa posição
        lnI = lnI + 2
    Wend
    
    ' Retorna toda a string
    retCharW = stInput
        
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".retCharW"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Preenche uma string com zeros
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function fillString(stInput As String, lnSize As Long) As String
    On Error GoTo ErrTreat:

    ' Se a string for de tamanho menor
    If (Len(stInput) < lnSize) Then
        
        ' Redimenciona string
        fillString = stInput + String(lnSize - Len(stInput), 0)
    
    ' Se a string é maior
    ElseIf (Len(stInput) > lnSize) Then
        
        ' Corta a string
        fillString = Mid(stInput, 1, lnSize)
    
    ' Se for de mesmo tamanho
    ElseIf (Len(stInput) = lnSize) Then
        
        ' Retorna
        fillString = stInput
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".fillString"
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma wide-char em wide-string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function wcharTOwstring(stInput As String) As String
    
    ' Se deve usar código novo
    If (bl_StringDLL) Then
        wcharTOwstring = obj_StringDLL.wcharTOwstring(stInput)
    Else
        wcharTOwstring = obj_OLD.wcharTOwstring(stInput)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma wide-string em wide-char
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function wstringTOwchar(stInput As String) As String
    
    ' Se deve usar código novo
    If (bl_StringDLL) Then
        wstringTOwchar = obj_StringDLL.wstringTOwchar(stInput)
    Else
        wstringTOwchar = obj_OLD.wstringTOwchar(stInput)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte um texto-unicode em wide-string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function txtuniTOwstring(stInput As String) As String
    
    ' Se deve usar código novo
    If (bl_StringDLL) Then
        txtuniTOwstring = obj_StringDLL.txtuniTOwstring(stInput)
    Else
        txtuniTOwstring = obj_OLD.txtuniTOwstring(stInput)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte um wide-string em texto-unicode
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function wstringTOtxtuni(stInput As String) As String
    
     ' Se deve usar código novo
    If (bl_StringDLL) Then
        wstringTOtxtuni = obj_StringDLL.wstringTOtxtuni(stInput)
    Else
        wstringTOtxtuni = obj_OLD.wstringTOtxtuni(stInput)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna se uma string possui RTL
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function rtlString(stInput As String) As Boolean
    Dim lnI As Long, lnJ As Long
    On Error GoTo errRtlString:
    
    ' Pega tamanho final
    lnJ = Len(stInput)
    
    ' Varre entrada
    For lnI = 1 To lnJ
        
        ' Verifica o tipo de caracter
        Select Case AscW(Mid(stInput, lnI, 1))
        
        ' Se pertencer aos RTL
        Case &H5BE To &H7B1, &HFB1D To &HFEFC, &H202B, &H202E, &H200F
            
            ' Retorna que é RTL
            rtlString = True
            
            ' Finaliza
            Exit Function
        End Select
    Next lnI
    
    ' Retorna que não é RTL
    rtlString = False
    
    Exit Function
errRtlString:
    LogErrMessage Err.Description, ST_MY_NAME + ".rtlString"
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Conversões booleanas (string)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function boolTOchar(blValue As Boolean) As String
    
    ' Verifica o tipo
    If blValue Then
        
        ' Retorna 1
        boolTOchar = ST_TRUE
    Else
        
        ' Retorna 0
        boolTOchar = ST_FALSE
    End If
End Function

Public Function charTObool(stValue As String) As Boolean
    
    ' Verifica o char
    If (stValue = ST_TRUE) Then
        
        ' Retorna
        charTObool = True
    Else
        
        ' Retorna
        charTObool = False
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Conversões booleanas (byte)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function boolTObyte(blValue As Boolean) As Byte
    
    ' Verifica o tipo
    If blValue Then
        
        ' Retorna 1
        boolTObyte = 1
    Else
        
        ' Retorna 0
        boolTObyte = 0
    End If
End Function

Public Function byteTObool(btValue As Byte) As Boolean
    
    ' Verifica o char
    If (btValue = 0) Then
        
        ' Retorna
        byteTObool = False
    Else
        
        ' Retorna
        byteTObool = True
    End If
End Function