VB下几个非常有用的函数,解决用ADODB对Access数据库进行操作的一个问题
分类:多线程

    在进行数据库的查询时,会经常遇到这样的情况:
  例如想在一个用户数据库中查询他的用户名和他的密码,但恰好该用户使用的名字和密

中有特殊的字符,例如单引号,“|”号,双引号或者连字符“&”。
  例如他的名字是1"test,密码是A|&900
  这时当你执行以下的查询语句时,肯定会报错:
SQL = "SELECT * FROM SecurityLevel WHERE UID="" & UserID & """
SQL = SQL & " AND PWD="" & Password & """ 
  因为你的SQL将会是这样:
SELECT * FROM SecurityLevel WHERE UID="1"test" AND PWD="A|&900" 
  在SQL中,"|"为分割字段用的,显然会出错了。现在提供下面的几个函数 专门用来处
理这
些头疼的东西:
Function ReplaceStr (TextIn, ByVal SearchStr As String, _
ByVal Replacement As String, _
ByVal CompMode As Integer)

图片 1Function replace(ByVal sstr As String, ByVal stag As String, ByVal srep As String) As String
图片 2    Dim l1, l2, l3, x, i As Long
图片 3    Dim st As String
图片 4    x = InStr(sstr, stag)
图片 5    If x < 1 Then
图片 6        replace = sstr
图片 7        Exit Function
图片 8    End If
图片 9    st = sstr
图片 10    l1 = Len(sstr)
图片 11    l2 = Len(stag)
图片 12    l3 = Len(srep)
图片 13    For i = 0 To l1
图片 14        st = Left(st, x - 1) & srep & Right(st, Len(st) - x - l2 + 1)
图片 15        x = InStr(x + l3, st, stag)
图片 16        If x < 1 Then Exit For
图片 17    Next
图片 18    replace = st
图片 19End Function
图片 20

问题:[microsoft][odbc microsoft access driver]标准表达式中数据类型不匹配
原因:Sql语句书写格式不标准
 解决办法:
        如:  string sqlstr="select * from student where studentId>='" + Convert.ToInt32(this.textBox1.Text)+"'";
        应改为:string sqlstr="select * from student where studentId>=" + Convert.ToInt32(this.textBox1.Text);

'————————(1)————————————
'获得指定ini文件中某个节下面的所有键值 TrueZq,,需要下面的API声明
'Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
'返回一个字符串数组
'调用举例:
'Dim arrClass() As String
'arrClass = GetInfoSection("class", "d:type.ini")
 
Public Function GetInfoSection(strSection As String, strIniFile As String) As String()
    Dim strReturn As String * 32767
    Dim strTmp As String
    Dim nStart As Integer, nEnd As Integer, i As Integer
    Dim sArray() As String
   
    Call GetPrivateProfileSection(strSection, strReturn, Len(strReturn), strIniFile)
   
    strTmp = strReturn
    i = 1
    Do While strTmp <> ""
        nStart = nEnd + 1
        nEnd = InStr(nStart, strReturn, vbNullChar)
        strTmp = Mid$(strReturn, nStart, nEnd - nStart)
        If Len(strTmp) > 0 Then
            ReDim Preserve sArray(1 To i)
            sArray(i) = strTmp
            i = i + 1
        End If
       
    Loop
    GetInfoSection = sArray
End Function

 Dim WorkText As String, Pointer As Integer
 If IsNull(TextIn) Then
  ReplaceStr = Null
 Else
  WorkText = TextIn
  Pointer = InStr(1, WorkText, SearchStr, CompMode)
  Do While Pointer > 0
   WorkText = Left(WorkText, Pointer - 1) & Replacement & _
   Mid(WorkText, Pointer + Len(SearchStr))
   Pointer = InStr(Pointer + Len(Replacement), WorkText, SearchStr, CompMode)
  Loop
  ReplaceStr = WorkText
 End If
End Function

图片 21Function split(ByVal sstr As String, ByVal spstr As String) As Variant
图片 22Dim star, lenstr, lensp, cur As Integer
图片 23Dim backstr() As String
图片 24Dim i As Integer
图片 25ReDim backstr(0)
图片 26lenstr = Len(sstr)
图片 27lensp = Len(spstr)
图片 28star = InStr(sstr, spstr)
图片 29If star < 1 Then
图片 30    backstr(0) = sstr
图片 31    split = backstr()
图片 32    Exit Function
图片 33End If
图片 34backstr(0) = Left(sstr, star - 1)
图片 35cur = star + lensp
图片 36For i = star + lensp To lenstr
图片 37    star = InStr(star + lensp, sstr, spstr)
图片 38    If star > 0 Then
图片 39        ReDim Preserve backstr(UBound(backstr) + 1)
图片 40        backstr(UBound(backstr)) = Mid(sstr, cur, star - cur)
图片 41        cur = star + lensp
图片 42    Else
图片 43        Exit For
图片 44    End If
图片 45Next
图片 46ReDim Preserve backstr(UBound(backstr) + 1)
图片 47backstr(UBound(backstr)) = Mid(sstr, cur, lenstr - cur + 1)
图片 48split = backstr()
图片 49End Function 
图片 50

图片 51private void button1_Click(object sender, System.EventArgs e)
图片 52图片 53        图片 54{
图片 55            DataSet myDS;
图片 56            myDS=new DataSet();
图片 57            myDS=cgtdb.GetDataFromAccess(accessDbname,"admin","123","select * from student where studentId>=" + Convert.ToInt32(this.textBox1.Text),"student" );
图片 58            if(myDS!=null)
图片 59图片 60            图片 61{
图片 62                this.dataGrid1.DataSource =myDS.Tables[0];  
图片 63                MessageBox.Show(myDS.Tables[0].Rows[0][0].GetType().ToString()      ) ;
图片 64            }
图片 65            
图片 66        }

'————————(2)————————————
'作用:去掉字符串中的首尾空格、所有无效字符
'测试用例
'Dim strRes As String
'Dim strSour As String
'
'strSour = " " & vbNullChar & vbNullChar & " ab cd" & vbNullChar
'strRes = zqTrim(strSour)
'MsgBox " 长度=" & Len(strSour) & "值=111" & strRes & "222"
Public Function zqTrim(ByVal strSour As String) As String
    Dim strTmp As String
    Dim nLen As Integer
    Dim i As Integer, j As Integer
    Dim strNow As String, strValid() As String, strNew As String
    'strNow 当前字符
    'strValid 有效字符
    'strNew 最后生成的新字符
   
    strTmp = Trim$(strSour)
    nLen = Len(strTmp)
    If nLen < 1 Then
        zqTrim = ""
        Exit Function
    End If
    j = 0
    For i = 1 To nLen
        strNow = Mid(strTmp, i, 1) '每次读取一个字符
        'MsgBox Asc(strNow)
        If strNow <> vbNullChar And Asc(strNow) <> 9 Then '如果有效,则存入有效数组
            ReDim Preserve strValid(j)
            strValid(j) = strNow
            j = j + 1
        End If
   
    Next i
   
    strNew = Join(strValid, "") '将所有有效字符连接起来
    zqTrim = Trim$(strNew) '去掉字符串中的首尾空格
End Function

Function SQLFixup(TextIn)
 SQLFixup = ReplaceStr(TextIn, """, """", 0)
End Function
Function JetSQLFixup(TextIn)
 Dim Temp
 Temp = ReplaceStr(TextIn, """, """", 0)
 JetSQLFixup = ReplaceStr(Temp, "|", "" & chr(124) & "", 0)
End Function

AC97でそれらしい関数を作ってみました。
【関数例】

 

'————————(3)————————————
'检查文件是否存在,存在返回 TRUE,否则返回FALSE
Public Function CheckFileExist(strFile As String) As Boolean   
    If Dir(strFile, vbDirectory) <> "" Then
        CheckFileExist = True
    Else
        CheckFileExist = False
    End If
End Function

Function FindFirstFixup(TextIn)
 Dim Temp
 Temp = ReplaceStr(TextIn, """, "" & chr(39) & "", 0)
 FindFirstFixup = ReplaceStr(Temp, "|", "" & chr(124) & "", 0)
End Function 
  有了上面几个函数后,当你在执行一个sql前,请先使用
SQL = "SELECT * FROM SecurityLevel WHERE UID="" & SQLFixup(UserID) & """
SQL = SQL & " AND PWD="" & SQLFixup(Password) & """

图片 67Public Function Replace97(varStrings As Variant, varBeforeChr As Variant, varAfterChr As Variant) As Variant
图片 68'----( 変数宣言 )----------------------------------------------
图片 69Dim lngX1    As Long
图片 70'----( 初期設定 )----------------------------------------------
图片 71Replace97 = varStrings
图片 72'----( 置換処理 )----------------------------------------------
图片 73If IsNull(varStrings) Or varStrings = "" Then
图片 74Else
图片 75  If IsNull(varBeforeChr) Or varBeforeChr = "" Then
图片 76  Else
图片 77    Replace97 = ""
图片 78    For lngX1 = 1 To Len(varStrings)
图片 79      If Mid(varStrings, lngX1, Len(varBeforeChr)) = varBeforeChr Then
图片 80        Replace97 = Replace97 & varAfterChr
图片 81        lngX1 = lngX1 + Len(varBeforeChr) - 1
图片 82      Else
图片 83        Replace97 = Replace97 & Mid(varStrings, lngX1, 1)
图片 84      End If
图片 85    Next lngX1
图片 86  End If
图片 87End If
图片 88End Function

图片 89Public Function DataTransition_ADODBCon() As ADODB.Connection
图片 90        Dim conn As New ADODB.Connection()
图片 91        Try
图片 92            ReadIniFile()
图片 93            conn.ConnectionString = "Provider=SQLOLEDB;Data Source='" & Trim(SqlServerName_Str_Pub) & " ';Initial Catalog='" & Trim(SqlInitDB_Str_Pub) & "';Integrated Security=SSPI;" & " ," & " '" & Trim(SqlUserName_Str_Pub) & "' " & " , " & " '" & Trim(SqlUserPassWord_Str_Pub) & "'" & ", " & " -1"
图片 94        Catch
图片 95            MsgBox(" MyOleConStr 错误号: " & Err.Number.ToString & "  错误描述 : " & Err.Description.ToString)
图片 96        End Try
图片 97        DataTransition_ADODBCon = conn
图片 98    End Function
图片 99
图片 100
图片 101
图片 102    Public Function SqlConStr() As String
图片 103        Dim sqlconstring As String = ""
图片 104        Try
图片 105            ReadIniFile()
图片 106
图片 107            sqlconstring = "data source=" & Trim(SqlServerName_Str_Pub) & "; initial catalog=" & Trim(SqlInitDB_Str_Pub) & ";  persist security info=true; user id=" & Trim(SqlUserName_Str_Pub) & "; Password=" & Trim(SqlUserPassWord_Str_Pub) & ";  workstation id=" & Trim(SqlServerName_Str_Pub) & "; packet size=4096"
图片 108        Catch
图片 109            MsgBox("错误号: " & Err.Number.ToString & "  错误描述 : " & Err.Description.ToString)
图片 110        End Try
图片 111        Return sqlconstring
图片 112    End Function
图片 113
图片 114    Public Function SqlConStr2() As String
图片 115        Dim sqlconstring As String = ""
图片 116        Try
图片 117            ReadIniFile()
图片 118
图片 119            sqlconstring = Trim(SqlServerName_Str_Pub) & "" & Trim(SqlInitDB_Str_Pub) & "" & Trim(SqlUserName_Str_Pub) & "" & Trim(SqlUserPassWord_Str_Pub)
图片 120        Catch
图片 121            MsgBox("SqlConStr  错误号: " & Err.Number.ToString & "  错误描述 : " & Err.Description.ToString)
图片 122        End Try
图片 123        Return sqlconstring
图片 124    End Function
图片 125
图片 126
图片 127    '*************************************************************************************************************************************************'
图片 128    '1.2.连接ACCESS数据库
图片 129    '*************************************************************************************************************************************************'
图片 130    Public Function Access_OleDBCon(ByVal DBPath As String) As OleDbConnection
图片 131        Dim OleCon As OleDbConnection = New OleDbConnection()
图片 132        'Dim DBPath As String = "d:mrfuDriverManager.mdb"
图片 133        OleCon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & DBPath & "'"
图片 134        Return OleCon
图片 135
图片 136    End Function
图片 137
图片 138    '*************************************************************************************************************************************************'
图片 139    '对ACCESS数据库进行操作
图片 140    '*************************************************************************************************************************************************'
图片 141
图片 142    Public Function Access_ADODBConNeedPassword(ByVal DBPathAndDatabaseName As String, ByVal UserID As String, ByVal Password As String, ByVal SqlStr As String) As String
图片 143
图片 144        Dim FlagStr As String = "0"
图片 145        Dim ConnectionString As String = ""
图片 146
图片 147
图片 148        ConnectionString = "DRIVER={Microsoft Access Driver (*.mdb)};" & _
图片 149                           "DBQ=" & DBPathAndDatabaseName & ";DefaultDir=;" & _
图片 150                           "UID=" & UserID & ";" & _
图片 151                           "PWD=" & Password & ";"
图片 152        Dim Adocon As ADODB.Connection
图片 153        Try
图片 154
图片 155
图片 156            Adocon = New ADODB.Connection
图片 157
图片 158            Adocon.ConnectionString = ConnectionString
图片 159            Adocon.ConnectionTimeout = 120
图片 160            Adocon.CommandTimeout = 160
图片 161            Adocon.Open()
图片 162
图片 163
图片 164            Adocon.Execute(SqlStr)
图片 165
图片 166            Adocon.Close()
图片 167
图片 168            Adocon = Nothing
图片 169            FlagStr = "1"
图片 170
图片 171        Catch
图片 172            If Adocon.State = ConnectionState.Open Then
图片 173                Adocon.Close()
图片 174            End If
图片 175            FlagStr = "0"
图片 176            MsgBox(Err.Description.ToString, MsgBoxStyle.Exclamation, "错误提示")
图片 177
图片 178        End Try
图片 179
图片 180        Return FlagStr
图片 181
图片 182
图片 183    End Function
图片 184
图片 185    '*************************************************************************************************************************************************'
图片 186    '访问ACCESS数据库,并返回小批量数据
图片 187    '*************************************************************************************************************************************************'
图片 188    Public Function Access_GetDataReturnArrayList(ByVal DBPathAndDatabaseName As String, ByVal UserID As String, ByVal Password As String, ByVal SqlStr As String, ByVal TableName As String, ByVal FiledsName As String) As ArrayList
图片 189
图片 190        Dim TempArrayList As ArrayList
图片 191        TempArrayList = Nothing
图片 192        Dim rs As ADODB.Recordset
图片 193        Dim ConnectionString As String = ""
图片 194        ConnectionString = "DRIVER={Microsoft Access Driver (*.mdb)};" & _
图片 195                           "DBQ=" & DBPathAndDatabaseName & ";DefaultDir=;" & _
图片 196                           "UID=" & UserID & ";" & _
图片 197                           "PWD=" & Password & ";"
图片 198        Dim Adocon As ADODB.Connection
图片 199        Try
图片 200            Adocon = New ADODB.Connection
图片 201            Adocon.ConnectionString = ConnectionString
图片 202            Adocon.ConnectionTimeout = 120
图片 203            Adocon.CommandTimeout = 160
图片 204            Adocon.Open()
图片 205            rs = New ADODB.Recordset
图片 206            rs.Open(SqlStr, Adocon, ADODB.CursorTypeEnum.adOpenKeyset, ADODB.LockTypeEnum.adLockOptimistic, CInt(ADODB.CommandTypeEnum.adCmdText))
图片 207
图片 208            TempArrayList = New ArrayList
图片 209
图片 210            '如果记录集为空,输出一个错误信息
图片 211            If (rs.BOF Or rs.EOF) Then
图片 212                Adocon.Close()
图片 213                Adocon = Nothing
图片 214                rs = Nothing
图片 215
图片 216                MsgBox("没有找到任何记录,请检查你的" & TableName & " 表 ", MsgBoxStyle.Information, "系统消息")
图片 217
图片 218                Return TempArrayList
图片 219            End If
图片 220            '循环存入数据
图片 221
图片 222            While (Not rs.EOF)
图片 223                TempArrayList.Add(rs.Fields(FiledsName).Value.ToString())
图片 224
图片 225                rs.MoveNext()
图片 226
图片 227            End While
图片 228            Adocon.Close()
图片 229
图片 230            Adocon = Nothing
图片 231            rs = Nothing
图片 232
图片 233        Catch
图片 234            If Adocon.State = ConnectionState.Open Then
图片 235                Adocon.Close()
图片 236            End If
图片 237
图片 238            MsgBox(Err.Description.ToString, MsgBoxStyle.Exclamation, "错误提示")
图片 239
图片 240        End Try
图片 241       
图片 242
图片 243        Return TempArrayList
图片 244
图片 245
图片 246    End Function
图片 247
图片 248    '*************************************************************************************************************************************************'
图片 249    '访问ACCESS数据库,并返回数据集
图片 250    '*************************************************************************************************************************************************'
图片 251    Public Function GetDataFromAccess(ByVal DBPathAndDatabaseName As String, ByVal UserID As String, ByVal Password As String, ByVal SqlStr As String, ByVal TableName As String) As DataSet
图片 252        Dim custDA As OleDbDataAdapter = New OleDbDataAdapter
图片 253        Dim custDS As DataSet = New DataSet
图片 254
图片 255        Dim rs As ADODB.Recordset
图片 256        Dim ConnectionString As String = ""
图片 257        ConnectionString = "DRIVER={Microsoft Access Driver (*.mdb)};" & _
图片 258                           "DBQ=" & DBPathAndDatabaseName & ";DefaultDir=;" & _
图片 259                           "UID=" & UserID & ";" & _
图片 260                           "PWD=" & Password & ";"
图片 261        Dim Adocon As ADODB.Connection
图片 262        Try
图片 263            Adocon = New ADODB.Connection
图片 264            Adocon.ConnectionString = ConnectionString
图片 265            Adocon.ConnectionTimeout = 120
图片 266            Adocon.CommandTimeout = 160
图片 267            Adocon.Open()
图片 268            rs = New ADODB.Recordset
图片 269            rs.Open(SqlStr, Adocon, ADODB.CursorTypeEnum.adOpenKeyset, ADODB.LockTypeEnum.adLockOptimistic, CInt(ADODB.CommandTypeEnum.adCmdText))
图片 270
图片 271            '如果记录集为空,输出一个错误信息
图片 272            If (rs.BOF Or rs.EOF) Then
图片 273                Adocon.Close()
图片 274                Adocon = Nothing
图片 275                rs = Nothing
图片 276
图片 277                MsgBox("没有找到任何记录,请检查你的" & TableName & " 表 ", MsgBoxStyle.Information, "系统消息")
图片 278
图片 279                Return custDS
图片 280            End If
图片 281            '存入dataset数据
图片 282
图片 283
图片 284            custDA.Fill(custDS, rs, "Customers")
图片 285            Adocon.Close()
图片 286            Adocon = Nothing
图片 287            rs = Nothing
图片 288
图片 289        Catch
图片 290            If Adocon.State = ConnectionState.Open Then
图片 291                Adocon.Close()
图片 292            End If
图片 293
图片 294            MsgBox(Err.Description.ToString, MsgBoxStyle.Exclamation, "错误提示")
图片 295
图片 296        End Try
图片 297
图片 298
图片 299        Return custDS
图片 300
图片 301
图片 302    End Function

'————————(4)————————————
'获得指定ini文件中某个节下面某个子键的键值,需要下面的API声明
'Public Declare Function GetPrivateProfileString Lib "kernel32" Alias _
'    "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
'    ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString _
'    As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
'返回一个字符串
'调用举例:
'Dim strRun As String
'strRun = GetiniValue("Windows","Run", "C:WindowsWin.ini")

※置換開始位置や置換回数などのパラメータは、考慮していません。
【確認】

Public Function GetiniValue(ByVal lpKeyName As String, ByVal strName As String, ByVal strIniFile As String) As String
    Dim strTmp As String * 255
   
    Call GetPrivateProfileString(lpKeyName, strName, "", _
            strTmp, Len(strTmp), strIniFile)
    GetiniValue = Left$(strTmp, InStr(strTmp, vbNullChar) - 1)
   
End Function

图片 303Public Function TEST()
图片 304MsgBox Replace97("ABC", "BC", "")      → A
图片 305MsgBox Replace97("ABCD", "BC", "")     → AD
图片 306MsgBox Replace97("ABCDABCDBC", "BC", "")  → ADAD
图片 307MsgBox Replace97("ABCDABCDBC", "BC", "XY") → AXYDAXYDXY 
图片 308End Function

'————————(5)————————————
'获得Windows目录 ,需要下面的API声明
'Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'返回一个字符串,如“C:Windows”、“C:Winnt”
'调用举例:
'Dim strWindir As String
'strWindir = GetWinDir()
Private Function GetWinDir()
    Dim windir As String * 100
    Call GetWindowsDirectory(windir, 100)
    GetWinDir = Left$(windir, InStr(windir, vbNullChar) - 1)
   
End Function

'————————(6)————————————
'获得Windows系统目录,需要下面的API声明
'Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'返回一个字符串,如“C:WindowsSystem”、“C:WinntSystem32”
'调用举例:
'Dim strSysDir As String
'strSysDir = GetSystemDir()
Private Function GetSystemDir()
    Dim strSysDir As String * 100
    Call GetSystemDirectory(strSysDir, 100)
    GetSystemDir = Left$(strSysDir, InStr(strSysDir, vbNullChar) - 1)   
End Function

本文由10bet手机官网发布于多线程,转载请注明出处:VB下几个非常有用的函数,解决用ADODB对Access数据库进行操作的一个问题

上一篇:中健壮的页结构的异常处理,asp中判断服务器是否安装了某种组件的函数10bet备用网址官网 下一篇:验证控件,net轻松打造功能完备的分页技术10bet手机官网:
猜你喜欢
热门排行
精彩图文