⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmsqlbuilder.frm

📁 很好! 很实用! 免费!
💻 FRM
📖 第 1 页 / 共 2 页
字号:
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.ocx"
Begin VB.Form frmSQLBuilder 
   Caption         =   "Form1"
   ClientHeight    =   6990
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9570
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   6990
   ScaleWidth      =   9570
   Begin VB.CommandButton cmdStart 
      Caption         =   "产生模板内容"
      Height          =   315
      Left            =   3000
      TabIndex        =   1
      Top             =   0
      Width           =   1455
   End
   Begin VB.ComboBox txtTable 
      Height          =   315
      Left            =   480
      TabIndex        =   0
      Text            =   "Combo1"
      Top             =   0
      Width           =   2535
   End
   Begin RichTextLib.RichTextBox txtContent 
      Height          =   5775
      Left            =   0
      TabIndex        =   3
      Top             =   480
      Width           =   14055
      _ExtentX        =   24791
      _ExtentY        =   10186
      _Version        =   393217
      Enabled         =   -1  'True
      ReadOnly        =   -1  'True
      ScrollBars      =   3
      Appearance      =   0
      TextRTF         =   $"frmSQLBuilder.frx":0000
   End
   Begin VB.Label lblTable 
      AutoSize        =   -1  'True
      Caption         =   "表名"
      Height          =   195
      Left            =   120
      TabIndex        =   2
      Top             =   0
      Width           =   360
   End
   Begin VB.Line Line1 
      X1              =   0
      X2              =   11040
      Y1              =   360
      Y2              =   360
   End
End
Attribute VB_Name = "frmSQLBuilder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs As ADODB.Recordset
Private Sub Add(ByVal str As String)
    txtContent.Text = txtContent.Text + str + Chr(13) + Chr(10)
End Sub

Private Sub cmdStart_Click()
Dim ws As Object
Dim sTemp As String
Dim sSQL As String
    Set ws = CreateObject("MSWinsock.Winsock")

    sSQL = ""
    txtContent.Text = " "
    
    sSQL = sSQL + " select syscolumns.name as ColName,"
    sSQL = sSQL + " case"
    sSQL = sSQL + " when systypes.name in ('int','smallint','tinyint','IDType') then  'Long'"
    sSQL = sSQL + " when systypes.name in ('decimal','float','numeric','real') then  'Double'"
    sSQL = sSQL + " when systypes.name in ('datetime','smalldatetime') then  'Date'"
    sSQL = sSQL + " Else 'String'"
    sSQL = sSQL + " End"
    sSQL = sSQL + " as 'ColType',"
    sSQL = sSQL + " sysproperties.value as ColDescription "
    sSQL = sSQL + " From syscolumns, systypes,sysproperties"
    sSQL = sSQL + " where syscolumns.id*=sysproperties.id and syscolumns.colorder*=sysproperties.smallid and syscolumns.xusertype=systypes.xusertype  and syscolumns.id in (select id from  sysobjects where name =" + CheckString(txtTable.Text) + ")"
    sSQL = sSQL + " order by syscolumns.colid"
    Set rs = g_cn.Execute(sSQL)
    If rs.RecordCount = 0 Then Exit Sub
    'Busy
    g_Busy.Show "Busy.....", vbBusySchedule, rs.RecordCount * 6 + 8
    
    Add "'***************************************************************"
    Add "'" + txtTable.Text + "类模块"
    Add "'CreateTime:" + CStr(Now) + ";Editor:" + NTDomainUserName
    Add "'ComputerIP:" + ws.LocalIP + ";ComputerName:" + ws.LocalHostName
    Add "'***************************************************************"
    Add "Option Explicit"
             'Busy
            g_Busy.Caption = "define var"
            If Not g_Busy.ScheduleValueAdd() Then Exit Sub
           'define var
            Add "'*****************************************"
            Do While Not rs.EOF
                'Busy
                If Not g_Busy.ScheduleValueAdd() Then Exit Sub

                If rs("ColName").value = "ID" Then
                    Add "Public  m_" + rs("ColName").value + " as " + rs("ColType").value + "'DBO." + txtTable.Text + "." + rs("ColName").value + ";描述:" + nullToString(rs("ColDescription").value, 1) + ";主键"
                ElseIf rs("ColName").value = "CreateDate" Then
                    Add "Private m_" + rs("ColName").value + " as " + rs("ColType").value + "'DBO." + txtTable.Text + "." + rs("ColName").value + ";描述:" + nullToString(rs("ColDescription").value, 1) + ";记录加入的时间,在Insert的时候取值getDate(),在Update的时候不用修改"
                ElseIf rs("ColName").value = "ModifyDate" Then
                    Add "Private m_" + rs("ColName").value + " as " + rs("ColType").value + "'DBO." + txtTable.Text + "." + rs("ColName").value + ";描述:" + nullToString(rs("ColDescription").value, 1) + ";记录最后修改的时间,在Insert的时候取值getDate(),在Update的时候也取值getDate()"
                ElseIf rs("ColName").value = "OperatorID" Then
                    Add "Public  m_" + rs("ColName").value + " as " + rs("ColType").value + "'DBO." + txtTable.Text + "." + rs("ColName").value + ";描述:" + nullToString(rs("ColDescription").value, 1) + ";记录操作人的ID,从模块中的g_sUserID得到"
                Else
                    Add "Public  m_" + rs("ColName").value + " as " + rs("ColType").value + "'DBO." + txtTable.Text + "." + rs("ColName").value + ";描述:" + nullToString(rs("ColDescription").value, 1) + ";"
                End If
            rs.MoveNext
            Loop
            Add "'*****************************************"
            Add "Dim sSQL as String "
            
            'Busy
            g_Busy.Caption = "build templet"
            If Not g_Busy.ScheduleValueAdd() Then Exit Sub
            
            Add "'" + txtTable.Text + " Templet在给对象赋值时使用,可以少写不少代码..."
            Add "'Public function Templet() as boolean"
            Add "'On Error Resume Next"
            rs.MoveFirst
            Do While Not rs.EOF
                sTemp = "       '"
                'Busy
                If Not g_Busy.ScheduleValueAdd() Then Exit Sub
                
                sTemp = sTemp + ".m_" + rs("ColName").value + "=" + Chr(34) + Chr(34)
                rs.MoveNext
                Add sTemp
            Loop
            Add "'End Function"
            
            Add ""
            Add "'修改数据开始"
            'Busy
            g_Busy.Caption = "build insert"
            If Not g_Busy.ScheduleValueAdd() Then Exit Sub
            
            'build insert
            Add "'" + txtTable.Text + " Insert SQL"
            Add "Public function Insert() as boolean"
            Add "On Error Resume Next"
                
            Add "   sSQL=" + Chr(34) + Chr(34)
        
            Add "   sSQL=sSQL+" + Chr(34) + " insert into " + txtTable.Text
            Add "   sSQL=sSQL+" + Chr(34) + " (" + Chr(34)
            sTemp = ""
            rs.MoveFirst
            Do While Not rs.EOF
                'Busy
                If Not g_Busy.ScheduleValueAdd() Then Exit Sub
                sTemp = sTemp + rs("ColName").value + ","
                
            rs.MoveNext
            Loop
            Add "   sSQL=sSQL+" + Chr(34) + Mid(sTemp, 1, Len(sTemp) - 1) + Chr(34)
            Add "   sSQL=sSQL+" + Chr(34) + ") Values (" + Chr(34)
            sTemp = ""
            rs.MoveFirst
            Do While Not rs.EOF
                'Busy
                If Not g_Busy.ScheduleValueAdd() Then Exit Sub
                If rs("ColName").value = "OperatorID" Then
                        sTemp = sTemp + "   sSQL=sSQL+"
                        sTemp = sTemp + "Checkstring(g_sUserID)"
                        sTemp = sTemp + "+" + Chr(34) + "," + Chr(34)
                ElseIf rs("ColName").value = "CreateDate" Or rs("ColName").value = "ModifyDate" Then
                        sTemp = sTemp + "   sSQL=sSQL+"
                        sTemp = sTemp + Chr(34) + "getDate()" + Chr(34)
                        sTemp = sTemp + "+" + Chr(34) + "," + Chr(34)
                Else
                        sTemp = sTemp + "   sSQL=sSQL+"
                        Select Case rs("ColType").value
                            Case "String"
                                sTemp = sTemp + "CheckString(m_" + rs("ColName").value + ")"
                            Case "Long"
                                sTemp = sTemp + "CStr(m_" + rs("ColName").value + ")"
                            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) + ")" + Chr(34)
            Add "   g_cn.BeginTrans"

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -