public
Last active

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

  • Download Gist
mssql-mysterx-example.rkt
Racket
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
#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]))

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.