NAS08/nas08-scripts
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix ChatGPT error

Browse source
This commit is contained in:
Rufus King 2026-07-27 20:35:27 -04:00
parent bf0f376cdb
commit f68993cc14
1 changed files with 188 additions and 239 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

355
Stocks/WebService/libreoffice_macro.txt
View file

@ -1,37 +1,12 @@
' ========================================================================= ' =========================================================================
' StockFunctions.bas ' StockFunctions.bas
' Collabora / LibreOffice Basic port of the ONLYOFFICE custom functions. ' Collabora / LibreOffice Basic
' '
' UPDATED 2026-07-27: FUNDTIME now returns Yahoo's last market update ' FUNDTIME now returns Yahoo's latest market update date/time:
' date and time as a combined Calc date/time value.
' '
' FUNDPRICE returns the current price from stockproxy.
' FUNDPRICE_HIST returns a historical price from stockproxy.
' FUNDTIME returns Yahoo's regularMarketTime as a date/time value.
'
' Example FUNDTIME result:
' 2026-07-27 19:58:00 ' 2026-07-27 19:58:00
' '
' The returned value is a real Calc date/time value, not text, so it can ' The date and time are obtained from the stockproxy /current endpoint.
' be sorted, compared, formatted, or used in date/time calculations.
'
' HOW TO INSTALL IN COLLABORA:
' 1. Open the sheet in Collabora (collabora.kingdezigns.com).
' 2. Tools > Macros > Edit Macros (opens the Basic IDE).
' 3. In the tree, find "<Your Document Name>" (NOT "My Macros" -
' you want this stored IN the document so it travels with the file).
' 4. Right-click "Standard" under your document > Insert > Module.
' 5. Paste this entire file's contents into the new module.
' (Or, if StockFunctions already exists, replace its contents.)
' 6. Fill in PROXY_SECRET() below with the real value if not already set.
' 7. Save the document (Ctrl+S). Macro security must allow this
' document's macros to run - if prompted, allow them.
'
' USAGE IN CELLS:
' =FUNDPRICE(D4)
' =FUNDPRICE_HIST(D4, TEXT($B$3,"yyyy-mm-dd"))
' =FUNDPRICE(A5) <- replaces old =STOCKPRICE(A5)
' =FUNDTIME(A5) <- returns Yahoo date/time of latest market update
' ========================================================================= ' =========================================================================
Option Explicit Option Explicit
@ -39,182 +14,168 @@ Option Explicit
' ---- Config ------------------------------------------------------------- ' ---- Config -------------------------------------------------------------
Function PROXY_BASE() As String Function PROXY_BASE() As String
PROXY_BASE = "https://stocks.kingdezigns.com" PROXY_BASE = "https://stocks.kingdezigns.com"
End Function End Function
Function PROXY_SECRET() As String Function PROXY_SECRET() As String
PROXY_SECRET = "90c2528e9b5221c110f7c2c9cd6c65dc" ' <-- from Vaultwarden PROXY_SECRET = "90c2528e9b5221c110f7c2c9cd6c65dc"
End Function End Function
' ---- Public spreadsheet functions --------------------------------------- ' ---- Public spreadsheet functions ---------------------------------------
Function FUNDPRICE(ticker As String) As Variant Function FUNDPRICE(ticker As String) As Variant
Dim sUrl As String, sJson As String, vPrice As Variant Dim sUrl As String
Dim sJson As String
Dim vPrice As Variant
``` sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
"&key=" & PROXY_SECRET() "&key=" & PROXY_SECRET()
sJson = HttpGetText(sUrl) sJson = HttpGetText(sUrl)
If sJson = "" Then If sJson = "" Then
FUNDPRICE = "#ERROR" FUNDPRICE = "#ERROR"
Exit Function Exit Function
End If End If
vPrice = JsonNumber(sJson, "price") vPrice = JsonNumber(sJson, "price")
If IsNull(vPrice) Then If IsNull(vPrice) Then
FUNDPRICE = "#N/A" FUNDPRICE = "#N/A"
Else Else
FUNDPRICE = vPrice FUNDPRICE = vPrice
End If End If
```
End Function End Function
Function FUNDPRICE_HIST(ticker As String, dateStr As String) As Variant Function FUNDPRICE_HIST(ticker As String, dateStr As String) As Variant
Dim sUrl As String, sJson As String, vPrice As Variant Dim sUrl As String
Dim sJson As String
Dim vPrice As Variant
``` sUrl = PROXY_BASE() & "/historical?ticker=" & EncodeUrl(ticker) & _
sUrl = PROXY_BASE() & "/historical?ticker=" & EncodeUrl(ticker) & _ "&date=" & EncodeUrl(dateStr) & _
"&date=" & EncodeUrl(dateStr) & "&key=" & PROXY_SECRET()
sJson = HttpGetText(sUrl)
If sJson = "" Then
FUNDPRICE_HIST = "#ERROR"
Exit Function
End If
vPrice = JsonNumber(sJson, "price")
If IsNull(vPrice) Then
FUNDPRICE_HIST = "#N/A"
Else
FUNDPRICE_HIST = vPrice
End If
```
End Function
' Returns Yahoo's latest market update date and time as a real Calc
' date/time value.
'
' Example:
' Yahoo JSON:
' "date":"2026-07-27","time":"19:58:00"
'
' FUNDTIME returns:
' 2026-07-27 19:58:00
'
Function FUNDTIME(ticker As String) As Variant
Dim sUrl As String
Dim sJson As String
Dim vDate As Variant
Dim vTime As Variant
Dim sDateTime As String
Dim oDateTime As Date
```
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
"&key=" & PROXY_SECRET() "&key=" & PROXY_SECRET()
sJson = HttpGetText(sUrl) sJson = HttpGetText(sUrl)
If sJson = "" Then If sJson = "" Then
FUNDPRICE_HIST = "#ERROR"
Exit Function
End If
vPrice = JsonNumber(sJson, "price")
If IsNull(vPrice) Then
FUNDPRICE_HIST = "#N/A"
Else
FUNDPRICE_HIST = vPrice
End If
End Function
' ---- Yahoo market update date/time --------------------------------------
'
' Returns:
'
' 2026-07-27 19:58:00
'
' This combines the "date" and "time" fields returned by stockproxy.
'
Function FUNDTIME(ticker As String) As String
Dim sUrl As String
Dim sJson As String
Dim sDate As String
Dim sTime As String
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
"&key=" & PROXY_SECRET()
sJson = HttpGetText(sUrl)
If sJson = "" Then
FUNDTIME = "#ERROR" FUNDTIME = "#ERROR"
Exit Function Exit Function
End If End If
' Get the separate date and time values from stockproxy. sDate = JsonString(sJson, "date")
vDate = JsonString(sJson, "date") sTime = JsonString(sJson, "time")
vTime = JsonString(sJson, "time")
If IsNull(vDate) Or IsNull(vTime) Then If sDate = "" Or sTime = "" Then
FUNDTIME = "#N/A" FUNDTIME = "#N/A"
Exit Function Exit Function
End If End If
' Combine into a single date/time string. FUNDTIME = sDate & " " & sTime
sDateTime = CStr(vDate) & " " & CStr(vTime)
' Convert to a real Calc date/time value.
On Error GoTo DateError
oDateTime = CDate(sDateTime)
FUNDTIME = oDateTime
Exit Function
```
DateError:
FUNDTIME = "#N/A"
End Function End Function
' ---- Internal helpers ---------------------------------------------------- ' ---- Internal helpers ----------------------------------------------------
' Synchronous HTTP GET, returns response body as text, "" on failure. ' Synchronous HTTP GET, returns response body as text, "" on failure.
Function HttpGetText(sUrl As String) As String Function HttpGetText(sUrl As String) As String
Dim oSFA As Object, oStream As Object, oTextStream As Object Dim oSFA As Object
Dim sResult As String Dim oStream As Object
Dim oTextStream As Object
Dim sResult As String
``` On Error GoTo ErrHandler
On Error GoTo ErrHandler
oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess") oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess")
oStream = oSFA.openFileRead(sUrl) oStream = oSFA.openFileRead(sUrl)
oTextStream = createUnoService("com.sun.star.io.TextInputStream") oTextStream = createUnoService("com.sun.star.io.TextInputStream")
oTextStream.setInputStream(oStream) oTextStream.setInputStream(oStream)
oTextStream.setEncoding("UTF-8") oTextStream.setEncoding("UTF-8")
sResult = "" sResult = ""
Do While Not oTextStream.isEOF() Do While Not oTextStream.isEOF()
sResult = sResult & oTextStream.readLine() & Chr(10) sResult = sResult & oTextStream.readLine() & Chr(10)
Loop Loop
oTextStream.closeInput() oTextStream.closeInput()
HttpGetText = sResult HttpGetText = sResult
Exit Function Exit Function
```
ErrHandler: ErrHandler:
HttpGetText = "" HttpGetText = ""
End Function End Function
' Pulls a numeric value out of a flat JSON string for a given key. ' Pulls a numeric value out of a flat JSON string for a given key.
' e.g. JsonNumber("{""price"":18.37}", "price") -> 18.37
' Returns Null if the key isn't found or has no numeric value.
Function JsonNumber(sJson As String, sKey As String) As Variant Function JsonNumber(sJson As String, sKey As String) As Variant
Dim iPos As Integer, iStart As Integer, iEnd As Integer Dim iPos As Integer
Dim sNum As String, cChar As String Dim iStart As Integer
Dim iEnd As Integer
Dim sNum As String
Dim cChar As String
``` iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
If iPos = 0 Then If iPos = 0 Then
JsonNumber = Null JsonNumber = Null
Exit Function Exit Function
End If End If
iPos = InStr(iPos, sJson, ":") iPos = InStr(iPos, sJson, ":")
If iPos = 0 Then If iPos = 0 Then
JsonNumber = Null JsonNumber = Null
Exit Function Exit Function
End If End If
iStart = iPos + 1 iStart = iPos + 1
Do While iStart <= Len(sJson) And Mid(sJson, iStart, 1) = " " Do While iStart <= Len(sJson) And Mid(sJson, iStart, 1) = " "
iStart = iStart + 1 iStart = iStart + 1
Loop Loop
iEnd = iStart iEnd = iStart
Do While iEnd <= Len(sJson) Do While iEnd <= Len(sJson)
cChar = Mid(sJson, iEnd, 1) cChar = Mid(sJson, iEnd, 1)
If (cChar >= "0" And cChar <= "9") Or _ If (cChar >= "0" And cChar <= "9") Or _
@ -223,73 +184,67 @@ Do While iEnd <= Len(sJson)
Else Else
Exit Do Exit Do
End If End If
Loop Loop
sNum = Mid(sJson, iStart, iEnd - iStart) sNum = Mid(sJson, iStart, iEnd - iStart)
If Len(sNum) = 0 Then If Len(sNum) = 0 Then
JsonNumber = Null JsonNumber = Null
Else Else
JsonNumber = CDbl(sNum) JsonNumber = CDbl(sNum)
End If End If
```
End Function End Function
' Pulls a quoted STRING value out of a flat JSON string for a given key.
' e.g. JsonString("{""resolved_date"":""2026-07-23""}", "resolved_date")
' -> "2026-07-23"
'
' Returns Null if the key isn't found or has no quoted value.
Function JsonString(sJson As String, sKey As String) As Variant
Dim iPos As Integer
Dim iColon As Integer
Dim iQuoteStart As Integer
Dim iQuoteEnd As Integer
``` ' Pulls a quoted string value out of a flat JSON string.
iPos = InStr(sJson, Chr(34) & sKey & Chr(34)) Function JsonString(sJson As String, sKey As String) As String
Dim iPos As Integer
Dim iColon As Integer
Dim iQuoteStart As Integer
Dim iQuoteEnd As Integer
If iPos = 0 Then iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
JsonString = Null
If iPos = 0 Then
JsonString = ""
Exit Function Exit Function
End If End If
iColon = InStr(iPos, sJson, ":") iColon = InStr(iPos, sJson, ":")
If iColon = 0 Then If iColon = 0 Then
JsonString = Null JsonString = ""
Exit Function Exit Function
End If End If
iQuoteStart = InStr(iColon, sJson, Chr(34)) iQuoteStart = InStr(iColon, sJson, Chr(34))
If iQuoteStart = 0 Then If iQuoteStart = 0 Then
JsonString = Null JsonString = ""
Exit Function Exit Function
End If End If
iQuoteEnd = InStr(iQuoteStart + 1, sJson, Chr(34)) iQuoteEnd = InStr(iQuoteStart + 1, sJson, Chr(34))
If iQuoteEnd = 0 Then If iQuoteEnd = 0 Then
JsonString = Null JsonString = ""
Exit Function Exit Function
End If End If
JsonString = Mid(sJson, iQuoteStart + 1, _ JsonString = Mid(sJson, iQuoteStart + 1, _
iQuoteEnd - iQuoteStart - 1) iQuoteEnd - iQuoteStart - 1)
```
End Function End Function
' Minimal percent-encoder - sufficient for tickers and yyyy-mm-dd strings.
' Minimal percent-encoder.
Function EncodeUrl(s As String) As String Function EncodeUrl(s As String) As String
Dim i As Integer, c As String, sOut As String Dim i As Integer
Dim c As String
Dim sOut As String
``` sOut = ""
sOut = ""
For i = 1 To Len(s) For i = 1 To Len(s)
c = Mid(s, i, 1) c = Mid(s, i, 1)
If (c >= "A" And c <= "Z") Or _ If (c >= "A" And c <= "Z") Or _
@ -304,38 +259,32 @@ For i = 1 To Len(s)
sOut = sOut & "%" & Right("0" & Hex(Asc(c)), 2) sOut = sOut & "%" & Right("0" & Hex(Asc(c)), 2)
End If End If
Next i Next i
EncodeUrl = sOut
```
EncodeUrl = sOut
End Function End Function
' ---- Snapshot ------------------------------------------------------------
Sub RefreshPriceSnapshot Sub RefreshPriceSnapshot
Dim oDoc As Object, oSheet As Object Dim oDoc As Object
Dim oSrcRange As Object, oDestRange As Object Dim oSheet As Object
Dim oCell As Object Dim i As Integer
Dim i As Integer
``` oDoc = ThisComponent
oDoc = ThisComponent oSheet = oDoc.Sheets.getByIndex(0)
oSheet = oDoc.Sheets.getByIndex(0) ' adjust index/name if needed
' Copy P3:Q53 -> R3:S53 as values only ' Copy P3:Q53 -> R3:S53 as values only
For i = 2 To 4 ' rows 3 to 53 (0-indexed: row 3 = index 2) For i = 2 To 4
oSheet.getCellByPosition(17, i).setValue( _ oSheet.getCellByPosition(17, i).setValue( _
oSheet.getCellByPosition(15, i).getValue()) _ oSheet.getCellByPosition(15, i).getValue())
' P->R (col P=15, R=17)
oSheet.getCellByPosition(18, i).setValue( _ oSheet.getCellByPosition(18, i).setValue( _
oSheet.getCellByPosition(16, i).getValue()) _ oSheet.getCellByPosition(16, i).getValue())
' Q->S (col Q=16, S=18)
Next i Next i
MsgBox "Price snapshot refreshed."
```
MsgBox "Price snapshot refreshed."
End Sub End Sub