Attribute VB_Name = "mPath"
Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Módulo para tradução do programa
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Guarda o nome do módulo
Private Const ST_MY_NAME As String = "mPath"

' Pasta do programa
Private Const ST_MY_PATH As String = "Lyrik\"

' API's externa
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" (ByVal hwndOwner As Long, ByVal nFolder As Long, ByRef pIdl As Long) As Long
Private Declare Function SHGetPathFromIDListA Lib "shell32" (ByVal PpIdl As Long, ByVal pszPath As String) As Long


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna uma pasta especial
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function getSpecialFolder(efNumber As ESPECIAL_FOLDER) As String
    Dim lnIDL As Long
    Dim stBuff As String
    Dim lnBuffLen As Long
    On Error GoTo ErrTreat:
    
    ' Se não ocorreram erros
    If (SHGetSpecialFolderLocation(0, efNumber, lnIDL) = LN_NO_ERROR) Then
    
        ' Inicia buff
        stBuff = String(LN_API_BUFF_SIZE, 0)
        
        ' Retorna pasta
        SHGetPathFromIDListA lnIDL, stBuff
        lnBuffLen = InStr(1, stBuff, Chr(0))
        
        ' Verifica se retornou ok
        If (lnBuffLen > 1) Then
        
            ' Retorna pasta
            stBuff = getCompletPath(Left(stBuff, lnBuffLen - 1)) + ST_MY_PATH
            
            ' Verifica se a pasta é válida
            If isValidPath(stBuff) Then
                
                ' Retorna pasta
                getSpecialFolder = stBuff
                
                ' Sai da função
                Exit Function
            End If
        End If
    End If
        
    ' Retorna a pasta do programa
    getSpecialFolder = st_WorkDir
    
    Exit Function
ErrTreat:
    LogErrMessage Err.Description, ST_MY_NAME + ".getSpecialFolder", efNumber
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna se uma pasta existe
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function isPathExist(stPath As String) As Boolean
    On Error GoTo ErrTreat:
    
    ' Verifica se existe
    If Has(GetAttr(stPath), vbDirectory) Then
        
        ' Retorna que existe
        isPathExist = True
    Else
        
        ' Retorna que não existe
        isPathExist = False
    End If
    
    Exit Function
ErrTreat:
         
     ' Retorna que não existe
     isPathExist = False
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retorna se uma pasta existe ou se conseguiu criá-la
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function isValidPath(stPath As String) As Boolean
    On Error Resume Next
    
    ' Verifica se existe
    If isPathExist(stPath) Then
        
        ' Retorna que já existe
        isValidPath = True
    Else
        
        ' Tenta criar
        MkDir stPath
        
        ' Verifica e retorna novamente
        isValidPath = isPathExist(stPath)
    End If
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Completa o caminho de uma pasta
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub CompletPath(stPath As String)
    
    ' Verifica se não termina com um separador
    If (Mid(stPath, Len(stPath)) <> ST_PATH_SEP) Then
        
        ' Adiciona
        stPath = stPath + ST_PATH_SEP
    End If
End Sub

Public Function getCompletPath(stPath As String) As String
    
    ' Verifica se não termina com um separador
    If (Mid(stPath, Len(stPath)) <> ST_PATH_SEP) Then
        
        ' Adiciona
        getCompletPath = stPath + ST_PATH_SEP
    Else
        
        ' Retorna padrão
        getCompletPath = stPath
    End If
End Function