frmsqlbuilder.frm

很好！ 很实用！ 免费！

            Add "      g_cn.Execute sSQL"
            Add "      If Err.Number = 0 Then"
            Add "         g_cn.CommitTrans"
            Add "         'Add Log*********************'"
            Add "         g_System.AddLog " + Chr(34) + txtTable.Text + Chr(34) + ",sSQL"
            Add "         Insert = True"
            Add "      Else"
            Add "         g_cn.RollbackTrans"
            Add "         Insert = False"
            Add "         Err.Clear"
            Add "      End If"
            Add "End Function"
        
            'Busy
            g_Busy.Caption = "build update"
            If Not g_Busy.ScheduleValueAdd() Then Exit Sub
        
            'build update
            Add "'" + txtTable.Text + " Update SQL"
            Add "Public function Update() as boolean"
            Add "On Error Resume Next"
                
            Add "    sSQL=" + Chr(34) + Chr(34)
        
            Add "    sSQL=sSQL+" + Chr(34) + " update " + txtTable.Text + " Set " + Chr(34)
            sTemp = ""
            rs.MoveFirst
            Do While Not rs.EOF
                'Busy
                If Not g_Busy.ScheduleValueAdd() Then Exit Sub
                If rs("ColName").value = "ID" Or rs("ColName").value = "CreateDate" Then
                ElseIf rs("ColName").value = "OperatorID" Then
                    sTemp = sTemp + "    sSQL=sSQL+" + Chr(34) + rs("ColName").value + "=" + Chr(34) + "+"
                    sTemp = sTemp + "CheckString(g_sUserID)"
                    sTemp = sTemp + "+" + Chr(34) + "," + Chr(34)
                ElseIf rs("ColName").value = "ModifyDate" Then
                    sTemp = sTemp + "    sSQL=sSQL+" + Chr(34) + rs("ColName").value + "=" + Chr(34) + "+"
                    sTemp = sTemp + Chr(34) + "getDate()" + Chr(34)
                    sTemp = sTemp + "+" + Chr(34) + "," + Chr(34)
                Else
                    sTemp = sTemp + "    sSQL=sSQL+" + Chr(34) + rs("ColName").value + "=" + Chr(34) + "+"
                    Select Case rs("ColType").value
                        Case "String"
                            sTemp = sTemp + "CheckString(m_" + rs("ColName").value + ")"
                        Case "Long"
                            If Right(rs("ColName").value, 2) = "ID" Then
                                sTemp = sTemp + "stringToNull(m_" + rs("ColName").value + ",2)"
                            Else
                                sTemp = sTemp + "CStr(m_" + rs("ColName").value + ")"
                            End If
                        Case "Double"
                            sTemp = sTemp + Chr(34) + "convert(Float," + Chr(34) + "+CheckString(m_" + rs("ColName").value + ")+" + Chr(34) + ")" + Chr(34)
                        Case "Date"
                            sTemp = sTemp + Chr(34) + "convert(Datetime," + Chr(34) + "+CheckString(m_" + rs("ColName").value + ")+" + Chr(34) + ")" + Chr(34)
                    End Select
                    sTemp = sTemp + "+" + Chr(34) + "," + Chr(34)
                End If
                
                rs.MoveNext
                If sTemp > "" Then
                    If rs.EOF Then
                        sTemp = Mid(sTemp, 1, Len(sTemp) - 4)
                    End If
                    Add sTemp
                End If
                sTemp = ""
            Loop
            Add "    sSQL=sSQL+" + Chr(34) + " where ID=" + Chr(34) + "+checkString(m_ID)"
            Add "    g_cn.BeginTrans"
            Add "      g_cn.Execute sSQL"
            Add "      If Err.Number = 0 Then"
            Add "         g_cn.CommitTrans"
            Add "         'Add Log*********************'"
            Add "         g_System.AddLog " + Chr(34) + txtTable.Text + Chr(34) + ",sSQL"
            Add "         Update = True"
            Add "      Else"
            Add "         g_cn.RollbackTrans"
            Add "         Update = False"
            Add "         Err.Clear"
            Add "      End If"
            Add "End Function"
            'Busy
            g_Busy.Caption = "build delete"
            If Not g_Busy.ScheduleValueAdd() Then Exit Sub
        
            'build delete
            Add "'" + txtTable.Text + " Delete SQL"
            Add "Public function Delete() as boolean"
            Add "On Error Resume Next"
                
            Add "    sSQL=" + Chr(34) + Chr(34)
        
            Add "    sSQL=sSQL+" + Chr(34) + " Delete " + txtTable.Text + " where ID=" + Chr(34) + "+checkString(m_ID)"
            Add "    g_cn.BeginTrans"
            Add "      g_cn.Execute sSQL"
            Add "      If Err.Number = 0 Then"
            Add "         g_cn.CommitTrans"
            Add "         'Add Log*********************'"
            Add "         g_System.AddLog " + Chr(34) + txtTable.Text + Chr(34) + ",sSQL"
            Add "         Delete = True"
            Add "      Else"
            Add "         g_cn.RollbackTrans"
            Add "         Delete = False"
            Add "         Err.Clear"
            Add "      End If"
            Add "End Function"
        
            'Busy
            g_Busy.Caption = "fill by ID"
            If Not g_Busy.ScheduleValueAdd() Then Exit Sub
            'fill by ID ,根据ID填充本对象
            Add "'" + txtTable.Text + " Fill By ID SQL ,根据ID填充本对象"
            Add "'参数  iID:对象的ID值"
            Add "Public function FillByID(byval sID as string) as boolean"
            Add "Dim rsTemp As ADODB.Recordset "
            Add "    Set rsTemp = New ADODB.Recordset"
                
            Add "    sSQL=" + Chr(34) + Chr(34)
            Add "    sSQL=sSQL+" + Chr(34) + " Select * from " + txtTable.Text + " where ID=" + Chr(34) + "+checkString(sID)"
            Add "    rsTemp.Open sSQL, g_cn"
            Add "      If rsTemp.RecordCount > 0 Then"
            rs.MoveFirst
            Do While Not rs.EOF
                'Busy
                If Not g_Busy.ScheduleValueAdd() Then Exit Sub
                Add "         m_" + rs("ColName").value + "=rsTemp.Fields(" + Chr(34) + rs("ColName").value + Chr(34) + ").Value"
            rs.MoveNext
            Loop
            Add "         FillByID = True"
            Add "      Else"
            Add "         FillByID = False"
            Add "      End If"
            Add "End Function"
            
            'Busy
            g_Busy.Caption = "GetList"
            If Not g_Busy.ScheduleValueAdd() Then Exit Sub
            'getList
            Add "'" + txtTable.Text + " get List Recordset SQL,根据条件返回本数据库的记录集"
            Add "'参数  sFields:查找到的记录集的字段列表;sWhere:找到记录的条件;sOrder:记录集的排序字段及方式"
            Add "Public function GetList(optional byval sFields as string =" + Chr(34) + "*" + Chr(34) + ",optional byval sWhere as String=" + Chr(34) + Chr(34) + ",optional byval sOrder as string =" + Chr(34) + Chr(34) + ") as RecordSet"
            Add "Dim rsTemp As ADODB.Recordset "
            Add "    Set rsTemp = New ADODB.Recordset"
            Add "    sSQL=" + Chr(34) + Chr(34)
            Add "    sSQL=sSQL+" + Chr(34) + " Select " + Chr(34) + "+ sFields +" + Chr(34) + " from " + txtTable.Text
            Add "    if Len(sWhere)>0 then "
            Add "       sSQL=sSQL+" + Chr(34) + " where " + Chr(34) + "+ sWhere "
            Add "    end if"
            Add "    if Len(sOrder)>0 then "
            Add "       sSQL=sSQL+" + Chr(34) + " Order by " + Chr(34) + "+ sOrder "
            Add "    end if"
            Add "    rsTemp.Open sSQL, g_cn"
            Add "    Set GetList=rsTemp"
            Add "End Function"
            
            'Busy
            g_Busy.Caption = "get Recordset by ID"
            If Not g_Busy.ScheduleValueAdd() Then Exit Sub
            'get Recordset by ID  根据ID返回本数据库的记录集
            Add "'" + txtTable.Text + " get Recordset By ID SQL,根据ID返回本数据库的记录集"
            Add "'参数  iID:对象的ID值;sFields:查找到的记录集的字段列表;sOrder:记录集的排序字段及方式"
            Add "Public function GetRecordsetByID(byval sID as string,optional byval sFields as string =" + Chr(34) + "*" + Chr(34) + ",optional byval sOrder as string =" + Chr(34) + Chr(34) + ") as ADODB.Recordset"
            Add "Dim rsTemp As ADODB.Recordset "
            Add "    Set rsTemp = New ADODB.Recordset"
                
            Add "    sSQL=" + Chr(34) + Chr(34)
            Add "    sSQL=sSQL+" + Chr(34) + " Select " + Chr(34) + "+ sFields +" + Chr(34) + " from " + txtTable.Text + " where ID=" + Chr(34) + "+checkString(sID)"
            Add "    if Len(sOrder)>0 then "
            Add "       sSQL=sSQL+" + Chr(34) + " Order by " + Chr(34) + "+ sOrder "
            Add "    end if"
            
            Add "    rsTemp.Open sSQL, g_cn"
            Add "    Set GetRecordsetByID=rsTemp"
            Add "End Function"
    'Busy
    g_Busy.Dispose
End Sub

Private Sub Form_Load()
Dim rsSysobjects As ADODB.Recordset

    Set rs = New ADODB.Recordset
    
    Set rsSysobjects = New ADODB.Recordset
    rsSysobjects.Open "select Name,ID from sysobjects where XType='U' order by Name", g_cn
    
    Do While Not rsSysobjects.EOF
        txtTable.AddItem rsSysobjects.Fields(0).value
        rsSysobjects.MoveNext
    Loop
    txtTable.ListIndex = 0
    Set rsSysobjects = Nothing
End Sub

Private Sub Form_Resize()
On Error Resume Next
    txtContent.Left = 10
    txtContent.Height = Me.Height - txtContent.Top - 200
    txtContent.Width = Me.Width - 100
    Line1.Y2 = Line1.Y1
    Line1.X2 = Me.Width
Err.Clear
End Sub

Private Sub Form_Unload(Cancel As Integer)
    g_Busy.Dispose
    Set rs = Nothing
End Sub