I have a function, which is supposed to return zero, if the input cannot be converted to an integer.
But sometimes it fails, if the field from a resultset is not a proper value, whatever it is.
Function nulblank(str)
dim val
if IsNull(str) then
val=0
else
str = trim(str)
if isNumeric(str) then
val = cDbl(str)
else
val = 0
end if
end if
nulblank = val
end function
I get an error 0x80020009 on str = trim(str)
This function is only called on
set rs = conn.execute(sql)
i = nulblank(rs("somefield"))
How can I make this function "failsafe", so it never dies, but returns 0 on "bad" values?
I guess I could do on error resume next and if Err.Number <> 0 then something.
But what can be in a rs("somefield") which is not null, but cannot be trim()'ed?
That error usually relates to an empty recordset.
You should check that the recordset has a row before attempting to retrieve a column value, eg:
set rs = conn.execute(sql)
if not rs.eof then
i = nulblank(rs("somefield"))
end if
Related
I'm trying to get an array of keys from Request.Form in ASP Classic. Theoretically I should simply be able to use Request.Form.Keys and Request.Form.Items, but they simply don't work. I get:
Object doesn't support this property or method: 'request.form.Keys'
I've tried making functions of my own, but they ultimately fail on the same point -- .Keys fails when running it on a Request.Form dictionary.
What the heck am I doing wrong????
Function dictionary_keys( dict )
Dim i
ReDim theKeys( dict.Count-1 )
for i = 0 To dict.Count-1
theKeys(i) = dict.Keys(i)
next
dictionary_keys = theKeys
End Function
Function dictionary_values( dict )
Dim i
ReDim theVals( dict.Count-1 )
for i = 0 To dict.Count-1
theVals(i) = dict.Keys(i)
next
dictionary_values = theVals
End Function
^^ Both of those fail at dict.Keys(i)
UPDATE: Based on #Lankymart's answer below, this is what I came up with:
Function request_keys( req )
Dim key, result, i
i = 0
ReDim result( req.Count-1 )
For Each key in req
result(i) = key
i = i + 1
Next
request_keys = result
End Function
Function request_values( req )
Dim key, result, i
i = 0
ReDim result( req.Count-1 )
For Each key in req
result(i) = req(key)
i = i + 1
Next
request_values = result
End Function
The Request.Form and Request.QueryString collections are not Scripting.Dictionary objects and as such don't support the Keys collection, but it's simple enough to convert them to a Scripting.Dictionary.
Dim dict: Set dict = Server.CreateObject("Scripting.Dictionary")
Dim key
For Each key in Request.Form
Call dict.Add(key, Request.Form(key))
Next
I get the error
Procedure or function has to many arguments specified
but only sometimes. It's a REST API and cellphones call this function to validate the user. Today it's onli 1-2 cellphones and they make the call every second minute.
It works well most times but sometimes I get this error code.
To see what's wrong, I've made a small loop that gathers the parameters into a string. And sometimes they are two #GUID and #Datum and sometimes repeat themselves.
Here is the VB code:
Public Shared Sub validatePhone(secretKey As String, ByRef _RS As phoneData, Fnr As Integer)
Dim connStr As String = System.Configuration.ConfigurationManager.AppSettings("ConnStringSQL")
Dim Conn As SqlConnection = New System.Data.SqlClient.SqlConnection(connStr)
Dim _theString As New System.Text.StringBuilder
Try
_RS.message = ""
_RS.status = True
Dim Status As Integer = 0
Dim _GUID As Guid = New Guid(secretKey)
Try
Conn.Open()
Catch ex As Exception
End Try
cmd.Connection = Conn
Apt.SelectCommand = cmd
cmd.CommandType = CommandType.StoredProcedure
cmd.CommandText = "API2017_checkPhone"
cmd.Parameters.Clear()
cmd.Parameters.Add("#GUID", SqlDbType.UniqueIdentifier).Value = _GUID
cmd.Parameters.Add("#Datum", SqlDbType.SmallDateTime).Value = Now
For Each item As SqlParameter In cmd.Parameters
_theString.Append(item.ParameterName & ";")
Next
Apt.Fill(ds, "DataCheckPhone")
If ds.Tables("DataCheckPhone").Rows.Count > 0 Then
With ds.Tables("DataCheckPhone").Rows(0)
Status = .Item("spStatus")
If Status = 0 Then
_RS.Namn = .Item("Namn")
_RS.SalesID = .Item("SalesID")
_RS.Anlaggning = .Item("Anlaggning")
_RS.Anlnr = .Item("Anlnr")
Funktions.URLEncodeStr(_RS.Namn)
Funktions.URLEncodeStr(_RS.Anlaggning)
End If
End With
Else
Dim _Lnum As Integer
Funktions.Logg(Fnr & ": " & "Fatal error", 999, _Lnum, 0)
_RS.message = "Error 999:" & _Lnum.ToString
Return
End If
Catch ex As Exception
_RS.status = False
_RS.Anlaggning = Nothing
_RS.Anlnr = 0
_RS.Namn = Nothing
_RS.SalesID = Nothing
Dim _Lnum As Integer
Funktions.Logg(Fnr & ": " & ex.Message & "{" & _theString.ToString & "}", 999, _Lnum, 0)
_RS.message = "Error 999:" & _Lnum.ToString
Finally
ds.Tables.Clear()
Try
ds.Tables("DataCheckPhone").Dispose()
Catch ex As Exception
End Try
End Try
Try
Conn.Close()
Conn.Dispose()
Catch ex As Exception
End Try
End Sub
And here is the stored procedure:
ALTER PROCEDURE [dbo].[API2017_checkPhone]
#GUID as uniqueidentifier,
#Datum as smalldatetime
AS
DECLARE #Status AS INT
DECLARE #Anlaggning AS NVARCHAR(50)
DECLARE #Namn AS NVARCHAR(50)
DECLARE #Anlnr AS INT
DECLARE #SalesID AS uniqueidentifier
DECLARE #LockedSalesman AS BIT
DECLARE #LockedAnlaggning AS BIT
SET #Status = 0
IF EXISTS (SELECT * FROM KK2017_connectedPhones WHERE [guid] = #guid)
BEGIN
SET #status = 0
SET #salesID = (SELECT salesID FROM KK2017_connectedPhones
WHERE [guid] = #guid)
SET #Anlnr = (SELECT anlnr FROM KK2017_Säljare WHERE salesID = #salesID)
SET #Namn = (SELECT Namn FROM KK2017_Säljare WHERE salesID = #salesID)
SET #Anlaggning = (SELECT namn FROM KK2017_Anlaggning WHERE anlnr = #Anlnr)
SET #LockedSalesman = (SELECT locked FROM KK2017_Säljare WHERE salesID = #salesID)
UPDATE KK2017_Säljare
SET inloggad = #Datum
WHERE salesID = #SalesID
IF #LockedSalesman = 1
BEGIN
SET #Status = 2
END
SET #LockedAnlaggning = (SELECT locked FROM KK2017_Anlaggning
WHERE AnlNr = #Anlnr)
IF #LockedAnlaggning = 1
BEGIN
SET #status = 3
END
END
ELSE
SET #status = 1
SELECT
#Status AS spStatus,
#Anlaggning AS Anlaggning,
#anlnr AS anlnr,
#Namn AS namn,
#SalesID AS salesID
I must have done something wrong but can not see it.
If anyone has a proposal, I would be grateful.
/Claes
You have a threading issue because you have defined cmd as shared, which means there is only one instance servicing all of the incoming requests. Sometimes two threads are in the process of adding parameters at the same time, and both threads end up with four, hence the error.
The standard pattern here would be declare cmd as a local variable, and instantiate a new instance each time the function is called. The overhead to this is negligible.
Also, avoid shared variables in multithreaded applications (such as web services). There is only one copy of the variable for all users and all threads, and 99% of the time that is not what you actually want. For the other 1% usually you'd use application variables or HttpCache. In this case you should use a local variable.
Having a problem with migration of a site from one server to another, here is the error I'm getting:
Microsoft Cursor Engine error '80040e21'
Multiple-step operation generated errors. Check each status value.
/common/classes/Cart.asp, line 110
Line 110 is:
fld.Value = Request(fld.Name)
Here is the code that's causing the issue:
public function InsertOrder
set rs = Server.CreateObject("ADODB.Recordset")
rs.ActiveConnection = OrdersConnectionString
rs.Source = "SELECT * FROM "& OrdersTable
rs.CursorType = 3
rs.CursorLocation = 3
rs.LockType = 3
rs.Open()
rs.AddNew
For Each fld in rs.Fields
if Len(Request(fld.Name)) > 0 then
fld.Value = Request(fld.Name)
end if
Next
rs.Update
rs.Requery
rs.Sort=OrderKey &" desc "
OrderID=rs(OrderKey)
end function
It used to use SQL2008 but the new server us running SQL2016.
Thanks for any ideas you can give.
Judging from the code causing this error, this is most likely a problem with type casting behind the scenes. Somehow the database driver fails to properly convert the data to the proper type, so you have to do that yourself.
One way which is pretty flexible, is defining key/value pairs (VBScript Dictionary can fit in this case) where the key will be the field name, and the value will be the type to which to convert the value. (String, Integer, Double, Date)
Sample code would be: (untested, but should work as-is, provided you put correct details)
Const FIELD_TYPE_STRING = 1
Const FIELD_TYPE_INTEGER = 2
Const FIELD_TYPE_DOUBLE = 3
Const FIELD_TYPE_DATE = 4
Const FIELD_TYPE_CURRENCY = 5
Function ConverFieldValue(rawValue, fieldType)
ConverFieldValue = VBNull
Select Case fieldType
Case FIELD_TYPE_STRING:
ConverFieldValue = CStr(rawValue)
Case FIELD_TYPE_INTEGER:
If rawValue<>"" Then ConverFieldValue = CLng(rawValue)
Case FIELD_TYPE_DOUBLE
If rawValue<>"" Then ConverFieldValue = CDbl(rawValue):
Case FIELD_TYPE_DATE:
If rawValue<>"" Then ConverFieldValue = CDate(rawValue)
Case FIELD_TYPE_CURRENCY:
If rawValue<>"" Then ConverFieldValue = CCur(rawValue)
End Select
End Function
Dim typeMapping
Set typeMapping = Server.CreateObject("Scripting.Dictionary")
'''***Add actual field names and types below:****
typeMapping.Add "Field1", FIELD_TYPE_STRING
typeMapping.Add "Field2", FIELD_TYPE_INTEGER
typeMapping.Add "Field3", FIELD_TYPE_DOUBLE
typeMapping.Add "Field4", FIELD_TYPE_CURRENCY
typeMapping.Add "Field5", FIELD_TYPE_DATE
'''*************************************************
Dim currentFieldType, currentFieldValue
Set rs = Server.CreateObject("ADODB.Recordset")
rs.ActiveConnection = OrdersConnectionString
rs.Source = "SELECT * FROM "& OrdersTable
rs.CursorType = 3
rs.CursorLocation = 3
rs.LockType = 3
rs.Open()
rs.AddNew
For Each fld in rs.Fields
if Len(Request(fld.Name)) > 0 then
currentFieldType = typeMapping(fld.Name)
currentFieldValue = ConverFieldValue(Request(fld.Name), currentFieldType)
fld.Value = currentFieldValue
end if
Next
rs.Update
rs.Requery
rs.Sort=OrderKey &" desc "
OrderID=rs(OrderKey)
I have a recursive function that creates a list of items based on their hierarchy(integer is used to determine which level 1 to 10 max). There can be x number of items in any given level. I want to store all the items that belong the same level at the corresponding index of the jagged array. The items aren't retrieved based on their level so the level can be jumping around all of over the place as the function recurses.
Function RecurseParts(lngPartID1, lngLevel) As Object
'this function will recursivley print the parts lists for the part ID passed in
If IsNumeric(lngPartID1 & "") Then
Dim objRSTemp As Object = Server.CreateObject("ADODB.Recordset")
objRSTemp.CursorLocation = adUseClient
objRSTemp.Open(PART_LIST_SQL & lngPartID1, objConn, adOpenForwardOnly, adLockReadOnly)
'objRSTemp.ActiveConnection = Nothing
If objRSTemp.eof And objRSTemp.bof Then
'PROBLEM, WE HAVE NO RECORDS
Response.Write("There Were No Parts For This Assembly (Part ID #:" & lngPartID1 & ")")
Else
'make output
Dim strTemp As String = String.Empty
If lngLevel <> 1 Then strTemp = " style=""display: none;"">"
Response.Write("<table id='tblparts" & lngCurrentLineNum & "' border=""0"" cellspacing=""0"" width=""100%"" cellpadding=""1"" " & strTemp)
Do Until objRSTemp.EOF
'increase the current line num
lngCurrentLineNum = lngCurrentLineNum + 1
'get current Part ID
lngCurrentPartID = objRSTemp("PartID").value
'reset flag
blnIsAssm = False
'loop thru array of assemblies to see if this is a parent
For ctr = 0 To UBound(arrAssmList, 2)
If arrAssmList(0, ctr) = lngCurrentPartID Then
'the current part is an assembly
blnIsAssm = True
Exit For
ElseIf arrAssmList(0, ctr) > lngCurrentPartID Then
Exit For
End If
Next
If blnIsAssm Then
'recurse these parts
If RecurseParts(objRSTemp("PartID").value, lngLevel + 1) = True Then
'awesome
End If
End If
objRSTemp.MoveNext()
Loop
Response.Write("</table>")
End If
If objRSTemp.State Then objRSTemp.Close()
objRSTemp = Nothing
'RETURN FUNCTION
RecurseParts = True
Else
'no PART ID passed in
Response.Write("No Part ID Passed In")
RecurseParts = False
End If
End Function
It sounds like a Dictionary would work here.
Dim myDict As New Dictionary(Of Integer, List(Of String))
In your recursive function. The parts in the {} are the parts you have to supply.
'this builds the keys as you go
If Not myDict.ContainsKey({{key} -> your Integer}) Then
'add key and use the From statement to add a value if know at this time
myDict.Add({key}, New List(Of String) From {value})
Else
myDict({key}).Add({string to insert at this level})
End If
List of keys in reverse order:
Dim keys = myDict.Keys.OrderByDescending(Function(k) k)
I was able to create a List to store all the partIDs and their levels.
Dim arrSubID As New List(Of List(Of Integer))()
Function RecurseParts(paramenters)
For ctr = 0 To UBound(arrAssmList, 2)
If arrAssmList(0, ctr) = lngCurrentPartID Then
'checks whether we need a new index in the list
If lngLevel + 1 > arrSubID.Count Then
arrSubID.Add(New List(Of Integer))
End If
'adds the partID where it belongs!
arrSubID(lngLevel).Add(lngCurrentPartID)
blnIsAssm = True
Exit For
ElseIf arrAssmList(0, ctr) > lngCurrentPartID Then
Exit For
End If
Next
End Function
I recently inherited a website in ASP, which I am not familiar with. Yesterday, one of the pages began to throw an error:
Microsoft VBScript runtime error '800a0009'
Subscript out of range: 'i'
default.asp, line 19
Here is the code from lines 13-27:
<%
set rs = Server.CreateObject("ADODB.Recordset")
rs.open "SELECT * FROM VENDORS_LIST_TBL WHERE inStr('"& dVendorStr &"','|'&ID&'|')", Cn
DIM dTitle(100), dDescription(100), dLink(100)
i = 0 : Do while NOT rs.EOF : i = i + 1
dTitle(i) = rs.fields.item("dTitle").value
dDescription(i) = rs.fields.item("dDescription").value
dLink(i) = rs.fields.item("dLink").value : if dLink(i) <> "" then dTitle(i) = "" & dTitle(i) & ""
if NOT rs.EOF then rs.movenext
Loop
x = i
rs.Close : Set rs = Nothing
%>
Any ideas on what's going on here and how I can fix it?
Thank you!
You've declared dTitle, dDescription and dLink as Arrays with a size of 100. As you are walking through the recordset, you are assigning elements to those arrays. It would appear that you have more than 100 records in your recordset, so the logic is trying to do something like:
dTitle(101) = rs.fields.item("dTitle").value
This will throw an error because your array isn't big enough to hold all of your data.
The "solution" you chose is not very good. What if within 2 years there will be more than 500? You will forget all about this and waste hours yet again.
Instead of fixed size arrays you can just use dynamic arrays:
DIM dTitle(), dDescription(), dLink()
ReDim dTitle(0)
ReDim dDescription(0)
ReDim dLink(0)
i = 0
Do while NOT rs.EOF
i = i + 1
ReDim Preserve dTitle(i)
ReDim Preserve dDescription(i)
ReDim Preserve dLink(i)
dTitle(i) = rs.fields.item("dTitle").value
dDescription(i) = rs.fields.item("dDescription").value
dLink(i) = rs.fields.item("dLink").value
If (Not(IsNull(dLink(i)))) And (dLink(i) <> "") Then
dTitle(i) = "" & dTitle(i) & ""
End If
rs.movenext
Loop
This will start with one (empty) item in each array - for some reason the code seems to need this - then on each iteration one more item will be added, preserving the others.
Note that I've also fixed small issue that might have caused trouble - in case of NULL value in "dLink" field, you would get blank anchors in your HTML because NULL is not empty string in VBScript.
This how GetRows can be used to achieve the same goal.
<%
Function VendorSearch(sVendor)
Dim cn: Set cn = SomeLibraryFunctionThatOpensAConnection()
Dim cmd: Set cmd = Server.CreateObject("ADODB.Command")
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT dTitle, dDescription, dLink FROM VENDORS_LIST_TBL WHERE inStr(?,'|'&ID&'|')"
cmd.Parameters.Append cmd.CreateParameter("Vendor", adVarChar, adParamInput, Len(sVendor), sVendor)
Set cmd.ActiveConnection = cn
Dim rs : Set rs = cmd.Execute()
VendorSearch = rs.GetRows()
rs.Close()
cn.Close()
End Function
Dim arrVendor : arrVendor = VendorSearch(dVendorStr)
Const cTitle = 0, cDesc = 1, cLink = 2
Dim i
For i = 0 To UBound(arrVendor, 2)
If IsNull(arrVendor(cLink, i) Or arrVendor(cLink, i) = "" Then
arrVendor(cTitle, i) = "" & arr(cTitle, i) & ""
End If
Next
%>
Notes:
The Select statement contains only those fields required in the results, the use of * should be avoided
A parameterised command is used to avoid SQL Injection threat from SQL contactenation.
Constants used for field indices into the resulting 2 dimensional array.
Whilst this code replicates the original munging of the title value this is here as an example only. In reality construction of HTML should be left as late as possible and outputing of all such strings as title and description should be passed through Server.HTMLEncode before sending to the response.