PBWin Create VARIANT date type (VT_DATE)

[Michael Mattias]

' File: Test_vtDate.bas
' Purpose: Create a VARIANT data type of type VT_DATE. 
' Primary Anticipated Use:   parameterized SQL queries executed via ADO.
' Date: 09.14.09
' Author: Michael Mattias Racine WI
' Compiler used: PB/WIN 9.0.1

#COMPILE EXE
#DIM     ALL

#INCLUDE "WIN32API.INC"

FUNCTION PBMAIN () AS LONG
    
 LOCAL vDate  AS VARIANT
 LOCAL S      AS STRING
 LOCAL iRET   AS LONG
 LOCAL st     AS SYSTEMTIME
 
  St.wYear  = 1900   ' this tested OK in function
  St.wMonth = 1
  st.wDay   = 1

  St.wYear  = 2009    ' so did this.
  St.wMonth = 09
  st.wDay   = 14
 
  St.wYear  = 2009    ' This should return error...and it does
  St.wMonth = 13
  st.wDay   = 14
                                       
  iRet        =  MakeVariantDate (ST, vDate)  ' can add params later if this works
  IF ISFALSE iREt THEN   ' success!
         S     =  DbDateFromVariantDate (vDate)
         MSGBOX USING$ ("VARIANTVT #  VARIANT_#() # formatted &" , VARIANTVT(vDate), VARIANT#(vDate), S) ,,  "Returned"
  ELSE
         MSGBOX USING$("Error_,  VARIANTVT_#()= #", VARIANTVT (vDate))
  END IF

' VT_R8 = double = 3
' VT_DATE  7
' VT_ERROR = 10
    
END FUNCTION

' First, let's just test that returning a variant is an option for compiler
' Syntax error.. hmm, guess you Cannot return VARIANT from function, OK so I will just pass it.
' NOT DOCUMENTED IN FUNCTION/END FUNCTION Documentation, where it says "
' You may specify the type of data returned by a Function to the calling code"

' Params: ST [IN], desired date/time (not tested with time, only tested with dates)
'         vDate [INOUT] A variant, type not requiring any allocations (VT_EMPTY suggested).
'         Will be returned as type VT_DATE (7) with correct value on success, or VT_ERROR on error.
' return: FALSE = success and vDate will be type VT_DATE
'         TRUE  = failed and vDate will be type VT_ERROR

FUNCTION MakeVariantDate (st AS SYSTEMTIME, vDate AS VARIANT) AS LONG

  LOCAL dDate AS DOUBLE
  LOCAL pVAPI  AS VARIANTAPI PTR
  LOCAL iret  AS LONG
 
  ' convert system time to a double:
  iRet =  SystemTimeTOVariantTime (st, dDate)  ' Returns true on success and fills dDate when so
  IF ISTRUE iRet THEN   ' the call succeeded
       '
       ' But that IS NOT a VT_DATE! It's a VT_DOUBLE!
       '  fix the value and type of passed variant variable
         pVAPI            =   VARPTR (vDate)
         @pvAPI.vt        =   %VT_DATE
         @pvAPI.vd.dblval = dDate
         
   ELSE ' function failed, most likely an invalid date time was passed
         LET vDate =  ERROR %DISP_E_OVERFLOW    ' "out of present range" closest I can find
   END IF
   
   FUNCTION =  ISFALSE (iRet)  ' return zero on no error.

END FUNCTION

' DATE-FORMATTING FUNCTION FOR USE WHEN TESTING
FUNCTION DbDatefromVariantDate (vDate AS VARIANT) AS STRING

    LOCAL ST AS SYSTEMTIME
    LOCAL szDF AS ASCIIZ * 48,  szDate AS ASCIIZ * 48
    LOCAL vbTime AS DOUBLE

    vbTime                  = VARIANT#(vDate)   ' this wants a type  7 date; VARIANT# apparenty handles this "as double"
    VariantTimeToSystemTime vbTime, St
    szDf          =  "yyyy'-'MM'-'dd"
    GetDateFormat     BYVAL %NULL, BYVAL %NULL ,st, szDf, szDate, SIZEOF (szDate)
    FUNCTION        = szDate
END FUNCTION

'  *** END OF FILE ***