Public m_Sql As String Public m_lbls As String Public m_View As Integer '0C create 1R retrieve 2 U update D delete Public m_mcbo As Integer ' Public m_scbo As Integer ' Public m_Conn As CSealConnection Private sRs As New CSealRecordset Private m_Count As Integer Private m_iShow As Integer Dim flabel() As String Dim fname() As String Dim fshow() As Integer Dim fvalue() As String Dim fsql() As String Public m_bFinished As Boolean 'Public m_ModTable As String Private Sub prepare() Dim k As Integer m_Count = 0 m_iShow = 0 If Len(Trim$(m_lbls)) > 0 Then Dim tmp() As String, fs() As String sRs.COpen m_Sql, m_Conn, 1, 3, 1 If sRs.RecordCount = 0 And m_View > 0 Then Exit Sub tmp = Split(m_lbls, ";") m_Count = UBound(tmp) ReDim fname(m_Count) ReDim flabel(m_Count) ReDim fshow(m_Count) ReDim fsql(m_Count) ReDim fvalue(m_Count) For k = 0 To UBound(tmp) fs = Split(tmp(k), "#") flabel(k) = Trim(fs(0)) fname(k) = Trim(fs(1)) fshow(k) = Val(fs(2)) If UBound(fs) > 2 Then fsql(k) = fs(3) If Val(fs(2)) > 0 Then m_iShow = m_iShow + 1 If m_View > 0 Then fvalue(k) = sRs.GetFieldValue(fname(k)) Next k m_Count = UBound(fname) + 1 sRs.CClose End If End Sub

For k = 0 To m_Count - 1 If k > 0 Then Load txtFieldValue(k) Load lblFieldName(k) Load cboEnum(k) End If If fshow(k) = 0 Then txtFieldValue(k).Visible = False: lblFieldName(k).Visible = False: cboEnum(k).Visible = False Else lblFieldName(k).Visible = True: lblFieldName(k).Caption = flabel(k) lblFieldName(k).Left = lblFieldName(0).Left: lblFieldName(k).Top = txtFieldValue(0).Top + iShow * (txtFieldValue(0).Height + 100) If fshow(k) = 2 Then '索引其他表 fillCombEnum cboEnum(k), fsql(k), fvalue(k) 'sRs.GetFieldValue(fname(k)) If k = m_scbo Then cboEnum_Click m_mcbo cboEnum(k).Visible = True: txtFieldValue(k).Visible = False cboEnum(k).Left = txtFieldValue(0).Left: cboEnum(k).Top = lblFieldName(k).Top Else ' fshow(k) = 1 Or fshow(k) = 3 Or fshow(k) = 9 Then '文本框 txtFieldValue(k).Text = fvalue(k) txtFieldValue(k).Visible = True: cboEnum(k).Visible = False txtFieldValue(k).Left = txtFieldValue(0).Left: txtFieldValue(k).Top = lblFieldName(k).Top End If If fshow(k) = 3 Then '時間類型 txtFieldValue(k) = Format(fvalue(k), "yyyy-mm-dd") End If If m_View = 1 Or fshow(k) = 9 Then '字段不可改，或虛擬字段 txtFieldValue(k).Enabled = False cboEnum(k).Locked = True End If iShow = iShow + 1 End If Next k

'DATABASE層 '封裝數據庫連接源,及其操作.

'打開到數據源的連接 '##ModelId=384A0336023A Public Sub COpen(Optional ConnectionString As String, Optional szUser As String, Optional szPwd As String, Optional OpenOption As Integer = ⑴) On Error GoTo COpenErr 'your code goes here... If ConnectionString <> "" Then m_ConnectString = ConnectionString End If TranslateString m_ConnectString adoConn.Open m_ConnectString, szUser, szPwd, OpenOption m_State = adoConn.State iErrNum = 0 szErrmsg = "" Exit Sub COpenErr: iErrNum = Err.Number szErrmsg = Err.Description 'Call RaiseError(MyUnhandledError, "CSealConnection:COpen Method") End Sub '啟動新的事務。 '用于返回唆使事務嵌套層次的長整型變量.' '##ModelId=384A06930028 Public Function BeginTrans() As Long On Error GoTo BeginTransErr BeginTrans = adoConn.BeginTrans() 'your code goes here... iErrNum = 0 szErrmsg = "" Exit Function BeginTransErr: iErrNum = Err.Number szErrmsg = Err.Description BeginTrans = 0 'Call RaiseError(MyUnhandledError, "CSealConnection:BeginTrans Method") End Function '保存所有更改并結束當前事務。它也能夠啟動新事務 '##ModelId=384A07000078 Public Sub CommitTrans() On Error GoTo CommitTransErr 'your code goes here... adoConn.CommitTrans iErrNum = 0 szErrmsg = "" Exit Sub CommitTransErr: iErrNum = Err.Number szErrmsg = Err.Description ' Call RaiseError(MyUnhandledError, "CSealConnection:CommitTrans Method") End Sub '取消當前事務中所做的任何更改并結束事務。它也能夠啟動新事務。 ' '##ModelId=384A07390014 Public Sub RollbackTrans() On Error GoTo RollbackTransErr 'your code goes here... adoConn.RollbackTrans iErrNum = 0 szErrmsg = "" Exit Sub RollbackTransErr: iErrNum = Err.Number szErrmsg = Err.Description 'Call RaiseError(MyUnhandledError, "CSealConnection:RollbackTrans Method") End Sub '關閉CSealConnection對象 '##ModelId=384A08EA0032 Public Sub CClose() On Error GoTo CCloseErr 'your code goes here... If m_State = adStateOpen Then adoConn.Close m_State = adStateClosed End If iErrNum = 0 szErrmsg = "" Exit Sub CCloseErr: iErrNum = Err.Number szErrmsg = Err.Description 'Call RaiseError(MyUnhandledError, "CSealConnection:CClose Method") End Sub

'關閉CSealRecordset對象 '##ModelId=384B2E3902F8 Public Sub CClose() On Error GoTo CCloseErr 'your code goes here... If adoRecordset.State = adStateOpen Then adoRecordset.Close End If iErrNum = 0 szErrmsg = "" Exit Sub CCloseErr: iErrNum = Err.Number szErrmsg = Err.Description 'Call RaiseError(Err.Number, "CSealRecordset:CClose Method") End Sub 'Open 方法可打開代表基本表、查詢結果或之前保存的 Recordset 中記錄的游標。 'iBlob 是不是對2進制字段進行操作 '##ModelId=384A0ADD014A Public Sub COpen(source As String, Optional ActiveConnection As CSealConnection, Optional Cursortype As CursorTypeEnum, Optional LockType As LockTypeEnum, Optional Options As Long, Optional iBlob As Integer = 1) 'Dim myconn As New ADODB.Connection Dim dbMode As String On Error GoTo COpenErr 'your code goes here... If adoRecordset.State = adStateOpen Then adoRecordset.Close End If source = UCase(source) If ActiveConnection Is Nothing Then adoRecordset.Open source, , Cursortype, LockType, Options Else dbMode = ActiveConnection.m_DbMode Select Case dbMode Case "SQLSERVER", "SQLOLEDB", "MYSQL" adoRecordset.CursorLocation = adUseClient Case "DB2": If iBlob = 0 Then '/*沒有BLOB字段操作 adoRecordset.CursorLocation = adUseServer Else adoRecordset.CursorLocation = adUseClient End If End Select 'adoRecordset.Open source, ActiveConnection.CurConnection, Cursortype, LockType, Options adoRecordset.Open source, ActiveConnection.MyConnection, Cursortype, LockType, Options 'adoRecordset.Open Source, myconn, Cursortype, LockType, Options End If iErrNum = 0 szErrmsg = "" Exit Sub COpenErr: iErrNum = Err.Number szErrmsg = Err.Description 'Call RaiseError(Err.Number, "CSealRecordset:COpen Method") End Sub '為可更新的 Recordset 對象創建新記錄。 ' ' '##ModelId=384A0C6E03AC Public Sub AddNew() On Error GoTo AddNewErr 'your code goes here... adoRecordset.AddNew iErrNum = 0 szErrmsg = "" Exit Sub AddNewErr: iErrNum = Err.Number szErrmsg = Err.Description ''Call RaiseError(MyUnhandledError, "CSealRecordset:AddNew Method") End Sub '使用 CancelUpdate 方法可取消對當前記錄所作的任何更改或放棄新添加的記錄。除非所做的更改是可以用 RollbackTrans '方法回卷的事務的1部份，或是可以用 CancelBatch 方法取消的批更新的1部份，否則在調用 Update 方法后將沒法撤銷對當前記錄或新記錄所做的更- '- '改， ' '如果在調用 CancelUpdate 方法時添加新記錄，則調用 AddNew 之前確當前記錄將再次成為當前記錄。 ' '如果還沒有更改當前記錄或添加新記錄，調用 CancelUpdate 方法將產生毛病。 ' '##ModelId=384A0CD4033E Public Sub CancelUpdate() On Error GoTo CancelUpdateErr 'your code goes here... adoRecordset.CancelUpdate iErrNum = 0 szErrmsg = "" Exit Sub CancelUpdateErr: iErrNum = Err.Number szErrmsg = Err.Description 'Call RaiseError(Err.Number, "CSealRecordset:CancelUpdate Method") End Sub '使用 Delete 方法可標記 Recordset 對象中確當前記錄。如果 Recordset 對象不允許刪除記錄將引發毛病。使用立即更新模式將在數據庫中進行- '- '立即刪除，否則記錄將標記為從緩存刪除，實際的刪除將在調用 UpdateBatch 方法時進行 '##ModelId=384A0DAD01FE Public Sub Delete(Optional iAffectRecords As AffectEnum = adAffectCurrent) On Error GoTo DeleteErr 'your code goes here... adoRecordset.Delete iAffectRecords iErrNum = 0 szErrmsg = "" Exit Sub DeleteErr: iErrNum = Err.Number szErrmsg = Err.Description 'Call RaiseError(Err.Number, "CSealRecordset:Delete Method") End Sub

'將 Recordset 保存（持久）在文件中。 '在 Save 方法完成后，當前行位置將成為 Recordset 的首行。 ' 'FileName   可選。保存 Recordset 的文件的完全路徑名。 ' 'PersistFormat   可選。保存 Recordset 所用的格式。當前默許并唯1有效的值為 adPersistADTG。 ' '在第1次保存 Recordset 時指定 FileName。如果隨后調用 Save，應疏忽 FileName，否則將產生運行時毛病。如果隨后用新的 'FileName 調用 Save，那末 Recordset 將保存到新文件中，不過新文件和原始文件都是打開的。 ' 'Save 不關閉 Recordset 或 FileName，從而可以繼續使用 Recordset 并保存最新的更改。在 Recordset 關閉之前 'FileName 將保持打開，在這段時間其他利用程序可以讀取但不能寫入 FileName。 ' ' '##ModelId=384A117E01A4 Public Sub Save(ByVal filename As String, Optional PersistFormat As Integer)     On Error GoTo SaveErr     'your code goes here...     If Dir(filename) <> "" Then        Kill filename     End If     adoRecordset.Save filename, PersistFormat     iErrNum = 0     szErrmsg = ""     Exit Sub SaveErr:     iErrNum = Err.Number     szErrmsg = Err.Description     ''Call RaiseError(Err.Number, "CSealRecordset:Save Method") End Sub Public Sub Edit()   End Sub '保存對 Recordset 對象確當前記錄所做的所有更改 '使用 Update 方法保存自從調用 AddNew 方法，或自從現有記錄的任何字段值產生更改以后，對 Recordset 對象確當前記錄所作的所有更改。Re- 'cordset '對象必須支持更新。 ' ' '##ModelId=384A12350096 Public Sub Update()     On Error GoTo UpdateErr     'your code goes here...          '/*還要添加校驗字段的計算  By Anthony     adoRecordset.Update     iErrNum = 0     szErrmsg = ""     Exit Sub UpdateErr:     iErrNum = Err.Number     szErrmsg = Err.Description     ''Call RaiseError(MyUnhandledError, "CSealRecordset:Update Method") End Sub

'##ModelId=3855AA160334 Public Sub SetFieldValue(ByVal szFdname As String, FdValue As Variant) adoRecordset.Fields(szFdname) = FdValue End Sub '##ModelId=3855AA170280 Public Function GetFieldValue(ByVal szFdname As String) As String On Error GoTo errorhandle GetFieldValue = Trim("" & adoRecordset.Fields(szFdname)) iErrNum = 0 szErrmsg = "" Exit Function errorhandle: iErrNum = Err.Number szErrmsg = Err.Description GetFieldValue = "" End Function Public Function GetFieldValueByIndex(ByVal Index As Long) As String GetFieldValueByIndex = Trim("" & adoRecordset.Fields(Index).value) End Function '得到Field的名字 '##ModelId=3855AA18008C Public Function GetFieldName(FieldNum As Integer) As String On Error GoTo GetFieldNameErr 'your code goes here... GetFieldName = adoRecordset.Fields(FieldNum).Name iErrNum = 0 szErrmsg = "" Exit Function GetFieldNameErr: iErrNum = Err.Number szErrmsg = Err.Description 'Call RaiseError(Err.Number, "CSealRecordset:GetFieldName Method") End Function '返回Field的類型. '##ModelId=3855AA1802B2 Public Function GetFieldType(FieldNum As Integer) As DataTypeEnum On Error GoTo GetFieldTypeErr 'your code goes here... GetFieldType = adoRecordset.Fields(FieldNum).Type iErrNum = 0 szErrmsg = "" Exit Function GetFieldTypeErr: iErrNum = Err.Number szErrmsg = Err.Description 'Call RaiseError(Err.Number, "CSealRecordset:GetFieldType Method") End Function

Public Function ExecuteCmd(Optional lRowsAffected As Long, Optional ByRef vParameters As Variant, Optional lOptions As CommandTypeEnum) As CSealRecordset On Error GoTo errorhandle Set ExecuteCmd = New CSealRecordset Set ExecuteCmd.CurRecordset = adoCommand.Execute(lRowsAffected, vParameters, lOptions) iErrNum = 0 szErrmsg = "" Exit Function errorhandle: iErrNum = Err.Number szErrmsg = Err.Description End Function

' Set sqlCmd.ActiveConnection = m_Conn ' sqlCmd.CommandType = 1 ' sqlCmd.CommandText = "delete from tbl_module_pv where tdate='" & txtSelDate & "' and moduleid=" & rs.GetFieldValue("moduleid") _ ' & ";insert into tbl_module_pv(moduleid,tdate,profit,tlist) " _ ' & " (select t.moduleid, tv.tdate, sum(tv.profit),group_concat(tv.taskid) from tbl_task_pv tv, tbl_task t" _ ' & " where t.taskid=tv.taskid and tdate='" & txtSelDate & "' group by moduleid having moduleid = " & rs.GetFieldValue("moduleid") & " )" ' sqlCmd.ExecuteCmd