Update Stock Time Stamp to Eastern Time
This commit is contained in:
parent
547a74768e
commit
70a1a14735
1 changed files with 241 additions and 11 deletions
|
|
@ -1,30 +1,46 @@
|
|||
' =========================================================================
|
||||
'
|
||||
' StockFunctions.bas
|
||||
' Collabora / LibreOffice Basic
|
||||
'
|
||||
' FUNDTIME now returns Yahoo's latest market update date/time:
|
||||
' FUNDTIME returns Yahoo's latest market update date/time
|
||||
' converted from UTC to U.S. Eastern Time.
|
||||
'
|
||||
' Example:
|
||||
'
|
||||
' stockproxy UTC:
|
||||
' 2026-07-27 19:58:00
|
||||
'
|
||||
' The date and time are obtained from the stockproxy /current endpoint.
|
||||
' FUNDTIME:
|
||||
' 2026-07-27 15:58:00
|
||||
'
|
||||
' Eastern Time automatically observes:
|
||||
'
|
||||
' EDT = UTC-4
|
||||
' EST = UTC-5
|
||||
'
|
||||
' =========================================================================
|
||||
|
||||
|
||||
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 ---------------------------------------
|
||||
' ---- Public spreadsheet functions --------------------------------------
|
||||
|
||||
Function FUNDPRICE(ticker As String) As Variant
|
||||
|
||||
Dim sUrl As String
|
||||
Dim sJson As String
|
||||
Dim vPrice As Variant
|
||||
|
|
@ -46,10 +62,12 @@ Function FUNDPRICE(ticker As String) As Variant
|
|||
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
|
||||
|
|
@ -72,23 +90,61 @@ Function FUNDPRICE_HIST(ticker As String, dateStr As String) As Variant
|
|||
Else
|
||||
FUNDPRICE_HIST = vPrice
|
||||
End If
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
' ---- Yahoo market update date/time --------------------------------------
|
||||
'
|
||||
' Returns:
|
||||
' stockproxy supplies the Yahoo timestamp in UTC.
|
||||
'
|
||||
' FUNDTIME converts that UTC timestamp to U.S. Eastern Time.
|
||||
'
|
||||
' During daylight saving time:
|
||||
'
|
||||
' EDT = UTC - 4 hours
|
||||
'
|
||||
' During standard time:
|
||||
'
|
||||
' EST = UTC - 5 hours
|
||||
'
|
||||
' Example:
|
||||
'
|
||||
' UTC:
|
||||
' 2026-07-27 19:58:00
|
||||
'
|
||||
' This combines the "date" and "time" fields returned by stockproxy.
|
||||
' Eastern:
|
||||
' 2026-07-27 15:58:00
|
||||
'
|
||||
Function FUNDTIME(ticker As String) As String
|
||||
|
||||
Dim sUrl As String
|
||||
Dim sJson As String
|
||||
Dim sDate As String
|
||||
Dim sTime As String
|
||||
|
||||
Dim iYear As Integer
|
||||
Dim iMonth As Integer
|
||||
Dim iDay As Integer
|
||||
Dim iHour As Integer
|
||||
Dim iMinute As Integer
|
||||
Dim iSecond As Integer
|
||||
|
||||
Dim dUTC As Date
|
||||
Dim dMarch As Date
|
||||
Dim dNovember As Date
|
||||
Dim dDSTStart As Date
|
||||
Dim dDSTEnd As Date
|
||||
|
||||
Dim iMarchSunday As Integer
|
||||
Dim iNovemberSunday As Integer
|
||||
Dim iOffset As Integer
|
||||
|
||||
|
||||
' ---------------------------------------------------------------
|
||||
' Get current stock data from stockproxy
|
||||
' ---------------------------------------------------------------
|
||||
|
||||
sUrl = PROXY_BASE() & "/current?ticker=" & EncodeUrl(ticker) & _
|
||||
"&key=" & PROXY_SECRET()
|
||||
|
||||
|
|
@ -99,6 +155,11 @@ Function FUNDTIME(ticker As String) As String
|
|||
Exit Function
|
||||
End If
|
||||
|
||||
|
||||
' ---------------------------------------------------------------
|
||||
' Get UTC date and time from JSON
|
||||
' ---------------------------------------------------------------
|
||||
|
||||
sDate = JsonString(sJson, "date")
|
||||
sTime = JsonString(sJson, "time")
|
||||
|
||||
|
|
@ -107,14 +168,116 @@ Function FUNDTIME(ticker As String) As String
|
|||
Exit Function
|
||||
End If
|
||||
|
||||
FUNDTIME = sDate & " " & sTime
|
||||
|
||||
' ---------------------------------------------------------------
|
||||
' Parse date
|
||||
'
|
||||
' Expected:
|
||||
' YYYY-MM-DD
|
||||
' ---------------------------------------------------------------
|
||||
|
||||
iYear = CInt(Left(sDate, 4))
|
||||
iMonth = CInt(Mid(sDate, 6, 2))
|
||||
iDay = CInt(Right(sDate, 2))
|
||||
|
||||
|
||||
' ---------------------------------------------------------------
|
||||
' Parse time
|
||||
'
|
||||
' Expected:
|
||||
' HH:MM:SS
|
||||
' ---------------------------------------------------------------
|
||||
|
||||
iHour = CInt(Left(sTime, 2))
|
||||
iMinute = CInt(Mid(sTime, 4, 2))
|
||||
iSecond = CInt(Right(sTime, 2))
|
||||
|
||||
|
||||
' ---------------------------------------------------------------
|
||||
' Create UTC date/time
|
||||
' ---------------------------------------------------------------
|
||||
|
||||
dUTC = DateSerial(iYear, iMonth, iDay)
|
||||
dUTC = dUTC + TimeSerial(iHour, iMinute, iSecond)
|
||||
|
||||
|
||||
' ---------------------------------------------------------------
|
||||
' Find second Sunday in March
|
||||
' ---------------------------------------------------------------
|
||||
|
||||
dMarch = DateSerial(iYear, 3, 8)
|
||||
|
||||
iMarchSunday = 8 - WeekDay(dMarch)
|
||||
|
||||
If iMarchSunday < 0 Then
|
||||
iMarchSunday = iMarchSunday + 7
|
||||
End If
|
||||
|
||||
dDSTStart = dMarch + iMarchSunday
|
||||
|
||||
' 2:00 AM EST = 07:00 UTC
|
||||
dDSTStart = dDSTStart + TimeSerial(7, 0, 0)
|
||||
|
||||
|
||||
' ---------------------------------------------------------------
|
||||
' Find first Sunday in November
|
||||
' ---------------------------------------------------------------
|
||||
|
||||
dNovember = DateSerial(iYear, 11, 1)
|
||||
|
||||
iNovemberSunday = 8 - WeekDay(dNovember)
|
||||
|
||||
If iNovemberSunday < 0 Then
|
||||
iNovemberSunday = iNovemberSunday + 7
|
||||
End If
|
||||
|
||||
dDSTEnd = dNovember + iNovemberSunday
|
||||
|
||||
' 2:00 AM EDT = 06:00 UTC
|
||||
dDSTEnd = dDSTEnd + TimeSerial(6, 0, 0)
|
||||
|
||||
|
||||
' ---------------------------------------------------------------
|
||||
' Determine Eastern Time offset
|
||||
' ---------------------------------------------------------------
|
||||
|
||||
If dUTC >= dDSTStart And dUTC < dDSTEnd Then
|
||||
|
||||
' Eastern Daylight Time
|
||||
iOffset = 4
|
||||
|
||||
Else
|
||||
|
||||
' Eastern Standard Time
|
||||
iOffset = 5
|
||||
|
||||
End If
|
||||
|
||||
|
||||
' ---------------------------------------------------------------
|
||||
' Convert UTC to Eastern Time
|
||||
' ---------------------------------------------------------------
|
||||
|
||||
dUTC = dUTC - TimeSerial(iOffset, 0, 0)
|
||||
|
||||
|
||||
' ---------------------------------------------------------------
|
||||
' Return:
|
||||
'
|
||||
' YYYY-MM-DD HH:MM:SS
|
||||
' ---------------------------------------------------------------
|
||||
|
||||
FUNDTIME = Format(dUTC, "YYYY-MM-DD HH:MM:SS")
|
||||
|
||||
End Function
|
||||
|
||||
|
||||
' ---- Internal helpers ----------------------------------------------------
|
||||
' ---- 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
|
||||
|
|
@ -132,21 +295,29 @@ Function HttpGetText(sUrl As String) As String
|
|||
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
|
||||
|
|
@ -156,97 +327,147 @@ Function JsonNumber(sJson As String, sKey As String) As Variant
|
|||
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) = " "
|
||||
|
||||
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 _
|
||||
|
|
@ -256,18 +477,23 @@ Function EncodeUrl(s As String) As String
|
|||
|
||||
Else
|
||||
|
||||
sOut = sOut & "%" & Right("0" & Hex(Asc(c)), 2)
|
||||
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
|
||||
|
|
@ -275,7 +501,9 @@ Sub RefreshPriceSnapshot
|
|||
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( _
|
||||
|
|
@ -286,5 +514,7 @@ Sub RefreshPriceSnapshot
|
|||
|
||||
Next i
|
||||
|
||||
|
||||
MsgBox "Price snapshot refreshed."
|
||||
|
||||
End Sub
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue