frmmain.frm

几个不错的VB例子

                End If
                                                            
                rstCols.MoveNext
            Loop
            i = InStrRev(sSql, ",", Len(sSql))
            If i > 0 Then
                sSql = Mid(sSql, 1, i - 1) & """" & vbCrLf
                sSql = sSql & "sSql = sSql  & "") values(""" & vbCrLf
            End If
            If Trim(sData) <> "" Then
                i = InStrRev(sData, ",", Len(sData))
                If i > 0 Then
                    sData = Mid(sData, 1, i - 1) & """" & vbCrLf
                    sData = sData & "sSql = sSql  & "")""" & vbCrLf
                End If
            End If
            
            sData = sData & vbCrLf
            
            sData = sData & "Call SQLExecute(gdb,sSql)" & vbCrLf
            
            If chkType(miC_DIM) Then sView = sView & sDecl & vbCrLf & vbCrLf
            If chkType(miC_INSERT) Then sView = sView & sSql & sData
            
            rstCols.MoveFirst
        '==================================
        
        ' Include Delete Statement
            sDecl = ""
            sData = ""
            sSql = vbCrLf
            sSql = sSql & "' DELETE STATEMENT"
            sSql = sSql & vbCrLf
            
            sSql = sSql & "sSql = ""delete from " & msTableName & " where """ & vbCrLf
            sSql = sSql & vbCrLf
            sSql = sSql & "Call SQLExecute(gdb,sSql)" & vbCrLf
            
            If chkType(miC_DELETE) Then sView = sView & sSql
        '==================================
        
        ' Include Update Statement
            sSql = vbCrLf
            sSql = sSql & "' UPDATE STATEMENT"
            sSql = sSql & vbCrLf
            
            
            sSql = sSql & "sSql = ""update " & msTableName & " set """ & vbCrLf
            
            Do Until rstCols.EOF
                If rstCols.Fields(2) = msTableName Then
                    iDType = DBDataType(rstCols.Fields(11))
                    sSql = sSql & "sSql = sSql & """ & rstCols.Fields(3) & " = " & """ & " & sFunc1(iDType) & "T_X_T(m_i_T_" & UCase(rstCols.Fields(3)) & ")" & sFunc2(iDType) & " & "",""" & vbCrLf
                    i = i + 1
                End If
                                                            
                rstCols.MoveNext
            Loop
            i = InStrRev(sSql, ",", Len(sSql))
            If i > 0 Then
                sSql = Mid(sSql, 1, i - 1) & """" & vbCrLf
                sSql = sSql & "sSql = sSql  & "" where """ & vbCrLf
                sSql = sSql & vbCrLf
                sSql = sSql & "Call SQLExecute(gdb,sSql)" & vbCrLf
            End If
            
            If chkType(miC_UPDATE) Then sView = sView & sSql
        '==================================
        
        rstCols.Close
        
        ' Format
        If chkFormat(miT_SPACES) Then sView = Replace(sView, "' DELETE", Space(Val(txtFormat(miT_SPACES))) & "' DELETE")
        If chkFormat(miT_SPACES) Then sView = Replace(sView, "' INSERT", Space(Val(txtFormat(miT_SPACES))) & "' INSERT")
        If chkFormat(miT_SPACES) Then sView = Replace(sView, "' UPDATE", Space(Val(txtFormat(miT_SPACES))) & "' UPDATE")
        If chkFormat(miT_SPACES) Then sView = Replace(sView, "Call ", Space(Val(txtFormat(miT_SPACES))) & "Call ")
        If chkFormat(miT_SPACES) Then sView = Replace(sView, "Private const ", Space(Val(txtFormat(miT_SPACES))) & "Private const ")
        If chkFormat(miT_SPACES) Then sView = Replace(sView, "sSql = ", Space(Val(txtFormat(miT_SPACES))) & "sSql = ")
        
        sView = Replace(sView, "Call SQLExecute(gdb", "Call SQLExecute(" & txtDBName)
        If chkFormat(miT_STRING_VAR) Then sView = Replace(sView, "sSql", txtFormat(miT_STRING_VAR))
        If chkFormat(miT_SQL_CHECK) Then sView = Replace(sView, "sSql", txtFormat(miT_STRING_VAR))
        If chkFormat(miT_TEXT_BOX) Then sView = Replace(sView, "T_X_T", txtFormat(miT_TEXT_BOX))
        If chkFormat(miT_PREFIX) Then sView = Replace(sView, "m_i_T_", txtFormat(miT_PREFIX))
        
        ' Copy to Clipboard
        Clipboard.SetText sView
        
        ' Display
        rtb.Text = sView
        
        MousePointer = vbDefault
    
    
    Case iB_CONNECT
        If txtDB = "" Then
            MsgBox "Please create and save Connection String"
            Exit Sub
        Else
            gsDBConnection = txtDB
        End If
        
        i = 0
NewOpen:
        If gdbSQLQ.State <> adStateOpen Then
           gdbSQLQ.CommandTimeout = 60
           gdbSQLQ.Open gsDBConnection
        Else
            gdbSQLQ.Close
            i = i + 1
            If i > 2 Then
                MsgBox "Can not connect to Database"
                Exit Sub
            Else
                GoTo NewOpen
            End If
            
        End If
        lstTables.Clear
        
        Set rstTables = gdbSQLQ.OpenSchema(adSchemaTables)
        Do Until rstTables.EOF
            If rstTables.Fields(3) = "TABLE" Then
                lstTables.AddItem rstTables.Fields(2)
            End If

            i = i + 1
            rstTables.MoveNext
        Loop
        
        rstTables.Close
        cmd(iB_BUILD).Enabled = True
        cmd(iB_ASSIGN).Enabled = True
        cmd(iB_FIELDS).Enabled = True
        
    End Select
    MousePointer = vbDefault


ErrExit:      Exit Sub
ErrHandler:   Call ErrorHandler(Name, 0, "cmd_Click")
End Sub


Private Sub cmdCall_Click()
    frmDBConnection.Show
End Sub

Private Sub Edit_Click()

End Sub

Private Sub Exit_Click()

End Sub

Private Sub Form_Load()
If gbErrorHandSwitch Then On Error GoTo ErrHandler
    Dim i As Integer
    
    LoadFormSettings Me
    
    Caption = "QUERY BUILDER " & SystemVersion
    
    miDBNameNum = GetSetting("SQLS", "Settings", "DBNum", 0)
    
    cboDB.Clear
    
    For i = 0 To 15
        msDBName(i) = GetSetting("SQLS", "Settings", "DBName_" & CStr(i), "")
        msDBConnect(i) = GetSetting("SQLS", "Settings", "DBConnect_" & CStr(i), "")
        cboDB.AddItem msDBName(i), i
        If i = miDBNameNum Then
            cboDB = msDBName(i)
            txtDB = msDBConnect(i)
        End If
    Next i
    
    For i = 0 To miDBNameNum - 1
        msDBName(i) = GetSetting("SQLS", "Settings", "DBName_" & CStr(i), "")
        cboDB.AddItem msDBName(i), i
    Next i
    
'    txtDB = GetSetting("SQLS", "Settings", "ConnectionString", "Provider=SQLOLEDB.1;Password=tripled;Persist Security Info=True;User ID=sa;Initial Catalog=IMS_BENGALLA;Data Source=W2KIMSTEST")
    txtDBName = GetSetting("SQLS", "Settings", "DBName", "gdb")
    txtFormat(miT_STRING_VAR) = GetSetting("SQLS", "Settings", "sSql", "sSql")
    txtFormat(miT_SQL_CHECK) = GetSetting("SQLS", "Settings", "SQLCheck", "SQLCheck")
    txtFormat(miT_TEXT_BOX) = GetSetting("SQLS", "Settings", "txtBOX", "txtBOX")
    txtFormat(miT_SPACES) = GetSetting("SQLS", "Settings", "Spaces", "4")
    txtFormat(miT_RECORDSET) = GetSetting("SQLS", "Settings", "Recordset", "rst")
    txtFormat(miT_PREFIX) = GetSetting("SQLS", "Settings", "Prefix", "miT_")
    
    chkFormat(miT_STRING_VAR).Value = 1
    chkFormat(miT_SQL_CHECK).Value = 1
    chkFormat(miT_TEXT_BOX).Value = 1
    chkFormat(miT_SPACES).Value = 1
    chkFormat(miT_RECORDSET).Value = 1
    chkFormat(miT_PREFIX).Value = 1
    
    chkType(miC_INSERT).Value = 1
    chkType(miC_DELETE).Value = 1
    chkType(miC_UPDATE).Value = 1
    chkType(miC_DIM).Value = 1
    rtb.Text = ""
    

    
ErrExit:      Exit Sub
ErrHandler:   Call ErrorHandler(Name, 0, "Form_Load")
End Sub

Private Sub Form_Unload(Cancel As Integer)
If gbErrorHandSwitch Then On Error GoTo ErrHandler
    
    SaveFormSettings Me
    SaveSetup
    UnloadAllForms
    End
    
ErrExit:      Exit Sub
ErrHandler:   Call ErrorHandler(Name, 0, "Form_Unload")
End Sub


Private Sub SaveSetup()
If gbErrorHandSwitch Then On Error GoTo ErrHandler
    Dim i As Integer, iEmpty As Integer
    Call SaveSetting("SQLS", "Settings", "ConncetionString", txtDB)
    Call SaveSetting("SQLS", "Settings", "DBName", txtDBName)
    Call SaveSetting("SQLS", "Settings", "sSql", txtFormat(miT_STRING_VAR))
    Call SaveSetting("SQLS", "Settings", "SQLCheck", txtFormat(miT_SQL_CHECK))
    Call SaveSetting("SQLS", "Settings", "txtBOX", txtFormat(miT_TEXT_BOX))
    Call SaveSetting("SQLS", "Settings", "Spaces", txtFormat(miT_SPACES))
    Call SaveSetting("SQLS", "Settings", "Recordset", txtFormat(miT_RECORDSET))
    Call SaveSetting("SQLS", "Settings", "Prefix", txtFormat(miT_PREFIX))
    
    iEmpty = -1
    
    For i = 0 To 15
        If cboDB = msDBName(i) Then
            miDBNameNum = i
            Call SaveSetting("SQLS", "Settings", "DBNum", i)
            Exit Sub
        End If
        If msDBName(i) = "" And iEmpty = -1 Then iEmpty = i
    Next i
        
    For i = 15 To 1 Step -1
        msDBName(i) = msDBName(i - 1)
        msDBConnect(i) = msDBConnect(i - 1)
        Call SaveSetting("SQLS", "Settings", "DBName_" & CStr(i), msDBName(i))
        Call SaveSetting("SQLS", "Settings", "DBConnect_" & CStr(i), msDBConnect(i))
    Next i
    i = 0
    msDBName(i) = cboDB
    msDBConnect(i) = txtDB
    Call SaveSetting("SQLS", "Settings", "DBName_" & CStr(i), msDBName(i))
    Call SaveSetting("SQLS", "Settings", "DBConnect_" & CStr(i), msDBConnect(i))
    Call SaveSetting("SQLS", "Settings", "DBNum", i)

ErrExit:      Exit Sub
ErrHandler:   Call ErrorHandler(Name, 0, "SaveSetup")
End Sub
Private Sub lstTables_Click()
If gbErrorHandSwitch Then On Error GoTo ErrHandler
    msTableName = lstTables.Text
ErrExit:      Exit Sub
ErrHandler:   Call ErrorHandler(Name, 0, "lstTables_Click")
End Sub

Private Function SQLFormat(sSql As String) As String
If gbErrorHandSwitch Then On Error GoTo ErrHandler
    Dim s As String, i As Integer
    Dim iStart As Integer, iEnd As Integer
    
    s = sSql
    
    s = Replace(s, " _" & vbCrLf, "")
    s = Replace(s, "_ ", "")
    s = Replace(s, vbCrLf, "")
    s = Replace(s, "& """, "")
    s = Replace(s, """ &", "")
    s = Replace(s, "_ &", "")
    s = Replace(s, """", "")
    s = Replace(s, "Select ", " SELECT ")
    s = Replace(s, "select ", " SELECT ")
    s = Replace(s, Chr(32), " ")
    s = Replace(s, " On ", " ON ")
    s = Replace(s, " on ", " ON ")
    s = Replace(s, " Inner ", " INNER ")
    s = Replace(s, " inner ", " INNER ")
    s = Replace(s, " Join", " JOIN ")
    s = Replace(s, " join", " JOIN ")
    s = Replace(s, " left ", " LEFT ")
    s = Replace(s, " left ", " LEFT ")
    s = Replace(s, " Outer ", " OUTER ")
    s = Replace(s, " outer ", " OUTER ")
    s = Replace(s, " Right ", " RIGHT ")
    s = Replace(s, " right ", " RIGHT ")
    s = Replace(s, " Union ", " UNION ")
    s = Replace(s, " union ", " UNION ")
    s = Replace(s, " From ", " FROM ")
    s = Replace(s, " from ", " FROM ")
    s = Replace(s, " Where ", " WHERE ")
    s = Replace(s, " where ", " WHERE ")
    s = Replace(s, " Order ", " ORDER ")
    s = Replace(s, " order ", " ORDER ")
    s = Replace(s, " Group ", " GROUP ")
    s = Replace(s, " group ", " GROUP ")
    s = Replace(s, " By ", " BY ")
    s = Replace(s, " by ", " BY ")
    s = Replace(s, " Or ", " OR ")
    s = Replace(s, " or ", " OR ")
    s = Replace(s, " And ", " AND ")
    s = Replace(s, " and ", " AND ")
    For i = 1 To 20
        s = Replace(s, Space(2), Space(1))
    Next
    
    If chkPartial = 0 Then
        s = Replace(s, "SELECT ", vbCrLf & " SELECT ")
        s = Replace(s, Chr(32), " ")
        s = Replace(s, " ON ", vbCrLf & " ON ")
    '    s = Replace(s, "on ", vbCrLf & "ON ")
        s = Replace(s, " INNER ", vbCrLf & " INNER ")
'        s = Replace(s, " JOIN ", vbCrLf & " JOIN ")
        s = Replace(s, " LEFT ", vbCrLf & " LEFT ")
'        s = Replace(s, " OUTER ", vbCrLf & " OUTER ")
        s = Replace(s, " RIGHT ", vbCrLf & " RIGHT ")
        s = Replace(s, " UNION  ", vbCrLf & " UNION ")
        s = Replace(s, " FROM ", vbCrLf & " FROM ")
        s = Replace(s, " WHERE ", vbCrLf & " WHERE ")
        s = Replace(s, " ORDER ", vbCrLf & " ORDER ")
        s = Replace(s, " GROUP ", vbCrLf & " GROUP ")
        s = Replace(s, " BY ", vbCrLf & " BY ")
        s = Replace(s, " OR ", vbCrLf & " OR ")
        s = Replace(s, " AND ", vbCrLf & " AND ")
        s = Replace(s, ",", "," & vbCrLf & Space(8))
        s = Replace(s, vbCrLf, """" & vbCrLf & "sSql = sSql & """)
        
        For i = 1 To 10
            s = Replace(s, Space(9), Space(8))
        Next
        s = Replace(s, "sSql = sSql & "" SELECT", "sSql = ""SELECT")
        s = Right(s, Len(s) - 3)
    End If
    
    If chkContinue <> 0 Then
        s = Replace(s, vbCrLf, " _" & vbCrLf)
        s = Replace(s, "sSql = sSql & ", " & ")
    End If
    
    SQLFormat = s
    
ErrExit:      Exit Function
ErrHandler:   Call ErrorHandler(Name, 0, "SQLFormat")
End Function