Link to home
Create AccountLog in
Avatar of Latzi_Marian
Latzi_MarianFlag for Australia

asked on

How to stop duplicates being written from VB6 code to SQL Table

I have a project where I have to write to an SQL database some values (32 values) .Here's the routine which does the job:

Private Sub Write_To_SQL()
    Dim Var
    Dim sDate As String
    Dim Connection, RS
    Dim rsField, iFieldCount
    Dim SQLStmt As String
    Dim sstring As String
    sDate = Format(DateTime.Now, vbGeneralDate)
   
    Set Connection = CreateObject("ADODB.Connection")
   
    Set RS = New ADODB.Recordset
   
    Connection.Open "driver=SQL Server;server=(local);uid=;pwd=;database=DATA_LOG;"
 

    SQLStmt = "INSERT INTO    Recipes_West_Table   " & _
    "Values( '" & Label4.Caption & "' ," & Form1.txtVal1.Text & "," & Label3.Caption & ")"
 
    Set RS = Connection.Execute(SQLStmt)
    Remove_Group
    Var = 1
End Sub

No problems it works if I trigger the subroutine from a button.Like
Private Sub Command1_Click()
Write_To_SQL
End Sub
But unfortunately I have to trigger the Write_To_SQL subroutine from a textbox values.Namely when
IF Form1.Text1.Text = "1" then
Write to SQL
End If
The problem is that the Text.Text stays 1 for various lenghts of time.So To avoid triggering twice the Wrtite_To_SQL routine I have to put some conditions like if the Write_To_SQL is executed and Form1.Text1.Text hasn't done a TRANSITION from Text1.Text = " 1"  to Text1.Text = "0" and then AGAIN to Text1.Text = "1" (This is the point I have to write to SQL again) ,then don't trigger the routine.I've tried all sorts of tricks trying to build some "flip/flop" to detect transitions of Text1.Text from 1 to 0 to 1 --> write.I just don't know what are the best practices to do this kind of thing.Please help if someone got an ideea.Thanx
Avatar of Guy Hengel [angelIII / a3]
Guy Hengel [angelIII / a3]
Flag of Luxembourg image

this should do.

note however that your code it subject to sql injection.

SQLStmt = "INSERT INTO    Recipes_West_Table  (col1, col2, col3) " & _
    "SELECT '" & Label4.Caption & "' ," & Form1.txtVal1.Text & "," & Label3.Caption & " WHERE NOT EXISTS ( SELECT null from  Recipes_West_Table where col2 = " & Form1.txtVal1.Text & " )  "

Open in new window

Avatar of Latzi_Marian

ASKER

I don't get it Angellll.The SQL querry itself will still be triggered more than 1 time.I have to put some condition to stop it being called.
Sql injection attacks shouldn't happen as this  system is fully isolated from the net and the code will reside inside a SCADA application and will have no inteface whatsoever.Like form1.Visible  = False
My problem is the trigger. I have to run Write_To_SQL only and only when a transition of Form1.Text1.Text happened from 0--> to 1.Once.To write again I need to have transition of Form1.Text1.Text   from  Form1.Text1.Text = 1 to Form1.Text1.Text = 0 and then to Form1.Text1.Text = 1.So  a transition from 0->1.will trigger Write_To_SQL only once.
ASKER CERTIFIED SOLUTION
Avatar of Guy Hengel [angelIII / a3]
Guy Hengel [angelIII / a3]
Flag of Luxembourg image

Link to home
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
See answer
Could you use a module level boolean variable that gets set to 'True' when the text value is '1'. Then only execute the Write_To_SQL sub if the variable is 'True' and then setting it back to false at the end of the sub. When the text value changes appropriately then reset the module level variable back to 'True' ?
Hi TreyH,

If I do what you say the this is what will happen.Let's say text1 value is 1 .Then variable will be true.I execute the query and set it to false.But as soon as the code gets back to the point where I did set the variable to true it will do it again because text1 is still 1.This will go round and round untill the value for text1 cahnges back to 0.This is my very problem.Unfortunately angellll will have to give me a practical example as I tried to implement what he said but for some reason the code halts at the sql statement.I think it's because the label.caption value is not fully built and when sql tries to execute will be a missmatch between the number of values and number of columns.
Angellll,

Of course it work.Very simple.What makes it hard is the OPC SERVER I am using.It is bugged up a bit.These OPC servers are more volatile than solvent.I restarted the pc because after I checked the code 10 times there was no way in the worls it wouldn't work and after restart it does work.Here;s the whole code:

' Simple OPC demo program designed to show actions required to get data
' from an OPC Automation interface. Not meant to be pretty from either a code
' (variable naming is very variable!) or graphical view!
'
' Note that 'Rockwell Software OPC Automation' has been included as a project reference
' to get definitions of the OPC objects.
' (See the Project/References menu item in VB)
'
Option Base 1
Dim MyOPCServer As OPCServer 'Server object
Dim MyOPCServerGroups As OPCGroups 'Groups collection
Dim WithEvents MyOPCServerGroup As OPCGroup ' Group object - WithEvents gives data change callback
Dim MyOPCItems As OPCItems 'Items collection
Dim gServerHandles() As Long 'Server handles for items
Dim gClientHandles(2) As Long 'Client Handles for items
Dim gArray As Variant 'Array data
Dim PrevText As Integer



Private Sub Initialize_OPC()
Set MyOPCServer = New OPCServer
MyOPCServer.Connect "RSLinx OPC Server"
If MyOPCServer.ServerState = OPCRunning Then
    'above is example of use of enumerated value OPCRunning which is much nicer
    'than writing If state=1 Then
    Label2.Caption = "Running"
    cmdAddGroup.Enabled = True
    Add_OPC_Group
End If

End Sub


Private Sub Add_OPC_Group()
Set MyOPCServerGroups = MyOPCServer.OPCGroups ' Get groups collection
MyOPCServerGroups.DefaultGroupIsActive = True 'Default group state
Set MyOPCServerGroup = MyOPCServerGroups.Add("TestGroup") 'Add new group (name is not important)
MyOPCServerGroup.UpdateRate = 500 'Update rate in mS
MyOPCServerGroup.IsSubscribed = True 'Enable data callbacks
cmdAddItem.Enabled = True
cmdRemoveGroup.Enabled = True
Add_Item
End Sub

Private Sub Add_Item()
' Adds two items, one a single value, the other an array
' You will need to configure the OPC topic in RSLinx to point to your processor

Set MyOPCItems = MyOPCServerGroup.OPCItems
Dim ItemIDs(2) As String
Dim ServerErrors() As Long
Dim i As Long

ItemIDs(1) = "[TestTopic]N11:0" 'Tag TestDINT(N11:0), Topic OPCTest
gClientHandles(1) = 1
ItemIDs(2) = "[TestTopic]N11:1,L30"    'array of 30 items
gClientHandles(2) = 2
MyOPCItems.AddItems 2, ItemIDs, gClientHandles, gServerHandles, ServerErrors
' check for errors
For i = LBound(ServerErrors) To UBound(ServerErrors)
    If ServerErrors(i) <> 0 Then
    MsgBox "Error adding OPC Item " & ItemIDs(i), vbOKOnly, "Error"
    Unload Me
    Stop
    End If
Next
cmdWrite.Enabled = True
cmdWrite2.Enabled = True


 End Sub



Private Sub cmdWrite2_Click() 'Write an array
Dim IServerHandles(1) As Long
Dim IValues(1) As Variant
Dim arr(4) As Variant
Dim ItemErrors() As Long
Dim INumItems As Long

INumItems = 1 ' 1 array - dimension of arr() gives length of array
IServerHandles(1) = gServerHandles(2)
arr(1) = Val(txtVal21)
arr(2) = Val(txtVal22)
arr(3) = Val(txtVal23)
arr(4) = Val(txtVal24)
IValues(1) = arr
MyOPCServerGroup.SyncWrite INumItems, IServerHandles, IValues, ItemErrors
lblError2.Caption = MyOPCServer.GetErrorString(ItemErrors(1))
End Sub

Private Sub cmdWrite_Click() ' Write single data point
Dim IServerHandles(1) As Long
Dim IValues(1) As Variant
Dim ItemErrors() As Long
Dim INumItems As Long

INumItems = 1
IServerHandles(1) = gServerHandles(1)
IValues(1) = Val(txtVal1)
MyOPCServerGroup.SyncWrite INumItems, IServerHandles, IValues, ItemErrors
lblError.Caption = MyOPCServer.GetErrorString(ItemErrors(1))

End Sub




Private Sub Form_Unload(Cancel As Integer)
    If cmdRemoveGroup.Enabled = True Then
    MyOPCServerGroups.Remove ("TestGroup")
End If
Set MyOPCServerGroup = Nothing
Set MyOPCServer = Nothing
End Sub


Private Sub MyOPCServerGroup_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date)
'This routine is 'automatically' called whenever the OPC server detcts a change in any item
'in the group
Dim i As Integer
Dim Q As String
Dim temp As Long
'Identify data that has changed
'Also, if you need the data outside this routine you will need to make a copy of it
For i = 1 To NumItems
    If ClientHandles(i) = gClientHandles(1) Then
        ChangeCount = ChangeCount + 1
        temp = Qualities(i) And &HC0
        If temp = &HC0 Then
            Q = "GOOD"
        ElseIf temp = 0 Then
            Q = "BAD"
        ElseIf temp = &H40 Then
            Q = "Uncertain"
        Else
            Q = "N/A!"
        End If
        Label1.Caption = "Value is: " & ItemValues(i) & ",  Quality:" & Q
    ElseIf ClientHandles(i) = gClientHandles(2) Then
        ' Should really look at quality as above
        gArray = ItemValues(i) 'example of copying data for use outside this routine
        Label3.Caption = "" & gArray(0) & ", " & gArray(1) & ", " & gArray(2) & "," & gArray(3) & "," & gArray(4) & "," & _
        "" & gArray(5) & ", " & gArray(6) & "," & gArray(7) & "," & gArray(8) & "," & gArray(9) & "," & gArray(10) & "," & _
        "" & gArray(11) & ", " & gArray(12) & "," & gArray(13) & "," & gArray(14) & "," & gArray(15) & "," & gArray(16) & "," & _
        "" & gArray(17) & ", " & gArray(18) & "," & gArray(19) & "," & gArray(20) & "," & gArray(21) & "," & gArray(22) & "," & _
        "" & gArray(23) & ", " & gArray(24) & "," & gArray(25) & "," & gArray(26) & "," & gArray(27) & "," & gArray(28) & "," & _
        "" & gArray(29)
       
       
    End If
Next


Write_To_SQL

End Sub

Private Sub Write_To_SQL()
    Dim Var
    Dim sDate As String
    Dim Connection, RS
    Dim rsField, iFieldCount
    Dim SQLStmt As String
    Dim sstring As String
    sDate = Format(DateTime.Now, vbGeneralDate)
   
    Set Connection = CreateObject("ADODB.Connection")
   
    Set RS = New ADODB.Recordset
   
    Connection.Open "driver=SQL Server;server=(local);uid=;pwd=;database=DATA_LOG;"
 

    SQLStmt = "INSERT INTO    Recipes_West_Table   " & _
    "Values( '" & Label5.Caption & "' ," & Form1.txtVal1.Text & "," & Label3.Caption & ")"
 
    Set RS = Connection.Execute(SQLStmt)
    Remove_Group
    Var = 1
End Sub
Private Sub Remove_Group()
MyOPCServerGroups.Remove ("TestGroup")
Label1.Caption = ""
Label3.Caption = ""
cmdWrite.Enabled = False
cmdWrite2.Enabled = False
cmdAddItem.Enabled = False
cmdRemoveGroup.Enabled = False
End Sub
Private Sub Form_Load()
Main
Label4.Caption = DateTime.Now
Timer1.Enabled = True
Timer2.Enabled = False
End Sub

Private Sub Timer1_Timer()
Dim Var
If Form1.Text1.Text = 0 Then
Var = 0
End If
If Timer1.Interval = 1000 Then
Label5.Caption = DateTime.Now

If Form1.Text1.Text <> PrevText And Form1.Text1.Text = 1 And Var = 0 Then
Initialize_OPC

End If
End If
PrevText = Form1.Text1.Text
End Sub


















'---======================================-------------- Button Controls------------==============================================------
Private Sub cmdConnect_Click()
Set MyOPCServer = New OPCServer
MyOPCServer.Connect "RSLinx OPC Server"
If MyOPCServer.ServerState = OPCRunning Then
    'above is example of use of enumerated value OPCRunning which is much nicer
    'than writing If state=1 Then
    Label2.Caption = "Running"
    cmdAddGroup.Enabled = True
End If
End Sub
Private Sub cmdAddGroup_Click()
Set MyOPCServerGroups = MyOPCServer.OPCGroups ' Get groups collection
MyOPCServerGroups.DefaultGroupIsActive = True 'Default group state
Set MyOPCServerGroup = MyOPCServerGroups.Add("TestGroup") 'Add new group (name is not important)
MyOPCServerGroup.UpdateRate = 500 'Update rate in mS
MyOPCServerGroup.IsSubscribed = True 'Enable data callbacks
cmdAddItem.Enabled = True
cmdRemoveGroup.Enabled = True
End Sub
Private Sub cmdAddItem_Click()
' Adds two items, one a single value, the other an array
' You will need to configure the OPC topic in RSLinx to point to your processor

Set MyOPCItems = MyOPCServerGroup.OPCItems
Dim ItemIDs(2) As String
Dim ServerErrors() As Long
Dim i As Long

ItemIDs(1) = "[TestTopic]N11:0" 'Tag TestDINT, Topic OPCTest
gClientHandles(1) = 1
ItemIDs(2) = "[TestTopic]N11:1,L30"    'array of four items
gClientHandles(2) = 2
MyOPCItems.AddItems 2, ItemIDs, gClientHandles, gServerHandles, ServerErrors
' check for errors
For i = LBound(ServerErrors) To UBound(ServerErrors)
    If ServerErrors(i) <> 0 Then
    MsgBox "Error adding OPC Item " & ItemIDs(i), vbOKOnly, "Error"
    Unload Me
    Stop
    End If
Next
cmdWrite.Enabled = True
cmdWrite2.Enabled = True

End Sub
Private Sub cmdRemoveGroup_Click()
MyOPCServerGroups.Remove ("TestGroup")
Label1.Caption = ""
Label3.Caption = ""
cmdWrite.Enabled = False
cmdWrite2.Enabled = False
cmdAddItem.Enabled = False
cmdRemoveGroup.Enabled = False
End Sub

Private Sub Command1_Click()
Write_To_SQL
End Sub




Thanx again.
You would only set the variable back to 'True' once the text1 value changes again. A rough example would be to use the Text1_Change event to test whether text1 = '1'. Say a user types in '1'; you could use the _Change event to test for '1' and set the variable to 'True'. Your sub would fire, setting the variable to 'False' after it finished. The variable would stay 'False' until the _Change event tested for the value '1' again and set the variable back to 'True'.

Private Sub Text1_Change
     If text1.text = "1" Then
          m_bFlagVariable = True
     Else
          m_bFlagVariable = False
     End IF
End Sub

However, AngelIII's method might be simpler - the only drawback is querying the database everytime the Write_To_SQL sub runs.