//声明:引用或转载时请保留作者姓名.'****************************************************'Writer: furenjun 2006.5.10'****************************************************Imports System.IOImports System.DataImports System.Data.SqlClientImports System.TextImports ADOXImports System.Data.OleDbImports ADODB
Public Class C_Mrfu_DBHR
'Private SqlCon As SqlConnection = New _ 'SqlConnection("data source=FURENJUN;initial catalog=CarDriManage;user id=sa;password=sa") '定义一个数据连接对象，并初始化 'Dim olecon2 As OleDbConnection = New OleDbConnection() 'Dim str1 As String = "d:\mrfu\jsdb.mdb" 'olecon2.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & str1 & "'" '''Build a connection string 'Dim connectionString As String = "" ' connectionString = "Provider=SQLOLEDB;" ' connectionString += "Server=FURENJUN;Database=pubs;" ' connectionString += "User ID=sa;Password=sa" 'SqlCon在启动窗体中对其实例化，并为其赋初值 '''Create and open a connection using the connection string ' adoOleDbConnection = New OleDbConnection(connectionString) '''Build a SQL statement to query the datasource 'Dim sqlString As String = "" ' sqlString = "Select * From authors where state='TN' " '''Retrieve the data using the SQL statement and existing connection ' adoOleDbDataAdapter = New OleDbDataAdapter(sqlString, adoOleDbConnection) '''Create a instance of a Dataset ' dataSet = New DataSet() '''Fill the dataset with the data retrieved. The name of the table '''in the dataset must be the same as the table name in the report. ' adoOleDbDataAdapter.Fill(dataSet, "authors") Private myDataSet As DataSet '定义一个数据集对象 Private mySqlDataAdapter As SqlDataAdapter '定义一个数据适配器对象 Private myOleDBDataAdapter As OleDbDataAdapter '定义一个数据适配器对象 'Private mySqlCon As SqlConnection '定义一个数据库连接对象 Private SqlCmd As SqlCommand '定义一个sql数据命令对象 Dim SqlServerName_Str_Pub As String '服务器名 Dim SqlUserName_Str_Pub As String '用户登录名 Dim SqlUserPassWord_Str_Pub As String '密码 Dim SqlInitDB_Str_Pub As String '默认数据库 Dim SqlLoginTimeout_Str_Pub As String '登录超时 Dim SqlConnectionTimeout_Str_Pub As String '连接超时 Dim m_sRunMsg As String = ""
Public Property GsRunMsg() As String
Get ' The Get property procedure is called when the value ' of a property is retrieved. Return m_sRunMsg End Get Set(ByVal Value As String) ' The Set property procedure is called when the value ' of a property is modified. ' The value to be assigned is passed in the argument to Set. m_sRunMsg = Value End Set
End Property '*************************************************************************************************************************************************' '1.数据库连接操作(SqlCon and OleDBCon ) '*************************************************************************************************************************************************' Private Function INI_Fun_Pub(ByVal SectionName As String, ByVal KeyName As String, ByVal DefaultStr As String, ByVal FileName As String) As String Dim FileLine_Str_Dim As String Dim SectionName_Str_Dim As String Dim FileLineNum_Str_Dim As Double Dim i As Integer Dim KeyName_Str_Dim As String Dim Information_Str_Dim As String Dim FileExist_Str_Dim As String Try ''''''''''''''''''''''''''''''查询文件是否存在 FileExist_Str_Dim = Dir(FileName) If FileExist_Str_Dim = "" Then INI_Fun_Pub = DefaultStr Else INI_Fun_Pub = DefaultStr FileOpen(1, FileName, OpenMode.Input) While Not EOF(1) FileLine_Str_Dim = Trim(LineInput(1)) If FileLine_Str_Dim <> "" Then '''''''''''''''''''''''''''''''判断是不是块索引部分 If Microsoft.VisualBasic.Left(Trim(FileLine_Str_Dim), 1) = "[" ThenEstimateSect: SectionName_Str_Dim = Trim(Mid(Trim(FileLine_Str_Dim), 2, Len(Trim(FileLine_Str_Dim)) - 2)) If Trim(SectionName_Str_Dim.ToUpper()) = Trim(SectionName.ToUpper()) Then While Not EOF(1) FileLine_Str_Dim = Trim(LineInput(1)) ''''''''''''''''''''''''''''进入块索引，引入下一句 If Microsoft.VisualBasic.Left(Trim(FileLine_Str_Dim), 1) = "[" Then '''''''''''''''''''''''如果还是块索引 GoTo EstimateSect Else FileLineNum_Str_Dim = Len(Trim(FileLine_Str_Dim)) For i = 1 To FileLineNum_Str_Dim KeyName_Str_Dim = Trim(Microsoft.VisualBasic.Left(FileLine_Str_Dim, i)) If Microsoft.VisualBasic.Right(Trim(KeyName_Str_Dim), 1) = "=" Then KeyName_Str_Dim = Trim(Microsoft.VisualBasic.Left(Trim(KeyName_Str_Dim), Len(Trim(KeyName_Str_Dim)) - 1)) Information_Str_Dim = Trim(Microsoft.VisualBasic.Right(Trim(FileLine_Str_Dim), Len(Trim(FileLine_Str_Dim)) - i)) If Trim(KeyName.ToUpper()) = Trim(KeyName_Str_Dim.ToUpper()) Then INI_Fun_Pub = Trim(Information_Str_Dim) FileClose(1) Exit Function Else Exit For End If End If Next End If End While End If End If End If End While FileClose(1) End If Catch m_sRunMsg = (Err.Description) End Try End Function Private Sub ReadIniFile() '*=====读INI=====* Try Dim MyPath As String MyPath = CurDir() 'MsgBox(MyPath) Dim str1, str2, str3, str4, str5, str6 As String SqlServerName_Str_Pub = INI_Fun_Pub("SQLSERVER", "MrFuServerName", "TestServer", MyPath & "\LinkMsSql.INI") SqlUserName_Str_Pub = INI_Fun_Pub("SQLSERVER", "MrFuUserName", "sa", MyPath & "\LinkMsSql.ini") SqlUserPassWord_Str_Pub = INI_Fun_Pub("SQLSERVER", "MrFuUserPassword", "athena", MyPath & "\LinkMsSql.ini") SqlInitDB_Str_Pub = INI_Fun_Pub("SQLSERVER", "MrFuInitDB", "AttSysDB", MyPath & "\LinkMsSql.ini") SqlLoginTimeout_Str_Pub = INI_Fun_Pub("SQLSERVER", "LoginTimeout", "20", MyPath & "\LinkMsSql.ini") SqlConnectionTimeout_Str_Pub = INI_Fun_Pub("SQLSERVER", "ConnectionTimeout", "30", MyPath & "\LinkMsSql.ini") 'str1 = INI_Fun_Pub("SQLSERVER", "ServerName", "TestServer", MyPath & "\LinkMsSql.INI") 'str2 = INI_Fun_Pub("SQLSERVER", "UserName", "sa", MyPath & "\LinkMsSql.ini") 'str3 = INI_Fun_Pub("SQLSERVER", "UserPassword", "athena", MyPath & "\LinkMsSql.ini") 'str4 = INI_Fun_Pub("SQLSERVER", "InitDB", "AttSysDB", MyPath & "\LinkMsSql.ini") 'str5 = INI_Fun_Pub("SQLSERVER", "LoginTimeout", "20", MyPath & "\LinkMsSql.ini") 'str6 = INI_Fun_Pub("SQLSERVER", "ConnectionTimeout", "30", MyPath & "\LinkMsSql.ini") 'MsgBox(str1 + str2 + str3 + str4 + str5 + str6) Catch m_sRunMsg = ("ReadIniFile 错误号: " & Err.Number.ToString & " 错误描述 : " & Err.Description.ToString) End Try End Sub Public Function SQL_Con() As SqlClient.SqlConnection Try ReadIniFile() ' Dim objSqlConnection As SqlConnection = New _ ' SqlConnection("data source=furenjun;initial catalog=CarDriManage;user id=sa;password=sa") Dim SqlCnn As SqlConnection = New SqlConnection("data source = " & SqlServerName_Str_Pub _ & ";user id=" & SqlUserName_Str_Pub _ & ";password=" & SqlUserPassWord_Str_Pub _ & ";initial catalog = " & SqlInitDB_Str_Pub) SQL_Con = SqlCnn Catch m_sRunMsg = ("SQL_Con 错误号: " & Err.Number.ToString & " 错误描述 : " & Err.Description.ToString) End Try End Function Public Function MyOleCon() As OleDb.OleDbConnection Dim adoOleDbConnection As OleDbConnection Try ReadIniFile() Dim connectionString As String = "" connectionString = "Provider=SQLOLEDB;Server =" & Trim(SqlServerName_Str_Pub) & ";Database=" & Trim(SqlInitDB_Str_Pub) & ";User ID=" & Trim(SqlUserName_Str_Pub) & ";Password=" & Trim(SqlUserPassWord_Str_Pub) '最好不要采用单行写再相加 ''Build a connection string 'Dim connectionString As String = "" 'connectionString = "Provider=SQLOLEDB;" 'connectionString += "Server=FURENJUN;Database=CarDriManage;" 'connectionString += "User ID=sa;Password=sa" adoOleDbConnection = New OleDbConnection(connectionString) Catch m_sRunMsg = (" MyOleCon 错误号: " & Err.Number.ToString & " 错误描述 : " & Err.Description.ToString) End Try Return adoOleDbConnection End Function Public Function MyOleConStr() As String Dim connectionString As String = "" Try ReadIniFile() connectionString = "Provider=SQLOLEDB; Server=" & Trim(SqlServerName_Str_Pub) & "; Database=" & Trim(SqlInitDB_Str_Pub) & "; User ID=" & Trim(SqlUserName_Str_Pub) & "; Password=" & Trim(SqlUserPassWord_Str_Pub) Catch m_sRunMsg = (" MyOleConStr 错误号: " & Err.Number.ToString & " 错误描述 : " & Err.Description.ToString) End Try Return connectionString End Function Public Function DataTransition_ADODBCon() As ADODB.Connection Dim conn As New ADODB.Connection Try ReadIniFile() 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" Catch m_sRunMsg = (" MyOleConStr 错误号: " & Err.Number.ToString & " 错误描述 : " & Err.Description.ToString) End Try DataTransition_ADODBCon = conn End Function Public Function SqlConStr() As String Dim sqlconstring As String = "" Try ReadIniFile() 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" Catch m_sRunMsg = ("错误号: " & Err.Number.ToString & " 错误描述 : " & Err.Description.ToString) End Try Return sqlconstring End Function Public Function SqlConStr2() As String Dim sqlconstring As String = "" Try ReadIniFile() sqlconstring = Trim(SqlServerName_Str_Pub) & "\" & Trim(SqlInitDB_Str_Pub) & "\" & Trim(SqlUserName_Str_Pub) & "\" & Trim(SqlUserPassWord_Str_Pub) Catch m_sRunMsg = ("SqlConStr 错误号: " & Err.Number.ToString & " 错误描述 : " & Err.Description.ToString) End Try Return sqlconstring End Function '*************************************************************************************************************************************************' '1.2.连接ACCESS数据库 '*************************************************************************************************************************************************' Public Function Access_OleDBCon(ByVal DBPath As String) As OleDbConnection Dim OleCon As OleDbConnection = New OleDbConnection 'Dim DBPath As String = "d:\mrfu\DriverManager.mdb" OleCon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & DBPath & "'" Return OleCon End Function '*************************************************************************************************************************************************' '对ACCESS数据库进行操作 '*************************************************************************************************************************************************' Public Function Access_ADODBConNeedPassword(ByVal DBPathAndDatabaseName As String, ByVal UserID As String, ByVal Password As String, ByVal SqlStr As String) As String Dim FlagStr As String = "0" Dim ConnectionString As String = "" ConnectionString = "DRIVER={Microsoft Access Driver (*.mdb)};" & _ "DBQ=" & DBPathAndDatabaseName & ";DefaultDir=;" & _ "UID=" & UserID & ";" & _ "PWD=" & Password & ";" Dim Adocon As ADODB.Connection Try Adocon = New ADODB.Connection Adocon.ConnectionString = ConnectionString Adocon.ConnectionTimeout = 120 Adocon.CommandTimeout = 160 Adocon.Open() Adocon.Execute(SqlStr) Adocon.Close() Adocon = Nothing FlagStr = "1" Catch If Adocon.State = ConnectionState.Open Then Adocon.Close() End If FlagStr = "0" m_sRunMsg = (Err.Description.ToString) ', MsgBoxStyle.Exclamation, "错误提示") End Try Return FlagStr End Function '*************************************************************************************************************************************************' '访问ACCESS数据库,并返回小批量数据 '*************************************************************************************************************************************************' 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 Dim TempArrayList As ArrayList TempArrayList = Nothing Dim rs As ADODB.Recordset Dim ConnectionString As String = "" ConnectionString = "DRIVER={Microsoft Access Driver (*.mdb)};" & _ "DBQ=" & DBPathAndDatabaseName & ";DefaultDir=;" & _ "UID=" & UserID & ";" & _ "PWD=" & Password & ";" Dim Adocon As ADODB.Connection Try Adocon = New ADODB.Connection Adocon.ConnectionString = ConnectionString Adocon.ConnectionTimeout = 120 Adocon.CommandTimeout = 160 Adocon.Open() rs = New ADODB.Recordset rs.Open(SqlStr, Adocon, ADODB.CursorTypeEnum.adOpenKeyset, ADODB.LockTypeEnum.adLockOptimistic, CInt(ADODB.CommandTypeEnum.adCmdText)) TempArrayList = New ArrayList '如果记录集为空,输出一个错误信息 If (rs.BOF Or rs.EOF) Then Adocon.Close() Adocon = Nothing rs = Nothing m_sRunMsg = ("没有找到任何记录,请检查你的" & TableName & " 表 ") ', MsgBoxStyle.Information, "系统消息") Return TempArrayList End If '循环存入数据 While (Not rs.EOF) TempArrayList.Add(rs.Fields(FiledsName).Value.ToString()) rs.MoveNext() End While Adocon.Close() Adocon = Nothing rs = Nothing Catch If Adocon.State = ConnectionState.Open Then Adocon.Close() End If m_sRunMsg = (Err.Description.ToString) ', MsgBoxStyle.Exclamation, "错误提示") End Try Return TempArrayList End Function '*************************************************************************************************************************************************' '访问ACCESS数据库,并返回数据集 '*************************************************************************************************************************************************' 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 Dim custDA As OleDbDataAdapter = New OleDbDataAdapter Dim custDS As DataSet = New DataSet Dim rs As ADODB.Recordset Dim ConnectionString As String = "" ConnectionString = "DRIVER={Microsoft Access Driver (*.mdb)};" & _ "DBQ=" & DBPathAndDatabaseName & ";DefaultDir=;" & _ "UID=" & UserID & ";" & _ "PWD=" & Password & ";" Dim Adocon As ADODB.Connection Try Adocon = New ADODB.Connection Adocon.ConnectionString = ConnectionString Adocon.ConnectionTimeout = 120 Adocon.CommandTimeout = 160 Adocon.Open() rs = New ADODB.Recordset rs.Open(SqlStr, Adocon, ADODB.CursorTypeEnum.adOpenKeyset, ADODB.LockTypeEnum.adLockOptimistic, CInt(ADODB.CommandTypeEnum.adCmdText)) '如果记录集为空,输出一个错误信息 If (rs.BOF Or rs.EOF) Then Adocon.Close() Adocon = Nothing rs = Nothing m_sRunMsg = ("没有找到任何记录,请检查你的" & TableName & " 表 ") ', MsgBoxStyle.Information, "系统消息") Return custDS End If '存入dataset数据 custDA.Fill(custDS, rs, "Customers") Adocon.Close() Adocon = Nothing rs = Nothing Catch If Adocon.State = ConnectionState.Open Then Adocon.Close() End If m_sRunMsg = (Err.Description.ToString) ', MsgBoxStyle.Exclamation, "错误提示") End Try Return custDS End Function '*************************************************************** '取出Access数据库中的所有表名 '*************************************************************** Public Function GetTableNameFromAccess(ByVal AccessDbPathAndFileName As String) As ArrayList Dim TablesArray As New ArrayList Dim cnn1 As New ADODB.Connection Dim cmd1 As New ADODB.Command Dim tbl1 As New Table Try cnn1.Open("Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & AccessDbPathAndFileName) Dim cat1 As New Catalog cat1.ActiveConnection = cnn1 Dim i As Integer = cat1.Tables.Count '统计access库中表的个数 ' MsgBox("共有 " & CStr(i) & "张表") 'Dim TableName1(i + 1) As String Dim j As Integer = 0 If i > 0 Then For j = 0 To i - 1 ' TableName1(j) = (cat1.Tables(j).Name.ToString) ' MsgBox("表名:" & TableName1(j)) TablesArray.Add(cat1.Tables(j).Name.ToString()) Next j End If cnn1.Close() Catch ex As Exception If (cnn1.State = ConnectionState.Open) Then cnn1.Close() End If End Try Return TablesArray End Function '*********************************************************************** '在Access表执行Sql语句 '*********************************************************************** Public Function ExecuteSqlstrInAccess(ByVal AccessDbPathAndFileName As String, ByVal SqlStr As String) As Boolean Dim bResult As Boolean = True Dim cnn1 As New ADODB.Connection Dim cmd1 As New ADODB.Command Dim tbl1 As New Table Try cnn1.Open("Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & AccessDbPathAndFileName) cmd1 = New ADODB.Command With cmd1 .ActiveConnection = cnn1 .CommandText = SqlStr '执行 select ,insert,update,delete 等sql语句. .CommandType = ADODB.CommandTypeEnum.adCmdText .Execute() End With cnn1.Close() Catch ex As Exception bResult = False If (cnn1.State = ConnectionState.Open) Then cnn1.Close() End If m_sRunMsg = (Err.Description.ToString) ', MsgBoxStyle.Information, "ExecuteSqlstrInAccess错误提示") End Try Return bResult End Function '*************************************************************************************************************************************************' '2.调用存储过程操纵数据库 '*************************************************************************************************************************************************' Public Function P_GetDataFromDB(ByVal Proc1 As String, ByVal mySqlCon As SqlConnection) As DataSet myDataSet = New DataSet myDataSet.Clear() '实例化一个数据集对象 Dim scmd As New SqlCommand scmd = New SqlCommand(Proc1, mySqlCon) scmd.CommandType = CommandType.StoredProcedure Dim mySqlDataadapter1 As New SqlDataAdapter mySqlDataadapter1 = New SqlDataAdapter(scmd) Try mySqlCon.Open() mySqlDataadapter1.Fill(myDataSet) Catch myDataSet = Nothing m_sRunMsg = ("P_GetDataFromDB 错误号：" & Err.Number.ToString & "错误描述：" & Err.Description.ToString) Finally If mySqlCon.State = ConnectionState.Open Then mySqlCon.Close() End If End Try Return myDataSet End Function '使用存储过程和数据阅读器获取数据 Public Function P_ExecAddPra(ByVal ProStr1 As String, ByVal Pram1 As String, ByVal Pram2 As String, ByVal SqlCon1 As SqlConnection) As SqlDataReader Dim myReader As SqlClient.SqlDataReader Dim scmd As New SqlCommand(ProStr1, SqlCon1) scmd.CommandType = CommandType.StoredProcedure With scmd.Parameters '.Add(New SqlParameter("@no", SqlDbType.VarChar)).Value = "NO.1005" '.Add(New SqlParameter("@cb", SqlDbType.VarChar)).Value = "CB.1006" '或者采用下面的方法也可 .Add(Pram2, SqlDbType.VarChar, 50) .Item(Pram2).Value = Pram1 End With Try myReader = Nothing SqlCon1.Open() myReader = scmd.ExecuteReader Catch expsql As SqlException 'MsgBox(expsql.ToString & "错误号 :" & Err.Number & "错误描述 :" & Err.Description, MessageBoxButtons.OK, MessageBoxIcon.Error) myReader.Close() m_sRunMsg = ("P_ExecAddPra 错误号：" & Err.Number.ToString & "错误描述：" & Err.Description.ToString) Finally If SqlCon1.State = ConnectionState.Open Then SqlCon1.Close() '关闭连接 End If End Try Return myReader End Function Public Function P_ExecAndAddPra2(ByVal ProStr1 As String, ByVal praWorth As String, ByVal PraVar As String, ByVal SqlCon1 As SqlConnection) As String Dim scmd As New SqlCommand(ProStr1, SqlCon1) Dim resultStr As String = "" scmd.CommandType = CommandType.StoredProcedure With scmd.Parameters '.Add(New SqlParameter("@no", SqlDbType.VarChar)).Value = "NO.1005" '.Add(New SqlParameter("@cb", SqlDbType.VarChar)).Value = "CB.1006" '或者采用下面的方法也可 .Add(PraVar, SqlDbType.VarChar, 50) .Item(PraVar).Value = praWorth End With Try SqlCon1.Open() resultStr = scmd.ExecuteScalar Catch expsql As SqlException 'MessageBox.Show(expsql.ToString, MessageBoxButtons.OK, MessageBoxIcon.Error) m_sRunMsg = ("P_ExecAndAddPra2 错误号：" & Err.Number.ToString & "错误描述：" & Err.Description.ToString) Finally If SqlCon1.State = ConnectionState.Open Then SqlCon1.Close() End If End Try Return resultStr End Function Public Function P_ExecAndAddPra4(ByVal ProName As String, ByVal PraVar1 As String, ByVal praValue1 As String, ByVal PraVar2 As String, ByVal praValue2 As String, ByVal SqlCon1 As SqlConnection) As String Dim scmd As New SqlCommand(ProName, SqlCon1) Dim resultStr As String = "-1" scmd.CommandType = CommandType.StoredProcedure With scmd.Parameters '.Add(New SqlParameter("@no", SqlDbType.VarChar)).Value = "NO.1005" '.Add(New SqlParameter("@cb", SqlDbType.VarChar)).Value = "CB.1006" .Add(New SqlParameter(PraVar1, SqlDbType.VarChar)).Value = praValue1 .Add(New SqlParameter(PraVar2, SqlDbType.VarChar)).Value = praValue2 '或者采用下面的方法也可 '.Add(PraVar1, SqlDbType.VarChar, 50) '.Item(PraVar1).Value = praWorth1 End With Try SqlCon1.Open() resultStr = Convert.ToString(scmd.ExecuteScalar) Catch expsql As SqlException 'MessageBox.Show(expsql.ToString, MessageBoxButtons.OK, MessageBoxIcon.Error) resultStr = "-1" m_sRunMsg = ("P_ExecAndAddPra2 错误号：" & Err.Number.ToString & "错误描述：" & Err.Description.ToString) Finally If SqlCon1.State = ConnectionState.Open Then SqlCon1.Close() End If End Try Return resultStr End Function Public Function P_ExecAndAddPra3(ByVal ProStr1 As String, ByVal PraWorth1 As String, ByVal PraVar1 As String, ByVal PraWorth2 As String, ByVal PraVar2 As String, ByVal SqlCon1 As SqlConnection) As Integer Dim n As Integer = 0 Dim scmd As New SqlCommand(ProStr1, SqlCon1) Dim resultStr As String = "" scmd.CommandType = CommandType.StoredProcedure With scmd.Parameters '.Add(New SqlParameter("@no", SqlDbType.VarChar)).Value = "NO.1005" '.Add(New SqlParameter("@cb", SqlDbType.VarChar)).Value = "CB.1006" '或者采用下面的方法也可 .Add(PraVar1, SqlDbType.VarChar, 50) .Item(PraVar1).Value = PraWorth1 .Add(PraVar2, SqlDbType.VarChar, 50) .Item(PraVar2).Value = PraWorth2 End With Try SqlCon1.Open() resultStr = scmd.ExecuteNonQuery n = 1 Catch expsql As SqlException m_sRunMsg = ("P_ExecAndAddPra3 错误号：" & Err.Number.ToString & "错误描述：" & Err.Description.ToString) n = 0 Finally If SqlCon1.State = ConnectionState.Open Then SqlCon1.Close() '关闭连接 End If End Try Return n End Function Public Function P_ExecAndNoPra(ByVal ProStr1 As String, ByVal SqlCon1 As SqlConnection) As Integer Dim n As Integer = 0 Dim scmd As New SqlCommand(ProStr1, SqlCon1) Dim resultStr As String = "" scmd.CommandType = CommandType.StoredProcedure Try SqlCon1.Open() resultStr = scmd.ExecuteNonQuery n = 1 Catch expsql As SqlException m_sRunMsg = ("P_ExecAndNoPra 错误号：" & Err.Number.ToString & "错误描述：" & Err.Description.ToString) n = 0 Finally If SqlCon1.State = ConnectionState.Open Then SqlCon1.Close() '关闭连接 End If End Try Return n End Function '*************************************************************************************************************************************************' '3.创建ACCESS数据库 '*************************************************************************************************************************************************' Public Function CreateAccessDB(ByVal NewDBPathName As String) As Integer Dim i As Integer = 1 Dim cat As Catalog = New Catalog Try cat.Create("Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & NewDBPathName & _ "Jet OLEDB:Engine Type=5") 'Console.WriteLine("Database Created Successfully") Catch i = 0 m_sRunMsg = ("CreateAccessDB 错误号 : " & Err.Number.ToString & " 错误描述：" & Err.Description.ToString) End Try cat = Nothing Return i End Function '*************************************************************************************************************************************************' '4.获取或更新数据库中的数据 '*************************************************************************************************************************************************' Public Function GetMaxNumFrom_SqlDB(ByVal SqlStr As String, ByVal mySqlCon As SqlConnection, ByVal TableName As String) As String '获取当前所有纪录的最大纪录号 Dim str2 As String = "1000" Dim myDataset2 As DataSet myDataset2 = New DataSet mySqlCon.Open() Try myDataset2.Clear() myDataset2 = GetDataFrom_SqlDB(SqlStr, mySqlCon, TableName) str2 = myDataset2.Tables(0).Rows(0).Item(0) Dim m As Integer = 0 m = myDataset2.Tables(0).Rows.Count() If m = 0 Then str2 = "0001" m_sRunMsg = ("没有找到最大值，系统自动生成初始编号'0001'.") ', MsgBoxStyle.Information, "提示") Else Dim n As Integer = CInt(str2) + 1 str2 = CStr(n) ' MsgBox("最大值为:" & str2) End If Catch exp As Exception myDataSet = Nothing m_sRunMsg = (" GetMaxNumFrom_SqlDB 错误号：" & Err.Number & "错误描述：" & Err.Description) Finally If mySqlCon.State = ConnectionState.Open Then mySqlCon.Close() '关闭连接 End If End Try Return str2 End Function Public Function GetDataFrom_SqlDB(ByVal SqlStr As String, ByVal mySqlCon As SqlConnection, ByVal TableName As String) As DataSet '注意此处mysqlcon要采用动态连接 'mySqlCon = New SqlConnection() 'SqlCnn1 = New CTYSqlCon_CLB.Class1() 'mySqlCon = SqlCnn1.MSSQLLink myDataSet = New DataSet myDataSet.Clear() '实例化一个数据集对象 Try mySqlCon.Open() '打开数据库连接 mySqlDataAdapter = New SqlDataAdapter(SqlStr, mySqlCon) '将数据库的数据映射到数据适配器 mySqlDataAdapter.Fill(myDataSet, TableName) '填充数据集的数据 Catch myDataSet = Nothing m_sRunMsg = (" GetDataFrom_SqlDB 错误号：" & Err.Number.ToString & "错误描述：" & Err.Description.ToString) Finally If mySqlCon.State = ConnectionState.Open Then mySqlCon.Close() '关闭数据连接，这一点很重要 End If End Try Return myDataSet End Function '***************************************************** '获取sql数据库中用户所建表的表名,id号 '***************************************************** Public Function GetUserTableNameFrom_SqlDB(ByVal mySqlCon As SqlConnection) As DataSet '注意此处mysqlcon要采用动态连接 'mySqlCon = New SqlConnection() 'SqlCnn1 = New CTYSqlCon_CLB.Class1() 'mySqlCon = SqlCnn1.MSSQLLink Dim SqlStr As String = "select name,id from sysobjects where xtype='U'" Dim TableName As String = "sysobjects" myDataSet = New DataSet myDataSet.Clear() '实例化一个数据集对象 Try mySqlCon.Open() '打开数据库连接 mySqlDataAdapter = New SqlDataAdapter(SqlStr, mySqlCon) '将数据库的数据映射到数据适配器 mySqlDataAdapter.Fill(myDataSet, TableName) '填充数据集的数据 Catch myDataSet = Nothing m_sRunMsg = (" GetDataFrom_SqlDB 错误号：" & Err.Number.ToString & "错误描述：" & Err.Description.ToString) Finally If mySqlCon.State = ConnectionState.Open Then mySqlCon.Close() '关闭数据连接，这一点很重要 End If End Try Return myDataSet End Function '************************************************** '更新Sql数据库，返回受影响的纪录条数 '************************************************** Public Function Update_Sql_Data(ByVal SqlStr As String, ByVal mySqlCon As SqlConnection) As Double '注意此处mysqlcon要采用动态连接 Dim objCommand As SqlCommand = New SqlCommand 'mySqlCon = New SqlConnection() 'SqlCnn1 = New CTYSqlCon_CLB.Class1() 'mySqlCon = SqlCnn1.MSSQLLink '此处应用到具体项目中的全局变量，到程序中先行实例化． Dim i As Double = 0 Try mySqlCon.Open() objCommand.Connection = mySqlCon objCommand.CommandText = SqlStr objCommand.CommandType = CommandType.Text i = objCommand.ExecuteNonQuery() Catch i = 0 m_sRunMsg = ("Update_Sql_Data 错误号：" & Err.Number.ToString & "错误描述：" & Err.Description.ToString) Finally If mySqlCon.State = ConnectionState.Open Then mySqlCon.Close() '关闭连接 End If End Try Return i End Function '************************************************** '更新Sql数据库，返回受影响的纪录条数 '************************************************** Public Function Get_Sql_ExecuteScalar(ByVal SqlStr As String, ByVal mySqlCon As SqlConnection) As Double '注意此处mysqlcon要采用动态连接 Dim objCommand As SqlCommand = New SqlCommand 'mySqlCon = New SqlConnection() 'SqlCnn1 = New CTYSqlCon_CLB.Class1() 'mySqlCon = SqlCnn1.MSSQLLink '此处应用到具体项目中的全局变量，到程序中先行实例化． Dim i As Double = 0 Try mySqlCon.Open() objCommand.Connection = mySqlCon objCommand.CommandText = SqlStr objCommand.CommandType = CommandType.Text i = Convert.ToInt64(objCommand.ExecuteScalar()) Catch i = 0 m_sRunMsg = ("Update_Sql_Data 错误号：" & Err.Number.ToString & "错误描述：" & Err.Description.ToString) Finally If mySqlCon.State = ConnectionState.Open Then mySqlCon.Close() '关闭连接 End If End Try Return i End Function Public Function GetDataFrom_OleDB(ByVal SqlStr As String, ByVal myOleDBCon As OleDbConnection, ByVal TableName As String) As DataSet '注意此处mysqlcon要采用动态连接 myDataSet = New DataSet myDataSet.Clear() '实例化一个数据集对象 Try myOleDBCon.Open() '打开数据库连接 myOleDBDataAdapter = New OleDbDataAdapter(SqlStr, myOleDBCon) '将数据库的数据映射到数据适配器 myOleDBDataAdapter.Fill(myDataSet, TableName) Catch myDataSet = Nothing m_sRunMsg = (" GetDataFrom_OleDB 错误号：" & Err.Number & "错误描述：" & Err.Description) Finally If myOleDBCon.State = ConnectionState.Open Then myOleDBCon.Close() '关闭连接 End If End Try Return myDataSet End Function '********************************************************* '更新（UPDATE、INSERT 和 DELETE）采用ole方式联接的数据库,返回受影响的纪录条数 '********************************************************* Public Function UpDate_OleDB(ByVal SqlStr As String, ByVal OleDBCon As OleDbConnection) As Integer 'Dim SqlConStr As String = "provider=SQLOLEDB.1;Data Source=" & _ '"localhost;uid=sa;pwd=sa;Initial Catalog=CarDriManage;" Dim i As Integer = 0 Try 'Dim OleDBCon As New OleDbConnection(SqlConStr) OleDBCon.Open() Dim oleSqlCommand As New OleDbCommand(SqlStr, OleDBCon) oleSqlCommand.CommandText = SqlStr i = oleSqlCommand.ExecuteNonQuery() Catch e As Exception i = 0 m_sRunMsg = (" UpDate_OleDB 错误号：" & Err.Number & "错误描述：" & Err.Description) Finally If OleDBCon.State = ConnectionState.Open Then OleDBCon.Close() '关闭连接 End If End Try Return i End Function '********************************************************* '访问采用ole方式联接的数据库,返回结果的第一行第一列 '********************************************************* Public Function OleDB_ExecuteScalar(ByVal SqlStr As String, ByVal OleDBCon As OleDbConnection) As Integer 'Dim SqlConStr As String = "provider=SQLOLEDB.1;Data Source=" & _ '"localhost;uid=sa;pwd=sa;Initial Catalog=CarDriManage;" '如:select count(*) from myTableName where yourCondition Dim ValueOfFirstRowFirstColumn As Integer = Nothing Try 'Dim OleDBCon As New OleDbConnection(SqlConStr) OleDBCon.Open() Dim oleSqlCommand As New OleDbCommand(SqlStr, OleDBCon) oleSqlCommand.CommandText = SqlStr ValueOfFirstRowFirstColumn = oleSqlCommand.ExecuteScalar Catch e As Exception ValueOfFirstRowFirstColumn = Nothing m_sRunMsg = (" UpDate_OleDB 错误号：" & Err.Number & "错误描述：" & Err.Description) Finally If OleDBCon.State = ConnectionState.Open Then OleDBCon.Close() '关闭连接 End If End Try Return ValueOfFirstRowFirstColumn End Function '使用数据阅读器获取数据 Public Function Get_SqlData_UseReader(ByVal SqlStr As String, ByVal SqlCon As SqlConnection) As ArrayList '返回使用大小按需分配的数组 Dim Command As New SqlCommand(SqlStr, SqlCon) Dim myAL As New ArrayList '动态增长容量的数组 Dim myDR As SqlClient.SqlDataReader Try SqlCon.Open() 'executeReader method returns a SqlDataReader 'that allows you to sequentially read data from a table myDR = Command.ExecuteReader 'create an arraylist object While myDR.Read myAL.Add(myDR.GetValue(0)) 'myDR.GetValues End While Catch myAL = Nothing m_sRunMsg = (" Get_SqlData_UseReader 错误号：" & Err.Number & "错误描述：" & Err.Description) Finally If SqlCon.State = ConnectionState.Open Then SqlCon.Close() '关闭连接 End If If myDR.IsClosed = False Then myDR.Close() End If End Try Return myAL End Function
End Class