真正删除数据库的记录 大家知道,缺省情况下,VB 删除记录只是把记录作上个删除标志而已,并没有真正删除。要真正删除记录,你可以使用 VB 提供的以下方法:BeginTrans、CommitTrans、RollBack。其中,BeginTrans 方法开始记录数据库的变动,CommitTrans 方法确认数据库的变动,而 RollBack 方法则可以恢复被删除或修改的记录。它们可以嵌套使用。因此,要恢复被删除的记录,应该在使用 BeginTrans 方法之后及使用 CommiTrans 方法之前使用 RollBack 方法。 返回 数据约束控件和 RecordSet 数据约束控件是指要求与Data 控件连接到一起的控件, 如DBGird 等。典型的特征是都有一个DataSource 属性, 该属性在运行时是不可用的。 在没有使用数据控件Data 而采用DAO 命令打开一个数据库后,如何将表中记录显示在数据约束控件内?方法如下: 约束控件在设计时应该连接到一个空的 DATA1, 在运行中: Set DATA1.Recordset = 没有使用数据控件建立的Recordset 刷新该数据约束控件, 注意不能刷新DATA1。 由 awing 提供的例子如下: 在一个窗体内建立一个文本控件和一个数据控件,将文本控件的DataSource属性指向Data1,设置对应的字段,然后编下如程序: dim db as database dim rs as recordset set db=opendatabase("temp.mdb") set rs =db.openrecordset("files",dbopentable) set data1.recordset=rs 运行程序后,点击数据控件的移动记录。 返回 语言选择引起的查询错误 平常在我们新建数据库时, 一般都使用了以下的代码: Set database = workspace.CreateDatabase (name, locale, options) 而在 locale 中, 如果您使用了 dbLangGeneral, 一些古怪的情况就会出现, 例如在 "select * from db where name like '陈*'", 结果您会发现所有姓 "池" 的人, 也出现的结果中, 在用 rs.findfirst "city like '温州*'", 结果是不会定位在温州, 而是找到的广州或北京。。
这一切都是因为使用了 dbLangGeneral导致的,简体中文的正确选择是 dbLangChineseTraditional 。 应该注意的是, 在其他数据库如 SQL Server 也有类似的情况。
BTW: 在locale 中设置数据库的口令, 方法是: dbLangChineseTraditional & ";pwd=NewPassword" 返回 非法退出引起的 RecordCount记数错误 感谢 zhuyongming 提供。 Access 表里无记录,但 RecordCount 却显示记录为1。后来发现该表曾经非法退出造成的, 又复制了一个表就好使了。 返回 不用 EOF 以加快记录循环 通常我们使用以下的代码进行记录循环:
Do while not records.eof combo1.additem records![Full Name] records.movenext loop
结果是每个循环中数据库都要进行一次数据结束测试。在大量的记录的情况下, 浪费的时间相当大。 而使用以下的代码, 可以提高近 1/3 的速度:
records.movelast intRecCount=records.RecordCount records.movefirst
for intCounter=1 to intRecCount combo1.additem records![Full Name] records.movenext next intCounter 返回 断开所有的数据连接 如果在代码中使用了数据控件如 DAO, RDO, 或 ADO, 在退出时应该关闭所有打开的 recordset, database,和 workspace 。 虽然对象能自动注销, 但是数据连接不会马上断开, 可能会导致一些内存不能被系统重新分配。
下面的代码可以关闭所有打开的 DAO workspace, 并释放所占的内存。
Private Sub Form_Unload(Cancel As Integer) On Error Resume Next ' Dim ws As Workspace Dim db As Database Dim rs As Recordset ' For Each ws In Workspaces For Each db In ws.Databases For Each rs In db.Recordsets rs.Close Set rs = Nothing Next db.Close Set db = Nothing Next ws.Close Set ws = Nothing Next ' End Sub 返回 取得下个自动生成的 ID 在许多数据库里我们使用了自动增加的 ID, 能取得下个自动产生的 ID, 意味着在数据增加后, 不再需要使用 LastModified 属性和 bookmarks。 With Data1.Recordset .AddNew MsgBox !ID '下个自动生成的 ID .CancelUpdate End With 返回 用DATA控件绑定报表控件打印报表 1 在数据库中生成一TEMP表。 2 用报表生成器生成报表,然后删除数据库中的TEMP表。 3 在VB中打开数据库,用OPENRECORDSET语句生成一个RECORDSET (此RECORDSET的结构要与第一步生成的TEMP表一样,但记录数可以 用WHERE子句限制) 用SET DATA1.RECORDSET=RS(RECORDSET)将RECORDSET的数据赋予数据控件。 4 设定报表控件的REPORTFILENAME属性为报表文件名; REPORTSOURCE属性为3; DATASOURCE属性为数据控件名 5 执行ME.CR1.ACTION=1即可打印。 但我不知如何直接利用RECORDSET中的数据,如果你知道请告知。 感谢由 FENG 提供该技巧。 返回 取得正确的 RecordCount 值 特别是在 RecordSet 中记录比较多的情况,在更新 RecordSet 后 RecordCount 返回的值一般比真实的值要小, 以下的方法可以保证得到正确的值:
Data1.Recordset.MoveLast RCount = Data1.Recordset.RecordCount 返回 锁住数据库中的表 把表达式 True=False 放到表的 ValidationRule 属性就能锁上。 HardLockTable 实现了该功能。
声明 Public MyDB As Database Dim Dummy As Integer
函数 Function HardLockTable (ByVal whichAction As String, ByVal aTable As String) As Integer On Error GoTo HardLockTableError HardLockTable = True Select Case whichAction Case "Lock" MyDB.TableDefs(aTable).ValidationRule = "True=False" MyDB.TableDefs(aTable).ValidationText = "This table locked via " & "ValidationRule on " & Now Case "UnLock" MyDB.TableDefs(aTable).ValidationRule = "" MyDB.TableDefs(aTable).ValidationText = "" Case "TestThenUnLock" If MyDB.TableDefs(aTable).ValidationRule = "True=False" Then MyDB.TableDefs(aTable).ValidationRule = "" MyDB.TableDefs(aTable).ValidationText = "" End If End Select HardLockTableErrorExit: 'subFlushDBEngine 'optional, see next suggestion Exit Function HardLockTableError: HardLockTable = False MsgBox Error$ & " error " & "in HardLockTable trying " & "to " & whichAction & " " & aTable Resume HardLockTableErrorExit End Function
使用例子 '上锁 Dummy = HardLockTable("Lock", "TestTable") ' 开锁 Dummy = HardLockTable("UnLock", "TestTable") 返回 Data 控件使用有密码的 Access 数据库 使用 Data 控件打开 Accecc 数据库: 设置 Connect 属性为 ;pwd=密码 Data1.Connect = ";pwd=密码" 修改密码: Data1.Database.NewPassword _老密码_, _新密码_ 返回 处理在 Access 数据库中的 Null 值 Access 的字符串字段可以包含 NULL 值。在读这些字段到 VB 的 String 变量时,会出现运行时间的错误。最好的解决方法是使用 & 操作符将该字段与空串连接:
sString = "" & RS(0) 返回 表或查询是否存在 在 VB5 中需要 Microsoft DAO 3.x Object Library。
Public Const NameNotInCollection = 3265 Dim DB As Database
Private Function ExistsTableQuery(TName As String) As Boolean
Dim Test As String On Error Resume Next
' 该名字在表名中是否存在。 Test = db.TableDefs(TName).Name If Err <> NameNotInCollection Then ExistsTableQuery = True ' Reset the error variable: Err = 0 ' 该名字在查询中是否存在。 Test = db.QueryDefs(TName$).Name If Err <> NameNotInCollection Then ExistsTableQuery = True End If End If End Function 返回 连接Data到多个表单 假设 Form1,Form2 表单都有 Data 控件,在 Form2 的 Form_Load 事件中加入以下的代码,可以实现对DATA 的多个连接。
Sub Form_Load () Set Data1.Recordset = Form1.Data1.Recordset End Sub 返回 处理 Select 语句中的单引号 在数据库应用中, 经常要动态生成 Select 语句,典型的情况: SqlString = "Select * from myBas where Name = '" & Text1 & "'" 好啦, 问题出现了, 如果在录入的 Text1 中有一个单引号,结果是把 SqlString 发给数据库时, 将出错!
其实要做的防范很简单, 增加一个函数:
FUNCTION CheckString (s) as String pos = InStr(s, "'") While pos > 0 s = Mid(s, 1, pos) & "'" & Mid(s, pos + 1) pos = InStr(pos + 2, s, "'") Wend
CheckString="'" & s & "'" END FUNCTION
以后在动态生成 Select 语句, 使用: SqlString = "Select * from myBas where Name = " & CheckString(Text1) 返回 非 DSN 的 ODBC 连接 如果使用 DSN 的话, 每台电脑都要设置 ODBC 连接, 可能还要安装 ODBC 驱动程序。 一旦修改 DSN , 要重新设置每台电脑。 不过, 用了 DSN-Less 连接, 就不需要在每台电脑设置 ODBC 啦。
其实要做的非常简单, 只要修改在连接串中设置 driver 和 server 就 OK。如:
cnstr = "driver={SQL Server}; server=myserver;" & "database=mydb; uid=myuid; pwd=mypwd; dsn=;" Set cn = en.OpenConnection("", False, False, cnstr)
注意: driver 要用 { },如果使用 DAO 控件, 应该在 Connect 头上增加 "ODBC; "。 返回 建立和删除一个 DSN 1. 增加声明:
Private Const ODBC_ADD_DSN = 1 ' Add data source Private Const ODBC_CONFIG_DSN = 2 ' Configure (edit) data source Private Const ODBC_REMOVE_DSN = 3 ' Remove data source Private Const vbAPINull As Long = 0& ' NULL Pointer
Private Declare Function SQLConfigDataSource Lib "ODBCCP32.DLL" (ByVal hwndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long
2. 新增加一个 DSN
Dim intRet As Long Dim strDriver As String Dim strAttributes As String
'设置数据库类别 这里是 SQL Server strDriver = "SQL Server" 'null 结尾的参数 '请看相关文档 strAttributes = "SERVER=SomeServer" & Chr$(0) strAttributes = strAttributes & "DESCRIPTION=Temp DSN" & Chr$(0) strAttributes = strAttributes & "DSN=DSN_TEMP" & Chr$(0) strAttributes = strAttributes & "DATABASE=pubs" & Chr$(0) strAttributes = strAttributes & "UID=sa" & Chr$(0) strAttributes = strAttributes & "PWD=" & Chr$(0) '如果要显示对话,可使用 Form1.Hwnd 代替 vbAPINull. intRet = SQLConfigDataSource(vbAPINull, ODBC_ADD_DSN, strDriver, strAttributes) If intRet Then MsgBox "DSN 建立" Else MsgBox "失败" End If
3. 删除一个 DSN
Dim intRet As Long Dim strDriver As String Dim strAttributes As String
strDriver = "SQL Server" strAttributes = "DSN=DSN_TEMP" & Chr$(0) intRet = SQLConfigDataSource(vbAPINull, ODBC_REMOVE_DSN, strDriver, strAttributes) If intRet Then MsgBox "DSN 删除" Else MsgBox "失败" End If 返回 安装 T-SQL 调试器服务端 VB5 的企业版包括了一个 Transact-SQL 调试器, 可以用来调试 MS SQL Server 6.5 的存储过程。 可以VB5 的安装程序没有完整的安装该调试器, 因为该调试器包括客户端和服务端两个部分, VB5 的安装程序只完成了客户端(一个 Add-In ), 而服务端要手工安装。
方法是: 找到在 VB5 企业版 CD 中 /Tools/Tsql 目录下的 SDI_NT4.EXE, 在数据库服务器上执行该文件, 就好啦。 该调试器要求 SQL 6.5 在 SP1 或以上。 返回 列出 SQL Server 数据库中所有的存储过程 Dim cn As rdoConnection Dim ps As rdoPreparedStatement Dim rs As rdoResultset Dim strConnect As String Dim strSQL As String '利用 DSNless 连接到 pubs 数据库 '改变参数以适合你自己的 SQL Server strConnect = "Driver={SQL Server}; Server=myserver; " & "Database=pubs; Uid=sa; Pwd=" Set cn = rdoEnvironments(0).OpenConnection(dsName:="", Prompt:=rdDriverNoPrompt, ReadOnly:=False, Connect:=strConnect)
strSQL = "Select so.name,sc.name,st.name,sc.length " & "FROM syscolumns sc,master..systypes st,sysobjects so " & "WHERE sc.id in (select id from sysobjects where type ='P')" & " AND so.type ='P' " & "AND sc.id = so.id " & "AND sc.type = st.type " & "AND sc.type <> 39"
Set ps = cn.CreatePreparedStatement("MyPs", strSQL)
Set rs = ps.OpenResultset(rdOpenStatic)
list1.AddItem "SP Name,Param Name,Data Type,Length" While Not rs.EOF list1.AddItem rs(0) & " , " & rs(1) & " , " & rs(2) & " , " & rs(3) rs.MoveNext Wend rs.Close Set rs = Nothing cn.Close Set cn = Nothing 返回 为什么安装后的数据库应用总是路径不对或找不到? 例如在使用 DATA 控件, 最好在程序中用代码生成数据库路径,如: DATA1.DATABASENAME = 当前目录 & 数据库名称 只要保证数据库和应用程序在同一个目录下, 就可以啦。 返回 如何在 SQL 语句中使用日期? 1 "UPDATE A SET D = '" & DATE & "'" 2 "UPDATE A SET D = #" & DATE & "#"
如果是在 SQL Server 等, 应考虑日期的格式问题。 返回 如何使用 DBGrid? 1 在 DBGrid 上右击, 选择 编辑, 再次在 DBGRID 上右击, 这时出现了控制 DBGrid 的菜单。 2 如果不改变 DBGrid 的属性, 直接与 DATA 连接, 列会自动调整。 返回 压缩修复数据库 1. Create a new project in Visual Basic. Form1 is created by default. 2. Add a Common Dialog control to Form1. CommonDialog1 is created by default. 3. Add a Command Button control to Form1. Command1 is created by default. Set its Caption property to "Repair". 4. Add the following code to the Click event for Command1:
Private Sub Command1_Click() On Error GoTo Repair_Error Dim MDB_Name As String
CommonDialog1.Filter = "Access (*.mdb)|*.mdb" CommonDialog1.Flags = &H1000 CommonDialog1.FilterIndex = 1 CommonDialog1.Action = 1
If CommonDialog1.FileName <> "" Then Screen.MousePointer = 11 MDB_Name = CommonDialog1.FileName RepairDatabase (MDB_Name) Screen.MousePointer = 0 MsgBox "Database repaired successfully", 64, "Repair" End If Screen.MousePointer = 0 Exit Sub Repair_Error: MsgBox "Error when repairing database", 16, "Error" Screen.MousePointer = 0 Exit Sub End Sub
5. Add a second Command Button control to Form1. Command2 is created by default. Set its Caption property to "Compact". 6. Add the following code to the Click event for Command2:
Private Sub Command2_Click() On Error GoTo Compact_Error
Dim MDB_Name As String Dim MDB_NewName As String Dim MDB_Local As String Dim MDB_Options As String
MDB_NewName = "c:/dummy.mdb" CommonDialog1.Filter = "Access (*.MDB)|*.mdb" CommonDialog1.Flags = &H1000 CommonDialog1.FilterIndex = 1 CommonDialog1.Action = 1
If CommonDialog1.FileName <> "" Then MDB_Name = CommonDialog1.FileName CompactDatabase MDB_Name, MDB_NewName & MDB_Local & MDB_Options Kill MDB_Name Name MDB_NewName & MDB_Local & MDB_Options As MDB_Name MsgBox "Database compressed OK", 64, "Compact" End If Exit Sub Compact_Error: MsgBox "Unable to compress database", 16, "Error" Exit Sub End Sub 返回 快速删除数据库中的所有记录 下面这个函数演示如何快速删除数据库中的所有记录 Function DeleteAllRecords () Dim DB As Database Dim X As Integer Dim TDF As TableDef DoCmd SetWarnings False Set DB = CurrentDB() For X = 0 To DB.TableDefs.Count - 1 Set TDF = DB.TableDefs(X) If (TDF.Attributes And DB_SYSTEMOBJECT) = 0 Then DB.Execute "Delete * From [" & DB.TableDefs(X).Name & "]" End If Next X DoCmd SetWarnings True End Function 返回 将ADO数据库中的图象拷贝到文件中 Private Function GetRandomFileName(sDirTarget As String, _ sPrefix As String, _ sExtention As String) As String
'Generates a unique temp file name for the specified directory 'with the specified extention On Error Resume Next Dim fs As FileSystemObject ' **** requires filesystem object Dim sFName As String Dim iRnd As Long Dim iUpperBound As Long, iLowerbound As Long
TRYAGAIN:
Randomize iUpperBound = 99 iLowerbound = 0 iRnd = Int((iUpperBound - iLowerbound + 1) * Rnd + iLowerbound)
sFName = CStr(iRnd) + CStr(DatePart("d", Now())) _ + CStr(DatePart("h", Now())) _ + CStr(DatePart("n", Now()))
sFName = sPrefix + sFName + "." + sExtention
Set fs = New FileSystemObject
If Not fs.FileExists(sDirTarget + "/" + sFName) Then GetRandomFileName = sDirTarget + sFName Exit Function Else GoTo TRYAGAIN End If
End Function
Public Function CopyImageField(fld As ADODB.Field, _ fldTO As ADODB.Field)
'This function takes the source field image and copies it 'into the destination field. 'The function first saves the image in the source field to a 'temp file on disc. Then reads this temp file into 'the destination field. 'The temp file is then deleted On Error Resume Next
Dim iFieldSize As Long Dim varChunk As Variant Dim baData() As Byte Dim iOffset As Long Dim sFName As String Dim iFileNum As Long Dim cnt As Long Dim z() As Byte
Const CONCHUNKSIZE As Long = 16384
Dim iChunks As Long Dim iFragmentSize As Long
'Get a unique random filename sFName = GetRandomFileName(App.Path, "pic", "tmp")
'Open a file to output the data to iFileNum = FreeFile Open sFName For Binary Access Write Lock Write As iFileNum
'Copy the logo to a variable in chunks. iFieldSize = fld.ActualSize iChunks = iFieldSize / CONCHUNKSIZE iFragmentSize = iFieldSize Mod CONCHUNKSIZE If iFragmentSize > 0 Then ' if there is a frag then write it first, else just use chunk ReDim baData(iFragmentSize) baData() = fld.GetChunk(iFragmentSize) Put iFileNum, , baData() End If
'Fragment added; Now write rest of chunks ReDim baData(CONCHUNKSIZE) For cnt = 1 To iChunks baData() = fld.GetChunk(CONCHUNKSIZE) Put iFileNum, , baData Next cnt
'Close file Close iFileNum
'Now we have the file on disk Load the pic from 'the temp file into the other field
Open sFName For Binary Access Read As #1 ReDim z(FileLen(sFName)) Get #1, , z() fldTO.AppendChunk z Close #1
'Delete the file Kill (sFName)
End Function
|