[VB] VB實現一個窗體的增刪改查的demo

阿新 • • 發佈：2019-01-18

日常開發中，經常會針對默寫資料表進行增刪改查。

每次都要單獨處理，費時費力，考慮通過一個窗體進行封裝。（借鑑當時接觸的某家公司的套路）

外圍在呼叫時，傳入sql字串，展示字串，然後被呼叫窗體根據傳入的資訊進行排版展示。

同時通過設定增刪改查標誌，提供增刪改查的關聯操作。

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

在傳入的 m_lbls裡指定相應的資料庫的欄位名fname, 需要展示的中文名flabel, 展示的格式fshow, 關聯的sql等。

窗體裡，目前只支援標籤，文字框，下拉框，通過傳入的資訊動態載入展示。

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

還有相當一塊內容是對資料庫(ADO)的封裝，在類模組 XXXConnection, XXXXRecordSet, XXXXCommand 實現聯接，資料集，命令列等方式的讀取更新。

其中connection完成連線的開啟，關閉，事務的開啟提交，回滾等。

'DATABASE層
'封裝資料庫連線源,及其操作.

'開啟到資料來源的連線
'##ModelId=384A0336023A
Public Sub COpen(Optional ConnectionString As String, Optional szUser As String, Optional szPwd As String, Optional OpenOption As Integer = -1)
 
    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

XXXRecordSet實現對sql的查詢（COpen），資料集的遍歷，獲取，寫入等。

'關閉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 是否對二進位制欄位進行操作
'##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
'方法回捲的事務的一部分，或者是可以用 CancelBatch 方法取消的批更新的一部分，否則在呼叫 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 所用的格式。當前預設並唯一有效的值為 adPersistADTG。
'
'在第一次儲存 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

而command類模組，實現一些批處理命令的封裝。

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

詳細程式碼可見： http://download.csdn.net/detail/fonjames/9560638

（其實上面已經把大部分程式碼貼出來了：-）

ssm實現簡單的增刪改查demo

訂閱 Spring介紹: spring 使用基本的 JavaBean 來完成以前只可能由 EJB 完成的事情。然而， Spring的用途不僅限於伺服器端的開發。從簡單性、可測試性和鬆耦合的角度而言，任何Java 應用都可以

函數、文件操作實現數據增刪改查---low版本

腳本 python 首先說明這個腳本很low，目前水平有限，只能實現使用固定的語法對數據進行增刪改查。但是現在腳本不low，怎麽讓明年的我來嘲笑今年的自己需求 a.可進行模糊查詢，語法至少支持下面3種: 　　 select name,age from staff_table where

Struts2+Spring+Hibernate實現員工管理增刪改查功能（一）之ssh框架整合

pri support scrip ext ack efault ring src 兩張前言轉載請標明出處：http://www.cnblogs.com/smfx1314/p/7795837.html 本項目是我寫的一個練習，目的是回顧ssh框架的整合以及

ztree--插件實現增刪改查demo（完整版）

mes add treenode pan tno btn tin 異步 als ztree--插件實現增刪改查demo（完整版） var setting = { async: { enabl

基於AT UI實現表格的增刪改查遇到的坑

data 基於報錯 color CA cannot bsp 加載 http 基於AT UI實現表格的增刪改查遇到的坑坑一、表格數據加載的渲染報錯報錯：Error in render: "TypeError: Cannot read property ‘isC

python實現mongodb的增刪改查

pmd xxx rsn rpm vfat uwa paul dpf wdf python實現mongodb的增刪改查環境：192.168.122.1 pytho

Mybatis實現部門表增刪改查以及排序

tis hide 映射類型 f2c cep interface mes sele 廢話不說,直接開門見山! 需要在WebContent下的lib下導入兩個包 mybatis-3.2.5.jar ojdbc6.jar 1 package com.xdl.entit

Spring Data jpa + extjs 實現簡單的增刪改查

公司最近的專案一部分是在使用MyBatis，還有一部分使用SpringJPA，jpa平時沒怎麼用過，今天閒來無事做個增刪改查的demo,記錄下來。環境;jdk 1.8 編輯器： IDEA 資料庫：postgresql 首先貼上專案所需要的依賴 <?xml version=

php實現資料庫的增刪改查總結

查詢語句的語法： select() * | 欄位列表 from 表列表 where 條件查詢可以返回一個結果集 select * from mytable select id,name from mytable select * from mytable where id=3

純c語言實現連結串列，實現連結串列增刪改查

#include <stdio.h> #include <string.h> #include <stdlib.h> struct selflist{ int num; selflist* next; }; struct selflist* hea

java實現mysql資料庫增刪改查

1.連線資料庫: import java.sql.Connection; import java.sql.DriverManager; public class DBConnection { static String driver = "com.mysql.jdbc.Driver"; s

Springboot整合Thymeleaf、layui實現簡單的增刪改查

Springboot整合Thymeleaf、layui實現簡單的增刪改查主頁面列表分頁顯示搜尋功能新增使用者編輯使用者 Mapper對映 Controller層 list.html初始化載入表格資料搜尋過載表

JDBC實現簡單的增刪改查

exceptio 介紹 cde sna arch png into 註冊 sets JDBC的開發步驟 * a: 步驟介紹 1.註冊驅動告知JVM使用的是哪一個數據庫的驅動 2.獲得連接使用JDBC中的類,完成對MySQL數據庫的連接 3.獲

Hibernate+struts2之ajax非同步實現簡單的增刪改查例子

使用hibernate表連線 entity程式碼（程式碼過多就不上傳了，自行封裝） Publisher實體 public class Publisher implements Serializable{ private int id; private String nam

JFinal框架學習------整合bootstrap前端框架，實現簡單的增刪改查功能

Bootstrap，來自 Twitter，是目前最受歡迎的前端框架。Bootstrap 是基於 HTML、CSS、JAVASCRIPT 的，它簡潔靈活，使得 Web 開發更加快捷。一、JFinal整合bootstrap 1.下載bootstra

SSM框架+thymeleaf實現基本的增刪改查

前言本文使用了SSM框架、thymeleaf和jquery實現了基本的增刪改查。名詞解釋 SSM框架：springMVC、spring、mybatis thymeleaf：一個與Velocity、FreeMarker類似的模板引擎 jquery：一個快速、簡潔的JavaScrip

SSM+dubbo+zookeeper實現基本的增刪改查

前言本文中使用的專案是由上一篇文章中的專案改造而來。具體來說，就是引入了dubbo和zookeeper，並將Controller層與service層dao層進行了拆分，使雙方通過service介面遠端呼叫的形式，再次實現了基本的增刪改查。上一篇文章：http://www.cnblogs.com/han

使用 PyMySQL 連線資料庫，並實現簡單的增刪改查

首先需要 import pymysql 1.連線資料庫 #獲取資料庫連線 def getDBConn(): conn = pymysql.connect( host = 'localhost', port = 3306, user = 'root', password

express實現簡單的增刪改查學習筆記(2)

接上一個(1),將會用express實現簡單的增刪改查的功能 1.在專案資料夾下新建data資料夾，此資料夾下新建data.json，裡面寫一個空的陣列 2.在專案資料夾下新建db.js const json = require('./data'); //是新生成的da

JSP+Servlet+JavaBean實現資料庫的增刪改查

基本思想：JSP檔案顯示頁面，使用form或href超連結傳值到Servlet中方法，在Servlet方法中呼叫Dao層的類物件，實現對資料庫裡的資料的增刪改查，之後重新返回到JSP輸出操作完的結果。共分為四個包和對應的JSP檔案： 1.DB包：建立連線資料庫的方法，以及關閉操作資料庫的方法。 2.S

[VB] VB實現一個窗體的增刪改查的demo

相關推薦