[Решено] Basic, путь к временному каталогу

Автор Massaraksh7, 1 мая 2024, 14:13

0 Пользователи и 1 гость просматривают эту тему.

mikekaganski

#15
ЦитироватьsPath = "C:\Temp\Send.txt"
...
    if oUCB.Exists(sPath) then
...
        oInputStream.setInputStream(oUCB.OpenFileRead(sPath))

exists и openFileRead принимают аргумент FileURL. Он должен быть именно URL, то есть в Вашем случае file:///C:/Temp/Send.txt.

Наша реализация использует INetURLObject, который достаточно умный, чтобы попытаться преобразовать любую строку, которая не является правильным URL, в URL из формата файлового пути. Но всё же стоит писать код, соответствующий API - поэтому лучше сделать что-то вроде

sPath = ConvertToURL("C:\Temp\Send.txt")
используя функцию ConvertToURL.
С уважением,
Михаил Каганский

Massaraksh7

#16
Ещё одна странность: так (влож.1) работает, а так (влож.2) - нет. Это касаемо любых подобных констант. Причём, в других макросах работают оба варианта. (Уточню: другие макросы находятся в документе, а этот - в приложении). Чего не хватает?

bigor

Цитата: Massaraksh7 от  4 мая 2024, 16:25а этот - в приложении
в смысле в библиотеке самого LO? А такой код, если его поместить туда же, что возвращает?
sub tst_1
print com.sun.star.table.CellVertJustify.TOP
end sub
Поддержать наш форум можно здесь

Massaraksh7

Если отдельно вся Sub, то и там, и там работает нормально. Если print поставить в коде c Application, то та же ошибка. Может, у меня что в коде не так? Привести код?

bigor

Без кода, в любом случае вам вряд ли кто поможет. Выкладывайте код
Поддержать наш форум можно здесь

Massaraksh7

#20
dim oOutputStream, oInputStream, sheet, sheets, doc
dim data()

'---Получить временный каталог
function GetTempDir
  oSubst = CreateUnoService("com.sun.star.util.PathSubstitution")
  GetTempDir = oSubst.getSubstituteVariableValue("$(temp)")
end function

'---Получить путь до rec.srv
function GetRecPath
  s = GetTempDir+"/rec.srv"
  GetRecPath = ConvertFromURL(s)
end function 

'---Получить путь до send.srv
function GetSendPath
  s = GetTempDir+"/send.srv"
  GetSendPath = ConvertFromURL(s)
end function 

'---Запись строки в rec.srv
Sub Answer(s as string)
oOutputStream.writeString(s & Chr(13) & Chr(10))
end sub

'---Прпытка чтения send.srv - непусто - OK
Function GetSend
On Error GoTo Handler
     FileName = GetSendPath
     Open FileName For Input As #1
     Line Input #1,s
     Close #1
     GetSend = s
     Exit Function
Handler:
     GetSend = ""
End Function

'---Ожидание готовности файла send.srv
Function WaitForSend
n = 0
timeout = 1000
rep:
   s = GetSend
   if s="" then
   wait 100
      if n > timeout then
      MsgBox("Тайм-аут")
      WaitForSend = ""
      exit Function
      end if
   goto rep
   end if
WaitForSend = s
End Function

'---Установить текущий лист
Sub activelist(com)
nlist = CInt(com(1))
sheet = sheets.getByIndex(nlist-1)
Answer("OK")
end sub

'---Прлучить последнюю строку и столбец
Sub getavarange(com)
oCursor = sheet.createCursor()
oCursor.gotoEndOfUsedArea(True)
LastRow = oCursor.getRangeAddress().EndRow
LastCol = oCursor.getRangeAddress().EndColumn
s = trim(CStr(LastRow+1)) & "^" & trim(CStr(LastCol+1))
Answer(s)
end sub

Sub oneborder(r1,c1,r2,c2,br,w)
if (br and 1)>0 then
    sBorder = "LeftBorder"
    aBorder=sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).getPropertyValue(sBorder)
    aBorder.LineWidth=w
    sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).setPropertyValue(sBorder,aBorder)
endif   
if (br and 2)>0 then
    sBorder = "RightBorder"
    aBorder=sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).getPropertyValue(sBorder)
    aBorder.LineWidth=w
    sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).setPropertyValue(sBorder,aBorder)
endif       
if (br and 4)>0 then
    sBorder = "TopBorder"
    aBorder=sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).getPropertyValue(sBorder)
    aBorder.LineWidth=w
    sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).setPropertyValue(sBorder,aBorder)
endif       
if (br and 8)>0 then
    sBorder = "BottomBorder"
    aBorder=sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).getPropertyValue(sBorder)
    aBorder.LineWidth=w
    sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).setPropertyValue(sBorder,aBorder)
endif       
end sub

'---Установить границы
Sub setborder(com)
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
br = CInt(com(5))
w  = CInt(com(6))

if br=16 then
   if r1=r2 then
      oneborder(r1,c1,r1,c2,12,w)
      oneborder(r1,c1,r1,c1,13,w)
      oneborder(r1,c2,r1,c2,14,w)     
      Answer("OK")     
      exit sub
   endif   
   if c1=c2 then
      oneborder(r1,c1,r2,c1,3,w)
      oneborder(r1,c1,r1,c1,7,w)
      oneborder(r2,c1,r2,c1,11,w)     
      Answer("OK")     
      exit sub
   endif   
   if r1<>r2 and c1<>c2 then
      oneborder(r1,c1,r1,c2,4,w)
      oneborder(r2,c1,r2,c2,8,w)
      oneborder(r1,c1,r2,c1,1,w)
      oneborder(r1,c2,r2,c2,2,w)
      oneborder(r1,c1,r1,c1,5,w)
      oneborder(r1,c2,r1,c2,6,w)
      oneborder(r2,c1,r2,c1,9,w)
      oneborder(r2,c2,r2,c2,10,w)
      Answer("OK")   
      exit sub
   endif     
endif
oneborder(r1,c1,r2,c2,br,w)
Answer("OK")
end Sub

'---Запись текста в ячейку
Sub settext(com)
row = CInt(com(1))
col = CInt(com(2))
sheet.getCellByPosition(col-1,row-1).setString(com(3))
Answer("OK")
end sub

'---Запись числа в ячейку, например 7 или 3,25
Sub setvalue(com)
row = CInt(com(1))
col = CInt(com(2))
sheet.getCellByPosition(col-1,row-1).Value = com(3)
Answer("OK")
end sub

'---Установка числа знаков после точки, если @ то текст
Sub setdigits(com)
locale = doc.getPropertyValue("CharLocale")
pars = UBound(com)
if pars=2 then
   col = CInt(com(1))
   if com(2)="@" then
      strfmt = "@"
      goto fin
   end if
   n=CInt(Com(2))
   goto nxt
endif
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
if com(5)="@" then
   strfmt = "@"
   goto fin
endif
n = CInt(com(5))
nxt:
if n = 0 then
     strfmt = "0"
else
     strfmt = "0,"
     for i=1 to n
        strfmt = strfmt & "0"
     next i
endif
fin:   
fmt = doc.NumberFormats.queryKey(strfmt, locale ,False)
if fmt<0 then
   doc.NumberFormats.addNew(strfmt, locale)
   fmt = doc.NumberFormats.queryKey(strfmt, locale ,False)   
endif   
if pars=2 then sheet.getCellRangeByPosition(col-1,0,col-1,0).Columns(0).NumberFormat = fmt
if pars=5 then sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).NumberFormat = fmt
Answer("OK")
end sub

'---Имя шрифта
Sub setfontname(com)
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
nm = com(5)
sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).CharFontName = nm
Answer("OK") 
end Sub

'---Высота шрифта
Sub setfontheight(com)
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
h  = CInt(com(5))
sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).CharHeight = h
Answer("OK") 
end Sub

'---Шрифт жирный =1 или нет =0
Sub setbold(com)
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
  if com(5)="1" then
  sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).CharWeight = 200
  else
  sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).CharWeight = 100
  end if
Answer("OK") 
end Sub

'---Шрифт наклонный =1 или нет =0
Sub setitalic(com)
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
  if com(5)="1" then
  sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).CharPosture = 2 'com.sun.star.awt.FontSlant.ITALIC
  else
  sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).CharPosture = 0 'com.sun.star.awt.FontSlant.NONE
  end if
Answer("OK") 
end Sub

'---Шрифт подчёркнутый =1 или нет =0
Sub setunderline(com)
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
  if com(5)="1" then
  sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).CharUnderline = 1 'com.sun.star.awt.FontUnderline.SINGLE
  else
  sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).CharUnderline = 0 'com.sun.star.awt.FontUnderline.NONE
  end if
Answer("OK") 
end Sub

'---Цвет шрифта символов
Sub setfcolor(com)
dim color as long
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
color = CLng(com(5))
sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).CharColor = color
Answer("OK")
end Sub

'---Цвет фона
Sub setcolor(com)
dim color as long
dim s as string
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
color = CLng(com(5))
sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).CellBackColor = color
Answer("OK")
end Sub

'---Вертикальное выравнивание
Sub setvalign(com)
pars = UBound(com)
if pars=2 then
   col = CInt(com(1))
   va = CInt(com(2))
   if va = 0 then sheet.getCellRangeByPosition(col-1,0,col-1,0).Columns(0).VertJustify = 1
   if va = 1 then sheet.getCellRangeByPosition(col-1,0,col-1,0).Columns(0).VertJustify = 2
   if va = 2 then sheet.getCellRangeByPosition(col-1,0,col-1,0).Columns(0).VertJustify = 3
else   
    r1 = CInt(com(1))
    c1 = CInt(com(2))
    r2 = CInt(com(3))
    c2 = CInt(com(4))
    va = CInt(com(5))
    if va = 0 then sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).VertJustify = 1
    if va = 1 then sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).VertJustify = 2
    if va = 2 then sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).VertJustify = 3
endif   
Answer("OK")
end Sub

'---Горизонтальное выравнивание
Sub sethalign(com)
pars = UBound(com)
if pars=2 then
   col = CInt(com(1))
   ha = CInt(com(2))
   if ha = 0 then sheet.getCellRangeByPosition(col-1,0,col-1,0).Columns(0).HoriJustify = 1 'com.sun.star.table.CellVertJustify.LEFT
   if ha = 1 then sheet.getCellRangeByPosition(col-1,0,col-1,0).Columns(0).HoriJustify = 2 'com.sun.star.table.CellVertJustify.CENTER
   if ha = 2 then sheet.getCellRangeByPosition(col-1,0,col-1,0).Columns(0).HoriJustify = 3 'com.sun.star.table.CellVertJustify.RIGHT
else   
   r1 = CInt(com(1))
   c1 = CInt(com(2))
   r2 = CInt(com(3))
   c2 = CInt(com(4))
   ha = CInt(com(5))
   if ha = 0 then sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).HoriJustify = 1 'com.sun.star.table.CellHoriJustify.LEFT
   if ha = 1 then sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).HoriJustify = 2 'com.sun.star.table.CellHoriJustify.CENTER
   if ha = 2 then sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).HoriJustify = 3 'com.sun.star.table.CellHoriJustify.RIGHT
endif   
Answer("OK")
end Sub

'---Запись массива данных, апостроф ' признак текстовой строки, числа с точкой 1.234
Sub setdata(com)
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
Redim data(r2-r1,c2-c1)
for i=r1 to r2
    for j=c1 to c2
        s = oInputStream.readLine()
        s1 = Mid(s,1,1)
        if s1="'" then
               data(i-r1,j-c1) = Mid(s,2,Len(s)-1)
        else
               if trim(s)="" then
                  data(i-r1,j-c1) = ""
               else
                  data(i-r1,j-c1) = Val(s)
               end if
        end if
    next j
next i
sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).setDataArray(data)
Answer("OK")
end sub

'---Объединение ячеек
Sub setmerge(com)
r1 = CInt(com(1))
c1 = CInt(com(2))
r2 = CInt(com(3))
c2 = CInt(com(4))
sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).merge(TRUE)
Answer("OK")
end Sub

Sub setwrap(com)
pars = UBound(com)
if pars=2 then
   col = CInt(com(1))
   w =   CInt(com(2))
   if w = 0 then sheet.getCellRangeByPosition(col-1,0,col-1,0).Columns(0).IsTextWrapped = FALSE
   if w = 1 then sheet.getCellRangeByPosition(col-1,0,col-1,0).Columns(0).IsTextWrapped = TRUE
else   
    r1 = CInt(com(1))
    c1 = CInt(com(2))
    r2 = CInt(com(3))
    c2 = CInt(com(4))
    w  = CInt(com(5))
    if w = 0 then sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).IsTextWrapped = FALSE
    if w = 1 then sheet.getCellRangeByPosition(c1-1,r1-1,c2-1,r2-1).IsTextWrapped = TRUE
endif   
Answer("OK")
end Sub

'---Закрыть файлы
Sub closefiles
Answer("OK")
Answer("@@@")
oOutputStream.closeOutput()
oInputStream.closeInput()
end sub

'---Макрос обработки и выполнения запросов
Sub server
sheets = ThisComponent.getSheets()
doc = ThisComponent
sheet = sheets.getByIndex(0)

1:
s = WaitForSend

oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
oInputStream = createUnoService("com.sun.star.io.TextInputStream")
oOutputStream = createUnoService("com.sun.star.io.TextOutputStream")
oInputStream.setInputStream(oUcb.OpenFileRead(ConvertToURL(GetSendPath)))
oOutputStream.setOutputStream(oUcb.OpenFileWrite(ConvertToURL(GetRecPath)))
oInputStream.setEncoding("UTF8")
oOutputStream.setEncoding("UTF8")
do while NOT oInputStream.isEOF()
   sInputLine = oInputStream.readLine()
   if sInputLine = "@@@" then goto fin
   com = Split(sInputLine,"^")
   if com(0) = "close" then
      closefiles
      ThisComponent.CurrentController.Frame.close(true)
      exit sub
   end if   
   if com(0) = "exit" then
      closefiles
      exit sub
   end if
   if com(0) = "activelist"    then activelist(com)   
   if com(0) = "getavarange"   then getavarange(com)     
   if com(0) = "setborder"     then setborder(com)   
   if com(0) = "settext"       then settext(com)
   if com(0) = "setvalue"      then setvalue(com)
   if com(0) = "setdigits"     then setdigits(com)
   if com(0) = "setfname"      then setfontname(com)
   if com(0) = "setfheight"    then setfontheight(com)   
   if com(0) = "setfbold"      then setbold(com)
   if com(0) = "setfitalic"    then setitalic(com)   
   if com(0) = "setfunderline" then setunderline(com)
   if com(0) = "setfcolor"     then setfcolor(com)
   if com(0) = "setcolor"         then setcolor(com) 
   if com(0) = "setvalign"     then setvalign(com) 
   if com(0) = "sethalign"     then sethalign(com) 
   if com(0) = "setdata"       then setdata(com) 
   if com(0) = "setmerge"      then setmerge(com)   
   if com(0) = "setwrap"       then setwrap(com)
   loop     
   
fin:   
Answer("@@@")
oInputStream.closeInput()
Kill GetSendPath
oOutputStream.closeOutput()
goto 1
End Sub

Для отладки, например, вертикального выравнивания TOP, нужно создать во временном каталоге файл send.srv со следующим содержимым:
setvalign^10^10^10^10^0
exit
@@@

bigor

В качестве догадки. Вы передаете переменную com в процедуру, и basic привязывается к ней и пытвется найти у нее sun.star.table.CellVertJustify.TOP чего естественно не находит
В общем догадка подтвердилась, если переименовать параметр в com1 и далее все поправить в процедуре, то все работает штатно
Поддержать наш форум можно здесь

Massaraksh7

Спасибо, константы заработали!

Massaraksh7

#23
А что ему здесь может не нравиться?
P.S.: Разобрался.