接続文字列
# http://oshiete1.goo.ne.jp/qa5196452.html
# SQL Serverの場合、一般的に使われているのが、
#・Microsoft OLE DB Provider for ODBC(MSDASQL)
#・Microsoft OLE DB Provider for SQL Server(SQLOLEDB) 〜最も一般的
#・Microsoft SQL Server Native Client(SQLNCLI) 〜SQL Server 2005対応
#・Microsoft SQL Server Native Client 10.0(SQLNCLI10) 〜SQL Server 2008対応
# SQLNCLI.1
# SQLOLEDB.1
import System.Win32.Com
import System.Win32.Com.Automation
sqlconn = "Provider=SQLOLEDB.1;Password=passwd;User ID=userName;Initial Catalog=DBname;Data Source=tcp:192.168.1.123,1433"
mdbconn = "DRIVER={Microsoft Access Driver (*.mdb)};Dbq=C:\\Users\\uname\\Documents\\hoge.mdb ;Pwd=password"
createConnection :: String -> IO (IDispatch a)
createConnection dsn = do
c <- createObject "ADODB.Connection"
openConnection dsn c
return c
where
openConnection :: String -> IDispatch a -> IO ()
openConnection dsn = method0 "Open" [inString dsn]
adOpenStatic = inInt 3
adLockOptimistic = inInt 3
adCmdText = inInt 1
createRecordset :: (Variant a1) => a1 -> String -> IO (IDispatch a)
createRecordset cn sql = do
rs <- createObject "ADODB.Recordset"
openRecordset cn sql rs
return rs
openRecordset :: (Variant a) => a -> String -> IDispatch i -> IO ()
openRecordset cn sql =
method0 "Open" [inString sql, inVariant cn, adOpenStatic,
adLockOptimistic, adCmdText]
closeObject :: IDispatch a -> IO ()
closeObject = method0 "Close" []
fields :: IDispatch i -> IO (IDispatch a)
fields = propertyGet_0 "Fields"
moveFirst :: IDispatch i -> IO ()
moveFirst = method_0_0 "MoveFirst"
moveNext :: IDispatch i -> IO ()
moveNext = method_0_0 "MoveNext"
eofORbof :: IDispatch i -> IO Bool
eofORbof rs = do
eof <- propertyGet_0 "EOF" rs
bof <- propertyGet_0 "BOF" rs
return (eof || bof)
items :: IDispatch i -> [String] -> Int -> IO [String]
items fls xs 0 = do
x <- function1 "Item" [inInt 0] outString fls
return (x:xs)
items fls xs n = do
x <- function1 "Item" [inInt n] outString fls
items fls (x:xs) (n-1)
readLine :: IDispatch d -> [String] -> Int -> IO [String]
readLine rs xs n = do
fls <- propertyGet_0 "Fields" rs
items fls xs n
fieldsCount :: (Variant b) => IDispatch d -> IO b
fieldsCount rs = do
field <- propertyGet_0 "Fields" rs
propertyGet_0 "Count" field
allLines :: IDispatch i -> [[String]] -> Int -> IO [[String]]
allLines rs xs len = do
eb <- eofORbof rs
if eb then return xs
else do line <- readLine rs [] len
e <- eofORbof rs
if e then return (line:xs)
else do moveNext rs
allLines rs (line:xs) len
dbRead :: String -> String -> IO [[String]]
dbRead constr sqlstr = coRun $ do
con <- createConnection constr
rs <- execute con sqlstr
cnt <- fieldsCount rs
all <- allLines rs [] (cnt-1)
closeObject rs
closeObject con
return $reverse all
where
execute :: IDispatch i -> String -> IO (IDispatch a)
execute connection sqlStatement =
function_1_1 "Execute" sqlStatement connection
rsRead constr sqlstr = coRun $ do
con <- createConnection constr
rs <- createRecordset con sqlstr
cnt <- fieldsCount rs
all <- allLines rs [] (cnt-1)
closeObject rs
closeObject con
return $reverse all
*Main> dbRead mdbconn "SELECT count(*) FROM table"
[["100"]]
*Main> dbRead sqlconn "SELECT count(*) FROM table"
[["201"]]
*Main> dbRead mdbconn "SELECT * FROM table"
[["0","0","","99"],["0","0","","98"],["0","0","","97"]・・・