数据库高手请进

数据库 同时被 2 个专栏收录
6 篇文章 0 订阅
43 篇文章 0 订阅

2013-06-26

今天决定开源部分源码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form MainForm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "数据库主窗口"
   ClientHeight    =   8340
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   11955
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8340
   ScaleWidth      =   11955
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command7 
      Caption         =   "整理"
      Height          =   375
      Left            =   10680
      TabIndex        =   10
      Top             =   3360
      Width           =   1215
   End
   Begin VB.CommandButton Command6 
      Caption         =   "开始"
      Height          =   375
      Left            =   8040
      TabIndex        =   9
      Top             =   3360
      Width           =   1215
   End
   Begin VB.TextBox Text2 
      BorderStyle     =   0  'None
      Height          =   1095
      HideSelection   =   0   'False
      Left            =   0
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   8
      Top             =   7200
      Width           =   11895
   End
   Begin VB.CommandButton Command5 
      Caption         =   "测试SQL"
      Height          =   375
      Left            =   6720
      TabIndex        =   7
      Top             =   3360
      Width           =   1215
   End
   Begin MSComctlLib.ListView ListView1 
      Height          =   3255
      Left            =   2760
      TabIndex        =   6
      Top             =   3840
      Width           =   9135
      _ExtentX        =   16113
      _ExtentY        =   5741
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.CommandButton Command4 
      Caption         =   "关闭"
      Height          =   375
      Left            =   9360
      TabIndex        =   5
      Top             =   3360
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "导出EXCEL"
      Height          =   375
      Left            =   5400
      TabIndex        =   4
      Top             =   3360
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "查找"
      Height          =   375
      Left            =   4080
      TabIndex        =   3
      Top             =   3360
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "运行(&R)"
      Height          =   375
      Left            =   2760
      TabIndex        =   2
      Top             =   3360
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   3255
      Left            =   2760
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   0
      Width           =   9135
   End
   Begin MSComctlLib.TreeView TreeView1 
      Height          =   7095
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   2655
      _ExtentX        =   4683
      _ExtentY        =   12515
      _Version        =   393217
      Style           =   7
      Appearance      =   1
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'---MYDATA关系型数据库开发日志----------------------------------------------------------------------------
'2012/8/8
'细分CREATETABLE模块
'2012/8/1
'完成SELECT语句的初级功能,星号和字段选择。
'2012/7/31
'完成INSERT命令的开发,并开始进行SELECT的开发。
'2012/7/30
'完成CREATE TABLE命令的开发,并开始进行INSERT命令的开发
'
'2012/7/29
'程序主界面
'主要分为命令输入框,显示表名的树形表框,显示结果的数据框,执行各种命令的按钮栏和记录命令运行过程的记录框
'其中命令按钮栏包括运行,查找,导出EXCEL,测试SQL,开始,关闭,整理等按钮。
'
'-------------------------------------------------------------------------------

Dim intBiaoNum As Integer
Dim nodex As Node
Dim runSQL As String

'-------------------------------------------------------------------
'运行按钮
'此按钮的设计目的
'主要为读取命令输入框中的字符
'
Private Sub Command1_Click()
'运行
    Dim strCommand As String
    Dim strEnd As String
    
    
    If Me.Text1.SelText = "" Then
        runSQL = Me.Text1.Text
    Else
        runSQL = Me.Text1.SelText
    End If
    
    If runSQL = "" Then
        MsgBox "没有读取到命令", vbCritical, "错误"
        Exit Sub
    End If
    
    strEnd = Right(runSQL, 1)
    Debug.Print strEnd
    If strEnd <> ";" Then
        MsgBox "命令没有正确结束", vbCritical, "错误"
        Exit Sub
    End If
    runSQL = UCase(runSQL)
    runSQL = Replace(runSQL, vbCrLf, "")
    runSQL = Trim(runSQL)
    strCommand = Left(runSQL, 6)
    Debug.Print strCommand
    
    Select Case strCommand
        Case "CREATE":
            Debug.Print "CREATE"
            Call analyzeCREATETABLE(runSQL)
        Case "SELECT":
            Debug.Print "SELECT"
            Call analyzeSELECT(runSQL)
        Case "INSERT":
            Debug.Print "INSERT"
            Call analyzeINSERT(runSQL)
        Case "UPDATE":
        
        Case "DELETE"
            
        Case Else
            MsgBox "无法解析此命令", vbCritical, "错误"
    End Select
    
End Sub

Private Sub Command4_Click()
'
    End
    
End Sub

Private Sub Command5_Click()
'测试SQL
'    Call Test1
'    Call TEST2
'    Call TEST3
'    Call Test4
'    Call analyzeCREATETABLE("")
'    Debug.Print Dir(App.Path + "\ABC_S.DataS")
'    Call Test5
'    Call Test6
'    Debug.Print Me.Text1.SelText
    
End Sub

'    TreeView1.Nodes("root").Expanded = True
Private Sub Test4()
'
    Dim str1 As String
    Dim str2 As String
    
    str1 = Me.Text1.Text
    If str1 = "" Then
        MsgBox "没有读取到命令", vbCritical, "错误"
        Exit Sub
    End If
    
    str2 = Right(str1, 1)
    Debug.Print str2
    If str2 <> ";" Then
        MsgBox "命令没有正确结束", vbCritical, "错误"
        Exit Sub
    End If
    str1 = UCase(str1)
    str1 = Replace(str1, vbCrLf, "")
    Call analyzeCREATETABLE(str1)
    Debug.Print str1
End Sub
'字符= Replace(字符,  vbCrLf,"")
Private Sub Test1()


'    Set nodex = Me.TreeView1.Nodes.Add(, , "X1", "aaa")
'    Me.TreeView1.Nodes.Add "X1", tvwChild, "XX1", "abcd"
'    Me.TreeView1.Nodes.Add "XX1", tvwChild, "xxx1", "eeefg"
'    Me.TreeView1.Nodes.Add "X1", tvwChild, "XX2", "abecd"
'
'    Set nodex = Me.TreeView1.Nodes.Add(, , "X2", "abc")
'
'    Me.TreeView1.Nodes("X1").Expanded = True
'    Me.TreeView1.Nodes("XX1").Expanded = True
    Set nodex = Me.TreeView1.Nodes.Add(, , "Zhu1", "主数据库")
    Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao1", "TestTable1"
    Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao2", "TEST2"
    Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao3", "SKU"
    Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao4", "CUST"
    Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao5", "STORERKEY"
    Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao6", "ASN"
    Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao7", "ORDER"
    Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao8", "ITEM"
    Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao9", "ACOUNT"
    Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao10", "USERS"
    
    
    Me.TreeView1.Nodes("Zhu1").Expanded = True
    

End Sub

Private Sub TEST2()
'
    Dim str1 As String
    
    str1 = "SELECT * " + vbCrLf
    str1 = str1 + "FROM TEST2;" + vbCrLf
    
    Me.Text1.Text = str1
    
    
End Sub

Private Sub TEST3()
'
    Dim str2 As String
    
    Me.ListView1.ColumnHeaders.Add , , "Field1"
    Me.ListView1.ColumnHeaders.Add , , "Field2"
    Me.ListView1.ColumnHeaders.Add , , "Field3"
    Me.ListView1.ColumnHeaders.Add , , "Field4"
    Me.ListView1.ColumnHeaders.Add , , "Field5"
    Me.ListView1.ColumnHeaders.Add , , "Field6"
    Me.ListView1.ColumnHeaders.Add , , "Field7"
    Me.ListView1.ColumnHeaders.Add , , "Field8"
    Me.ListView1.ColumnHeaders.Add , , "Field9"
    Me.ListView1.ColumnHeaders.Add , , "Field10"
    
    
'    Me.ListView1.ListItems.Add , , "aa"
'    Me.ListView1.ListItems.Add , , "bb"
'    Me.ListView1.ListItems.Add , , "cc"
'    Me.ListView1.ListItems.Add , , "ee"
'    Me.ListView1.ListItems.Add , , "dd"
    For i1 = 0 To 10000
        Me.ListView1.ListItems.Add , , "AA" + CStr(i1)
        Me.ListView1.ListItems(i1 + 1).SubItems(1) = "BB" + CStr(i1)
        Me.ListView1.ListItems(i1 + 1).SubItems(2) = "CC" + CStr(i1)
        Me.ListView1.ListItems(i1 + 1).SubItems(3) = "DD" + CStr(i1)
        Me.ListView1.ListItems(i1 + 1).SubItems(4) = "EE" + CStr(i1)
        Me.ListView1.ListItems(i1 + 1).SubItems(5) = "FF" + CStr(i1)
        Me.ListView1.ListItems(i1 + 1).SubItems(6) = "GG" + CStr(i1)
        Me.ListView1.ListItems(i1 + 1).SubItems(7) = "HH" + CStr(i1)
        Me.ListView1.ListItems(i1 + 1).SubItems(8) = "II" + CStr(i1)
        Me.ListView1.ListItems(i1 + 1).SubItems(9) = "JJ" + CStr(i1)
    Next i1
    
    str2 = "开始查询数据" + vbCrLf
    str2 = str2 + "数据查询完成" + vbCrLf
    str2 = str2 + "耗时:5489 毫秒" + vbCrLf
    
    Me.Text2.Text = str2
    
    
End Sub

Private Sub Form_Activate()
'
    Call Text2_Click
End Sub

' Me.ListView1.ListItems(i1 + 1).SubItems(1) = CStr(Me.Adodc1.Recordset.Fields(0))
Private Sub Form_Load()
'
    
    Call loadTable
'    Call refreshText2
'    Call Text2_Click
End Sub

'Private Function analyzeCREATETABLE(strTmp1 As String) As Boolean
''
'    Dim strALLField As String
'    Dim intFirstTName As Integer
'    Dim strTableName As String
'    Dim strFields() As String
'    'TEST1
''    strTmp1 = "CREATE TABLE(A1(100),A2(200),A3(3000));"
''    strTmp1 = "CREATE TABLE(A1(100),A2(200));"
''    strALLField = Right(strTmp1, 12)
''    strTmp1 = "CREATE TABLE(A1(100),A2(200),A3(3000),A4(100),B3(50),B4(256));"
''    strALLField = Mid(strTmp1, 14, Len(strTmp1) - 15)
''    strTmp1 = "CREATE TABLE ddderfsd(A1(100),A2(200));"
''    strTmp1 = "CREATE TABLE ABC(A1(100),A2(200));"
''    strTmp1 = "CREATE TABLE ABC(A1(100),A2(200),A3(3000),A4(100),B3(50),B4(256));"
'
'    Debug.Print InStr(1, strTmp1, "(")
'    intFirstTName = InStr(1, strTmp1, "(")
'    strTableName = Mid(strTmp1, 14, intFirstTName - 14)
'    Debug.Print strTableName
'    strALLField = Mid(strTmp1, intFirstTName + 1, Len(strTmp1) - intFirstTName - 2)
'    Debug.Print strALLField
'    strFields = Split(strALLField, ",")
'    For i1 = 0 To UBound(strFields)
'        Debug.Print strFields(i1)
'    Next i1
'
'    If checkTableN(strTableName) = False Then
'        MsgBox "创建的表名冲突,请修改表名后重新创建", vbCritical, "错误"
'        analyzeCREATETABLE = False
'        Exit Function
'    End If
'
'
'    Call CreateTable(strTableName, UBound(strFields), strFields)
'    If createSystemInfo(strTableName) = True Then
'        Call refreshTreeList
'    Else
'        analyzeCREATETABLE = False
'        MsgBox "文件写入错误", vbCritical, "错误"
'    End If
'    analyzeCREATETABLE = True
'End Function
'CREATE TABLE ABC(A1(100),A2(200))
'CREATE TABLE(A1(100),A2(200));

'Private Function CreateTable(strTableName As String, intTableNum As Integer, strFeilds() As String) As Boolean
''
'    Dim l1 As Long
'    Dim i1 As Integer
'    Dim strFeildName As String
'    Dim strNUM As String
'    Dim intFName As Integer
'
'    l1 = FreeFile
'
'    Open App.Path + "\" + strTableName + "_S.DataS" For Output As l1
'
'        For i1 = 0 To intTableNum
''            If i1 = 0 Then Write #l1,
''            Write #l1, strFeilds(i1)
'            intFName = InStr(1, strFeilds(i1), "(")
'            strFeildName = Mid(strFeilds(i1), 1, intFName - 1)
'            strNUM = Mid(strFeilds(i1), intFName + 1, Len(strFeilds(i1)) - intFName - 1)
'
'            Write #l1, strFeildName, strNUM
'
'        Next i1
'
'    Close l1
'
'    Call refreshTreeList
'
'End Function

'Private Function createSystemInfo(strTable As String) As Boolean
''
'On Error GoTo Err_createSystemInfo
'    Dim l1 As Long
'    l1 = FreeFile
'
'    If Dir(App.Path + "\DBSystemT.ini") = "" Then
'
'        Open App.Path + "\DBSystemT.ini" For Output As l1
'
'            Print #l1, strTable
'        Close l1
'    Else
'
'        Open App.Path + "\DBSystemT.ini" For Append As l1
'
'            Print #l1, strTable
'        Close l1
'    End If
'    createSystemInfo = True
'Exit Function
'Err_createSystemInfo:
'    Debug.Print Err.Description
'    createSystemInfo = False
'End Function

Private Sub loadTable()
'
    Dim l1 As Long
    Dim i1 As Integer
    Dim strTableN As String
    l1 = FreeFile
    
    Set nodex = Me.TreeView1.Nodes.Add(, , "Zhu1", "主数据库")
    
    If Dir(App.Path + "\DBSystemT.ini") = "" Then
        Exit Sub
    End If
    i1 = 1
    Open App.Path + "\DBSystemT.ini" For Input As l1
    
        Do Until EOF(l1)
            Input #l1, strTableN
            Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao" + CStr(i1), strTableN
            Me.Text2.Text = Me.Text2.Text + "加载数据表" & strTableN & "完毕" + vbCrLf
            i1 = i1 + 1
        Loop
    Close l1
    
    Me.TreeView1.Nodes("Zhu1").Expanded = True
    Me.Text2.Text = Me.Text2.Text + "所有数据表加载完毕" + vbCrLf
    
'    Call refreshText2
End Sub

Private Sub refreshTreeList()
'
'    Set nodex = Null
    Dim l1 As Long
    Dim i1 As Integer
    Dim strTableN As String
    l1 = FreeFile
    
    Me.TreeView1.Nodes.Clear
    Set nodex = Me.TreeView1.Nodes.Add(, , "Zhu1", "主数据库")
    
    If Dir(App.Path + "\DBSystemT.ini") = "" Then
        Exit Sub
    End If
    i1 = 1
    Open App.Path + "\DBSystemT.ini" For Input As l1
    
        Do Until EOF(l1)
            Input #l1, strTableN
            Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao" + CStr(i1), strTableN
            Me.Text2.Text = Me.Text2.Text + "加载数据表" & strTableN & "完毕" + vbCrLf
            i1 = i1 + 1
        Loop
    Close l1
    
    Me.TreeView1.Nodes("Zhu1").Expanded = True
    Me.Text2.Text = Me.Text2.Text + "所有数据表加载完毕" + vbCrLf
End Sub

Private Sub refreshText2()
'
    Me.Text2.SelLength = 1
    Me.Text2.SelStart = Len(Text2.Text)
End Sub

Private Sub Text2_Change()

    Call refreshText2
End Sub

Private Sub Text2_Click()
'
    Call refreshText2
End Sub

Private Function checkTableN(strTmp1 As String) As Boolean
'
    Dim l1 As Long
'    Dim i1 As Integer
    Dim strTableN As String
    l1 = FreeFile
    
    If Dir(App.Path + "\DBSystemT.ini") = "" Then
        checkTableN = True
        Exit Function
    End If
    
    Open App.Path + "\DBSystemT.ini" For Input As l1
        Do Until EOF(l1)
            Input #l1, strTableN
            If strTableN = strTmp1 Then
                checkTableN = False
                GoTo loop1
            End If
        Loop
        GoTo loop2
loop1:
    Close l1
    
Exit Function
loop2:
    Close l1
    checkTableN = True
End Function
Private Sub addTreeList(strTmp1 As String)
'
End Sub
'Me.TreeView1.Nodes.Add "Zhu1", tvwChild, "Biao10", "USERS"

Private Sub Test5()
'
    Dim str1 As String
    
'    str1 = "INSERT INTO abc ( a1, a2 ) VALUES(AAA,BBB);"
'    str1 = "INSERT INTO dddfe ( a1, a2,a3 , a4, d3 ) VALUES(AAA,BBB, bdfd, adfee, dff);"
'    str1 = "INSERT INTO abc ( a1 ) VALUES(AAA);"
'    str1 = "INSERT INTO abc ( a2 ) VALUES(bbb);"
    str1 = UCase(str1)
    Call analyzeINSERT(str1)
    
End Sub
'INSERT INTO abc ( a1, a2 ) VALUES('AAA','BBB');


Private Sub analyzeINSERT(strTmp1 As String)
'
    Dim strTFeild() As String, strAllTFeild     As String
    Dim strVFeild() As String, strAllVFeild     As String
    Dim strTName    As String
    Dim intFirstRKH As Integer, intVALUERKH     As Integer
    Dim intSecondKL As Integer, intVALUEKL      As Integer
    Dim intVALUEPos As Integer
    
    Debug.Print InStr(1, strTmp1, "(")
    intFirstRKH = InStr(1, strTmp1, "(")
    strTName = Mid(strTmp1, 12, intFirstRKH - 12)
    Debug.Print Trim(strTName)
    
    intSecondKL = InStr(intFirstRKH, strTmp1, ")")
    Debug.Print intSecondKL
    strAllTFeild = Mid(strTmp1, intFirstRKH + 1, intSecondKL - intFirstRKH - 1)
    Debug.Print strAllTFeild
    strTFeild = Split(strAllTFeild, ",")
    For i1 = 0 To UBound(strTFeild)
        Debug.Print Trim(strTFeild(i1))
    Next i1
    
    intVALUEPos = InStr(intSecondKL, strTmp1, "VALUE")
    Debug.Print intVALUEPos
    intVALUERKH = InStr(intVALUEPos, strTmp1, "(")
    Debug.Print intVALUERKH
    intVALUEKL = InStr(intVALUEPos, strTmp1, ")")
    Debug.Print intVALUEKL
    strAllVFeild = Mid(strTmp1, intVALUERKH + 1, intVALUEKL - intVALUERKH - 1)
    Debug.Print strAllVFeild
    strVFeild = Split(strAllVFeild, ",")
    For i2 = 0 To UBound(strVFeild)
        Debug.Print Trim(strVFeild(i2))
    Next i2
    
    If UBound(strTFeild) <> UBound(strVFeild) Then
        MsgBox "请检查表字段和所输入的字符数量是否一致", vbCritical, "错误"
        Exit Sub
    End If
    If InsertDATAtoDB(Trim(strTName), strTFeild, strVFeild) = False Then
        Me.Text2.Text = Me.Text2.Text + "插入数据错误" + vbCrLf
    Else
        Me.Text2.Text = Me.Text2.Text + "插入数据成功" + vbCrLf
    End If
End Sub

Private Function InsertDATAtoDB(strTableName As String, strTFeild() As String, strVFeild() As String) As Boolean
'
On Error GoTo Err_InsertDATAtoDB
    Dim strTFeildN() As String, strALLTFeildN As String, strTmpFeildN As String, strTmp1 As String
    Dim strTFN As String, strTFNs() As String, strAllTFs As String
    Dim boolisDBNULL As Boolean
    Dim l1 As Long, l2 As Long
    
    l1 = FreeFile
    strALLTFeildN = ""
    If Dir(App.Path + "\" + strTableName + "_S.DataS") = "" Then
        InsertDATAtoDB = False
        Exit Function
    Else
        Open App.Path + "\" + strTableName + "_S.DataS" For Input As l1
            Do Until EOF(l1)
                Input #l1, strTmpFeildN, strTmp1
                strALLTFeildN = strALLTFeildN + strTmpFeildN + ","
            Loop
        Close l1
        strALLTFeildN = Left(strALLTFeildN, Len(strALLTFeildN) - 1)
        Debug.Print strALLTFeildN
        strTFeildN = Split(strALLTFeildN, ",")
    End If
    Debug.Print UBound(strTFeildN)
    strTFN = ""
    strAllTFs = ""
    boolisDBNULL = False
    For i1 = 0 To UBound(strTFeildN)
        For i2 = 0 To UBound(strTFeild)
            If strTFeildN(i1) = Trim(strTFeild(i2)) Then
                strTFN = strTFN + strTFeildN(i1) + ","
                strAllTFs = strAllTFs + strVFeild(i2) + ","
                boolisDBNULL = True
            End If
        Next i2
        If boolisDBNULL = False Then
            strAllTFs = strAllTFs + "NULL" + ","
        End If
        boolisDBNULL = False
    Next i1
    If strTFN = "" Then
        MsgBox "插入字段错误", vbCritical, "错误"
        InsertDATAtoDB = False
        Exit Function
    End If
    strTFN = Left(strTFN, Len(strTFN) - 1)
    strAllTFs = Left(strAllTFs, Len(strAllTFs) - 1)
    Debug.Print strTFN
    Debug.Print strAllTFs
'    strTFNs = Split(strTFN, ",")
'    For i3 = 0 To UBound(strTFNs)
'        For i4 = 0 To UBound(strVFeild)
'
'        Next i4
'    Next i3
    l2 = FreeFile
    If Dir(App.Path + "\" + strTableName + "_D.DataD") = "" Then
        Open App.Path + "\" + strTableName + "_D.DataD" For Output As l2
            Print #l2, strAllTFs
        Close l2
    Else
        Open App.Path + "\" + strTableName + "_D.DataD" For Append As l2
            Print #l2, strAllTFs
        Close l2
    End If
    InsertDATAtoDB = True
Exit Function
Err_InsertDATAtoDB:
    Debug.Print Err.Description
    InsertDATAtoDB = False
End Function

Private Sub Test6()
'
    Dim str1 As String
    
    str1 = "SELECT A1, A2 FROM ABC; "
'    str1 = "SELECT * FROM ABC; "
'    str1 = "SELECT A2 FROM ABC; "
    str1 = UCase(str1)
    str1 = Trim(str1)
    Call analyzeSELECT(str1)
End Sub
'SELECT A1, A2 FROM ABC;

Private Sub analyzeSELECT(strTmp1 As String)
'
    Dim intFROMPos As Integer
    Dim strTableName As String
    Dim strFields() As String
    
    Debug.Print InStr(1, strTmp1, "FROM")
    intFROMPos = InStr(1, strTmp1, "FROM")
    strTableName = Mid(strTmp1, intFROMPos + 4, Len(strTmp1) - (intFROMPos + 4))
'    Debug.Print InStr(1, strTmp1, "WHERE")
    strTableName = Trim(strTableName)
    Debug.Print strTableName
    
    Debug.Print Mid(strTmp1, 7, intFROMPos - 7)
    strFields = Split(Mid(strTmp1, 7, intFROMPos - 7), ",")
    For i1 = 0 To UBound(strFields)
        Debug.Print strFields(i1)
    Next
    
'    Call SelectFromDB(strTableName, strFields)
    If SelectFromDB(strTableName, strFields) = False Then
        Me.Text2.Text = Me.Text2.Text + "数据库读取错误" + vbCrLf
    End If
    
End Sub

Private Function SelectFromDB(strTName As String, strFeilds() As String) As Boolean
'
    On Error GoTo Err_SelectFromDB
    Dim l1          As Long, l2             As Long, intRow           As Integer, intCol        As Integer
    Dim strFeildN   As String, strTFeildS() As String, strAllTfeildNs As String, strNUM         As String
    Dim strVFeild1  As String, strVFeild2   As String, strVFeilds()   As String, strAllVFeilds  As String
    Dim strAllTableNames() As String, strAllTNs As String
    
    l1 = FreeFile
    strAllTfeildNs = ""
    strFeildN = ""
    If Dir(App.Path + "\" + strTName + "_S.DataS") = "" Then
        SelectFromDB = False
        Exit Function
    Else
        Open App.Path + "\" + strTName + "_S.DataS" For Input As l1
            Do Until EOF(l1)
                Input #l1, strFeildN, strNUM
                strAllTNs = strAllTNs + strFeildN + ","
                If Trim(strFeilds(0)) = "*" Then
                    strAllTfeildNs = strAllTfeildNs + strFeildN + ","
                Else
                For i5 = 0 To UBound(strFeilds)
                    If Trim(strFeildN) = Trim(strFeilds(i5)) Then
                        strAllTfeildNs = strAllTfeildNs + strFeildN + ","
                    End If
                Next i5
                End If
            Loop
        Close l1
        strAllTfeildNs = Left(strAllTfeildNs, Len(strAllTfeildNs) - 1)
        strAllTNs = Left(strAllTNs, Len(strAllTNs) - 1)
        Debug.Print strAllTfeildNs
        strTFeildS = Split(strAllTfeildNs, ",")
        strAllTableNames = Split(strAllTNs, ",")
    End If
    Me.ListView1.ColumnHeaders.Clear
    Me.ListView1.ListItems.Clear
    For i1 = 0 To UBound(strTFeildS)
        Me.ListView1.ColumnHeaders.Add , , CStr(strTFeildS(i1))
    Next i1
    l2 = FreeFile
    strAllVFeilds = ""
    intRow = 0
    intCol = 0
    If Dir(App.Path + "\" + strTName + "_D.DataD") = "" Then
        SelectFromDB = False
        Exit Function
    Else
        Open App.Path + "\" + strTName + "_D.DataD" For Input As l2
            Do Until EOF(l2)
'                Input #l2, strVFeild1, strVFeild2
                Line Input #l2, strVFeild1
                Debug.Print strVFeild1
                strVFeilds = Split(strVFeild1, ",")
                If Trim(strFeilds(0)) = "*" Then
                    strAllVFeilds = strVFeild1 + ","
                Else
'                    For i2 = 0 To UBound(strTFeildS)
                    For i2 = 0 To UBound(strAllTableNames)
                        For i3 = 0 To UBound(strFeilds)
'                            If Trim(strTFeildS(i2)) = Trim(strFeilds(i3)) Then
                            If Trim(strAllTableNames(i2)) = Trim(strFeilds(i3)) Then
                                strAllVFeilds = strAllVFeilds + strVFeilds(i2) + ","
                            End If
                        Next i3
                    Next i2
                End If
                strAllVFeilds = Left(strAllVFeilds, Len(strAllVFeilds) - 1)
                Debug.Print strAllVFeilds
                Call ImportToListVie(strAllVFeilds, intRow)
                intRow = intRow + 1
                strAllVFeilds = ""
            Loop
        Close l2
    End If
    Me.Text2.Text = Me.Text2.Text + "数据查询完毕" + vbCrLf
    SelectFromDB = True
Exit Function
Err_SelectFromDB:
    Debug.Print Err.Description
    Me.Text2.Text = Me.Text2.Text + Err.Description + vbCrLf
    SelectFromDB = False
End Function

Private Sub ImportToListVie(strTmp1s As String, intRow As Integer)
'
    Dim strVSFeild() As String
    
    strVSFeild = Split(strTmp1s, ",")
    For i1 = 0 To UBound(strVSFeild)
        If i1 = 0 Then
            If strVSFeild(i1) = "NULL" Then
                Me.ListView1.ListItems.Add , , ""
            Else
                Me.ListView1.ListItems.Add , , strVSFeild(i1)
            End If
        Else
            If strVSFeild(i1) = "NULL" Then
                Me.ListView1.ListItems(intRow + 1).SubItems(i1) = ""
            Else
                Me.ListView1.ListItems(intRow + 1).SubItems(i1) = strVSFeild(i1)
            End If
        End If
    Next i1
End Sub


'-----------------------------------------------------------------------------
'--数据表创建模块
'模块说明:
'此模块用于创建表字段信息,表体属性信息,等内容
'更新日志:
'2012/8/14 19:07
'把现有的创建表的几个函数都移动到CREATETABLE模块中
'
'
'
'
'------------------------------------------------------------------------------


'---------------------------------------------------------------------------------
'analyzeCREATETABLE函数说明:
'此函数用于解析CREATE开头的命令字符串
'提供一个参数
'strTmp1:必须
'用于传入命令字符串,并用做解析。
Public Function analyzeCREATETABLE(strTmp1 As String) As Boolean
'
    Dim strALLField As String
    Dim intFirstTName As Integer
    Dim strTableName As String
    Dim strFields() As String
    'TEST1
'    strTmp1 = "CREATE TABLE(A1(100),A2(200),A3(3000));"
'    strTmp1 = "CREATE TABLE(A1(100),A2(200));"
'    strALLField = Right(strTmp1, 12)
'    strTmp1 = "CREATE TABLE(A1(100),A2(200),A3(3000),A4(100),B3(50),B4(256));"
'    strALLField = Mid(strTmp1, 14, Len(strTmp1) - 15)
'    strTmp1 = "CREATE TABLE ddderfsd(A1(100),A2(200));"
'    strTmp1 = "CREATE TABLE ABC(A1(100),A2(200));"
'    strTmp1 = "CREATE TABLE ABC(A1(100),A2(200),A3(3000),A4(100),B3(50),B4(256));"
    
    Debug.Print InStr(1, strTmp1, "(")
    intFirstTName = InStr(1, strTmp1, "(")
    strTableName = Mid(strTmp1, 14, intFirstTName - 14)
    Debug.Print strTableName
    strALLField = Mid(strTmp1, intFirstTName + 1, Len(strTmp1) - intFirstTName - 2)
    Debug.Print strALLField
    strFields = Split(strALLField, ",")
    For i1 = 0 To UBound(strFields)
        Debug.Print strFields(i1)
    Next i1
    
    If checkTableN(strTableName) = False Then
        MsgBox "创建的表名冲突,请修改表名后重新创建", vbCritical, "错误"
        analyzeCREATETABLE = False
        Exit Function
    End If
    
    
    Call CreateTable(strTableName, UBound(strFields), strFields)
    If createSystemInfo(strTableName) = True Then
        Call refreshTreeList
    Else
        analyzeCREATETABLE = False
        MsgBox "文件写入错误", vbCritical, "错误"
    End If
    analyzeCREATETABLE = True
End Function
'CREATE TABLE ABC(A1(100),A2(200))
'CREATE TABLE(A1(100),A2(200));
    
'---------------------------------------------------------------------
'checkTableN函数说明
'用于检查要创建的表名在数据库中是否已经创建过
'如果创建过就返回FALSE,没有的话返回TRUE
'参数说明
'参数个数:1
'strTmp1:String类型
'用于传入表名,用于检验是否已经创建过此表。
Private Function checkTableN(strTmp1 As String) As Boolean
'
    Dim l1 As Long
'    Dim i1 As Integer
    Dim strTableN As String
    l1 = FreeFile
    
    If Dir(App.Path + "\DBSystemT.ini") = "" Then
        checkTableN = True
        Exit Function
    End If
    
    Open App.Path + "\DBSystemT.ini" For Input As l1
        Do Until EOF(l1)
            Input #l1, strTableN
            If strTableN = strTmp1 Then
                checkTableN = False
                GoTo loop1
            End If
        Loop
        GoTo loop2
loop1:
    Close l1
    
Exit Function
loop2:
    Close l1
    checkTableN = True
End Function

'-------------------------------------------------------------------------
'CreateTable函数说明
'此函数用于创建表体字段信息
'参数说明与参数个数:3个
'strTableName:此参数为要创建的表名
'intTableNum:此参数为此表中有多少个字段
'strFeilds:此参数为字段数组,为此表格中所有的字段组成的数组
Private Function CreateTable(strTableName As String, intTableNum As Integer, strFeilds() As String) As Boolean
'
    Dim l1 As Long
    Dim i1 As Integer
    Dim strFeildName As String
    Dim strNUM As String
    Dim intFName As Integer
    
    l1 = FreeFile
    
    Open App.Path + "\" + strTableName + "_S.DataS" For Output As l1
        
        For i1 = 0 To intTableNum
'            If i1 = 0 Then Write #l1,
'            Write #l1, strFeilds(i1)
            intFName = InStr(1, strFeilds(i1), "(")
            strFeildName = Mid(strFeilds(i1), 1, intFName - 1)
            strNUM = Mid(strFeilds(i1), intFName + 1, Len(strFeilds(i1)) - intFName - 1)
            
            Write #l1, strFeildName, strNUM
            
        Next i1

    Close l1
    
    Call refreshTreeList
    
End Function

'-----------------------------------------------------------------------------------------------
'createSystemInfo函数说明
'用于在系统表中添加新表的信息
'参数说明与个数:1
'strTable:要添加的表名
Private Function createSystemInfo(strTable As String) As Boolean
'
On Error GoTo Err_createSystemInfo
    Dim l1 As Long
    l1 = FreeFile
    
    If Dir(App.Path + "\DBSystemT.ini") = "" Then
        
        Open App.Path + "\DBSystemT.ini" For Output As l1
        
            Print #l1, strTable
        Close l1
    Else
        
        Open App.Path + "\DBSystemT.ini" For Append As l1
        
            Print #l1, strTable
        Close l1
    End If
    createSystemInfo = True
Exit Function
Err_createSystemInfo:
    Debug.Print Err.Description
    createSystemInfo = False
End Function


'----------------------------------------------------------------------------------------------------
'--2012年7月8日数据库项目立项
'一直在使用和学习数据库,突然有种想法,是否可以自己做个数据库,当然有时想想,这觉得是一种一想天开的想法
'单这种想法,一直在我脑海中回转,一直想着每种命令如何实现,想法想法觉得每种命令的实现方式因该都可以解决
'于是决定放手做一做,虽然也会别的程序语言,但还是决定使用VB来做,为什么,为了就是那份执着。此前也参考过
'别的SQL单句解析程序的源代码,主要是C和JAVA的,正则表达式的方式来解析,我当时也在考虑是否要采用这样的方式
'来编写和解析SQL语句。但最后想了很久决定用自己的方法来解析SQL语句不为别的就为了试一试可不可行。其初期,或说
'第一阶段我想实现的目标为:
'1.SELECT语句的实现
'2.DELETE语句的实现
'3.UPDATE语句的实现
'4.INSERT语句的实现
'5.CREATE语句的实现
'
'因此只是个实验性的数据库,只是为了论证我那些想法是否真的可以使用,并不是想真正的做一个可用的或是商用的数据库
'或是说现在还不是很想,下面为我想法的实现原理。
'其实现方法的设想为,文件类型中分为数据文件,和表体信息或属性文件
'
'
'1.SELECT语句:
'因为SELECT语句一般都是SELECT这五个字母为开头,而且一直到FROM这四个字母前结束,所以只要截取这连个字母当中的字符串就可以了
'而且截取到得字符串分两种情况
'a1.为一个*字符,就表示表中的所有的字段里的数据都要显示出来。这个不难读取表文件里的所有字段名,并一一读取每个字段里的数据
'并显示出来?
'a2.为指定的一些字段,这个有点难度,我是这么想的,先还是读取所有的数据,然后根据所选的字段做个二维表,吧所选的数据放入此表中并显示出来。
'a3.FROM这个指令为从那个几个表读取数据,我想先实现一个表,再实现关系表等多表读取。
'a4.WHERE指令中的语句,这个是最困难的因为其中包含了很多的命令,初期我只想能实现AND,OR,=,>,<等基础的比较指令在此程序中,绝的解析WHERE语句是SELECT语句中最困难的
'a5.其他像GOURPBY,ORDER BY,等语句不予实现,并且也不实现COUNT,SUM等函数命令。
'
'2.DELETE语句:
'b1.此命令比较复杂,应为文件中并不能实际的删改文件的内容,所以我想了几个方法
'1. 做个副表专门用来记录已删除信息的的记录号,读取文件前先到此表中查找下是否已被删除,当然这个方式速度是最慢的,不到万不得已,我想我不会使用此方法的。
'2. 用Random的方法,这个因该是最快的,但是这个需要定长表示,比较消耗磁盘空间,并且写入的速度也慢
'3. 这是比较常见方法,数据复制法,一行一行的复制数据,复制到要删除的那行跳过,并复制到一个临时文件中,
'并且复制完后删除原文件,把临时文件改名成原文件,但这个速度也不快,如文件变大后其复制的速度会很慢。
'b2. 以上三个方法各有所长也各有所短,我觉得我将分别使用,并要调试到最好的效果。
'
'3.UPDATE语句:
'c1.此和DELETE语句相似也是同样的几个问题?我也分别想出了几个方法来解决此个问题
'1. 与DELETE第一条一样做个副表,记录UPDATE的表的信息,如读取到,就直接读取此表中的信息,
'但每次修改都需要新建个副表,并删除原副表,所以比较复制,而且速度也不一定很快。
'2. 使用Random的方法,也一样更具记录号,修改原来的数据,其问题也是Random记录为定长所以比较耗磁盘空间,但修改速度因该是最快的。
'3. 也是数据复制法,一行一行的复制原数据,复制到要修改的那行,把修改的数据复制到副本中,并跳过那行后再复制其余的数据,并删除原文件,把复制的文件改名为原文件。
'c2. 以上三个方法与delete的方法相似,所以我觉得也要分别使用,并调教到最好的方式。
'
'4.INSERT语句:
'd1. 个人认为这个还是比较好实现的,直接使用append的方式添加数据到文件最后
'
'5.CREATE语句:
'e1. 此命令的实现也是非常困难的,个人认为分以下几步,并可能需要界面实现。
'1. 解析CREATE语句,因CREATE可创建多个对象,如表,视图,触发器等,所以先要解析到CREATE后面为TABLE的语句,也就是说初期只能实现创建表的CREATE语句
'2. 一般一条CREATE中分为,字段名,字段类型和长度,还有字段属性。可能初期我只能解析字段名和长度,并类型都为字符串。
'3. 其创建的表因该分为2部分,为表头标题文件和表体实际数据等文件,并因该还有个表的属性文件。
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'
'----------------------------------------------------------------------------------------------------





2013-02-20

今天想到,使用VB中的vbBack,做每个字符串或是数字的分割,这样基本上是不会出现,分割符上的重复出现,所有决定用这个方法,来解决问题,这样就可以使用列表等工具来存储和快速索引数据了。


突发其想想用VB做个能解析SQL的数据库程序。

特留个Q Q:37237015  和有相同爱好的朋友,交流交流。

开发日志

2012/10/26
觉得因该在读写数据层这一方面,添加个缓存池,或者数据连接池,也就是说,当从文件系统中读取到数据后,就保留在这个池当中,当有数据查询此表时,先从此表中读取数据,如找不到数据再从文件系统中查找数据。
现还没有想到实现的方法,等想到后放上实现方式和逻辑。


2012/8/2更新
实现了部分SELECT语句的功能如
SELECT * FROM ABC;
如ABC表中有A1,A2,A3这三个字段,将显示这三个字段的数据也可以指定这三个字段中任意字段显示。
以下附上简单的教程
简单教程:
其实现包括(不区分大小写)一定要已";"结尾
CREATE Table 例:
CREATE TABLE ABC(
A1(100),
A2(100),
A3(100)
);
说明A1为字段名,括号中的100为字段长度


SELECT FROM 例:
SELECT * FROM ABC;
显示ABC表中的所有字段,如A1,A2,A3
SELECT A1,A2,A3 FROM ABC;显示ABC表中所选的字段,这里选择了A1,A2,A3


INSERT INTO 例:
INSERT INTO ABC(A1,A2,A3)VALUES(AAA,BBB,CCC);
其中INTO 后面跟的为表名,括号后是表中要添加数据的字段,VALUES后是字段所对应的数据。

2012/8/1:  完成最简单的SELECT语句 附下载

http://www.kuaipan.cn/file/id_43844898763309112.html

2012/7/31:实现了CREATE TABLE 和 INSERT 另附部分代码下载

http://www.kuaipan.cn/file/id_43844898763309109.html


程序设计图



程序主界面



主要有几个问题自己想一想。
一。文件的存储方式
在文件的存储碰到的问题为
1。选择何种存储格式与方式。
众所周知,一般VB写入文件的格式或方式有OUTPUT,Random,binary和FileSystemObject,其中Random和binary都为PUT写入方式,而OUTPUT为Print和write
一个为逗号分隔,一个为TAB符分隔,FileSystemObject与OUTPUT写入文件方式类似,也为字段和字符行写入。
经过我每个方式测试,每个方式写入一百万条记录,每个记录有10个字段,并字段的长短不一随机而定,但不区分类型,都以字符串类型写入。
其中OUTPUT以逗号方式写入和FileSystemObject是最快的速度差不多,用TAB符就要慢点,binary为第二,Random方式是最慢的因为Random方式是定长写入的。
我想基本上数据的写入方式和储存格式,因该就是这样吧,最多格式上应该可以优化和压缩。




二。文件的读取和快速查找内容
这个就比较麻烦了,我仔细的研究了下,比如我要在那个写入一百万条记录的文件里寻找一条记录,其寻找第一条记录和最后条记录的时间是不同的
除Random方式读取文件可指定记录号,其他方式如INPUT,Binary和FileSystemObject都是一行一行读取或是扫描文件,直到找到你要的数据,当然也有牛人把整个文件读入内存,
并用指针的方式,快速查找到,需要的内容。
关于这个我有个最大的问题想问下各位数据库高手,比如说一条记录中我定义了一个主键或是索引字段,我程序启动把这个字段所有数据都读入内存,我用快速查找算法,或是B树算法找到了此值并直到了对应的行号,或是说数据的位置,那我如何快速在文件中找到此行并快速读取出此条记录的所有信息呢,难道只有扫描整个文件从头开始读取,一直读到我要的那行吗,没有办法直接读取指定的那行数据吗?
我知道Random方式读取数据可以指定记录位置读取,可它只能读取定长的数据,我是想问用INPUT,Binary或是FileSystemObject,是否可以快速读取指定行的数据,就像指针快速指到那行数据,并读取整条记录到变量当中,不要再重头开始一行行往下读,直到读到需要数据,这样速度太慢。
我在网上找了很多例子,和也看了些开源数据库他们的源代码。
我现在能想到的也是把整个表读入内存,让程序在内存中查找数据,这样速度可以很快。但问题是这样的话,当文件越大时,对内存的消耗也越大。
网上也有很多这样查找大文件里数据的例子,但我还是希望能直接读到我指定的那行记录数据信息。
请哪位高手达人不吝赐教,能否告知VB中有无快速读取文件中指定行数据的函数。
谢谢


三。解析SQL语句的字符串。
1.SELECT语句:
因为SELECT语句一般都是SELECT这五个字母为开头,而且一直到FROM这四个字母前结束,所以只要截取这连个字母当中的字符串就可以了
而且截取到得字符串分两种情况
a1.为一个*字符,就表示表中的所有的字段里的数据都要显示出来。这个不难读取表文件里的所有字段名,并一一读取每个字段里的数据
并显示出来?
a2.为指定的一些字段,这个有点难度,我是这么想的,先还是读取所有的数据,然后根据所选的字段做个二维表,吧所选的数据放入此表中并显示出来。
a3.FROM这个指令为从那个几个表读取数据,我想先实现一个表,再实现关系表等多表读取。
a4.WHERE指令中的语句,这个是最困难的因为其中包含了很多的命令,初期我只想能实现AND,OR,=,>,<等基础的比较指令在此程序中,绝的解析WHERE语句是SELECT语句中最困难的
a5.其他像GOURPBY,ORDER BY,等语句不予实现,并且也不实现COUNT,SUM等函数命令。


2.DELETE语句:
b1.此命令比较复杂,应为文件中并不能实际的删改文件的内容,所以我想了几个方法
1. 做个副表专门用来记录已删除信息的的记录号,读取文件前先到此表中查找下是否已被删除,当然这个方式速度是最慢的,不到万不得已,我想我不会使用此方法的。
2. 用Random的方法,这个因该是最快的,但是这个需要定长表示,比较消耗磁盘空间,并且写入的速度也慢
3. 这是比较常见方法,数据复制法,一行一行的复制数据,复制到要删除的那行跳过,并复制到一个临时文件中,
并且复制完后删除原文件,把临时文件改名成原文件,但这个速度也不快,如文件变大后其复制的速度会很慢。
b2. 以上三个方法各有所长也各有所短,我觉得我将分别使用,并要调试到最好的效果。


3.UPDATE语句:
c1.此和DELETE语句相似也是同样的几个问题。我也分别想出了几个方法来解决此个问题
1. 与DELETE第一条一样做个副表,记录UPDATE的表的信息,如读取到,就直接读取此表中的信息,
但每次修改都需要新建个副表,并删除原副表,所以比较复制,而且速度也不一定很快。
2. 使用Random的方法,也一样更具记录号,修改原来的数据,其问题也是Random记录为定长所以比较耗磁盘空间,但修改速度因该是最快的。
3. 也是数据复制法,一行一行的复制原数据,复制到要修改的那行,把修改的数据复制到副本中,并跳过那行后再复制其余的数据,并删除原文件,把复制的文件改名为原文件。
c2. 以上三个方法与delete的方法相似,所以我觉得也要分别使用,并调教到最好的方式。


4.INSERT语句:
d1. 个人认为这个还是比较好实现的,直接使用append的方式添加数据到文件最后


5.CREATE语句:
e1. 此命令的实现也是非常困难的,个人认为分以下几步,并可能需要界面实现。
1. 解析CREATE语句,因CREATE可创建多个对象,如表,视图,触发器等,所以先要解析到CREATE后面为TABLE的语句,也就是说初期只能实现创建表的CREATE语句
2. 一般一条CREATE中分为,字段名,字段类型和长度,还有字段属性。可能初期我只能解析字段名和长度,并类型都为字符串。
3. 其创建的表因该分为2部分,为表头标题文件和表体实际数据等文件,并因该还有个表的属性文件。


  • 0
    点赞
  • 1
    评论
  • 0
    收藏
  • 一键三连
    一键三连
  • 扫一扫,分享海报

©️2021 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值