290 lines
6.3 KiB
Text
290 lines
6.3 KiB
Text
' =========================================================================
|
|
' StockFunctions.bas
|
|
' Collabora / LibreOffice Basic
|
|
'
|
|
' FUNDTIME now returns Yahoo's latest market update date/time:
|
|
'
|
|
' 2026-07-27 19:58:00
|
|
'
|
|
' The date and time are obtained from the stockproxy /current endpoint.
|
|
' =========================================================================
|
|
|
|
Option Explicit
|
|
|
|
' ---- Config -------------------------------------------------------------
|
|
|
|
Function PROXY_BASE() As String
|
|
PROXY_BASE = "https://stocks.kingdezigns.com"
|
|
End Function
|
|
|
|
Function PROXY_SECRET() As String
|
|
PROXY_SECRET = "90c2528e9b5221c110f7c2c9cd6c65dc"
|
|
End Function
|
|
|
|
|
|
' ---- Public spreadsheet functions ---------------------------------------
|
|
|
|
Function FUNDPRICE(ticker As String) As Variant
|
|
Dim sUrl As String
|
|
Dim sJson As String
|
|
Dim vPrice As Variant
|
|
|
|
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
|
|
"&key=" & PROXY_SECRET()
|
|
|
|
sJson = HttpGetText(sUrl)
|
|
|
|
If sJson = "" Then
|
|
FUNDPRICE = "#ERROR"
|
|
Exit Function
|
|
End If
|
|
|
|
vPrice = JsonNumber(sJson, "price")
|
|
|
|
If IsNull(vPrice) Then
|
|
FUNDPRICE = "#N/A"
|
|
Else
|
|
FUNDPRICE = vPrice
|
|
End If
|
|
End Function
|
|
|
|
|
|
Function FUNDPRICE_HIST(ticker As String, dateStr As String) As Variant
|
|
Dim sUrl As String
|
|
Dim sJson As String
|
|
Dim vPrice As Variant
|
|
|
|
sUrl = PROXY_BASE() & "/historical?ticker=" & EncodeUrl(ticker) & _
|
|
"&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
|
|
|
|
|
|
' ---- 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"
|
|
Exit Function
|
|
End If
|
|
|
|
sDate = JsonString(sJson, "date")
|
|
sTime = JsonString(sJson, "time")
|
|
|
|
If sDate = "" Or sTime = "" Then
|
|
FUNDTIME = "#N/A"
|
|
Exit Function
|
|
End If
|
|
|
|
FUNDTIME = sDate & " " & sTime
|
|
End Function
|
|
|
|
|
|
' ---- Internal helpers ----------------------------------------------------
|
|
|
|
' Synchronous HTTP GET, returns response body as text, "" on failure.
|
|
Function HttpGetText(sUrl As String) As String
|
|
Dim oSFA As Object
|
|
Dim oStream As Object
|
|
Dim oTextStream As Object
|
|
Dim sResult As String
|
|
|
|
On Error GoTo ErrHandler
|
|
|
|
oSFA = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
|
oStream = oSFA.openFileRead(sUrl)
|
|
|
|
oTextStream = createUnoService("com.sun.star.io.TextInputStream")
|
|
oTextStream.setInputStream(oStream)
|
|
oTextStream.setEncoding("UTF-8")
|
|
|
|
sResult = ""
|
|
|
|
Do While Not oTextStream.isEOF()
|
|
sResult = sResult & oTextStream.readLine() & Chr(10)
|
|
Loop
|
|
|
|
oTextStream.closeInput()
|
|
|
|
HttpGetText = sResult
|
|
Exit Function
|
|
|
|
ErrHandler:
|
|
HttpGetText = ""
|
|
End Function
|
|
|
|
|
|
' Pulls a numeric value out of a flat JSON string for a given key.
|
|
Function JsonNumber(sJson As String, sKey As String) As Variant
|
|
Dim iPos As Integer
|
|
Dim iStart As Integer
|
|
Dim iEnd As Integer
|
|
Dim sNum As String
|
|
Dim cChar As String
|
|
|
|
iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
|
|
|
|
If iPos = 0 Then
|
|
JsonNumber = Null
|
|
Exit Function
|
|
End If
|
|
|
|
iPos = InStr(iPos, sJson, ":")
|
|
|
|
If iPos = 0 Then
|
|
JsonNumber = Null
|
|
Exit Function
|
|
End If
|
|
|
|
iStart = iPos + 1
|
|
|
|
Do While iStart <= Len(sJson) And Mid(sJson, iStart, 1) = " "
|
|
iStart = iStart + 1
|
|
Loop
|
|
|
|
iEnd = iStart
|
|
|
|
Do While iEnd <= Len(sJson)
|
|
cChar = Mid(sJson, iEnd, 1)
|
|
|
|
If (cChar >= "0" And cChar <= "9") Or _
|
|
cChar = "." Or cChar = "-" Then
|
|
iEnd = iEnd + 1
|
|
Else
|
|
Exit Do
|
|
End If
|
|
Loop
|
|
|
|
sNum = Mid(sJson, iStart, iEnd - iStart)
|
|
|
|
If Len(sNum) = 0 Then
|
|
JsonNumber = Null
|
|
Else
|
|
JsonNumber = CDbl(sNum)
|
|
End If
|
|
End Function
|
|
|
|
|
|
' Pulls a quoted string value out of a flat JSON string.
|
|
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
|
|
|
|
iPos = InStr(sJson, Chr(34) & sKey & Chr(34))
|
|
|
|
If iPos = 0 Then
|
|
JsonString = ""
|
|
Exit Function
|
|
End If
|
|
|
|
iColon = InStr(iPos, sJson, ":")
|
|
|
|
If iColon = 0 Then
|
|
JsonString = ""
|
|
Exit Function
|
|
End If
|
|
|
|
iQuoteStart = InStr(iColon, sJson, Chr(34))
|
|
|
|
If iQuoteStart = 0 Then
|
|
JsonString = ""
|
|
Exit Function
|
|
End If
|
|
|
|
iQuoteEnd = InStr(iQuoteStart + 1, sJson, Chr(34))
|
|
|
|
If iQuoteEnd = 0 Then
|
|
JsonString = ""
|
|
Exit Function
|
|
End If
|
|
|
|
JsonString = Mid(sJson, iQuoteStart + 1, _
|
|
iQuoteEnd - iQuoteStart - 1)
|
|
End Function
|
|
|
|
|
|
' Minimal percent-encoder.
|
|
Function EncodeUrl(s As String) As String
|
|
Dim i As Integer
|
|
Dim c As String
|
|
Dim sOut As String
|
|
|
|
sOut = ""
|
|
|
|
For i = 1 To Len(s)
|
|
c = Mid(s, i, 1)
|
|
|
|
If (c >= "A" And c <= "Z") Or _
|
|
(c >= "a" And c <= "z") Or _
|
|
(c >= "0" And c <= "9") Or _
|
|
c = "-" Or c = "_" Or c = "." Or c = "~" Then
|
|
|
|
sOut = sOut & c
|
|
|
|
Else
|
|
|
|
sOut = sOut & "%" & Right("0" & Hex(Asc(c)), 2)
|
|
|
|
End If
|
|
Next i
|
|
|
|
EncodeUrl = sOut
|
|
End Function
|
|
|
|
|
|
' ---- Snapshot ------------------------------------------------------------
|
|
|
|
Sub RefreshPriceSnapshot
|
|
Dim oDoc As Object
|
|
Dim oSheet As Object
|
|
Dim i As Integer
|
|
|
|
oDoc = ThisComponent
|
|
oSheet = oDoc.Sheets.getByIndex(0)
|
|
|
|
' Copy P3:Q53 -> R3:S53 as values only
|
|
For i = 2 To 4
|
|
|
|
oSheet.getCellByPosition(17, i).setValue( _
|
|
oSheet.getCellByPosition(15, i).getValue())
|
|
|
|
oSheet.getCellByPosition(18, i).setValue( _
|
|
oSheet.getCellByPosition(16, i).getValue())
|
|
|
|
Next i
|
|
|
|
MsgBox "Price snapshot refreshed."
|
|
End Sub
|