Publicstructure Tblstructure

取得資料結構副程式

1. 宣告結構體公用變數

PublicStructure tblStructure

Dim FieldName AsString

Dim Primary AsBoolean

Dim FieldType AsString

Dim FieldLength AsInteger

Dim FieldDec AsInteger

Dim NullValue AsBoolean

Dim DefaultValue AsString

Dim FieldTitle AsString

EndStructure

Public tblStruct() As tblStructure

1. 設計剖析資料結構副程式- 使用 Show Create Table 指令

PublicSub getTblStruct(ByVal tbl AsString)

Dim str AsString, fstr() AsString, fna AsString, dft AsString = "", ftp AsString = ""

Dim pstr AsString = ""

Dim i AsInteger, fi AsInteger, j AsInteger, ln AsInteger, fl AsInteger, sl AsInteger

Dim key1 AsString = "", key2 AsString = ""

' Dim daReader As OdbcDataReader

str = "Show Create Table " & tbl

' myCmd = New OdbcCommand(str, myCon)

' daReader = myCmd.ExecuteReader()

Dim ds AsNew DataSet

Dim da AsNew OdbcDataAdapter

da = New OdbcDataAdapter(str, myCon)

da.Fill(ds, "CMD")

Dim daTable As DataTable

daTable = ds.Tables("CMD")

str = ""

' str = daReader.Item(1).ToString

str = daTable.Rows(0).Item(1).ToString

If str > ""Then

i = InStr(str, "(")

str = Trim(Mid(str, i + 1, Len(str)))

i = InStr(str, "Primary Key ")

If i > 0 Then

pstr = Mid(str, i + 11, Len(str))

str = Trim(Mid(str, 1, i - 1))

For i = Len(str) To 1 Step -1

If Mid(str, i, 1) = ","Then

str = Mid(str, 1, i - 1)

ExitFor

EndIf

Next

EndIf

fstr = Split(str, ",")

i = UBound(fstr)

fi = i

If pstr > ""Then

key1 = Mid(pstr, InStr(pstr, "(") + 1, Len(pstr))

key1 = Mid(key1, 1, InStr(key1, ")") - 1)

If InStr(key1, ",") > 0 Then

key2 = Trim(Mid(key1, InStr(key1, ",") + 1, Len(key1)))

key1 = Trim(Mid(key1, 1, InStr(key1, ",") - 1))

key1 = Replace(key1, "`", "")

key2 = Replace(key2, "`", "")

Else

key1 = Trim(key1)

key1 = Replace(key1, "`", "")

key2 = ""

EndIf

EndIf

ReDim tblStruct(fi)

For i = 0 To fi

str = Trim(fstr(i))

j = InStr(str, "`")

str = Mid(str, j + 1, Len(str))

j = InStr(str, "`")

fna = Trim(Mid(str, 1, j - 1))

str = Mid(str, j + 1, Len(str))

tblStruct(i).FieldName = fna

If InStr(str, "Not Null") > 0 Then

tblStruct(i).NullValue = False

Else

tblStruct(i).NullValue = True

EndIf

If InStr(str, "int") > 0 Then tblStruct(i).FieldType = "Numeric"

If InStr(str, "decimal") > 0 Then

tblStruct(i).FieldType = "Numeric"

ln = 2

EndIf

If InStr(str, "float") > 0 Then

tblStruct(i).FieldType = "Numeric"

ln = 2

EndIf

If InStr(str, "double") > 0 Then

tblStruct(i).FieldType = "Numeric"

ln = 2

EndIf

If InStr(str, "real") > 0 Then

tblStruct(i).FieldType = "Numeric"

ln = 2

EndIf

If InStr(str, "tinyint(1)") > 0 Then tblStruct(i).FieldType = "Boolean"

If InStr(str, "char") > 0 Or InStr(str, "var") > 0 Then

If InStr(str, "varbinary") > 0 Then

tblStruct(i).FieldType = "Binary"

Else

tblStruct(i).FieldType = "String"

EndIf

fl = 0

sl = 0

If InStr(str, "(") > 0 Then

fl = InStr(str, "(")

sl = InStr(str, ")")

tblStruct(i).FieldLength = Val(Mid(str, fl + 1, (sl - fl - 1))) + ln

EndIf

EndIf

If InStr(str, "enum") > 0 Then

tblStruct(i).FieldType = "Enum"

tblStruct(i).FieldLength = 10

EndIf

If InStr(str, "date") > 0 Then tblStruct(i).FieldType = "Date"

If InStr(str, "timestamp") > 0 Then

tblStruct(i).FieldType = "Stamp"

tblStruct(i).FieldLength = 24

EndIf

If InStr(str, "text") > 0 Then tblStruct(i).FieldType = "Text"

If InStr(str, "blob") > 0 Then tblStruct(i).FieldType = "Blob"

If tblStruct(i).FieldType = "Stamp"Or tblStruct(i).FieldType = "Date"Then

tblStruct(i).DefaultValue = ""

Else

j = InStr(str, "Default")

If j > 0 Then

str = Mid(str, j + 7, Len(str))

tblStruct(i).DefaultValue = str

Else

tblStruct(i).DefaultValue = Nothing

EndIf

EndIf

If fna = key1 Or fna = key2 Then

tblStruct(i).Primary = True

Else

tblStruct(i).Primary = False

EndIf

Next

EndIf

EndSub

1. 顯示結構

PrivateSub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click

Call getTblStruct("bkiclog")

Dim i AsInteger, str AsString = ""

Dim strTBL As DataTable = New DataTable("StrTable")

Dim daView1 As DataView

Dim column As DataColumn

Dim row As DataRow

column = New DataColumn()

column.DataType = System.Type.GetType("System.String") 'System.Single

column.ColumnName = "Name"

strTBL.Columns.Add(column)

column = New DataColumn()

column.DataType = System.Type.GetType("System.String")

column.ColumnName = "Type"

strTBL.Columns.Add(column)

column = New DataColumn()

column.DataType = System.Type.GetType("System.Int16")

column.ColumnName = "Length"

strTBL.Columns.Add(column)

column = New DataColumn()

column.DataType = System.Type.GetType("System.String")

column.ColumnName = "Null"

strTBL.Columns.Add(column)

column = New DataColumn()

column.DataType = System.Type.GetType("System.String")

column.ColumnName = "Default"

strTBL.Columns.Add(column)

column = New DataColumn()

column.DataType = System.Type.GetType("System.String")

column.ColumnName = "Primary"

strTBL.Columns.Add(column)

For i = 0 To UBound(tblStruct)

row = strTBL.NewRow()

row(0) = tblStruct(i).FieldName

row(1) = tblStruct(i).FieldType

row(2) = tblStruct(i).FieldLength

row(3) = tblStruct(i).NullValue

row(4) = tblStruct(i).DefaultValue

row(5) = tblStruct(i).Primary

strTBL.Rows.Add(row)

Next

daView1 = strTBL.DefaultView

DGV.DataSource = Nothing

DGV.DataSource = daView1

DGV.Visible = True

EndSub

1. 設計剖析資料結構副程式- 使用 ADODB物件

4-1 事前須加入 ADODB物件參考

4-2 開啟 ADO連線

PublicSub openAdCon(ByVal dbStr AsString)

Dim str AsString

Dim opValue AsLong

opValue = 3145731 ' Using in Large Tables with no-catch results,下載必須使用此值

' opValue = 1 + 2 + 8 + 32 + 16384

Try

IfNot adCON.State = 1 Then

str = "DRIVER={MySQL ODBC " & DRV & " Driver};SERVER=" & HST & "; DATABASE=" & dbStr & ";UID=" & USR & ";PASSWORD=" & PSW & ";Option= " & opValue

adCON.ConnectionString = str

adCON.Open()

str = "Set character_set_client =" & SysChar & ";"

adCON.Execute(str)

str = "Set character_set_results=" & SysChar & ";"

adCON.Execute(str)

str = "Set character_set_connection = " & SysChar & ";"

adCON.Execute(str)

' str = "Set Session Max_allowed_Packet = 16777216;"

' adCON.Execute(str)

' str = "Set Global Max_allowed_Packet = 16777216;"

' adCON.Execute(str)

EndIf

Catch ex As Exception

MsgBox(ex.Message)

EndTry

EndSub

4-3 開啟ADO RecordSet

PublicSub openAdRs(ByVal db AsString, ByVal str AsString)

Try

IfNot adCON.State = 1 Then

Call openAdCon(db)

EndIf

If adRS.State = 1 Then adRS.Close()

Dim i AsInteger

i = InStr(str, " Order By ")

If i > 0 Then str = Trim(Mid(str, 1, i))

adRS.CursorLocation = ADODB.CursorLocationEnum.adUseClient

adRS.Open(str, adCON, 2, 4)

' Dim tp

' tp = adRS(0).Type ' 參閱 ADODB.DataTypeEnum()

Catch ex As Exception

MsgBox(ex.Message)

EndTry

EndSub

4-4 取得SQL指令對應結構

PublicSub getSqlStructure(ByVal str AsString)

Try

'*** id=0 不設Primary Field, 1 : 主鍵, 2 : 子鍵

Dim i AsInteger, ftp AsString

Dim jFLAG AsBoolean, sFLAG AsBoolean

jFLAG = False

sFLAG = False

Dim fln AsInteger, ln AsInteger

Dim sqlStruct() As tblStructure

If str = ""ThenExitSub

Call openAdRs(WDB, str) '//當tbl有暫存表時adCon無喇開啟暫存表

fln = adRS.Fields.Count - 1

ReDim sqlStruct(fln)

'//MsgBox(adRS(i).Type) ' Numeric format

'//MsgBox(adRS(i).Type.ToString & ", " & adRS(i).DefinedSize) 'String(Format)

For i = 0 To fln

ln = adRS(i).DefinedSize

ftp = adRS(i).Type.ToString

ftp = getAdoType(adRS(i).Type, ftp)

If ftp = "VarChar"Then ftp = "String"

If ftp = "Stamp"Then

ln = 26

Else

If ftp = "Date"Then

ln = 10

EndIf

EndIf

sqlStruct(i).FieldName = adRS(i).Name

sqlStruct(i).FieldTitle = adRS(i).Name

sqlStruct(i).FieldLength = ln

sqlStruct(i).FieldType = ftp

sqlStruct(i).DefaultValue = ""

Next

adRS.Close()

ReDim tblStruct(fln)

For i = 0 To fln

tblStruct(i) = sqlStruct(i)

Next

Catch ex As Exception

MsgBox(ex.Message)

EndTry

EndSub

PublicFunction getAdoType(ByVal tp AsInteger, ByVal ftp AsString) AsString

'// 2: adSmallInt, 3: adInteger, 4: adSingle, 5: adDouble, 6: adCurrency, 7: adDate, 8: adBSTR,

'// 11: adBoolean, 14: adDecimal, 16: adTinyInt, 17: adUnsignedTinyInt, 18: adUnsignedSmallInt, 19: adUnsignedInt, 20: adBigInt

'// 128: adBinary 129: adChar, 131: adNumeric, 133: adDBDate, 134:adDBTime, 135: adDBTimeStamp,

'// 200: adVarChar, 201: adLongVarChar, 202: adVarWChar, 204: adVarBinary, 205: adLongVarBinary

If tp <= 7 Or (tp >= 14 And tp <= 20) Then

Return"Numeric"

ExitFunction

EndIf

If tp = 130 Or (tp >= 200 And tp <= 203) Or InStr(ftp, "Char") > 0 Then

If InStr(ftp, "Long") > 0 Then

Return"Text"

Else

Return"String"

EndIf

ExitFunction

EndIf

If tp = 204 Or InStr(ftp, "Binary") > 0 Then

Return"Binary"

ExitFunction

EndIf

If tp = 205 Or InStr(ftp, "Blob") > 0 Then

Return"Blob"

ExitFunction

EndIf

If InStr(ftp, "Int") > 0 Then

Return"Numeric"

ExitFunction

EndIf

SelectCase ftp

Case"adBigInt", "adDecimal", "adNumeric", "adDouble", "adSingle"

Return"Numeric"

Case"adBoolean"

Return"Boolean"

Case"adCurrency"

Return"Numeric"

Case"adDate", "adDBDate"

Return"Date"

Case"adDBTimeStamp"

Return"Stamp"

CaseElse

Return"String"

EndSelect

EndFunction

1. 使用mysql 批次檔

5-1 建立批次指令

5-2 使用dobat.bat來產生輸出檔

5-3 取得輸出結果

5-4 剖析結果

PrivateSub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click

Dim res AsString, fstr AsString

Dim i AsInteger, str AsString = ""

If txtCMD.Text = ""ThenExitSub

fstr = Application.StartupPath & "/" & txtCMD.Text & "_Stru.txt"

IfMy.Computer.FileSystem.FileExists(fstr) = FalseThen

Call getStruByMysql()

End If

res = getStruResult()

If res = ""ThenExitSub

Call getTblStruct(res)

Dim strTBL As DataTable = New DataTable("StrTable")

Dim daView1 As DataView

Dim column As DataColumn

Dim row As DataRow

column = New DataColumn()

column.DataType = System.Type.GetType("System.String")

column.ColumnName = "Name"

strTBL.Columns.Add(column)

column = New DataColumn()

column.DataType = System.Type.GetType("System.String")

column.ColumnName = "Type"

strTBL.Columns.Add(column)

column = New DataColumn()

column.DataType = System.Type.GetType("System.Int16")

column.ColumnName = "Length"

strTBL.Columns.Add(column)

column = New DataColumn()

column.DataType = System.Type.GetType("System.String")

column.ColumnName = "Null"

strTBL.Columns.Add(column)

column = New DataColumn()

column.DataType = System.Type.GetType("System.String")

column.ColumnName = "Default"

strTBL.Columns.Add(column)

column = New DataColumn()

column.DataType = System.Type.GetType("System.String")

column.ColumnName = "Primary"

strTBL.Columns.Add(column)

For i = 0 To UBound(tblStruct)

row = strTBL.NewRow()

row(0) = tblStruct(i).FieldName

row(1) = tblStruct(i).FieldType

row(2) = tblStruct(i).FieldLength

row(3) = tblStruct(i).NullValue

row(4) = tblStruct(i).DefaultValue

row(5) = tblStruct(i).Primary

strTBL.Rows.Add(row)

Next

daView1 = strTBL.DefaultView

DGV.DataSource = Nothing

DGV.DataSource = daView1

DGV.Visible = True

EndSub

PrivateSub getStruByMysql()

Try

Dim dstr AsString, fstr AsString

Dim str AsString

fstr = Application.StartupPath & "\getTblStru.sql"

IfMy.Computer.FileSystem.FileExists(fstr) Then

My.Computer.FileSystem.DeleteFile(fstr)

EndIf

str = "Use " & WDB & ";" & vbCrLf

str = str & "Show Create Table " & txtCMD.Text & ";"

My.Computer.FileSystem.WriteAllText(fstr, str, False, System.Text.Encoding.Default)

dstr = Application.StartupPath & "\" & txtCMD.Text & "_Stru.txt"

IfMy.Computer.FileSystem.FileExists(dstr) Then

My.Computer.FileSystem.DeleteFile(dstr)

EndIf

dstr = Application.StartupPath & "\dobat.bat"

IfMy.Computer.FileSystem.FileExists(dstr) Then

My.Computer.FileSystem.DeleteFile(dstr)

EndIf

str = "cmd/c" & vbCrLf"H:" & vbCrLf

str = str & "H:\mysql\bin\mysql "

str = str & " -u " & USR & " -p" & PSW & " < " & fstr & " > " & Application.StartupPath & "/" & txtCMD.Text & "_Stru.txt"

My.Computer.FileSystem.WriteAllText(dstr, str, False, System.Text.Encoding.Default)

Call Shell(dstr, 1)

' My.Computer.FileSystem.DeleteFile(dstr)

Catch ex As Exception

MsgBox(ex.Message)

EndTry

EndSub

PrivateFunction getStruResult() AsString

Try

Dim dstr() AsString, fstr AsString, res AsString

Dim str AsString

fstr = Application.StartupPath & "/" & txtCMD.Text & "_Stru.txt"

IfMy.Computer.FileSystem.FileExists(fstr) = FalseThen

Return""

ExitFunction

EndIf

str = My.Computer.FileSystem.ReadAllText(fstr)

dstr = Split(str, vbCrLf)

res = dstr(1)

Return res

Catch ex As Exception

Return ""

End Try

EndFunction

PublicSub getTblStruct(ByVal tbl AsString)

Dim str AsString, fstr() AsString, fna AsString, dft AsString = "", ftp AsString = ""

Dim pstr AsString = ""

Dim i AsInteger, fi AsInteger, j AsInteger, ln AsInteger, fl AsInteger, sl AsInteger

Dim key1 AsString = "", key2 AsString = ""

' Dim daReader As OdbcDataReader

'// str = "Show Create Table " & tbl

'// myCmd = New OdbcCommand(str, myCon)

'// daReader = myCmd.ExecuteReader()

'//Dim ds As New DataSet

'//Dim da As New OdbcDataAdapter

'//da = New OdbcDataAdapter(str, myCon)

'//da.Fill(ds, "CMD")

'//Dim daTable As DataTable

'//daTable = ds.Tables("CMD")

'//str = ""

'// str = daReader.Item(1).ToString

'//str = daTable.Rows(0).Item(1).ToString

If tbl > ""Then

str = tbl

i = InStr(str, "(")

str = Trim(Mid(str, i + 1, Len(str)))

i = InStr(str, "Primary Key ")

If i > 0 Then

pstr = Mid(str, i + 11, Len(str))

str = Trim(Mid(str, 1, i - 1))

For i = Len(str) To 1 Step -1

If Mid(str, i, 1) = ","Then

str = Mid(str, 1, i - 1)

ExitFor

EndIf

Next

EndIf

fstr = Split(str, ",")

i = UBound(fstr)

fi = i

If pstr > ""Then

key1 = Mid(pstr, InStr(pstr, "(") + 1, Len(pstr))

key1 = Mid(key1, 1, InStr(key1, ")") - 1)

If InStr(key1, ",") > 0 Then

key2 = Trim(Mid(key1, InStr(key1, ",") + 1, Len(key1)))

key1 = Trim(Mid(key1, 1, InStr(key1, ",") - 1))

key1 = Replace(key1, "`", "")

key2 = Replace(key2, "`", "")

Else

key1 = Trim(key1)

key1 = Replace(key1, "`", "")

key2 = ""

EndIf

EndIf

ReDim tblStruct(fi)

For i = 0 To fi

str = Trim(fstr(i))

j = InStr(str, "`")

str = Mid(str, j + 1, Len(str))

j = InStr(str, "`")

fna = Trim(Mid(str, 1, j - 1))

str = Mid(str, j + 1, Len(str))

tblStruct(i).FieldName = fna

If InStr(str, "Not Null") > 0 Then

tblStruct(i).NullValue = False

Else

tblStruct(i).NullValue = True

EndIf

If InStr(str, "int") > 0 Then tblStruct(i).FieldType = "Numeric"

If InStr(str, "decimal") > 0 Then

tblStruct(i).FieldType = "Numeric"

ln = 2

EndIf

If InStr(str, "float") > 0 Then

tblStruct(i).FieldType = "Numeric"

ln = 2

EndIf

If InStr(str, "double") > 0 Then

tblStruct(i).FieldType = "Numeric"

ln = 2

EndIf

If InStr(str, "real") > 0 Then

tblStruct(i).FieldType = "Numeric"

ln = 2

EndIf

If InStr(str, "tinyint(1)") > 0 Then tblStruct(i).FieldType = "Boolean"

If InStr(str, "char") > 0 Or InStr(str, "var") > 0 Then

If InStr(str, "varbinary") > 0 Then

tblStruct(i).FieldType = "Binary"

Else

tblStruct(i).FieldType = "String"

EndIf

fl = 0

sl = 0

If InStr(str, "(") > 0 Then

fl = InStr(str, "(")

sl = InStr(str, ")")

tblStruct(i).FieldLength = Val(Mid(str, fl + 1, (sl - fl - 1))) + ln

EndIf

EndIf

If InStr(str, "enum") > 0 Then

tblStruct(i).FieldType = "Enum"

tblStruct(i).FieldLength = 10

EndIf

If InStr(str, "date") > 0 Then tblStruct(i).FieldType = "Date"

If InStr(str, "timestamp") > 0 Then

tblStruct(i).FieldType = "Stamp"

tblStruct(i).FieldLength = 24

EndIf

If InStr(str, "text") > 0 Then tblStruct(i).FieldType = "Text"

If InStr(str, "blob") > 0 Then tblStruct(i).FieldType = "Blob"

If tblStruct(i).FieldType = "Stamp"Or tblStruct(i).FieldType = "Date"Then

tblStruct(i).DefaultValue = ""

Else

j = InStr(str, "Default")

If j > 0 Then

str = Mid(str, j + 7, Len(str))

tblStruct(i).DefaultValue = str

Else

tblStruct(i).DefaultValue = Nothing

EndIf

EndIf

If fna = key1 Or fna = key2 Then

tblStruct(i).Primary = True

Else

tblStruct(i).Primary = False

EndIf

Next

EndIf

EndSub