adding data to oracle database in vb6 - oracle

I have a problem adding data oracle database,it's show me this message(" https://ufile.io/lzpuj ") Run-time ORA-00904:"EMPCODE": invalid identifier.
This is Cody:
Dim connEmp As ADODB.Connection
Dim rsEmp As ADODB.Recordset
Private Sub Command1_Click()
Set rsEmp = New ADODB.Recordset
rsEmp.Open "select * from tablebooks where empcode = '" & Text1.Text & "'",
connEmp, adOpenKeyset, adLockReadOnly, adCmdText
If rsEmp.RecordCount <> 0 Then
MsgBox " ! åÐÇ ÇáßÊÇÈ ãæÌæÏ ÈÇáÝÚá "
rsEmp.Close
Set rsEmp = Nothing
Exit Sub
Else
Set rsEmp = New ADODB.Recordset
rsEmp.Open "select * from tablebooks where empcode = '" & Text1.Text & "'",
connEmp, adOpenKeyset, adLockPessimistic, adCmdText
rsEmp.AddNew
rsEmp!Book_no = Val(Trim(Text1.Text))
rsEmp!Book_name = Trim(Text2.Text)
rsEmp!Author_name = Trim(Text10.Text)
rsEmp!Edition_no = Val(Trim(Text3.Text))
rsEmp!Publisher_place = Trim(Text11.Text)
rsEmp!Part_no = Val(Trim(Text5.Text))
rsEmp!Book_cost = Trim(Text6.Text)
rsEmp!Place_book = Trim(Text7.Text)
rsEmp!Note = Trim(Text9.Text)
rsEmp!Date_publishing = DTPicker1.Value
rsEmp!Subject = Trim(Combo4.Text)
rsEmp!State = Trim(Combo4.Text)
rsEmp.Update
connEmp.Execute "commit"
rsEmp.Close
Set rsEmp = Nothing
Label11.Visible = True
Label11 = " ! ÊãÊ ÇáÅÖÇÝÉ ÈäÌÇÍ "
End If
End Sub

First make sure empcode is exactly the right column name.
Then fix your code. You have two big issues:
It's crazy-vulnerable to Sql Injection attacks.
It tries to re-open the same command on the same connection in the ELSE block for no reason.
The exact fix for #1 depends on which provider you are using (Ole vs Odbc), but this link might help:
Call a parameterized Oracle query from ADODB in Classic ASP
For #2, this is somewhat better:
Dim connEmp As ADODB.Connection
Dim rsEmp As ADODB.Recordset
Private Sub Command1_Click()
Set rsEmp = New ADODB.Recordset
'TODO: Use parameterized query here!
rsEmp.Open "select * from tablebooks where empcode = #empcode '" & Text1.Text & "'",
connEmp, adOpenKeyset, adLockReadOnly, adCmdText
If rsEmp.RecordCount <> 0 Then
MsgBox " ! åÐÇ ÇáßÊÇÈ ãæÌæÏ ÈÇáÝÚá "
rsEmp.Close
Set rsEmp = Nothing
Exit Sub
End If
rsEmp.AddNew
rsEmp!Book_no = Val(Trim(Text1.Text))
rsEmp!Book_name = Trim(Text2.Text)
rsEmp!Author_name = Trim(Text10.Text)
rsEmp!Edition_no = Val(Trim(Text3.Text))
rsEmp!Publisher_place = Trim(Text11.Text)
rsEmp!Part_no = Val(Trim(Text5.Text))
rsEmp!Book_cost = Trim(Text6.Text)
rsEmp!Place_book = Trim(Text7.Text)
rsEmp!Note = Trim(Text9.Text)
rsEmp!Date_publishing = DTPicker1.Value
rsEmp!Subject = Trim(Combo4.Text)
rsEmp!State = Trim(Combo4.Text)
rsEmp.Update
connEmp.Execute "commit"
rsEmp.Close
Set rsEmp = Nothing
Label11.Visible = True
Label11 = " ! ÊãÊ ÇáÅÖÇÝÉ ÈäÌÇÍ "
End Sub

Related

Out of Memory error when trying to connect to oracle database (VB6)

when I m trying to set Recordset using oracle connection string, I m getting OUt of memory error.
on line "rsLIS.Open sql, gConnLIS, adOpenStatic, adLockReadOnly"
However some time it works like once in 5-6 attempts
but when it works it gives error on some other line
on line "If rsLink.Fields(2).value = rsLIS.Fields(1).value Then"
here are the things which I tried :
instead of directly using recordset, I tried to create array (GetRows) method.
Even though recordset count is 26 but UBound of array is showing 1
I have trying changing 3rd argument value from static to forward only
in line ""rsLIS.Open sql, gConnLIS, adOpenStatic, adLockReadOnly""
it also didn't work, it was showing recordset.count as 0
Did try after restarting the client system still same
I m getting this error on client side and since at my place I don't have development environment to debug
Error is "OUT OF MEMORY"
Public Function GetResults_New(MachName As String, patid As String, bCheckDate As Boolean, SendAssay As Boolean) As ADODB.Recordset
On Error GoTo errdesc
Call ShowTempMsg("Line 1")
Dim bXVar As Boolean
Dim i, j As Integer
Dim tmplis, tmporder
Dim tmpresult
bXVar = False
Dim rec_result As New ADODB.Recordset
Dim rsLink As New ADODB.Recordset
Dim rsLIS As New ADODB.Recordset
Dim xSampleIdType As String
gAppPath = AddEditINIfile("VAHSIF.INI", "IF", "sLinkPath", "")
xSampleIdType = AddEditINIfile(gAppPath & "\sLinkConfig.ini", MachName, "SampleIdType", "SampleId1", False)
Call Open_Connection
Call Open_Connection_LIS
rec_result.CursorLocation = adUseClient
If SendAssay = True Then
rec_result.Fields.Append "machineparamid", adBSTR, 50
rec_result.Fields.Append "Assayno", adBSTR, 50
rec_result.Fields.Append "SType", adBSTR, 50
rec_result.Fields.Append "Dilution", adBSTR, 50
Else
rec_result.Fields.Append "machineparamid", adBSTR, 50
rec_result.Fields.Append "SType", adBSTR, 50
rec_result.Fields.Append "Dilution", adBSTR, 50
End If
rec_result.Open
\
'Link Query For Mapped Params.
sql = "SELECT EquipParamMapping.EquipId, EquipParamMapping.EquipParamCode, EquipParamMapping.LISParamCode, EquipParamMapping.EquipAssayNo from EquipParam, EquipParamMapping where equipParam.equipid = equipparammapping.equipid and equipparam.equipparamcode = equipparammapping.equipparamcode and EquipParam.EquipID = '" & MachName & "' and EquipParam.isProgram = 'Y'"
**rsLink.Open sql, gConn, adOpenStatic, adLockReadOnly**
If enumConnTo = connOracle Then
sql = "select " & xSampleIdType & " , LIS_Param_Code From SL_21CI_View_sampleid_Orders where " & xSampleIdType & " || SuffixCode = '" & patid & "' and isApplicable <> 'N' "
Else
sql = "select " & xSampleIdType & " , LIS_Param_Code From SL_21CI_View_sampleid_Orders where " & xSampleIdType & " + cast(SuffixCode as varchar(20)) = '" & patid & "' and isApplicable <> 'N' "
End If
rsLIS.Open sql, gConnLIS, adOpenStatic, adLockReadOnly
While Not rsLIS.EOF
If bXVar = True Then
rsLink.MoveFirst
bXVar = False
End If
While Not rsLink.EOF
bXVar = True
**If rsLink.Fields(2).value = rsLIS.Fields(1).value Then**
If SendAssay = True Then
rec_result.AddNew
rec_result("machineparamid") = rsLink.Fields("EquipParamCode")
rec_result("Assayno") = rsLink.Fields("EquipAssayNo")
rec_result("SType") = " "
rec_result("Dilution") = "0"
rec_result.Update
rec_result.MoveFirst
Else
rec_result.AddNew
rec_result("machineparamid") = rsLink.Fields("EquipParamCode")
rec_result("SType") = " "
rec_result("Dilution") = "0"
rec_result.Update
rec_result.MoveFirst
End If
GoTo NextParam
End If
rsLink.MoveNext
Wend
NextParam:
rsLIS.MoveNext
Wend
Set GetResults_New = rec_result
Exit Function
errdesc:
Call InsertIntoLogWithFileName("Transaction.GetResults_New" & vbNewLine & sql & vbNewLine & err.Description & "ErrLine : " & ErrLine)
End Function
Thanks
That still leaves the question on which line the error occurs. Also: "it also didn't work, it was showing recordset.count as 0". The RecordSet.Count property depends on the provider. Use a function similar to this instead:
Public Function RecordCount(ByVal cn As ADODB.Connection, ByVal sTable As String) As Long
Dim sSQL As String, lRetVal as Long
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
sSQL = "SELECT COUNT(1) AS RecCount FROM " & sTable & ";"
Call rs.Open(sSQL, cn)
If Not (rs.BOF And rs.EOF) Then
lRetVal = rs.Fields("RecCount").Value
Else
lRetVal = -1
End If
Call rs.Close
Set rs = Nothing
RecordCount = lRetVal
End Function
The .Count property might also very well be the cause of the Out of memory error, as I seem to remember that for determing the number of records, it loads all records (from the server) to count them. But I might be wrong there.

updating the table using recordset

I have a recordset rcdDNE. I want to update my reclamation by making some conditions with my existing recordset. But my table is not updating. Can you guys tell me where I am doing wrong?
Dim lngRecCount As Long
frmDNELoad.lblStatus.Caption = "Updating records in Reclamation Table..."
frmDNELoad.Refresh
CqDate = Format(Date, "dd/MM/yyyy")
Set rcdreclamation = New ADODB.Recordset
With rcdreclamation
.ActiveConnection = objConn
.Source = "SELECT * FROM T_DATA_reclamation"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
rcdDNE.MoveFirst
Do Until rcdDNE.EOF
With cmdDNEFRC
.ActiveConnection = objConn
.CommandText = "update t_data_reclamation set ClaimStatus = 'C',DateClosed = 'CqDate', Audit_LastUpdated = 'CqDate', Audit_UserAdded = 'SYSTEM' where RTProvided = '" & rcdDNE("AccountNbr") & "'"
.CommandType = adCmdText
End With
rcdDNE.MoveNext
Loop
Unless its something you forgot to put in your sample code, You are missing a call to the Execute function inside your Command object's with block.
With cmdDNEFRC
.ActiveConnection = objConn
.CommandText = "update t_data_reclamation set ClaimStatus = 'C',DateClosed = 'CqDate', Audit_LastUpdated = 'CqDate', Audit_UserAdded = 'SYSTEM' where RTProvided = '" & rcdDNE("AccountNbr") & "'"
.CommandType = adCmdText
.Execute 'dont forget execution
End With
Also when writing data to the table, using Connection objects BeginTrans and CommitTrans function is recommended, just in case something has to go wrong when writing the data you don't end up with data inconsistencies.

"Operation is not allowed when the object is open" error in VB6

When I am trying to execute the program I am getting an error like "operation is not allowed when the object is open".
I am geeting error in second part of the code where .Source = "SELECT * FROM t_data_Comments
Sub DneFroceClose()
Dim lngRecCount As Long
frmDNELoad.lblStatus.Caption = "Updating records in Reclamation and Comments Table..."
frmDNELoad.Refresh
CqDate = Format(Date, "dd/MM/yyyy")
Set rcdreclamation = New ADODB.Recordset
With rcdreclamation
.ActiveConnection = objConn
.Source = "SELECT * FROM T_DATA_reclamation"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
rcdDNE.MoveFirst
rcdreclamation.MoveFirst
Do Until rcdDNE.EOF
Do Until rcdreclamation.EOF
If rcdDNE.Fields![AccountNbr] = rcdreclamation.Fields![RTProvided] Then
rcdreclamation.Fields![ClaimStatus] = "C"
rcdreclamation.Fields![DateClosed] = CqDate
rcdreclamation.Fields![Audit_LastUpdated] = CqDate
rcdreclamation.Fields![Audit_UserAdded] = "SYSTEM"
rcdreclamation.Update
Call DneComments
Exit Do
Else
rcdreclamation.MoveNext
End If
Loop
rcdDNE.MoveNext
rcdreclamation.MoveFirst
Loop
End Sub
Sub DneComments()
With cmdDNEFRC
.ActiveConnection = objConn
.CommandText = "insert into t_data_Comments (ControlNbr, Audit_DateAdded, Audit_UserAdded, Description, EntryType) values ('" & rcdreclamation("ControlNbr") & "', '" & rcdreclamation("DateClosed") & "', '" & rcdreclamation("Audit_UserAdded") & "', 'Claim force-closed.', 'FORCE-CLS')"
.CommandType = adCmdText
End With
Set rcdDneComments = New ADODB.Recordset
With rcddnefrc
.ActiveConnection = objConn
.Source = "SELECT * FROM t_data_Comments"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
With rcddnefrc
.Requery
.AddNew
.Fields![ControlNbr] = rcdreclamation.Fields![ControlNbr]
.Fields![Audit_DateAdded] = rcdreclamation.Fields![DateClosed]
.Fields![Audit_UserAdded] = rcdDNE.Fields![Audit_UserAdded]
.Fields![Description] = "Claim force-closed."
.Fields![EntryType] = "FORCE-CLS"
.Update
End With
End Sub
Change the With line to
With rcdDneComments

the connection cannt be used to perform this operation. It may closed or not valid in this context error in vb6

I am trying to execute the query which stores recordset vales in sql db. when I am trying to execute that i am getting error like
the connection cannt be used to perform this operation. It may closed or not valid in this context error in vb6. Please help me to solve this issue.
' Write records to Database
frmDNELoad.lblStatus.Caption = "Loading data into database......"
Call FindServerConnection_NoMsg
Dim lngRecCount As Long
lngRecCount = 0
rcdDNE.MoveFirst
Set rcdReclamation = New ADODB.Recordset
With rcdReclamation
.ActiveConnection = objConn
.Source = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open cmdCommand
End With
Do Until rcdDNE.EOF
lngRecCount = lngRecCount + 1
frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
frmDNELoad.Refresh
DoEvents
Call CommitNew
rcdDNE.MoveNext
Loop
frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh
End Function
Sub CommitNew()
' Add records to DneFrc table
With rcdReclamation
.Requery
.AddNew
.Fields![RTN] = rcdDNE.Fields![RTN]
.Fields![AccountNbr] = rcdDNE.Fields![AccountNbr]
.Fields![FirstName] = rcdDNE.Fields![FirstName]
.Fields![MiddleName] = rcdDNE.Fields![MiddleName]
.Fields![LastName] = rcdDNE.Fields![LastName]
.Fields![Amount] = rcdDNE.Fields![Amount]
.Update
End With
End Sub
conection code
Sub InstantiateCommand_SQLText()
' Creates a command object to be used when executing SQL statements.
Set objCommSQLText = New ADODB.Command
objCommSQLText.ActiveConnection = objConn
objCommSQLText.CommandType = adCmdText
End Sub
Function FindServerConnection_NoMsg() As String
Dim rcdClientPaths As ADODB.Recordset
Dim strDBTemp As String
Const CLIENT_UPDATE_DIR = "\\PSGSPHX02\NORS\Rs\ClientUpdate\"
On Error Resume Next
' If persisted recordset is not there, try and copy one down from
' CLIENT_UPDATE_DIR. If that can't be found, create a blank one
' and ask the user for the server name.
Set rcdClientPaths = New ADODB.Recordset
' Does it already exist locally?
If FileExists_FullPath(App.Path & "\" & "t_PCD_ServerConnectionList.xml") = False Then
' Can it be retrieved from CLIENT_UPDATE_DIR
If Dir(CLIENT_UPDATE_DIR & "t_PCD_ServerConnectionList.xml") "" Then
FileCopy CLIENT_UPDATE_DIR & "t_PCD_ServerConnectionList.xml", App.Path & "\" & "t_PCD_ServerConnectionList.xml"
Else
' Creat a blank one.
With rcdClientPaths
.Fields.Append "ServerConnection", adVarChar, 250
.Fields.Append "Description", adVarChar, 50
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.CursorLocation = adUseClient
.Open
.Save App.Path & "\" & "t_PCD_ServerConnectionList.xml", adPersistXML
.Close
End With
End If
End If
' Open the recordset
With rcdClientPaths
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.CursorLocation = adUseClient
.Open App.Path & "\" & "t_PCD_ServerConnectionList.xml", , , , adCmdFile
End With
If rcdClientPaths.RecordCount 0 Then
' try each one listed
rcdClientPaths.MoveFirst
Do Until rcdClientPaths.EOF
strDBTemp = TryConnection_NoMsg(rcdClientPaths.Fields![serverconnection])
If strDBTemp "" Then
FindServerConnection_NoMsg = strDBTemp
Exit Function
End If
rcdClientPaths.MoveNext
Loop
strDBTemp = ""
End If
Do While strDBTemp = ""
If strDBTemp "" Then
strDBTemp = TryConnection_NoMsg(strDBTemp)
If strDBTemp "" Then
With rcdClientPaths
.AddNew
.Fields![serverconnection] = strDBTemp
.Update
.Save
End With
FindServerConnection_NoMsg = strDBTemp
Exit Function
End If
Else
Exit Function
End If
Loop
End Function
Function TryConnection_NoMsg(ByVal SvName As String) As String
On Error GoTo ErrHandle
' If a server was provided, try to open a connection to it.
Screen.MousePointer = vbHourglass
Set objConn = New ADODB.Connection
With objConn
.CommandTimeout = 30
.ConnectionTimeout = 30
.ConnectionString = "Provider=SQLOLEDB.1; Server=" & SvName & "; User ID=RS_Auth; Password=weLcomers_auth; Initial Catalog=NORS" ' Test
.Open
.Close
End With
Set objConn = Nothing
TryConnection_NoMsg = SvName
Screen.MousePointer = vbNormal
Exit Function
ErrHandle:
TryConnection_NoMsg = ""
Set objConn = Nothing
Screen.MousePointer = vbNormal
Exit Function
End Function
You have already closed the connection here in TryConnection_NoMsg function (?)
With objConn
.CommandTimeout = 30
.ConnectionTimeout = 30
.ConnectionString = "Provider=SQLOLEDB.1; Server=" & SvName & "; Database=NORS; User ID=RS_Auth; Password=weLcomers_auth; Initial Catalog=NORS" ' Test
.Open
.Close
I'd suspect that FindServerConnection_NoMsg is not managing to open the connection, and since it ends in NoMsg that you're not seeing the error about why the connection wasn't opened. You then go on to just use the connection without knowing that the open failed.
Post the code for FindServerConnection_NoMsg.
BTW, your question itself should have given you a clue. It specifically says that the connection can't be used, and that it may not be open. That should have told you where to start looking, and at the least told you you should have posted the code that opened the connection as part of your question.
Thanks for everyone. I sloved my problem. This what i cahnge in my code
Dim lngRecCount As Long
lngRecCount = 0
rcdDNE.MoveFirst
With cmdCommand
.ActiveConnection = objConn
.CommandText = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CommandType = adCmdText
End With
Set rcddnefrc = New ADODB.Recordset
With rcddnefrc
.ActiveConnection = objConn
.Source = "SELECT * FROM T_DATA_DNEFRC"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
Do Until rcdDNE.EOF
lngRecCount = lngRecCount + 1
frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
frmDNELoad.Refresh
DoEvents
Call CommitNew
rcdDNE.MoveNext
Loop
frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh

How can I upload a file to an Oracle BLOB field using VB6?

I want to take a file from disk and upload it into an Oracle BLOB field, using VB6. How can I do that?
Answering my own question, for reference:
Public Function SaveFileAsBlob(fullFileName As String, documentDescription As String) As Boolean
'Upload a binary file into the database as a BLOB
'Based on this example: http://www.codeguru.com/forum/printthread.php?t=337027
Dim rstUpload As ADODB.Recordset
Dim pkValue AS Long
On Error GoTo ErrorHandler
Screen.MousePointer = vbHourglass
'Create a new record (but leave document blank- we will update the doc in a moment)
'the where clause ensures *no* result set; we only want the structure
strSQL = "SELECT DOC_NUMBER, DOC_DESC, BLOB_FIELD " & _
" FROM MY_TABLE " & _
" WHERE PRIMARY_KEY = 0"
pkValue = GetNextPKValue
Set rstUpload = New ADODB.Recordset
With rstUpload
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open strSQL, myConn
.AddNew Array("DOC_NUMBER", "DOC_DESC"), _
Array(pkValue, documentDescription)
.Close
End With
'They may have the document open in an external application. Create a copy and work with that copy
Dim tmpFileName As String
tmpFileName = GetTempPath & ExtractFileName(fullFileName)
'if the tmp file exists, delete it
If Len(Dir(tmpFileName)) > 0 Then
Kill tmpFileName
End If
'see this URL for info about this subroutine:
'http://stackoverflow.com/questions/848087/how-can-i-copy-an-open-file-using-vb6
CopyFileEvenIfOpen fullFileName, tmpFileName
'Now that our record is inserted, update it with the file from disk
Set rstUpload = Nothing
Set rstUpload = New ADODB.Recordset
Dim st As ADODB.Stream
rstUpload.Open "SELECT BLOB_FIELD FROM MY_TABLE WHERE PRIMARY_KEY = " & pkValue
, myConn, adOpenDynamic, adLockOptimistic
Set st = New ADODB.Stream
st.Type = adTypeBinary
st.Open
st.LoadFromFile (tmpFileName)
rstUpload.Fields("BLOB_FIELD").Value = st.Read
rstUpload.Update
'Now delete the temp file we created
Kill (tmpFileName)
DocAdd = True
ExitPoint:
On Error Resume Next
rstUpload.Close
st.Close
Set rstUpload = Nothing
Set st = Nothing
Screen.MousePointer = vbDefault
Exit Function
ErrorHandler:
DocAdd = False
Screen.MousePointer = vbDefault
MsgBox "Source: " & Err.Source & vbCrLf & "Number: " & Err.Number & vbCrLf & Err.Description, vbCritical, _
"DocAdd Error"
Resume ExitPoint
End Function

Resources