VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cStringsDLL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Objeto responsável por tratar strings e realizar conversões (usando DLL)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Guarda o nome do objeto
Private Const ST_MY_NAME As String = "cStringsDLL"

' Instância do objeto da DLL
Private obj_DLL As LyrikString.Strings


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Inicia a classe
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
    
    ' Cria nova instância da DLL
    Set obj_DLL = New LyrikString.Strings
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte HTML para Texto
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub htmlTOtext(stInput As String)
    On Error GoTo ErrTreat:
    
    ' Se há entrada
    If (Len(stInput) > 0) Then

        ' Converte
        stInput = obj_DLL.parseHTML(stInput)
    End If
    
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".htmlTOtext"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte UTF8 para wide-string (antiga convUTF8)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function utf8TOwstring(stInput As String) As String
    Dim btAux() As Byte
    On Error GoTo ErrTreat:
    
    ' Se há entrada
    If (Len(stInput) > 0) Then
    
        ' Normaliza string
        normalizeString stInput
        
        ' Converte
        utf8TOwstring = obj_DLL.fromUTF8(stInput)
    Else
        
        ' Retorna inválido
        utf8TOwstring = ST_INVALID_VALUE
    End If
    
    Exit Function
ErrTreat:
    
    ' Gera erro
    LogErrMessage Err.Description, ST_MY_NAME + ".utf8TOwstring"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma wide-string em utf8
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function wstringTOutf8(stInput As String) As String
    On Error GoTo ErrTreat:
    
    ' Se há entrada
    If (Len(stInput) > 0) Then
    
        ' Converte
        wstringTOutf8 = obj_DLL.toUTF8(stInput)
    Else
        
        ' Retorna inválido
        wstringTOutf8 = ST_INVALID_VALUE
    End If
    
    Exit Function
ErrTreat:
    
    ' Gera erro
    LogErrMessage Err.Description, ST_MY_NAME + ".wstringTOutf8"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma wide-string em utf8-html
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function wstringTOutf8html(stInput As String) As String
    On Error GoTo ErrTreat:
    
    ' Se há entrada
    If (Len(stInput) > 0) Then
    
        ' Converte
        wstringTOutf8html = obj_DLL.toURL(stInput)
    Else
        
        ' Retorna inválido
        wstringTOutf8html = ST_INVALID_VALUE
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".wstringTOutf8html"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma wide-string em utf8-html (sem caracteres minusculos)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function wstringTOutf8uhtml(stInput As String, lnLimit As Long) As String
    Dim stAux As String
    Dim lnSize As Long
    On Error GoTo ErrTreat:
    
    ' Recupera tamanho da entrada
    lnSize = Len(stInput)
    
    ' Verifica tamanho de entrada
    If (lnSize > 0) Then
        
        ' Se for maior que o limite
        If (Len(stInput) > lnLimit) Then
            
            ' Retira excesso
            stAux = Mid(stInput, 1, lnLimit)
        Else
            
            ' Seta entrada
            stAux = stInput
        End If
        
        ' Converte para HTML e retorna
        wstringTOutf8uhtml = obj_DLL.toURL(stAux)
    Else
        
        ' Retorna inválido
        wstringTOutf8uhtml = ST_INVALID_VALUE
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".wstringTOutf8uhtml"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte um texto-unicode em wide-string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function txtuniTOwstring(stInput As String) As String
    On Error GoTo ErrTreat:

    ' Se há entrada
    If (Len(stInput) > 0) Then
    
        ' Converte
        txtuniTOwstring = obj_DLL.fromByteFile(stInput)
    Else
    
        ' Retorna inválido
        txtuniTOwstring = ST_INVALID_VALUE
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".txtuniTOwstring"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte um wide-string em texto-unicode
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function wstringTOtxtuni(stInput As String) As String
    On Error GoTo ErrTreat:

    ' Se há entrada
    If (Len(stInput) > 0) Then
    
        ' Converte
        wstringTOtxtuni = obj_DLL.toByteFile(stInput, Encodings_UTF16)
    Else
    
        ' Retorna inválido
        wstringTOtxtuni = ST_INVALID_VALUE
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".wstringTOtxtuni"
End Function

Public Function wstringTOtxtuni8(stInput As String) As String
    On Error GoTo ErrTreat:

    ' Se há entrada
    If (Len(stInput) > 0) Then
    
        ' Converte
        wstringTOtxtuni8 = obj_DLL.toByteFile(stInput, Encodings_UTF8)
    Else
    
        ' Retorna inválido
        wstringTOtxtuni8 = ST_INVALID_VALUE
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".wstringTOtxtuni8"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma wide-char em wide-string
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function wcharTOwstring(stInput As String) As String
    On Error GoTo ErrTreat:
    
    ' Se há entrada
    If (Len(stInput) > 0) Then
    
        ' Converte e retorna
        wcharTOwstring = obj_DLL.fromWideChar(stInput)
    Else
    
        ' Retorna inválido
        wcharTOwstring = ST_INVALID_VALUE
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".wcharTowstring"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma wide-string em wide-char
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function wstringTOwchar(stInput As String) As String
    On Error GoTo ErrTreat:
    
    ' Se há entrada
    If (Len(stInput) > 0) Then
    
        ' Converte e retorna
        wstringTOwchar = obj_DLL.toWideChar(stInput)
    Else
    
        ' Retorna inválido
        wstringTOwchar = ST_INVALID_VALUE
    End If
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".wstringTowchar"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Converte uma string em vetor de bytes
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub normalizeString(stInput As String)
    Dim i As Long
    On Error GoTo ErrTreat:
    
    ' Se entrada for válida
    If (Len(stInput) > 0) Then
    
        ' Varrendo entrada
        For i = Len(stInput) To 1 Step -1
        
            ' Normaliza
            Mid$(stInput, i, 1) = ChrW(Asc(Mid(stInput, i, 1)))
        Next i
    End If
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".normalizeString"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Salvando em arquivo (sempre quando possível será UTF16 - Unicode)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub FileSave(Address As String, Buff As String, Offset As Long, DeleteBefore As Boolean)
    On Error GoTo ErrTreat:
    
    ' Se há entrada
    If (Len(Buff) > 0) Then
    
        ' Repassa para DLL
        obj_DLL.FileSave Address, Buff, Offset, DeleteBefore, Encodings_UTF16
    End If
    
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".FileSave"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Salvando em arquivo (sempre quando possível será ASCII)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub FileSaveAscii(Address As String, Buff As String, Offset As Long, DeleteBefore As Boolean)
    On Error GoTo ErrTreat:
    
    ' Se há entrada
    If (Len(Buff) > 0) Then
    
        ' Repassa para DLL
        obj_DLL.FileSave Address, Buff, Offset, DeleteBefore, Encodings_Binary
    End If
    
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".FileSaveAscii"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Salvando em arquivo (sempre quando possível será UTF8)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub FileSaveUTF8(Address As String, Buff As String, Offset As Long, DeleteBefore As Boolean)
    On Error GoTo ErrTreat:
    
    ' Se há entrada
    If (Len(Buff) > 0) Then
    
        ' Repassa para DLL
        obj_DLL.FileSave Address, Buff, Offset, DeleteBefore, Encodings_UTF8
    End If
    
    Exit Sub
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".FileSaveUTF8"
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Lendo de arquivo
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function FileRead(Address As String, Offset As Long, Optional Size As Long = 0) As String
    On Error GoTo ErrTreat:
    
    ' Repassa para DLL
    FileRead = obj_DLL.FileRead(Address, Offset, Size)
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".FileRead"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Verifica se arquivo existe
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function FileExists(Address As String) As Boolean
    On Error GoTo ErrTreat:
    
    ' Repassa para DLL
    FileExists = obj_DLL.FileExists(Address)
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".FileExists"
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Tenta deletar arquivo
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function FileKill(Address As String) As Boolean
    On Error GoTo ErrTreat:
    
    ' Repassa para DLL
    obj_DLL.FileKill Address
    
    ' Seta que deletou
    FileKill = True
    Exit Function
ErrTreat:
    
    ' Seta que não deletou
    FileKill = False
End Function