Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
DB connection module in ADO.NET
Author:
mamiya_shou
Website:
http://mshou.bl.ee/
Submitted:
11/18/2014
Version:
VB 2010
Compatibility:
VB 2010, VB 2012, VB 2013
Category:
Databases
Views:
8917
DB connection module in ADO.NET.
Declarations:
Imports System.IO Imports System.Xml Imports System.Text Imports System.Data.SqlClient
Code:
'''
''' ADO.NETでのDB接続モジュール '''
Module mdlADOdotNET #Region "Public" '''
''' DB接続を開く '''
'''
SqlConnection
Public Function openConnection() As SqlConnection Dim con As New SqlConnection Dim htDBSettingXML As Hashtable Try ' DB設定情報を読み込む htDBSettingXML = readDBSettingXML() For Each de As DictionaryEntry In htDBSettingXML con.ConnectionString &= de.Key & " = " & de.Value & ";" Next con.Open() Catch ex As Exception errMessage(ex) End Try Return con End Function '''
''' DB接続を閉じる '''
'''
SqlConnection '''
openConnection()で開いたら必ず閉じること
Public Sub closeConnection(ByRef con As SqlConnection) Try If con IsNot Nothing Then con.Close() con.Dispose() End If Catch ex As Exception errMessage(ex) End Try End Sub '''
''' SqlDataReaderをHashTableに変換する '''
'''
SqlDataReader '''
key(カンマ区切り) '''
Hashtable
Public Function dr2Ht(ByVal dr As SqlDataReader, ByVal keyComma As String) As Hashtable Dim htRet As New Hashtable Dim keys() As String Try If keyComma IsNot Nothing Then keys = keyComma.Split(",") For Each key As String In keys htRet.Add(key, dr(key)) Next End If Catch ex As Exception errMessage(ex) End Try Return htRet End Function '''
''' SqlCommandを作成する '''
'''
SQL '''
SqlConnection '''
SqlTransaction '''
SqlCommand
Public Function createCommand(Optional ByVal sql As String = Nothing, Optional ByRef con As SqlConnection = Nothing, Optional ByRef trans As SqlTransaction = Nothing) As SqlCommand Dim cmd As New SqlCommand Try If con Is Nothing Then con = openConnection() End If cmd.Connection = con cmd.CommandText = sql If trans IsNot Nothing Then cmd.Transaction = trans End If Catch ex As Exception errMessage(ex) End Try Return cmd End Function '''
''' SELECT文を作成する '''
'''
フィールド '''
テーブル '''
Where句HashTable '''
Order句 '''
その他 '''
SQLCommand、指定されていれば作成した SELECT文をCommandTextに設定する '''
SELECT文
Public Function createSelectSQL(ByVal field As String, ByVal table As String, Optional ByRef htWhere As Hashtable = Nothing, Optional ByVal order As String = Nothing, _ Optional ByVal other As String = Nothing, Optional ByRef cmd As SqlCommand = Nothing) As String Dim sql As String = String.Empty Dim where As String = String.Empty Try sql = " SELECT " & field & " FROM " & table If htWhere IsNot Nothing Then If cmd IsNot Nothing Then cmd.Parameters.Clear() End If where = createWhereSQL(htWhere, cmd) sql &= where End If If order IsNot Nothing Then sql &= " ORDER BY " & order End If If other IsNot Nothing Then sql &= other End If If cmd IsNot Nothing Then cmd.CommandText = sql End If Catch ex As Exception errMessage(ex) End Try Return sql End Function '''
''' INSERT文を作成する '''
'''
INSERTする値HashTable '''
テーブル '''
htField以外の値HashTable(プレースホルダ はしない) '''
SQLCommand、指定されていれば作成した INSERT文をCommandTextに設定する '''
INSERT文
Public Function createInsertSQL(ByVal htField As Hashtable, ByVal table As String, Optional ByVal htOther As Hashtable = Nothing, Optional ByRef cmd As SqlCommand = Nothing) Dim sql As String = String.Empty Dim where As String = String.Empty Dim alKeys As New ArrayList Dim alValues As New ArrayList Dim key As String = String.Empty Dim value As String = String.Empty Dim cnt As Integer = 0 Try If htField.Count > 0 Then For Each de As DictionaryEntry In htField alKeys.Add(de.Key) alValues.Add("@value" & cnt) cnt += 1 Next ' htField以外の値HashTableの追加 If htOther IsNot Nothing Then For Each de As DictionaryEntry In htOther alKeys.Add(de.Key) alValues.Add(de.Value) Next End If key = String.Join(", ", alKeys.ToArray()) value = String.Join(", ", alValues.ToArray()) sql = " INSERT INTO " & table & " (" & key & ") VALUES (" & value & ") " ' SQLCommandが指定されていた場合 If cmd IsNot Nothing Then cnt = 0 cmd.Parameters.Clear() cmd.CommandText = sql For Each de As DictionaryEntry In htField cmd.Parameters.AddWithValue("@value" & cnt, de.Value) cnt += 1 Next End If End If Catch ex As Exception errMessage(ex) End Try Return sql End Function '''
''' UPDATE文を作成する '''
'''
UPDATEする値HashTable '''
テーブル '''
Where句HashTable '''
htField以外の値HashTable(プレースホルダ はしない) '''
SQLCommand、指定されていれば作成した UPDATE文をCommandTextに設定する '''
UPDATE文
Public Function createUpdateSQL(ByVal htField As Hashtable, ByVal table As String, Optional ByRef htWhere As Hashtable = Nothing, Optional ByVal htOther As Hashtable = Nothing, _ Optional ByRef cmd As SqlCommand = Nothing) As String Dim sql As String = String.Empty Dim where As String = String.Empty Dim alTmp As New ArrayList Dim cnt As Integer = 0 Try sql = "UPDATE " & table & " SET " If htField.Count > 0 Then cnt = 0 For Each de As DictionaryEntry In htField alTmp.Add(de.Key & " = @value" & cnt) cnt += 1 Next End If If htOther IsNot Nothing Then For Each de As DictionaryEntry In htOther alTmp.Add(de.Key & " = " & de.Value) Next End If sql &= String.Join(", ", alTmp.ToArray()) If htWhere IsNot Nothing Then If cmd IsNot Nothing Then cmd.Parameters.Clear() cnt = 0 For Each de As DictionaryEntry In htField cmd.Parameters.AddWithValue("@value" & cnt, de.Value) cnt += 1 Next End If where = createWhereSQL(htWhere, cmd) sql &= where End If If cmd IsNot Nothing Then cmd.CommandText = sql End If Catch ex As Exception errMessage(ex) End Try Return sql End Function '''
''' DELETE文を作成する '''
'''
テーブル '''
Where句HashTable '''
SQLCommand、指定されていれば作成した DELETE文をCommandTextに設定する '''
DELETE文
Public Function createDeleteSQL(ByVal table As String, Optional ByRef htWhere As Hashtable = Nothing, Optional ByRef cmd As SqlCommand = Nothing) As String Dim sql As String = String.Empty Dim where As String = String.Empty Try sql = " DELETE FROM " & table If htWhere IsNot Nothing Then If cmd IsNot Nothing Then cmd.Parameters.Clear() End If where = createWhereSQL(htWhere, cmd) sql &= where End If If cmd IsNot Nothing Then cmd.CommandText = sql End If Catch ex As Exception errMessage(ex) End Try Return sql End Function '''
''' Where句を作成 '''
'''
Where句HashTable '''
SQLCommand、指定されていればプレースホル ダのパラメータを設定する '''
Where句
Public Function createWhereSQL(ByVal htWhere As Hashtable, Optional ByRef cmd As SqlCommand = Nothing) As String Dim sql As String = String.Empty Dim alTmp As New ArrayList Dim cnt As Integer = 0 Try If htWhere.Count > 0 Then For Each de As DictionaryEntry In htWhere alTmp.Add(de.Key & " = " & "@where" & cnt) cnt += 1 Next sql = " WHERE " & String.Join(" AND ", alTmp.ToArray()) ' SQLCommandが指定されていた場合 If cmd IsNot Nothing Then cnt = 0 For Each de As DictionaryEntry In htWhere cmd.Parameters.AddWithValue("@where" & cnt, de.Value) cnt += 1 Next End If End If Catch ex As Exception errMessage(ex) End Try Return sql End Function #End Region #Region "Private" '''
''' DB設定情報を読み込む '''
'''
DB設定情報HashTable
Private Function readDBSettingXML() As Hashtable Dim xDocument As XmlDocument = New XmlDocument Dim xRoot As XmlElement Dim htDBSetting As New Hashtable Try ' XMLファイルをロード xDocument.Load(Directory.GetCurrentDirectory() & "\DBSetting.xml") ' XMLドキュメントからルート要素を取り出す xRoot = xDocument.DocumentElement For Each xElement As XmlElement In xRoot htDBSetting.Add(xElement.Name.Replace("_", " "), xElement.InnerText) Next Catch ex As Exception errMessage(ex) End Try Return htDBSetting End Function '''
''' エラーメッセージを表示する '''
'''
Exception Public Sub errMessage(ByVal ex As Exception) MessageBox.Show(ex.Message & vbCrLf & ex.StackTrace.Replace("場所", vbCrLf & "場所:"), "エラー") End Sub #End Region End Module
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement