frmtest.frm

一个由VB开发的。NET实体生成器` 提高.net代码质量及开发效率

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain 
   Caption         =   "实体生成器 V2.2 06-9-18 CTP"
   ClientHeight    =   4140
   ClientLeft      =   1860
   ClientTop       =   645
   ClientWidth     =   5115
   Icon            =   "frmTest.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   ScaleHeight     =   4140
   ScaleWidth      =   5115
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox cmbNamespace 
      Height          =   300
      Left            =   1440
      TabIndex        =   17
      Top             =   960
      Width           =   3465
   End
   Begin VB.ComboBox txtSource 
      Height          =   300
      Left            =   1440
      TabIndex        =   13
      Top             =   540
      Width           =   2595
   End
   Begin VB.Frame Frame1 
      Caption         =   "存储路径"
      Height          =   1815
      Left            =   240
      TabIndex        =   8
      Top             =   1350
      Width           =   4695
      Begin VB.ComboBox txtTargetSQL 
         Enabled         =   0   'False
         Height          =   300
         Left            =   180
         TabIndex        =   15
         Top             =   1320
         Width           =   4305
      End
      Begin VB.ComboBox txtTargetCSharp 
         Height          =   300
         Left            =   180
         TabIndex        =   14
         Top             =   600
         Width           =   4305
      End
      Begin VB.CheckBox chkMakingExtends 
         Caption         =   "生成扩展实体类"
         Height          =   195
         Left            =   1560
         TabIndex        =   11
         Top             =   300
         Width           =   1575
      End
      Begin VB.CheckBox chkSQL 
         Caption         =   "SQL 数据库创建代码路径"
         Enabled         =   0   'False
         Height          =   195
         Left            =   180
         TabIndex        =   10
         Top             =   1020
         Width           =   4095
      End
      Begin VB.CheckBox chkCSharp 
         Caption         =   "C# 代码文件"
         Height          =   195
         Left            =   180
         TabIndex        =   9
         Top             =   300
         Width           =   1395
      End
   End
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "关闭(&C)"
      Height          =   495
      Left            =   4080
      TabIndex        =   6
      Top             =   3330
      Width           =   855
   End
   Begin VB.ComboBox cmbConnectionType 
      Height          =   300
      ItemData        =   "frmTest.frx":08CA
      Left            =   1440
      List            =   "frmTest.frx":08D4
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   120
      Width           =   3465
   End
   Begin MSComctlLib.ProgressBar ProgressBar 
      Height          =   315
      Left            =   240
      TabIndex        =   3
      Top             =   3300
      Width           =   1455
      _ExtentX        =   2566
      _ExtentY        =   556
      _Version        =   393216
      Appearance      =   1
      Max             =   1
      Scrolling       =   1
   End
   Begin MSComDlg.CommonDialog cdlDialog 
      Left            =   0
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "DAL配置文件(*.XML)|*.XML|DAL配置文件(*.DAL)|*.DAL"
   End
   Begin VB.CommandButton cmdSelectFile 
      Caption         =   "打开(&O)"
      Height          =   315
      Left            =   4110
      TabIndex        =   2
      Top             =   540
      Width           =   795
   End
   Begin VB.CommandButton Command1 
      Caption         =   "生成(&E)"
      Default         =   -1  'True
      Height          =   495
      Left            =   3060
      TabIndex        =   0
      Top             =   3330
      Width           =   855
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "全局命名空间："
      Height          =   180
      Left            =   240
      TabIndex        =   16
      Top             =   1020
      Width           =   1260
   End
   Begin VB.Label lblStatus 
      AutoSize        =   -1  'True
      Caption         =   "当前状态："
      Height          =   180
      Left            =   240
      TabIndex        =   12
      Top             =   3810
      Width           =   900
   End
   Begin VB.Label lblParcent 
      AutoSize        =   -1  'True
      Caption         =   "操作进度 0%"
      Height          =   180
      Left            =   1830
      TabIndex        =   7
      Top             =   3390
      Width           =   990
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "连接类型："
      Height          =   180
      Left            =   240
      TabIndex        =   5
      Top             =   180
      Width           =   900
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "配置文件源："
      Height          =   180
      Left            =   240
      TabIndex        =   1
      Top             =   600
      Width           =   1080
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuOpen 
         Caption         =   "打开(&O)"
      End
      Begin VB.Menu mnuRun 
         Caption         =   "生成(&R)"
      End
      Begin VB.Menu bar1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuClearHistories 
         Caption         =   "清除历史记录(&H)"
      End
      Begin VB.Menu bar3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出(&E)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuC 
         Caption         =   "说明(&C)"
      End
      Begin VB.Menu mnuAbout 
         Caption         =   "关于(&A)"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private WithEvents coder As clsCSharpCoder
Attribute coder.VB_VarHelpID = -1
Private WithEvents SQLCoder As clsSQLCoder
Attribute SQLCoder.VB_VarHelpID = -1

Private Sub chkCSharp_Click()
    If chkCSharp.Value = 1 Then
        txtTargetCSharp.Enabled = True
        chkMakingExtends.Enabled = True
    Else
        txtTargetCSharp.Enabled = False
        chkMakingExtends.Enabled = False
    End If
End Sub

Private Sub chkSQL_Click()
'    If chkSQL.Value = 1 Then
'        txtTargetSQL.Enabled = True
'    Else
'        txtTargetSQL.Enabled = False
'    End If
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdSelectFile_Click()
    cdlDialog.ShowOpen
    If cdlDialog.CancelError = False And cdlDialog.FileName <> "" Then
        txtSource.Text = cdlDialog.FileName
    End If
End Sub

Private Sub coder_ClassExported(ByVal ClassName As String)
    lblStatus.Caption = "当前状态：类 " & ClassName & " 已完成"
End Sub

Private Sub coder_ExportCompleted()
    lblStatus.Caption = "当前状态：全部完成"
End Sub

Private Sub coder_ExportingClass(ByVal ClassName As String)
    lblStatus.Caption = "当前状态：正在生成 " & ClassName & " 类"
End Sub

Private Sub coder_ExportStep(ByVal Value As Long)
    ProgressBar.Value = Value
    lblParcent.Caption = "操作进度 " & Int(Value / ProgressBar.Max * 100) & "%"
End Sub

Private Sub coder_InitCompleted(ByVal MaxValue As Long)
    ProgressBar.Min = 0
    ProgressBar.Max = MaxValue
End Sub

Private Sub coder_MakingExtends(Cancel As Boolean)
    If chkMakingExtends.Value <> vbChecked Then
        Cancel = True
    End If
End Sub

Private Sub Command1_Click()
On Error GoTo err1
    If txtSource.Text = "" Then
        MsgBox "请选择配置文件源", vbExclamation, "提示"
        Exit Sub
    End If

'    If cmbNamespace.Text = "" Then
'        MsgBox "请输入全局命名空间", vbExclamation, "提示"
'        Exit Sub
'    End If
    
    If txtTargetCSharp.Text = "" Then
        MsgBox "请输入目标存储路径", vbExclamation, "提示"
        Exit Sub
    End If
    
    If chkMakingExtends.Value = vbChecked Then
        If MsgBox("诺发现已存在文件将予以覆盖，您确定吗？", vbYesNo + vbQuestion, "是否创建实体类") = vbNo Then
            Exit Sub
        End If
    End If
    
    If chkCSharp.Value = vbChecked Then
        'is C#
        If cmbConnectionType.ListIndex = 0 Then
            coder.Init Sql, txtSource.Text, cmbNamespace.Text
        Else
            coder.Init OleDb, txtSource.Text, cmbNamespace.Text
        End If
        coder.ExportCode txtTargetCSharp.Text
    End If
    
    If chkSQL.Value = vbChecked Then
        'is SQL
        SQLCoder.Init txtSource.Text
        SQLCoder.ExportCode txtTargetSQL.Text
    End If
    
    chkMakingExtends.Value = vbUnchecked
    
    '核对路径列表被改动的项如不在列表中存在则删除
    With txtSource
        For i = 0 To .ListCount - 1
            If .List(i) = .Text Then Exit For
        Next i
        If i = .ListCount Then .AddItem .Text
    End With
    
    With txtTargetCSharp
        For i = 0 To .ListCount - 1
            If .List(i) = .Text Then Exit For
        Next i
        If i = .ListCount Then .AddItem .Text
    End With
    
    With cmbNamespace
        For i = 0 To .ListCount - 1
            If .List(i) = .Text Then Exit For
        Next i
        If i = .ListCount Then .AddItem .Text
    End With
    
    With txtTargetSQL
        For i = 0 To .ListCount - 1
            If .List(i) = .Text Then Exit For
        Next i
        If i = .ListCount Then .AddItem .Text
    End With
    Exit Sub
err1:
    MsgBox Err.Description, vbCritical & vbCrLf & "错误代码：" & Err.Number, "发现错误"
End Sub


Private Sub Form_Load()
    Dim tmpTexts As String
    Dim i As Long
    Set coder = New clsCSharpCoder
    Set SQLCoder = New clsSQLCoder
    cmbConnectionType.ListIndex = 1
    
    Dim cfgFile As New DOMDocument
    If cfgFile.Load(App.Path & "\" & "config.cfg") = True Then
        With cfgFile
            For i = 0 To cmbConnectionType.ListCount - 1
                If cmbConnectionType.List(i) = .getElementsByTagName("DefaultConnection")(0).Text Then
                    cmbConnectionType.ListIndex = i
                    Exit For
                End If
            Next i
            
            For i = 0 To .getElementsByTagName("SourceFiles")(0).childNodes.length - 1
                txtSource.AddItem .getElementsByTagName("SourceFiles")(0).childNodes(i).Text
            Next i
            txtSource.ListIndex = txtSource.ListCount - 1
            
            For i = 0 To .getElementsByTagName("Namespace")(0).childNodes.length - 1
                cmbNamespace.AddItem .getElementsByTagName("Namespace")(0).childNodes(i).Text
            Next i
            cmbNamespace.ListIndex = cmbNamespace.ListCount - 1
            
            chkCSharp.Value = .getElementsByTagName("CheckedCSharp")(0).Text
            chkMakingExtends.Value = .getElementsByTagName("CheckedExtends")(0).Text
            
            For i = 0 To .getElementsByTagName("OutputCSFiles")(0).childNodes.length - 1
                txtTargetCSharp.AddItem .getElementsByTagName("OutputCSFiles")(0).childNodes(i).Text
            Next i
            txtTargetCSharp.ListIndex = txtTargetCSharp.ListCount - 1
            
            chkSQL.Value = .getElementsByTagName("CheckedSQL")(0).Text
            
            For i = 0 To .getElementsByTagName("OutputSQLFiles")(0).childNodes.length - 1
                txtTargetSQL.AddItem .getElementsByTagName("OutputSQLFiles")(0).childNodes(i).Text
            Next i
            txtTargetSQL.ListIndex = txtTargetSQL.ListCount - 1
        End With
    End If
    Set cfgFile = Nothing
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim i As Integer
    Dim cfgDoc As New DOMDocument, textChild As IXMLDOMNode
    cfgDoc.Load App.Path & "\configTemplete.cfg"
    
    cfgDoc.getElementsByTagName("DefaultConnection")(0).Text = cmbConnectionType.List(cmbConnectionType.ListIndex)
    
    cfgDoc.getElementsByTagName("SourceFiles")(0).cloneNode True
    For i = 0 To txtSource.ListCount - 1
        Set textChild = cfgDoc.createElement("Item")
        textChild.Text = txtSource.List(i)
        cfgDoc.getElementsByTagName("SourceFiles")(0).appendChild textChild
    Next i
    
    cfgDoc.getElementsByTagName("CheckedCSharp")(0).Text = chkCSharp.Value
    cfgDoc.getElementsByTagName("CheckedExtends")(0).Text = chkMakingExtends.Value
    
    cfgDoc.getElementsByTagName("OutputCSFiles")(0).childNodes.Reset
    For i = 0 To txtTargetCSharp.ListCount - 1
        Set textChild = cfgDoc.createElement("Item")
        textChild.Text = txtTargetCSharp.List(i)
        cfgDoc.getElementsByTagName("OutputCSFiles")(0).appendChild textChild
    Next i
    
    For i = 0 To cmbNamespace.ListCount - 1
        Set textChild = cfgDoc.createElement("Item")
        textChild.Text = cmbNamespace.List(i)
        cfgDoc.getElementsByTagName("Namespace")(0).appendChild textChild
    Next i
    
    
    cfgDoc.getElementsByTagName("CheckedSQL")(0).Text = chkSQL.Value
    
    cfgDoc.getElementsByTagName("OutputSQLFiles")(0).childNodes.Reset
    For i = 0 To txtTargetSQL.ListCount - 1
        Set textChild = cfgDoc.createElement("Item")
        textChild.Text = txtTargetSQL.List(i)
        cfgDoc.getElementsByTagName("OutputSQLFiles")(0).appendChild textChild
    Next i
    
    cfgDoc.save App.Path & "\config.cfg"
End Sub

Private Sub mnuAbout_Click()
    MsgBox "作者：林伟" & vbCrLf & "QQ:630843" & vbCrLf & "E-mail:[e-mail]" & vbCrLf & vbCrLf & "您的共享将改变中国软件产业的命运" & vbCrLf & vbCrLf & "               www.eachkind.com", vbInformation, "版权所有"
End Sub

Private Sub mnuClearHistories_Click()
    FileCopy App.Path & "\configTemplete.cfg", App.Path & "\config.cfg"
    txtSource.Clear
    txtTargetCSharp.Clear
    txtTargetSQL.Clear
    cmbNamespace.Clear
End Sub

Private Sub mnuExit_Click()
    cmdClose_Click
End Sub

Private Sub mnuOpen_Click()
    cmdSelectFile_Click
End Sub

Private Sub mnuRun_Click()
    Command1_Click
End Sub