Rough example of mysterx <--> ADO <--> Microsoft SQL Server

mssql-mysterx-example.rkt

#lang racket

(require mysterx
         racket/date)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; ado-sql-exec-query
;;
;; Note: This will return the rows in reverse order. If you care because you
;; used an ORDER BY in your query, then pass this list to reverse.
;;

(struct ado-field
  (Name    ; symbol?
   Type    ; symbol?
   Value)) ; any/c

(define/contract (ado-sql-exec-query
                  connection-string
                  query
                  #:command-timeout-secs [timeout 60])
  ((string?
    string?)
   (#:command-timeout-secs exact-positive-integer?)
   . ->* . (listof (listof ado-field?)))
  
  (let ([Connection (cocreate-instance-from-coclass "ADODB.Connection" 'local)])
    (com-set-property! Connection "ConnectionString" connection-string)
    (com-set-property! Connection "CommandTimeout" timeout)
    (com-invoke Connection "Open" "")
    (begin0
        (let* ([RecordSet (com-invoke Connection "Execute" query)]
               [Fields (com-get-property RecordSet "Fields")]
               [Fields-count (com-get-property Fields "Count")])
          (if (<= Fields-count 0)
              '()
              (let loop ()
                (let ([eof (com-get-property RecordSet "EOF")])
                  (if eof
                      '()
                      (cons
                       (begin0
                           (for/list ([i (in-range Fields-count)])
                               (let ([field (com-get-property Fields (list "Item" i))])
                                 (ado-field
                                  (string->symbol (com-get-property field "Name"))
                                  (ado-field-type-num->symbol (com-get-property field "Type"))
                                  (com-value->scheme-value (com-get-property field "Value")))))
                         (com-invoke RecordSet "MoveNext"))
                       (loop)))))))
      (com-invoke Connection "Close"))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (ado-field-type-num->symbol n)
  (case n
    [(0) 'adEmpty]       ; No value
    [(2) 'adSmallInt]    ; A 2-byte signed integer.
    [(3) 'adInteger]     ; A 4-byte signed integer.
    [(4) 'adSingle]      ; A single-precision floating-point value.
    [(5) 'adDouble]      ; A double-precision floating-point value.
    [(6) 'adCurrency]    ; A currency value
    [(7) 'adDate]        ; The number of days since December 30, 1899 + the fraction of a day.
    [(8) 'adBSTR]        ; A null-terminated character string.
    [(9) 'adIDispatch]   ; A pointer to an IDispatch interface on a COM object. Note: Currently not supported by ADO.
    [(10) 'adError]      ; A 32-bit error code
    [(11) 'adBoolean]    ; A boolean value.
    [(12) 'adVariant]    ; An Automation Variant. Note: Currently not supported by ADO.
    [(13) 'adIUnknown]   ; A pointer to an IUnknown interface on a COM object. Note: Currently not supported by ADO.
    [(14) 'adDecimal]    ; An exact numeric value with a fixed precision and scale.
    [(16) 'adTinyInt]    ;A 1-byte signed integer.
    [(17) 'adUnsignedTinyInt]           ; A 1-byte unsigned integer.
    [(18) 'adUnsignedSmallInt]          ; A 2-byte unsigned integer.
    [(19) 'adUnsignedInt]               ; A 4-byte unsigned integer.
    [(20) 'adBigInt]                    ; An 8-byte signed integer.
    [(21) 'adUnsignedBigInt]            ; An 8-byte unsigned integer.
    [(64) 'adFileTime] ; The number of 100-nanosecond intervals since January 1,1601
    [(72) 'adGUID]     ; A globally unique identifier (GUID)
    [(128) 'adBinary]  ; A binary value.
    [(129) 'adChar]    ; A string value.
    [(130) 'adWChar]   ; A null-terminated Unicode character string.
    [(131) ' adNumeric] ; An exact numeric value with a fixed precision and scale.
    [(132) 'adUserDefined]              ; A user-defined variable.
    [(133) 'adDBDate]                   ; A date value (yyyymmdd).
    [(134) 'adDBTime]                   ; A time value (hhmmss).
    [(135) 'adDBTimeStamp] ; A date/time stamp (yyyymmddhhmmss plus a fraction in billionths).
    [(136) 'adChapter] ; A 4-byte chapter value that identifies rows in a child rowset
    [(138) 'adPropVariant]  ; An Automation PROPVARIANT.
    [(139) 'adVarNumeric]   ; A numeric value (Parameter object only).
    [(200) 'adVarChar]      ; A string value (Parameter object only).
    [(201) 'adLongVarChar]  ; A long string value.
    [(202) 'adVarWChar]     ; A null-terminated Unicode character string.
    [(203) 'adLongVarWChar] ; A long null-terminated Unicode string value.
    [(204) 'adVarBinary]    ; A binary value (Parameter object only).
    [(205) 'adLongVarBinary]            ; A long binary value.
    ;; AdArray 	0x2000 	A flag value combined with another data type constant. Indicates an array of that other data type.
    [else 'adUnknownType]))

(define/contract (describe o)
  (com-object? . -> . void)
  (printf "METHODS: ~a\n" (com-methods o))
  (printf "SET props: ~a\n" (com-set-properties o))
  (printf "GET props: ~a\n" (com-get-properties o)))

(date-display-format 'iso-8601)
(define (com-value->scheme-value x)
  (cond
   [(com-date? x) (date->string (com-date->date x) #t)]
   [(com-currency? x) (com-currency->number x)]
   [else x]))