LIBREOFFICE XRAY БЛЯДЬ
XrayTool60_en
Если файл существует, а при StarDesktop.loadComponentFromURL выдаётся нечто похожее
BASIC runtime error. An exception occurred Type: com.sun.star.lang.IllegalArgumentException Message: Unsupported URL <D:\file.xls>: "from LoadEnv::initializeLoading".
то это может быть потому, что перед file path нужно добавить "file:///"
Dim empty_array()
result_doc = StarDesktop.loadComponentFromURL("file:///" + result_doc_path,"_blank",0,empty_array())
Sub Main
Dim Str As String
Dim Parsed As Object
Str = GetDocFullPath() ' "/home/user/document.ods" '
Parsed = ParseFilePath(Str)
MsgBox("FileDir:" + Parsed.FileDir) ' "/home/user/" '
MsgBox("FileName:" + Parsed.FileName) ' "document.ods" '
MsgBox("FileDirName:" + Parsed.FileDirName) ' "user" '
MsgBox("FileFullPath:" + Parsed.FileFullPath) ' "/home/user/document.ods" '
MsgBox("FileExtension:" + Parsed.FileExtension) ' "ods" '
MsgBox("FileDirNoSlash:" + Parsed.FileDirNoSlash) ' "/home/user" '
MsgBox("FileNameNoExtension:" + Parsed.FileNameNoExtension) ' "document" '
End Sub
Type FilePathParsedByParseFilePathFunction
FileDir As String
FileName As String
FileDirName As String
FileFullPath As String
FileExtension As String
FileDirNoSlash As String
FileNameNoExtension As String
End Type
Function ParseFilePath(ByVal FullPath As String) As Object
Dim i As Long
Dim PathLen As Long
Dim PathURL As String
Dim DirLenDiff As Long
Dim BaseNameLen As Long
Dim BaseDirectory As String
Dim BaseNameExtDiff 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)
ParseFilePath = CreateObject("FilePathParsedByParseFilePathFunction")
ParseFilePath.FileFullPath = 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
ParseFilePath.FileName = 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(ParseFilePath.FileName)
BaseNameLastDotIndex = BaseNameLen
For i = BaseNameLen To 2 Step -1
If Mid(ParseFilePath.FileName,i,1) = "." Then
BaseNameLastDotIndex = i
Exit For
End If
Next i
ParseFilePath.FileExtension = Right(ParseFilePath.FileName,BaseNameLen - BaseNameLastDotIndex)
BaseNameExtDiff = BaseNameLen - Len(ParseFilePath.FileExtension) - 1
If BaseNameExtDiff < 0 Then
BaseNameExtDiff = 0
End If
ParseFilePath.FileNameNoExtension = Left(ParseFilePath.FileName,BaseNameExtDiff)
' Getting directory name with slash and without. '
DirLenDiff = Len(FullPath) - Len(ParseFilePath.FileName)
ParseFilePath.FileDir = Left(FullPath,DirLenDiff)
DirLenDiff = DirLenDiff - 1
If DirLenDiff < 0 Then
DirLenDiff = 0
End If
ParseFilePath.FileDirNoSlash = Left(FullPath,DirLenDiff)
' Getting file directory name. '
PathURL = ConvertToURL(ParseFilePath.FileDirNoSlash)
If Left(PathURL,7) <> "file://" Then
PathURL = ConvertToURL("/" + ParseFilePath.FileDirNoSlash)
End If
PathLen = Len(PathURL)
For i = PathLen To 1 Step -1
If Mid(PathURL,i,1) = "/" Then
ParseFilePath.FileDirName = ConvertFromURL(Right(PathURL,PathLen - i))
Exit For
End If
Next i
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
Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса можно использовать чтобы парсить полный путь к файлу, получая из него все необходимые части: имя файла, расширение, имя директории, путь без имени файла, имя файла без расширения и т.п.
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
Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса возвращает строку, содержащую расширение файла, или пустую строку, если у файла нет расширения. Данная функция полезна в случае когда нужно узнать расширение по имени файла, либо по полному пути к файлу.
Libreoffice has built-in function to explode strings called Split. To join array into string there is an opposite "implode" function Join.
Sub Main Dim str As String Dim arr() As String str = "Calc||Microsoft Excel 97/2000/XP|xls|MS Excel 97" arr = Split(str,"|") MsgBox(arr(0)) ' "Calc" ' MsgBox(arr(4)) ' "MS Excel 97" ' MsgBox(Join(arr,",")) ' "Calc,,Microsoft Excel 97/2000/XP,xls,MS Excel 97" ' End Sub
Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса для разделения строк использует аналоги PHP-функций explode и implode, называемые Split и Join. Split разделяет строку при помощи разделителя в массив, а Join собирает массив в строку, объединяя указанным разделителем.
Ошибка может произойти и поставить в тупик в том случае, если определение функции расположено ранее её первого вызова и при этом вызов осуществлен без обязательных аргументов. Например:
Sub Main Dim str As String str = GetDocFullPath() MsgBox(GetFileBaseName(str)) End Sub Function GetDocFullPath(sInput as String) As String GetDocFullPath = ConvertFromURL(ThisComponent.getLocation()) End Function
Код выше сгенерирует ошибку
BASIC syntax error.
Symbol GetDocFullPath already defined differently.
Если же переместить местами определение функции, то ошибки уже не появится
Function GetDocFullPath(sInput as String) As String GetDocFullPath = ConvertFromURL(ThisComponent.getLocation()) End Function Sub Main Dim str As String str = GetDocFullPath() MsgBox(GetFileBaseName(str)) End Sub
Но можно и нужно в первую очередь исправить сам некорректный вызов функции, тогда и проблемы не будет.
Sub Main
Dim str As String
str = GetDocFullPath("BLABLABLA")
MsgBox(GetFileBaseName(str))
End Sub
Function GetDocFullPath(sInput as String) As String
GetDocFullPath = ConvertFromURL(ThisComponent.getLocation())
End Function
Sub Main
Dim str As String
str = GetDocFullPath() ' "/home/user/document.ods" '
MsgBox(GetFileBaseName(str)) ' "document.ods" '
str = "C:\Windows\system32\drivers\etc\hosts"
MsgBox(GetFileBaseName(str)) ' "hosts" '
str = "test.ods"
MsgBox(GetFileBaseName(str)) ' "test.ods" '
str = "many.dots.in.file.name.ods"
MsgBox(GetFileBaseName(str)) ' "many.dots.in.file.name.ods" '
End Sub
' Returns the filename of the given path. '
' For example "/home/user/document.ods" input will return "document.ods". '
' ByVal keyword prevents FullPath from modification because by default '
' arguments are passed by reference. '
Function GetFileBaseName(ByVal FullPath As String) As String
Dim i As Long
Dim PathLen As Long
Dim PathURL As String
' 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
GetFileBaseName = ConvertFromURL(Right(PathURL,PathLen - i))
Exit For
End If
Next i
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
Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса можно использовать чтобы получить имя файла и его расширение из полного пути к файлу.
Longstory:
Sub Main
Sheet = ThisComponent.CurrentController.getActiveSheet()
Cell = Sheet.getCellRangeByName("A1")
Cell.setString("Hello World")
MsgBox("Check the A1 cell contents! It will not be saved!")
CloseDocIgnoreConfirmation()
End Sub
Function CloseDocIgnoreConfirmation()
ThisComponent.Close(TRUE)
End Function
Short:
ThisComponent.Close(TRUE)
Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса можно использовать чтобы закрыть текущий документ, не спрашивая пользователя сохранить его или нет. Таким образом можно программно закрыть несохраненный документ, не сохранив изменения в нём и игнорируя диалоговые окна, мешающие закрытию.
Sub Main
MsgBox(GetDocFullPath())
End Sub
' 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
Описание:
Вышепредставленный программный код на бейсике для макросов либреофиса можно использовать чтобы получить полный путь к текущему (над которым работает макрос) документу / файлу в обычном формате.