Sub Main

    Dim str As String

    str = GetDocFullPath()
    MsgBox(str + " -> " + GetFileExtension(str))
    ' "/home/user/document.ods -> ods"                                         '
    
    str = "C:\Windows\system32\drivers\etc\hosts"
    MsgBox(str + " -> " + GetFileExtension(str))
    ' "C:\Windows\system32\drivers\etc\hosts -> "                              '
    
    str = "C:\Windows\system32\drivers\etc\hosts.ods.zip"
    MsgBox(str + " -> " + GetFileExtension(str))
    ' "C:\Windows\system32\drivers\etc\hosts.ods.zip -> zip"                   '
    
    str = "many.dots.in.file.name.ods"
    MsgBox(str + " -> " + GetFileExtension(str))
    ' "many.dots.in.file.name.ods -> ods"                                      '
    
    str = "test.ods"
    MsgBox(str + " -> " + GetFileExtension(str))
    ' "test.ods -> ods"                                                        '

    str = ".htaccess"
    MsgBox(str + " -> " + GetFileExtension(str))
    ' ".htaccess -> "                                                          '

    str = ""
    MsgBox(str + " -> " + GetFileExtension(str))
    ' " -> "                                                                   '
    
End Sub

' Returns extension by filename.                                               '
' Notice that files starting with dot (.htaccess) have no extension.           '
Function GetFileExtension(ByVal FullPath As String) As String

    Dim i As Long
    Dim PathLen As Long
    Dim PathURL As String
    Dim BaseName As String
    Dim BaseNameLen As Long
    Dim BaseNameLastDotIndex As Long
    ' Fetching file base name from FullPath                                    '
    ' Converting to URL for Linux/Windows compatibility.                       '
    '   URL notation does not allow certain special characters to be used.     '
    '   These are either replaced by other characters or encoded. A slash      ' 
    '   (/) is used as a path separator. For example, a file referred to as    ' 
    '   C:\My File.sxw on the local host in "Windows notation" becomes         '
    '   file:///C|/My%20File.sxw in URL notation.                              '
    ' https://help.libreoffice.org/Basic/Basic_Glossary                        '
    PathURL = ConvertToURL(FullPath)
    ' FullPath could be mistakenly converted to http. For example:             '
    ' ConvertToURL("many.dots.in.file.name.ods") will be misinterpreted.       ' 
    If Left(PathURL,7) <> "file://" Then 
        PathURL = ConvertToURL("/" + FullPath)
    End If
    PathLen = Len(PathURL)
    For i = PathLen To 1 Step -1
        If Mid(PathURL,i,1) = "/" Then
            BaseName = ConvertFromURL(Right(PathURL,PathLen - i))
            Exit For
        End If
    Next i
    
    ' Finding last occurence of "." in the file name. First symbol is ignored  '
    ' due to filenames starting with dot (.htaccess) have no extension.        '
    BaseNameLen = Len(BaseName)
    BaseNameLastDotIndex = BaseNameLen
    For i = BaseNameLen To 2 Step -1
        If Mid(BaseName,i,1) = "." Then
            BaseNameLastDotIndex = i
            Exit For
        End If
    Next i
    
    GetFileExtension = Right(BaseName,BaseNameLen - BaseNameLastDotIndex)

End Function

' Returns document full path if document has a path. Returns empty string if   '
' document has no path and IgnoreNoPathError flag is set to TRUE.              '
Function GetDocFullPath(Optional IgnoreNoPathError as Boolean) As String
    
    ' Default behavior is to return empty string if document location is empty.'
    ' This can happen if document is new and not saved thus do not have a path.'
    If NOT ThisComponent.hasLocation() AND IgnoreNoPathError <> TRUE Then
        ' Err.Raise is not valid statement but will generate error anyway.     '
        Err.Raise("Document has no path. Probably because is not saved.")
    End If
    
    GetDocFullPath = ConvertFromURL(ThisComponent.getLocation())
    
End Function

Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса возвращает строку, содержащую расширение файла, или пустую строку, если у файла нет расширения. Данная функция полезна в случае когда нужно узнать расширение по имени файла, либо по полному пути к файлу.


P.S. Присылайте криптовалюту если вам нравится то, что я делаю.
Если не нравится - тоже присылайте.
LTC (Litecoin): LLN6X2uV1iuQ1e4tdmQZsf2RRwh4pxPSej

Leave a Reply

*