VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "textSQL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private working_dir As String
Public Enum readtype
RowHead = 0
Number = 1
End Enum
Public Enum SortOrder
orderASC = 0
orderDESC = 1
End Enum
Public Enum SepKey
keyComma = 1
keyTab
End Enum
Public Function runif(ByVal get_number As Long, ByVal nmin As Long, ByVal nmax As Long) As Variant
'' ランダム数値の作成
'' get_number: 取得する数値の数
'' nmin: 最小値
'' nmax: 最大値
Dim n As Long
Dim dic As Object
'' ランダム値の生成
Set dic = Set_Dictionary
'' シードの初期化
Randomize
'' 日付_時間_ランダム数値として作成
Do While dic.Count <> get_number
n = Int((nmax - nmin + 1) * Rnd + nmin)
If dic.exists(n) = False Then
dic.Add n, Format(Now(), "yyyyMMdd_HHmmSS_") & Format(n, "00000")
End If
Loop
runif = dic.items
End Function
Public Function CREATE_DataBase()
Call Set_New_Data_Base
End Function
Public Function CREATE_DataTable(ByVal create_table_name As String, ByVal table_column_types As Variant, _
ByVal table_column_names As Variant)
Call SQL("CREATE", "TABLE", create_table_name, table_column_types, table_column_names)
End Function
Public Function INSERT_Columns(ByVal table_name As String, ByVal table_column_types As Variant, _
ByVal table_column_names As Variant, ByVal set_insert_columns_number As Long) As Object
'' INSERT table名 データ型配列、データ名配列、挿入位置の数字
' Set INSERT_Columns = Insert_New_Column_To_DataTable(table_name, set_insert_columns_number, _
' table_column_types, table_column_names)
Call SQL("INSERT", table_name, table_column_types, table_column_names, set_insert_columns_number)
End Function
Public Function UPDATE_Table(ByVal table_name As String, ByVal update_data As Variant)
'' UPDATE table名 dictionary名|配列名
Call SQL("UPDATE", table_name, update_data)
End Function
Public Function DELETE_Items(ByVal table_name As String, ByVal delete_key As Variant)
'' DELETE table名 *
'' DELETE table名 削除データキー配列
Call SQL("DELETE", table_name, delete_key)
End Function
Public Function DROP_Table(ByVal table_name As String)
Call SQL("DROP", table_name)
End Function
Public Function tables() As Variant
tables = Get_Table_List
End Function
Public Function table_ColNames(ByVal table_name As String) As Variant
Dim dic As Object
Set dic = Read_DataTable(table_name)
table_ColNames = dic.item("name")
End Function
Public Function table_Count(ByVal table_name As String) As Variant
Dim dic As Object
Set dic = Read_DataTable(table_name)
table_Count = dic.Count - 3
End Function
Public Function SELECT_Table(ByVal table_name As String, _
Optional view_column_names As Variant = "*", _
Optional select_column_names As Boolean = False, _
Optional formula As String = "", _
Optional order_table As Boolean = False, _
Optional names_to_order As String = "", _
Optional ASC_or_DESC As SortOrder = SortOrder.orderASC, _
Optional table_join As Boolean = False, _
Optional join_key_name As String = "", _
Optional join_table_name As String = "") As Object
'' SELECT * table名 WHERE 条件式
'' SELECT 列名配列 table名 ORDER 列名 ASC|DESC
'' SELECT 列名配列 table名 JOIN 列名 table名
Dim connection As Variant
'' 条件式による分岐
connection = Array(select_column_names, order_table, table_join)
Select Case join(connection, ",")
Case join(Array(False, False, False), ",")
Set SELECT_Table = SQL("SELECT", view_column_names, table_name)
Case join(Array(True, False, False), ",")
Set SELECT_Table = SQL("SELECT", view_column_names, table_name, _
"WHERE", formula)
Case join(Array(False, True, False), ",")
Set SELECT_Table = SQL("SELECT", view_column_names, table_name, _
"ORDER", names_to_order, ASC_or_DESC)
Case join(Array(False, False, True), ",")
Set SELECT_Table = SQL("SELECT", view_column_names, table_name, _
"JOIN", join_key_name, join_table_name)
Case join(Array(True, True, False), ",")
Set SELECT_Table = SQL("SELECT", view_column_names, table_name, _
"WHERE", formula, _
"ORDER", names_to_order, ASC_or_DESC)
Case join(Array(True, False, True), ",")
Set SELECT_Table = SQL("SELECT", view_column_names, table_name, _
"WHERE", formula, _
"JOIN", join_key_name, join_table_name)
Case join(Array(False, True, True), ",")
Set SELECT_Table = SQL("SELECT", view_column_names, table_name, _
"ORDER", names_to_order, ASC_or_DESC, _
"JOIN", join_key_name, join_table_name)
Case join(Array(True, True, True), ",")
Set SELECT_Table = SQL("SELECT", view_column_names, table_name, _
"WHERE", formula, _
"ORDER", names_to_order, ASC_or_DESC, _
"JOIN", join_key_name, join_table_name)
End Select
End Function
Public Function arr2dic(ByVal table_array As Variant) As Variant
Dim dt() As Variant
Dim stext As String
Dim i, j As Long
If InStr("文字列,数値,日付,時間", table_array(LBound(table_array, 1), LBound(table_array, 2))) > 0 Then
ReDim dt(LBound(table_array, 1) To UBound(table_array, 1) - 1, _
LBound(table_array, 2) To UBound(table_array, 2))
For i = LBound(table_array, 1) + 1 To UBound(table_array, 1)
For j = LBound(dt, 2) To UBound(dt, 2)
dt(i - 1, j) = table_array(i, j)
Next
Next
End If
Set table_array = Array_to_Dictionary(dt, 1)
End Function
Public Function dic2arr(ByVal table_object As Object) As Variant
dic2arr = Dictionary_to_Array(table_object)
End Function
Public Function SQL(ParamArray sql_code()) '' saaa
'' SQL構文を使って操作
Dim scode As String
Dim dic As Object
Dim i As Long
Dim ikey As Variant
Dim filename As String
Dim ch As String
Select Case sql_code(0)
Case "CREATE"
'' CREATE DATATABLE
'' CREATE TABLE table名 データ型配列 データ列名配列
'' 文字列変換
If sql_code(1) = "DATABASE" Then
Call Set_New_Data_Base
ElseIf sql_code(1) = "TABLE" Then
Call Add_Data_Table(sql_code(2), 1, sql_code(3), sql_code(4))
MsgBox sql_code(2) & "を作成しました", vbInformation
Else
MsgBox "書き方が間違っています。"
Exit Function
End If
Case "SELECT"
'' SELECT * table名 WHERE 条件式
'' SELECT 列名配列 table名 ORDER 列名 ASC|DESC
'' SELECT 列名配列 table名 JOIN 列名 table名
If Search_Dimentions(sql_code(1)) = 1 Then
Set dic = Select_Columns(Read_DataTable(sql_code(2)), sql_code(1))
ElseIf sql_code(1) = "*" Then
Set dic = Read_DataTable(sql_code(2))
Else
MsgBox "構文が間違ってきます。"
Exit Function
End If
If UBound(sql_code) < 3 Then GoTo Continue_Select
For i = 3 To UBound(sql_code)
Select Case sql_code(i)
Case "WHERE"
Set dic = SELECT_MODE(dic, sql_code(i), sql_code(i + 1))
i = i + 1
Case "ORDER", "JOIN"
Set dic = SELECT_MODE(dic, sql_code(i), sql_code(i + 1), sql_code(i + 2))
i = i + 2
End Select
Next
Continue_Select:
Set SQL = dic
Case "INSERT"
'' INSERT table名 データ型配列、データ名配列、挿入位置の数字
Set SQL = Insert_New_Column_To_DataTable(sql_code(1), sql_code(4), sql_code(2), sql_code(3))
Call Make_Backup_File(sql_code(1))
Case "UPDATE"
'' UPDATE table名 dictionary名|配列名
Call Write_DataTable(sql_code(1), Update_DataTable(sql_code(1), sql_code(2)))
Call Make_Backup_File(sql_code(1))
Case "DELETE"
'' DELETE table名 *
'' DELETE table名 削除データキー配列
Set dic = Read_DataTable(sql_code(1))
If sql_code(2) = "*" Then
For Each ikey In dic
If ikey = "primary_key" Or ikey = "name" Or ikey = "type" Then
Else
dic.Remove ikey
End If
Next
Else
If Search_Dimentions(sql_code(2)) = 0 Then sql_code(2) = Array(sql_code(2))
For Each ikey In sql_code(2)
dic.Remove ikey
Next
End If
''Set SQL = dic
Call Write_DataTable(sql_code(1), dic)
Call Make_Backup_File(sql_code(1))
Case "DROP"
'' DROP table名
filename = DT_name(sql_code(1))
ch = MsgBox(filename & vbCrLf & "このテーブルを削除しますか?", vbYesNo)
If ch = 6 Then
Kill filename
Debug.Print "Remove File: " & filename
MsgBox filename & vbCrLf & "テーブルを削除しました。", vbInformation
End If
Case ".table"
'' .table
SQL = Get_Table_List
Case ".table.names"
Set dic = Read_DataTable(sql_code(1))
SQL = dic.item("name")
End Select
End Function
Private Function SELECT_MODE(ByVal dic As Object, ByVal mode As Variant, ParamArray p()) As Object
On Error GoTo Continue
Dim num As Long
Select Case mode
Case "WHERE"
Set SELECT_MODE = Filter_Data_Table(dic, p(0))
Case "ORDER"
' If InStr(p(1), "ASC") > 0 Then
' num = 0
' ElseIf InStr(p(1), "DESC") > 0 Then
' num = 1
' Else
' num = 0
' End If
'
' Set SELECT_MODE = Sort_Data_Table(dic, p(0), num)
Set SELECT_MODE = Sort_Data_Table(dic, p(0), p(1))
Case "JOIN"
Set SELECT_MODE = Left_Join(dic, p(0), Read_DataTable(p(1)))
Case Else
Set SELECT_MODE = dic
End Select
Continue:
End Function
Private Sub Make_Backup_File(ByVal DataTable_name As String)
'' バックアップファイルを作成
Dim bf As String
bf = Join_Path(working_dir, "Backups\" & Format(Now(), "yyyyMMdd_HHmmSS") & "_backup_file_" & DataTable_name & ".txt")
FileCopy DT_name(DataTable_name), bf
End Sub
Private Function Remove_Rows_From_2dimArray(ByVal dt As Variant, ByVal row_num As Long) As Variant
'' 2次元配列の対象列を除外
'' row_num: 除外する行番号
Dim New_dt() As Variant
Dim i, j As Long
ReDim New_dt(LBound(dt, 1) To UBound(dt, 1) - 1, LBound(dt, 2) To UBound(dt, 2))
For i = LBound(dt, 1) To UBound(dt, 1)
For j = LBound(dt, 2) To UBound(dt, 2)
If i < row_num Then
New_dt(i, j) = dt(i, j)
ElseIf i > row_num Then
New_dt(i - 1, j) = dt(i, j)
End If
Next
Next
Remove_Rows_From_2dimArray = New_dt
End Function
Public Function arr2DicArr(ByVal data_array As Variant) As Variant
arr2DicArr = Get_Table_To_Array(data_array)
End Function
Private Function Get_Table_To_Array(ByVal dt As Variant) As Variant
'' 二次元配列を列名でdictionaryに登録し、それを配列にする
'' Update_DataTableのインプットデータに使用
'' dt: ２次元配列
'' 最初の行は列名にする
'' | 列名 | 列名 | 列名...|
'' | 値 | 値 | 値... |
Dim New_data() As Variant
Dim col_name() As Variant
Dim i, j, num As Long
Dim bCell As Variant
ReDim New_data(LBound(dt, 1) To UBound(dt, 1) - 1)
ReDim col_name(LBound(dt, 2) To UBound(dt, 2)) As Variant
'' 列名取得
For i = LBound(dt, 2) To UBound(dt, 2)
col_name(i) = dt(LBound(dt, 1), i)
Next
'' データを登録
For i = LBound(dt, 1) To UBound(dt, 1) - 1
Set New_data(i) = Set_Dictionary
For j = LBound(col_name) To UBound(col_name)
New_data(i).Add col_name(j), dt(i + 1, j)
Next
Next
Get_Table_To_Array = New_data
End Function
Private Function Get_DataTable_Format(ByVal DataTable_name As String) As Object
'' データテーブルに登録するために、空のdictionaryを取得
Dim n As Integer
Dim i As LongPtr
Dim text As String
Dim dic As Object
Set dic = Set_Dictionary
n = FreeFile
Open DT_name(DataTable_name) For Input As #n
i = 1
Do While Not EOF(n)
Line Input #n, text
If text = "" Then GoTo Continue
If i = 3 Then
For Each ikey In Split(text, vbTab)
dic.Add ikey, ""
Next
dic.Remove ("NAME")
End If
Continue:
i = i + 1
Loop
Close #n
Set Get_DataTable_Format = dic
End Function
Public Function filter4dic(ByVal data_object As Object, ByVal formula As String) As Object
Set filter4dic = Filter_Data_Table(data_object, formula)
End Function
Private Function Filter_Data_Table(ByVal data As Object, ByVal formula As String) As Object
'' Dictionaryタイプで取り込んだall_dataをフィルター処理
Dim d_Type, d_name As Variant
Dim fs As Variant
Dim i As Long
Dim ops As Variant
Dim base_data, f_data, or_data As Object
Dim sval, tval, ikey As Variant
''d_Type = data.item("type")
d_name = data.item("name")
'' 式と条件を分割
fs = Separate_Formula(formula)
'' 分岐前のコピーを作成
Set base_data = data
i = 1
Do
'' 比較演算子の判定
ops = Select_Operator(fs(1)(i), d_name)
'' 検索
Set f_data = Set_Dictionary
'' データ型の取得
If ops(0) <> "NA" Then
d_Type = data.item("type")(ops(1))
Else
d_Type = "文字列"
End If
'' 検索条件値のフォーマット変換
sval = Text_Format(ops(2), d_Type)
If IsEmpty(sval) Then
GoTo Continue
End If
For Each ikey In base_data.keys
'' 列名とデータ型は必ず登録
If ikey = "primary_key" Or ikey = "name" Or ikey = "type" Then
f_data.Add ikey, base_data(ikey)
GoTo Continue
End If
'' 対象データを取得
If ops(0) <> "NA" Then
tval = Text_Format(base_data(ikey)(ops(1)), d_Type)
Else
tval = join(base_data(ikey), ",")
End If
If IsEmpty(tval) Then GoTo Continue
'' 該当するデータを登録
Select Case ops(0)
Case "="
If InStr(tval, sval) > 0 Then
f_data.Add ikey, base_data(ikey)
End If
Case "=="
If tval = sval Then
f_data.Add ikey, base_data(ikey)
End If
Case "!="
If tval <> sval Then
f_data.Add ikey, base_data(ikey)
End If
Case ">=", "=>"
If tval >= sval Then
f_data.Add ikey, base_data(ikey)
End If
Case ">"
If tval > sval Then
f_data.Add ikey, base_data(ikey)
End If
Case "<=", "=<"
If tval <= sval Then
f_data.Add ikey, base_data(ikey)
End If
Case "<"
If tval < sval Then
f_data.Add ikey, base_data(ikey)
End If
Case "NA"
If InStr(tval, sval) > 0 Then
f_data.Add ikey, base_data(ikey)
End If
Case "Error"
Exit For
End Select
Continue:
Next
'' 前回条件がorの場合の処理
If i > 1 Then
If fs(0)(i - 1) = "or" Then
'' or_data(前回検索したデータ)をf_data(今回検索したデータ)に統合
For Each ikey In or_data.keys
If f_data.exists(ikey) = False Then
f_data.Add ikey, or_data(ikey)
End If
Next
End If
End If
'' 今回条件に対する処理
Select Case fs(0)(i)
Case "end"
Exit Do
Case "and"
Set base_data = Nothing
Set base_data = f_data
Set f_data = Nothing
Case "or"
Set or_data = Nothing
Set or_data = f_data
Set f_data = Nothing
End Select
i = i + 1
Loop
Set Filter_Data_Table = f_data
End Function
'''''''''''''''''''''
Private Function Select_Operator(ByVal formula As String, ByVal names As Variant) As Variant
'' 比較演算子の判定 names 配列型の名前リスト
'' ==: 完全一致
'' = : 部分一致
'' !=: 否定
'' > : 大なり
'' >=: 以上
'' < : 小なり
'' <=: 以下
'''''''''''''''''''''