I have a page that calls an api that in test mode has not required any authorization.
We are now moving to a live environment where a username and password will be required.
The api provider has sent the following message:
To access these services please send the requests by adding following HTTP header.
Authorization: Basic Base64Encode(“username: password”)
I'm not sure of the correct syntax and wondered if someone could help me out.
The original call (and working perfectly) is:
Dim xmlobj, username, password
username="myusername"
password="mypassword"
Set xmlobj = server.CreateObject("MSXML2.DOMDocument.3.0")
xmlobj.async = false
xmlobj.setProperty "ServerHTTPRequest", True
xmlObj.AddHeader "Authorization", "Basic", Base64Encode(username & ":" & password)
xmlobj.load(sUrl)
The above code throws an error
/api-test.asp |20|800a000d|Type_mismatch:_'Base64Encode'
Any help would be greatly appreciated.
Like I've mentioned in the comments, the syntax for the Authorization header is incorrect.
The API example doesn't expect "Base64Encode('username','password')" this is an example supplied by the API to show you how to take the string "username:password" and Base64 encode it which is what the Authorization header is expecting.
But you still need to have the Base64Encode() function definition for the code to work.
Base64Encode() and MyASC() functions are taken from Base64 encode VBS function (vb encoder algorithm), source code
Something like this should work;
<%
Function Base64Encode(inData)
'rfc1521
'2001 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, I
'For each group of 3 bytes
For I = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
&H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
Dim xmlobj, username, password
username="myusername"
password="mypassword"
Set xmlobj = server.CreateObject("MSXML2.XMLHTTP.3.0")
xmlobj.Open "GET", sUrl, False
xmlobj.setRequestHeader "Authorization", "Basic " & Base64Encode(username & ":" & password)
xmlobj.Send
Dim xmldoc
If xmlobj.status = 200 Then
Set xmldoc = Server.CreateObject("MSXML2.DOMDocument.3.0")
xmldoc.Load xmlobj.ResponseXML
Else
Response.Write "An error occurred!"
End If
%>
Related
I have a page that calls an api that in test mode has not required any authorization.
We are now moving to a live environment where a username and password will be required.
The api provider has sent the following message:
To access these services please send the requests by adding following HTTP header.
Authorization: Basic Base64Encode(“username: password”)
I'm not sure of the correct syntax and wondered if someone could help me out.
The original call (and working perfectly) is:
Dim xmlobj, username, password
username="myusername"
password="mypassword"
Set xmlobj = server.CreateObject("MSXML2.DOMDocument.3.0")
xmlobj.async = false
xmlobj.setProperty "ServerHTTPRequest", True
xmlObj.AddHeader "Authorization", "Basic", Base64Encode(username & ":" & password)
xmlobj.load(sUrl)
The above code throws an error
/api-test.asp |20|800a000d|Type_mismatch:_'Base64Encode'
Any help would be greatly appreciated.
Like I've mentioned in the comments, the syntax for the Authorization header is incorrect.
The API example doesn't expect "Base64Encode('username','password')" this is an example supplied by the API to show you how to take the string "username:password" and Base64 encode it which is what the Authorization header is expecting.
But you still need to have the Base64Encode() function definition for the code to work.
Base64Encode() and MyASC() functions are taken from Base64 encode VBS function (vb encoder algorithm), source code
Something like this should work;
<%
Function Base64Encode(inData)
'rfc1521
'2001 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim cOut, sOut, I
'For each group of 3 bytes
For I = 1 To Len(inData) Step 3
Dim nGroup, pOut, sGroup
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
&H100 * MyASC(Mid(inData, I + 1, 1)) + MyASC(Mid(inData, I + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
'Add a new line For Each 76 chars In dest (76*3/4 = 57)
'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
Next
Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select
Base64Encode = sOut
End Function
Function MyASC(OneChar)
If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
Dim xmlobj, username, password
username="myusername"
password="mypassword"
Set xmlobj = server.CreateObject("MSXML2.XMLHTTP.3.0")
xmlobj.Open "GET", sUrl, False
xmlobj.setRequestHeader "Authorization", "Basic " & Base64Encode(username & ":" & password)
xmlobj.Send
Dim xmldoc
If xmlobj.status = 200 Then
Set xmldoc = Server.CreateObject("MSXML2.DOMDocument.3.0")
xmldoc.Load xmlobj.ResponseXML
Else
Response.Write "An error occurred!"
End If
%>
Perspective: This script will run on user login and on command with a shortcut on the desktop. The order the application start is imperative. Throughout the script, I require the full path and the program name.
Problem: Each program path is a value in an array. I am trying to split each program path by “\” and get the upper bound to get the program name. Then Redim Preserve the original array and add the program on the second dimension. After reading for many hours, I grasp I can only change the last dimension, but I can’t figure out how to not get out of bound errors. This Creating a Multidimensional, Associative Array in VBScript is not trying to redim preserve from a For Each split.
Set objFso = CreateObject("Scripting.FileSystemObject")
'---Create Program Variables
strProgram1 = "%SystemRoot%\notepad.exe"
strProgram2 = "C:\Program Files\Microsoft Office\root\Office16\OUTLOOK.EXE"
strProgram3 = "C:\Program Files\Microsoft Office\root\Office16\ONENOTE.EXE"
strProgram4 = "C:\Program Files (x86)\Internet Explorer\iexplore.exe" & " https://www.google.com" 'IE with URL
'---Add Program Path Variables to an Array
ReDim strProgramList(3)
strProgramList = Array(strProgram1,strProgram2,strProgram3,strProgram4)
strProgramNameList = Array()
strProgramRestartList = Array()
boolNeedsRestart = false
'---Iterating using For each loop to get program name.
ReDim Preserve strProgramList(3, 1)
For Each strProgramPath In strProgramList
strPathComponents = Split(strProgramPath, "\")
strProgramName = strPathComponents(Ubound(strPathComponents))
strProgramList(0, LBound(strProgramList) + 1) = strProgramName
Next
MsgBox strProgramList(0,0) & vbNewLine & strProgramList(1,0) & vbNewLine & strProgramList(2,0) & vbNewLine & strProgramList(3,0) & vbNewLine & strProgramList(0,1) & vbNewLine & strProgramList(1,1) & vbNewLine & strProgramList(2,1) & vbNewLine & strProgramList(3,1)
How to use the FileSystemObject to parse/build pathes and how to work with two-dimensional arrays:
Option Explicit
Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject")
Dim a : a = Split("A:\B\CC.EXE A:\CC\DD.CMD C:\You\Got\It.pl")
ReDim b(2, UBound(a))
Dim i
For i = 0 To UBound(a)
b(0, i) = a(i)
b(1, i) = goFS.GetParentFolderName(a(i))
b(2, i) = goFS.GetFileName(a(i))
Next
ReDim Preserve b(2, UBound(b, 2) + 1)
b(0, UBound(b, 2)) = "P:\i\pa\po.py"
b(1, UBound(b, 2)) = goFS.GetParentFolderName(b(0, UBound(b, 2)))
b(2, UBound(b, 2)) = goFS.GetFileName(b(0, UBound(b, 2)))
For i = 0 To UBound(b, 2)
WScript.Echo b(0, i), "=", b(1, i), "+", b(2, i), "=>", goFS.BuildPath(b(1, i), b(2, i))
Next
output:
cscript twodim.vbs
A:\B\CC.EXE = A:\B + CC.EXE => A:\B\CC.EXE
A:\CC\DD.CMD = A:\CC + DD.CMD => A:\CC\DD.CMD
C:\You\Got\It.pl = C:\You\Got + It.pl => C:\You\Got\It.pl
P:\i\pa\po.py = P:\i\pa + po.py => P:\i\pa\po.py
How can I make this kind of code for Windows 2003 IIS server?
Dim req as New WebClient()
Dim myCache As New CredentialCache()
myCache.Add(New Uri(URL), "Basic", _
New NetworkCredential(Username, Password))
req.Credentials = myCache
Dim results as String
results = System.Encoding.UTF8.GetString(req.DownloadData(URL))
I suppose you could compile this to a webservice using VB.NET and make calls to it using SOAP from your classic ASP site.
You may find that you'd need to extend the functionality of the service to include other facilities to manipulate your requirements later on.
This probably isn't the best solution, but it's something to consider.
Found it myself, this VBScript code makes a call to url with user:pass credentials, the base64 class is required due the bug in ms library.
Dim http: Set http = Server.CreateObject("MSXML2.ServerXMLHTTP")
dim url
url = "any.html"
http.open "GET", url, False,"user","pass"
http.setRequestHeader "Authorization", "Basic " & Base64Encode("user:pass")
http.send
Function Base64Encode(inData) 'ripped from:
'http://www.pstruh.cz/tips/detpg_Base64Encode.htm 'rfc1521 '2001
Antonin Foller, PSTRUH Software, http://pstruh.cz Const Base64 = _
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim sOut, I
'For each group of 3 bytes For I = 1 To Len(inData) Step 3
Dim nGroup, pOut
'Create one long from this 3 bytes.
nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
&H100 * MyASC(Mid(inData, I + 1, 1)) + _
MyASC(Mid(inData, I + 2, 1))
'Oct splits the long To 8 groups with 3 bits
nGroup = Oct(nGroup)
'Add leading zeros
nGroup = String(8 - Len(nGroup), "0") & nGroup
'Convert To base64
pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
'Add the part To OutPut string
sOut = sOut + pOut
Next Select Case Len(inData) Mod 3
Case 1: '8 bit final
sOut = Left(sOut, Len(sOut) - 2) + "=="
Case 2: '16 bit final
sOut = Left(sOut, Len(sOut) - 1) + "="
End Select Base64Encode = sOut End Function
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.
How can I save and retrieve audio and video files in and from a SQL Server database?
The naive approach is to use a BLOB column and read the entire content into a byte[], then write the byte[] back to the client. The problem is that it consumes huge amounts of memory in your ASP.Net process.
A much better approach is to use streaming semantics, see these two articles:
Download and Upload images from SQL Server via ASP.Net MVC
FILESTREAM MVC: Download and Upload images from SQL Server
The articles refer to images, but you can use the code as-is to store any other form of media, including audio and video. Although the code is for ASP.Net MVC, the concepts use to stream large files into and from SQL Server can be used just as well from ASP.Net forms.
I'm not making a case that you should or should not use SQL Server as the storage for media. That is an entirely different discussion.
Refer to How to Store audio in Sql and retrieve for play, you come to know how to store the audio files in the database. Follow the same way for videos also.
Public Sub InsertAudioDataInTable(TableName, TableMapingName, TextName,_
LoopStart, LoopEnd, Panel, PathOnDisk)
Dim SndSourceStream As Stream = New FileStream(PathOnDisk, FileMode.Open,
FileAccess.Read)
Dim BinarySndReader As New BinaryReader(SndSourceStream)
Dim bytes As Byte() = BinarySndReader.ReadBytes(SndSourceStream.Length)
strImage = "#Aud" ' Aud mean a feild Audio in database
'''''''''''''''''''''''''''''''''''''''''''''''' For SQL String
Dim b = 0
Dim dataContaner(LoopEnd + 2 - LoopStart) As String
For a = LoopStart To LoopEnd
dataContaner(b) = Panel.Controls(TextName & a).Text
b = b + 1
Next
''''''''''''''
Dim myCmd As New SqlCommand
myCmd.Connection = Con
''''''''''
Dim T As String
' T.Text = null
Dim aaa = "INSERT INTO " & TableName
Dim bbb = ""
For i = LoopStart To LoopEnd
bbb = bbb + "F" & i & ","
Next
T = aaa & " (" + bbb & "Aud"
' T = T.Remove(T.Length - 1)
T = T & ")VALUES ("
Dim ccc = ""
b = 0
For a = LoopStart To LoopEnd
ccc = ccc & "'" & dataContaner(b) & "',"
b = b + 1
Next
T = T + ccc
myCmd.CommandText = T + strImage & ")"
myCmd.Parameters.Add(strImage, SqlDbType.Binary).Value = bytes
myCmd.ExecuteNonQuery()
''''''''
End Sub
Private Sub btSclass_Click(sender As Object, e As EventArgs) Handles btSclass.Click
If btSclass.Text = "Start Class" Then
If A7.Text <> "" Then
GlobalVariableDefault.startTime = DateTime.Now
A2.Text = GlobalVariableDefault.startTime.ToString("hh\:mm\:ss")
GlobalVariableDefault.StID = A7.Text
Me.Hide()
FTodayLesson.Show()
A2.Text = L.Text
btSclass.Text = "End Class"
btSclass.BackColor = Color.Red
If recording = False Then
mciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
mciSendString("record recsound", "", 0, 0)
recording = True
End If
Else
MyMessage("Select a student name from list")
End If
ElseIf btSclass.Text = "End Class" Then
mciSendString("save recsound " & Filez, "", 0, 0)
mciSendString("close recsound ", "", 0, 0)
recording = False
FunConnection(DatabaseName_Audio)
InsertAudioDataInTable("RecAudio", "InsertAdio", "A", 1, 8, PShortInfo, "D:\aa\Test.wav")
btSclass.BackColor = Color.WhiteSmoke
btSclass.Text = "Start Class"
MyMessage("Data Save")
FunConnection(DatabaseName_QurqnServer)
End If
End Sub
'''''data base used in above code