How to code in VB to get connected with SQL database and to perform delete function in one of the tables
VB as Front end and SQL as database
Collapse
X
-
From VB.NETOriginally posted by BSBHow to code in VB to get connected with SQL database and to perform delete function in one of the tables
---------------------
connect direct to SqlSever (MS SQL Server Studio 2005)
*************** *************** *************** *************** *****
Imports System.Data.Sql Client
Dim Cnn As New SqlConnection
Dim CnnStr$
CnnStr = "Data Source=PC2\SQLE XPRESS;Initial Catalog=KhmerDi ctionary;Integr ated Security=True;P ooling=False;"
Cnn = New SqlConnection(C nnStr)
Cnn.Open()
*************** *************** *************** *************** ******
Connect Indirect to Sql Server Database File
----------------------------------------------------------------------------------
Imports System.Data.Sql Client
Dim Cnn As New SqlConnection
Dim CnnStr$
CnnStr="Data Source=.\SQLEXP RESS;AttachDbFi lename="C:\Nimo lProject\Dictio nary Testing\Origina l DBDictionary\Kh merDictionary.m df";Integrate d Security=True;C onnect Timeout=30;User Instance=True"
Cnn = New SqlConnection(C nnStr)
Cnn.Open()
-----------------------------------------------------------------------------------------
Delete All Record or one Record by use Sql Command
*************** *************** *************** *************** ***********
Below is some usefull of DataBase Procedure Insert /Update/Delete
'Module2
-------------------------------------------------------------------------------------------------
Imports System.Data.Sql Client
Module Module2
Dim cnn As New SqlClient.SqlCo nnection
Public LocPos As Integer
Public TotalPos As Integer
Public Enum CustomDel
DellAll = 1
DelCustom = 2
End Enum
Public Enum Optionshow
SHowAllFields = 1
SHowSomeField = 2
End Enum
Sub DeleteData(ByVa l tbl As String, ByVal FieldCon As String, ByVal ValueCon As String, ByVal Deloption As CustomDel)
Try
Dim cm As New SqlClient.SqlCo mmand
Dim del As Integer
Dim SQLa As String : Dim SQLc As String
SQLa = "delete * from " & tbl
SQLc = "delete from " & tbl & " where " & FieldCon & "='" & ValueCon & "'"
Select Case Deloption
Case 1 : del = CustomDel.DellA ll : cm.CommandText = SQLa
Case 2 : del = CustomDel.DelCu stom : cm.CommandText = SQLc
End Select
cm.Connection = cnn
cm.ExecuteNonQu ery()
Catch ex As Exception
MsgBox(ex.Messa ge)
End Try
End Sub
Sub TransferData2tx t(ByVal frm As Form, ByVal tbl As String, ByVal Pos As Integer, ByVal ParamArray Txt() As String)
Dim cm As New SqlClient.SqlCo mmand
Dim ds As New DataSet
Dim adp As New SqlClient.SqlDa taAdapter
Dim ct As Control : Dim i As Integer
On Error GoTo err
cm.CommandText = "select * from " & tbl
cm.Connection = cnn
adp = New SqlClient.SqlDa taAdapter("sele ct * from " & tbl, cnn)
ds = New DataSet(tbl)
adp.Fill(ds, tbl)
TotalPos = ds.Tables(tbl). Rows.Count - 1
adp.Dispose()
Dim dr As SqlClient.SqlDa taReader = cm.ExecuteReade r
If ds Is Nothing Then Return
With ds.Tables(tbl). Rows(Pos)
For Each ct In frm.Controls
If TypeOf ct Is TextBox Then
For i = 0 To UBound(Txt)
If LCase(Txt(i)) = LCase(ct.Name) Then
ct.Text = .Item(i).ToStri ng
i = i + 1 : Exit For
End If
Next
End If
Next
End With
dr.Close()
err: Exit Sub
End Sub
Function IDcreator(ByVal tbl As String, ByVal IDStyle As String, ByVal Connector As String, ByVal FormatNumber As String, ByVal Field As String) As String
Dim cm As New SqlClient.SqlCo mmand
Dim da As New SqlClient.SqlDa taAdapter
Dim ds As New DataSet()
Dim Tem As String
Try
ds = New DataSet(tbl)
da = New SqlClient.SqlDa taAdapter("sele ct * from " & tbl, cnn)
da.Fill(ds, tbl)
Dim RecordCount = ds.Tables(tbl). Rows.Count() 'count all records in one table
Tem = IDStyle & Connector & Format(RecordCo unt + 1, FormatNumber)
Dim i = 1
Do
i = i + 1
cm.CommandText = "select * from " & tbl & " where " & Field & " = '" & Tem & "'"
cm.Connection = cnn
Dim rst As SqlClient.SqlDa taReader = cm.ExecuteReade r
If rst.HasRows Then
Tem = IDStyle & Connector & Format(RecordCo unt + i, FormatNumber)
rst.Close()
Else : IDcreator = Tem : Exit Function
End If
Loop
Catch ex As Exception
MsgBox(ex.Messa ge)
End Try
End Function
Sub showDataTolst(B yVal tbl As String, ByVal lst As ListView, ByVal showOption As Optionshow, ByVal ParamArray SelectField() As String)
Dim cm As New SqlClient.SqlCo mmand
Dim da As New SqlClient.SqlDa taAdapter
Dim ds As New DataSet()
Dim Opt As Integer, TemField As String
Dim a As Integer, Sql As String, i%, ii%
Dim ColH As ColumnHeader
lst.View = View.Details
lst.Clear()
Select Case showOption
Case 1 : Opt = Optionshow.SHow AllFields
Sql = "select * from " & tbl
Case 2 : Opt = Optionshow.SHow SomeField
For a = 0 To UBound(SelectFi eld)
TemField = TemField & SelectField(a) & ","
Next
TemField = Strings.Left(Te mField, Len(TemField) - 1)
Sql = "select " & TemField & " from " & tbl
End Select
cm.CommandText = Sql
cm.Connection = cnn
da = New SqlClient.SqlDa taAdapter(Sql, cnn)
ds = New DataSet(tbl)
da.Fill(ds, tbl)
For i = 0 To ds.Tables(tbl). Columns.Count - 1
Dim fieldName = ds.Tables(tbl). Columns(i).Colu mnName ' find caption of field name
ColH = New ColumnHeader()
ColH.Text = fieldName
lst.Columns.Add (ColH)
Next
For Each ColH In lst.Columns
ColH.Width = 90
Next
Dim dr As SqlClient.SqlDa taReader = cm.ExecuteReade r
While dr.Read
Dim lstitem As ListViewItem
For i = 0 To dr.FieldCount - 1
lstitem = New ListViewItem(dr .Item(i).ToStri ng)
For ii = 1 To dr.FieldCount - 1
lstitem.SubItem s.Add(dr.Item(i i).ToString)
Next
lst.Items.Add(l stitem)
Exit For
Next
End While
dr.Close()
End Sub
Sub AddNewRecord(By Val tbl As String, ByVal ParamArray Data() As String)
Dim cm As New SqlClient.SqlCo mmand
Dim da As New SqlClient.SqlDa taAdapter
Dim ds As New DataSet()
Dim Temp As String
Dim FTemp As String
Try
ds = New DataSet(tbl)
da = New SqlClient.SqlDa taAdapter("sele ct * from " & tbl, cnn)
da.Fill(ds, tbl)
Dim i As Integer
For i = 0 To UBound(Data)
Dim fieldName = ds.Tables(tbl). Columns(i).Colu mnName ' find caption of field name
Temp = Temp & fieldName & ","
FTemp = FTemp & "'" & Data(i) & "'" & ","
Next
Temp = Strings.Left(Te mp, Len(Temp) - 1)
FTemp = Strings.Left(FT emp, Len(FTemp) - 1)
Dim sql As String
sql = "Insert into " & tbl & "(" & Temp & ")" & " Values(" & FTemp & ")"
cm.CommandText = sql
cm.Connection = cnn
cm.ExecuteNonQu ery()
Catch ex As Exception
MsgBox(ex.Messa ge)
End Try
End Sub
Sub UpDateDataToTab le(ByVal tbl As String, ByVal FieldCon As String, ByVal ValueCon As String, ByVal ParamArray Data() As String)
Try
Dim Temp As String
Dim cm As New SqlClient.SqlCo mmand
Dim da As New SqlClient.SqlDa taAdapter
Dim ds As New DataSet()
ds = New DataSet(tbl)
da = New SqlClient.SqlDa taAdapter("sele ct * from " & tbl, cnn)
da.Fill(ds, tbl)
Dim i As Integer
For i = 0 To UBound(Data)
Dim fieldName = ds.Tables(tbl). Columns(i).Colu mnName ' find caption of field name
Temp = Temp & fieldName & "='" & Data(i) & "',"
Next
Temp = Strings.Left(Te mp, Len(Temp) - 1)
cm.CommandText = "update " & tbl & " set " & Temp & " where " & FieldCon & "='" & ValueCon & "'"
cm.Connection = cnn
cm.ExecuteNonQu ery()
Catch ex As Exception
MsgBox(ex.Messa ge)
End Try
End Sub
End Module
------------------------------------------------------------------------------------------------------------------
Example
*************** *************** *************** *************** *************** *************** *
sub Form_load
TransferData2tx t (Me, "ProductInf o", , "TextBox1", "TextBox2", "TextBox3", "TextBox4")
showDataTolst(" ProductInfo", Me.Lst, Optionshow.SHow AllFields)
end sub
Private Sub CmdFirst_Click( ByVal sender As System.Object, ByVal e As System.EventArg s) Handles CmdFirst.Click
Lst.Items(LocPo s).Selected = False
LocPos = 0 : Me.lblrecord.Te xt = "1 / " & TotalPos + 1
TransferData2tx t(Me, "ProductInf o", LocPos, "TextBox1", "TextBox2", "TextBox3", "TextBox4")
Lst.Items(LocPo s).Selected = True
End Sub
Private Sub CmdLast_Click(B yVal sender As Object, ByVal e As System.EventArg s) Handles CmdLast.Click
Lst.Items(LocPo s).Selected = False
LocPos = TotalPos : Me.lblrecord.Te xt = TotalPos + 1 & " / " & TotalPos + 1
TransferData2tx t(Me, "ProductInf o", LocPos, "TextBox1", "TextBox2", "TextBox3", "TextBox4")
Lst.Items(LocPo s).Selected = True
End Sub
Private Sub CmdNext_Click(B yVal sender As Object, ByVal e As System.EventArg s) Handles CmdNext.Click
Lst.Items(LocPo s).Selected = False
If LocPos >= TotalPos Then
lblrecord.Text = TotalPos + 1 & " OF " & TotalPos + 1
Else
LocPos = LocPos + 1
lblrecord.Text = LocPos + 1 & " / " & TotalPos + 1
TransferData2tx t(Me, "ProductInf o", LocPos, "TextBox1", "TextBox2", "TextBox3", "TextBox4")
Lst.Items(LocPo s).Selected = True
End If
End Sub
Private Sub CmdPre_Click(By Val sender As System.Object, ByVal e As System.EventArg s) Handles CmdPre.Click
Lst.Items(LocPo s).Selected = False
If LocPos = 0 Then
lblrecord.Text = 1 & " OF " & TotalPos + 1
Else
LocPos = LocPos - 1
lblrecord.Text = LocPos + 1 & " / " & TotalPos + 1
TransferData2tx t(Me, "ProductInf o", LocPos, "TextBox1", "TextBox2", "TextBox3", "TextBox4")
Lst.Items(LocPo s).Selected = True
End If
End Sub
Private Sub CmdNew_Click(By Val sender As System.Object, ByVal e As System.EventArg s) Handles CmdNew.Click
TextBox1.Text = IDcreator("Prod uctInfo", "Pro", "-", "0000", "ProID")
TextBox2.Clear( ) : TextBox3.Clear( ) : TextBox4.Clear( )
End Sub
Private Sub CmdSave_Click(B yVal sender As System.Object, ByVal e As System.EventArg s) Handles CmdSave.Click
If TextBox3.Text = "" Or IsNumeric(TextB ox3.Text) = False Then
ErrorProvider1. SetError(TextBo x3, "Invalid Data ! Please Check Your Data")
ElseIf TextBox4.Text = "" Or IsNumeric(TextB ox4.Text) = False Then
ErrorProvider2. SetError(TextBo x4, "Invalid Data ! Please Check Your Data")
Else
AddNewRecord("P roductinfo", TextBox1.Text, TextBox2.Text, TextBox3.Text, TextBox4.Text)
showDataTolst(" ProductInfo", Me.Lst, Optionshow.SHow AllFields)
End If
End Sub
Private Sub CmdDelete_Click (ByVal sender As System.Object, ByVal e As System.EventArg s) Handles CmdDelete.Click
DeleteData("Pro ductInfo", "Proid", TextBox1.Text, CustomDel.DelCu stom)
showDataTolst(" ProductInfo", Me.Lst, Optionshow.SHow AllFields)
End Sub
Private Sub CmdUpdate_Click (ByVal sender As System.Object, ByVal e As System.EventArg s) Handles CmdUpdate.Click
UpDateDataToTab le("ProductInfo ", "Proid", TextBox1.Text, TextBox1.Text, TextBox2.Text, TextBox3.Text, TextBox4.Text)
showDataTolst(" ProductInfo", Me.Lst, Optionshow.SHow AllFields)
End Sub
Private Sub Lst_SelectedInd exChanged(ByVal sender As System.Object, ByVal e As System.EventArg s) Handles Lst.SelectedInd exChanged
Dim i%
i = Lst.FocusedItem .Index
'MsgBox(Lst.Ite ms(i).ToString)
TransferData2tx t(Me, "ProductInf o", i, "TextBox1", "TextBox2", "TextBox3", "TextBox4")
End Sub
That All From Anatha Man bye bye..
E-mail address removed by Moderator
if my code does not work well pls contact my Email -
But still you did not mention your versions?Originally posted by BSBHow to code in VB to get connected with SQL database and to perform delete function in one of the tablesComment
-
sorry i am in the work and my company they don't use VB6, They use VB2005Originally posted by hariharanmcaBut still you did not mention your versions?
and VB6 in own computer at home.
if i free time i will answer this question in VB6 as soon as possible na..
bye bye..Comment
Comment