Related
I have a function (see below) and it works perfectly. I recently moved my code to another server and i did not change anything in it. It fails to run on new server.
Microsoft VBScript runtime error '800a0005'
Invalid procedure call or argument: 'Mid'
/calculate.asp, line 416
When i checked the line 416, i got this:
Dim result3: result3 = Mid(o3.responseText, Basla3, Bitir3)
and this is the complete function:
<%
Function xyz()
Dim o3: Set o3 = Server.CreateObject("MSXML2.ServerXMLHTTP")
Dim o_date3: o_date3 = split(EndingDate, ".")
Dim s_date3
If (Len(o_date3(2)) = 4) Then
s_date3 = o_date3(2)
Else
s_date3 = "20" & o_date3(2)
End If
If (Len(o_date3(1)) = 2) Then
s_date3 = s_date3 & o_date3(1)
Else
s_date3 = s_date3 & "0" & o_date3(1)
End If
If (Len(o_date3(0)) = 2) Then
s_date3 = s_date3 & o_date3(0)
Else
s_date3 = s_date3 & "0" & o_date3(0)
End If
Dim s3: s3 = "<soapenv:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soapenv=""http://schemas.xmlsoap.org/soap/envelope/"" xmlns:urn=""urn:AntTransferWSIntf-IAntTransferWS""><soapenv:Header/><soapenv:Body><urn:EURCurrency soapenv:encodingStyle=""http://schemas.xmlsoap.org/soap/encoding/""><DateStr xsi:type=""xsd:string"">" + s_date3 + "</DateStr></urn:EURCurrency></soapenv:Body></soapenv:Envelope>"
o3.Open "POST", serviceUrl, False
o3.setRequestHeader "Content-Type", "text/xml"
o3.setRequestHeader "Connection", "close"
o3.setRequestHeader "SOAPAction", " "
o3.send s3
Dim hataVarMiBasla3: hataVarMiBasla3 = (InStr(1, o3.responseText, "<faultstring>", vbTextCompare)) + 13
If (hataVarMiBasla3 > 13) Then
Dim hataVarMiBitir3: hataVarMiBitir3 = (InStr(1, o3.responseText, "</faultstring>", vbTextCompare)) - hataVarMiBasla3
Dim hata3: hata3 = Mid(o3.responseText, hataVarMiBasla3, hataVarMiBitir3)
KurGetir = hata3
Else
Dim Basla3: Basla3 = (InStr(1, o3.responseText, """xsd:double"">", vbTextCompare)) + 13
Dim Bitir3: Bitir3 = (InStr(1, o3.responseText, "</return>", vbTextCompare)) - Basla3
Dim result3: result3 = Mid(o3.responseText, Basla3, Bitir3)
xyz = CDbl(Replace(result3, ".", mstrComma))
End If
Set o3 = Nothing
End Function
%>
Why am i receiving this error?
Mid struct from MSDN
Mid(string, start[, length])
Not official reference but according to my experience, you get that error if
start is less than or equal to zero.
length is less than zero (if it is not missed in the Mid call)
Have a look at the error line and related ones.
Dim Basla3: Basla3 = (InStr(1, o3.responseText, """xsd:double"">", vbTextCompare)) + 13
Dim Bitir3: Bitir3 = (InStr(1, o3.responseText, "</return>", vbTextCompare)) - Basla3
Dim result3: result3 = Mid(o3.responseText, Basla3, Bitir3)
Lets suppose o3.responseText is empty because your code does not check whether the response is empty.
Basla3 can not be less than 13 according to InStr() + 13, so it's not the problem.
However it seems like Bitir3 can be less then zero according to InStr() - Basla3 (Basla3 evaluated as 13).
Continuing with the assumption, (InStr(1, o3.responseText, "</return>", vbTextCompare)) evaluated as 0, then with - Basla3 it will be evaluated as -13. Tada! rule 2 violated, length cannot be less than zero.
The problem with your code is, there is no check response length nor response status.
If the response is empty, consider the following:
Your new server may have connectivity problems unlike the old one.
The API which you have is authorized for the old server's IP address only.
In a nutshell, you should optimize the code and be sure that there is an xml response.
At least use something like that:
o3.Send
If o3.readyState = 4 And o3.status = 200 Then
If Len(o3.responseText) > 0 Then
'response is ready to parse
Else
'response status is ok but empty
End If
Else
'request failed
End If
BTW, due to your request is a soap call, I'd highly recommend done the job by parsing xml response using DomDocument etc.
Replacing decimal points, using Mid & InStr pair to check node existence are just trouble and bad practice also.
If I were to take a guess.
VBScript gives strange errors when your "MID" function has to deal with special characters, or what it thinks are non-string values.
So, o3.responseText probably contains text that it doesn't like.
I've tried all the ways I see to add a month to a certain date then return that in a specific format but I'm at a loss. Here's my code but I need to format it:
replace( formatdatetime( dateadd( "m" , 1 , request("date") ), 0 ) , "/" , "-" ) & "' )
request("date") is in yyyyy-dd-mm hh:mm:ss format and that's how I need the new date.
The following should work perfect:
replace( formatdatetime( dateadd( "m" , 1 , cDate(request("date")) ), 0 ) , "/" , "-" )
Notice the use of the cDate function to convert a value to a date explicitly.
Edit:
I removed last part of your code & "' ), it gave me an error otherwise.
When working with dates, it's especially important to take care of the proper data (sub)types. Feeding a string to a function that expects a date (and relying on 'VBScript - and your local settings - will do the right thing') is dangerous.
Using replace will never change the order of the date parts.
FormatDateTime depends on the local/regional settings and should be avoided as a sure path to disaster.
One way to solve this problem + most of all other problems concerning fancy formatting in VBScript is to use a .Net System.Text.StringBuilder:
Given Lib.vbs:
' Lib.vbs - simple VBScript library/module
' use
' ExecuteGlobal goFS.OpenTextFile(<PathTo\Lib.vbs>).ReadAll()
' to 'include' Lib.vbs in you main script
Class ToBeAShamedOf
Public a
Public b
End Class ' ToBeAShamedOf
Class cFormat
Private m_oSB
Private Sub Class_Initialize()
Set m_oSB = CreateObject("System.Text.StringBuilder")
End Sub ' Class_Initialize
Public Function formatOne(sFmt, vElm)
m_oSB.AppendFormat sFmt, vElm
formatOne = m_oSB.ToString()
m_oSB.Length = 0
End Function ' formatOne
Public Function formatArray(sFmt, aElms)
m_oSB.AppendFormat_4 sFmt, (aElms)
formatArray = m_oSB.ToString()
m_oSB.Length = 0
End Function ' formatArray
End Class ' cFormat
and main.vbs:
' main.vbs - demo use of library/module Lib.vbs
' Globals
Dim gsLibDir : gsLibDir = ".\"
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
' LibraryInclude
ExecuteGlobal goFS.OpenTextFile(goFS.BuildPath(gsLibDir, "Lib.vbs")).ReadAll()
WScript.Quit demoDateFormat()
WScript.Quit main()
Function main()
Dim o : Set o = New ToBeAShamedOf
o.a = 4711
o.b = "whatever"
WScript.Echo o.a, o.b
main = 1 ' can't call this a success
End Function ' main
Function demoDateFormat()
Dim sD : sD = "2012-05-16 01:02:03" ' near future; not yyyyy!
Dim dtD : dtD = CDate(sD)
Dim dtDM : dtDM = DateAdd("m", 1, dtD)
Dim oFmt : Set oFmt = New cFormat
WScript.Echo oFmt.formatArray( _
" sD: {1}{0} dtD: {2}{0} dtDM: {3}{0}dtDM': {4}" _
, Array(vbCrLf, sD, dtD, dtDM, oFmt.formatOne("{0:yyyy-MM-dd hh:mm:ss}", dtDM)))
demoDateFormat = 0 ' seems to be decent
End Function ' demoDateFormat
you'll get:
cscript main.vbs
sD: 2012-05-16 01:02:03
dtD: 16.05.2012 01:02:03
dtDM: 16.06.2012 01:02:03
dtDM': 2012-06-16 01:02:03
(to be seen in the context of this answer)
This may help:
FormatDateTime(DateAdd("M",1,DateSerial(Left(request("date"),4),Mid(request("date"),9,2),Mid(request("date"),6,2))) & " " & Mid(request("date"),12,8),d,0)
It basically converts the string to a valid date in the native format, adds the 1 requested month and then rebuilds the string.
NOTE: request("date") looks as though it returns the current datetime so running it in this way may generate a final value that is a second or so out, if that's a problem then you will be better storing a static value in a variable, otherwise this should hopefully be ok.
Hi I am using a code to get the referral URL as you can see below:
sRef = encode(Request.ServerVariables("HTTP_REFERER"))
The code above is getting the following URL:
http://www.rzammit.com/pages/linux-form.asp?adv=101&loc=349&websync=233344-4555665-454&ptu=454545
From that url I want to grab ONLY the ADV and LOC (Request.querystring doesnt work because this is a script which is run when the form is submitted)
So to cut the story short, by using the referral URL, i want to get out the values for the adv and loc parameters.
Any help please on how I can do this?
Below is the code I am currently using but I have a problem. The parameters which are after the loc, is showing as well. I want something dynamic. Also the values of the adv and loc can be longer.
<%
sRef = Request.ServerVariables("HTTP_REFERER")
a=instr(sRef, "adv")+4
b=instr(sRef, "&loc")
response.write(mid(sRef ,a,b-a))
response.write("<br>")
response.write(mid(sRef ,b+5))
%>
Here is something to get you started; it uses regular expressions to get all URL variables for you. You can use the split() function to split them on the "=" sign and get a simple array, or put them in a dictionary or whatever.
Dim fieldcontent : fieldcontent = "http://www.rzammit.com/pages/linux-form.asp?adv=101&loc=349&websync=233344-4555665-454&ptu=454545"
Dim regEx, Matches, Item
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
regEx.MultiLine = False
regEx.Pattern = "(\?|&)([a-zA-Z0-9]+)=([^&])"
Set Matches = regEx.Execute(fieldcontent)
For Each Item in Matches
response.write(Item.Value & "<br/>")
Next
Set regEx = Nothing
substring everything after the ?.
Split on "&"
Iterate the array to find "adv=" and "loc="
Below is the code:
Dim fieldcontent
fieldcontent = "http://www.rzammit.com/pages/linux-form.asp?adv=101&loc=349&websync=233344-4555665-454&ptu=454545"
fieldcontent = mid(fieldcontent,instr(fieldcontent,"?")+1)
Dim params
params = Split(fieldcontent,"&")
for i = 0 to ubound(params) + 1
if instr(params(i),"adv=")>0 then
advvalue = mid(params(i),len("adv=")+1)
end if
if instr(params(i),"loc=")>0 then
locvalue = mid(params(i),5)
end if
next
You can use the following generic function:
function getQueryStringValueFromUrl(url, key)
dim queryString, queryArray, i, value
' check if a querystring is present
if not inStr(url, "?") > 0 then
getQueryStringValueFromUrl = empty
end if
' extract the querystring part from the url
queryString = mid(url, inStr(url, "?") + 1)
' split the querystring into key/value pairs
queryArray = split(queryString, "&")
' see if the key is present in the pairs
for i = 0 to uBound(queryArray)
if inStr(queryArray(i), key) = 1 then
value = mid(queryArray(i), len(key) + 2)
end if
next
' return the value or empty if not found
getQueryStringValueFromUrl = value
end function
In your case:
dim url
url = "http://www.rzammit.com/pages/linux-form.asp?adv=101&loc=349&websync=233344-4555665-454&ptu=454545"
response.write "ADV = " & getQueryStringValueFromUrl(url, "adv") & "<br />"
response.write "LOC = " & getQueryStringValueFromUrl(url, "loc")
This title of the question may seem to be previously asked and answered but its different scenario for me. I use this script to stop sql injection in my ASP site. As per my knowledge or injecting script i have tried everything . Is it still possible to break through this code or do you feel this is fine .
Here is the script
<%
Function IsInject(strCheck, boolForm)
IsInject = False
If Not boolForm And Len(strCheck) > 50 Then IsInject = True
' Dim sCmdList, arrCmds, i
If boolForm Then
sCmdList = "declare,varchar,convert,delete,create,is_srvrolemember,ar(,cast("
Else
sCmdList = "update,union,select,drop,declare,varchar,convert,delete,create,is_srvrolemember,ar(,cast(,char("
End If
arrCmds = Split(sCmdList, ",")
For i = 0 To UBound(arrCmds)
If Instr(UCase(CStr(strCheck)), UCase(arrCmds(i))) > 0 Then
IsInject = True
Exit For
End If
Next
Erase arrCmds
End Function
Function CleanInject(strClean, boolInt)
If boolInt Then CleanInject = CInt(strClean) Else CleanInject = Replace(strClean, "'", "''")
End Function
'-----------------------------------------------------------
'redirect user if specific IP
'Dim ipaddress, bFBIRedirect, sInjectType
bFBIRedirect = True
ipaddress = Request.ServerVariables("REMOTE_ADDR")
Select Case ipaddress
Case "90.120.206.10"
Case Else
bFBIRedirect = False
End Select
If bFBIRedirect Then Response.Redirect "http://www.fbi.gov"
'-----------------------------------------------------------
'Dim bIsInject, sHackString
bIsInject = False
If Not bInject Then
' Dim qsItm
For Each qsItm In Request.QueryString
If IsInject(Request.QueryString(qsItm), False) Then
bIsInject = True
sHackString = qsItm & "=" & Request.QueryString(qsItm)
sHackType = "QueryString"
sInjectType = "qs-" & Request.QueryString(qsItm)
Exit For
End If
Next
End If
If Not bInject Then
' Dim frmItm
' For Each frmItm In Request.Form
' If IsInject(Request.Form(frmItm), True) Then
' bIsInject = True
' sHackString = Request.Form(frmItm)
' sHackString = frmItm & "=" & Request.Form(frmItm)
' sHackType = "Form"
' Exit For
' End If
' Next
End If
If bIsInject Then
Session("hacktype") = sHackType
Session("hackstr") = sHackString
Session("thepagefrom") = Request.ServerVariables("PATH_INFO")
Session("theip") = Request.ServerVariables("REMOTE_ADDR")
' Dim arrWhereAt, iWhereAt, sRedirect
arrWhereAt = Split(Request.ServerVariables("PATH_INFO"), "/")
iWhereAt = UBound(arrWhereAt)
sRedirect = "unknownerror.asp?ip=" & Request.ServerVariables("REMOTE_ADDR") & "&err=" & sInjectType & "&pg=" & Request.ServerVariables("PATH_INFO")
If iWhereAt = 1 Then sRedirect = "../" & sRedirect
If iWhereAt = 2 Then sRedirect = "../../" & sRedirect
If iWhereAt = 3 Then sRedirect = "../../../" & sRedirect
Response.Redirect sRedirect
End If
%>
Using blacklists to remove commands is not really a good idea. You have to make sure you cover all possible commands, and still someone might sneak something past. This would also probably fail if you get data from a user that is not an attack, but still contains an attack string. Example "Back in the days of the Soviet Union".
As Nikolai suggests, see if you can find some type of prepared statements to use. Or find a really good library to properly escape data for you.
rather doing that I think I would use ADO Parameter object when creating SQL queries, the second best thing is to do type conversion of the inputfields for the dynamic SQL queries, such as converting strings to SQL strings (replace any ' with two ''), making sure number is a number etc.
Here's my code
Dim RefsUpdate As String() = Session("Refs").Split("-"C)
Dim PaymentsPassedUpdate As String() = Session("PaymentsPassed").Split("-"C)
Dim x as Integer
For x = 1 to RefsUpdate.Length - 1
Dim LogData2 As sterm.markdata = New sterm.markdata()
Dim queryUpdatePaymentFlags as String = ("UPDATE OPENQUERY (db,'SELECT * FROM table WHERE ref = ''"+ RefsUpdate(x) +"'' AND bookno = ''"+ Session("number") +"'' ') SET alpaid = '"+PaymentsPassedUpdate(x) +"', paidfl = 'Y', amountdue = '0' ")
Dim drSetUpdatePaymentFlags As DataSet = Data.Blah(queryUpdatePaymentFlags)
Next
I don't get any errors for this but it doesn't seem to working as it should
I'm passing a bookingref like this AA123456 - BB123456 - CC123456 - etc and payment like this 50000 - 10000 - 30000 -
I basically need to update the db with the ref AA123456 so the alpaid field has 50000 in it.
Can't seem to get it to work
Any ideas?
Thanks
Jamie
I'm not sure what isn't working, but I can tell you that you are not going to process the last entry in your arrays. You are going from 1 to Length - 1, which is one short of the last index. Therefore, unless your input strings end with "-", you will miss the last one.
Your indexing problem mentioned by Mark is only one item, but it will cause an issue. I'd say looking at the base your problem stems from not having trimmed the strings. Your data base probably doesn't have spaces leading or trailing your data so you'll need to do something like:
Dim refsUpdateString as string = RefsUpdate(x).Trim()
Dim paymentsPassedUpdateString as string = PaymentsPassedUpdate(x).Trim()
...
Dim queryUpdatePaymentFlags as String = ("UPDATE OPENQUERY (db,'SELECT * FROM table WHERE ref = ''" & refsUpdateString & "'' AND bookno = ''" & Session("number") & "'' ') SET alpaid = '" & paymentsPassedUpdateString & "', paidfl = 'Y', amountdue = '0' ")
Also, I would recommend keeping with the VB way of concatenation and use the & character to do it.