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
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
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
%>
I have a vb.net MVC3 Razor app that generates PDF files. The problem is that if 2 seperate users click the print button at the same time it throws the following exception..:
The process cannot access the file 'E:\web\xxxxxxxxxxsonl\PDF_Files\MailingLables.pdf' because it is being used by another process.
All of the controller actions to do with printing are basically like below:
Function Ind_Cert(ByVal firstName As String, ByVal lastname As String, ByVal classRef As String)
Dim _Attendance As attendance = db.attendances.Where(Function(f) f.Completed_Class = "Completed" And f.firstName = firstName And f.lastName = lastname).FirstOrDefault
If Not IsNothing(_Attendance) Then
Dim _reg_classes As List(Of reg_classes) = db.reg_classes.ToList
Dim _registrants As List(Of reg_info) = db.reg_info.ToList
Dim _courses As List(Of cours) = db.courses.ToList
Dim _Board As List(Of board_members) = db.board_members.ToList
Dim Board_Member As board_members = _Board.Where(Function(f) f.Official_Cap = "xxxxxx President").FirstOrDefault
Dim RecordId As Integer = 0
Dim conf_info As conf_info = db.conf_info.Single(Function(r) r.id = 0)
Dim conf_num As Integer = conf_info.conf_number
Dim _conf_num As String = conf_num.ToString
Dim Length As Integer
Dim _prefix As String = String.Empty
If Str(conf_num) <> "" Then
Length = Str(conf_num).Length
End If
Dim Divisor As Integer = 10 ^ (Length - 1)
Dim conf_num_start As Integer = 0
Dim Digits(Length - 1) As Integer
While (conf_num > 10)
'Extract the first digit
Digits(conf_num_start) = Int(conf_num / Divisor)
'Extract remainder number - and store it back in Num
conf_num = conf_num Mod Divisor
'Decrease Divisor's value by 1/10th units
Divisor /= 10
'Increment Index
conf_num_start += 1
End While
If conf_num = 0 Or 4 Or 5 Or 6 Or 7 Or 8 Or 9 Then _prefix = "th"
If conf_num = 1 Then _prefix = "st"
If conf_num = 2 Then _prefix = "nd"
If conf_num = 3 Then _prefix = "rd"
Dim pdfpath As String = Path.Combine(AppDomain.CurrentDomain.BaseDirectory) + "\PDF_Files\"
Dim imagepath As String = Path.Combine(AppDomain.CurrentDomain.BaseDirectory) + "\PDF_Files\"
Dim _PdfName As String = "Cert_" + lastname + ".pdf"
Dim doc As New Document
doc.SetPageSize(iTextSharp.text.PageSize.LETTER.Rotate())
doc.SetMargins(1, 1, 1, 1)
Dim _pageCounter As Integer = 0
Dim Californian As BaseFont = BaseFont.CreateFont(Path.Combine(AppDomain.CurrentDomain.BaseDirectory) + "\Fonts\" + "CALIFB.TTF", BaseFont.CP1252, BaseFont.EMBEDDED)
Dim Copper As BaseFont = BaseFont.CreateFont(Path.Combine(AppDomain.CurrentDomain.BaseDirectory) + "\Fonts\" + "COPRGTB.TTF", BaseFont.CP1252, BaseFont.EMBEDDED)
Dim Bold_Times As BaseFont = BaseFont.CreateFont(BaseFont.TIMES_BOLD, BaseFont.CP1252, False)
Dim BF_Times As BaseFont = BaseFont.CreateFont(BaseFont.TIMES_ROMAN, BaseFont.CP1252, False)
Dim F_Name As New Font(BF_Times, 16, Font.BOLD, BaseColor.BLACK)
Dim _Parking_Name As New Font(BF_Times, 18, Font.NORMAL, BaseColor.BLACK)
Dim _Parking_Date As New Font(BF_Times, 24, Font.BOLD, BaseColor.BLACK)
'**********************************Y lines for trial***********************************
Dim y_line1 As Integer = 670
Dim _Counter As Integer = 1
Dim _Page As String = 1
Dim _CertJpg As Image = Image.GetInstance(imagepath + "/cert.jpg")
Dim imageWidth As Decimal = _CertJpg.Width
Dim imageHeight As Decimal = _CertJpg.Height
Dim writer As PdfWriter = PdfWriter.GetInstance(doc, New FileStream(pdfpath + _PdfName, FileMode.Create))
doc.Open()
Dim cb As PdfContentByte = writer.DirectContent
If _Attendance.Completed_Class = "Completed" Then
Dim _confInfo As conf_info = db.conf_info.Single(Function(a) a.id = 0)
Dim year As String = Right(_confInfo.conf_start_date, 4)
Dim _reg As reg_info = db.reg_info.Single(Function(b) b.id = _Attendance.reg_id)
Dim name As String = _reg.first_name + " " + _reg.last_name
Dim _dates As String = _confInfo.conf_start_date + " - " + _confInfo.conf_end_date
Dim _course As cours = db.courses.Single(Function(c) c.course_ref = _Attendance.course_ref)
Dim _className As String = _course.course_title.ToString
Dim _hours As String = _course.course_hours
Dim _certName As String = Board_Member.First_Name + " " + Board_Member.last_name
_CertJpg.Alignment = iTextSharp.text.Image.UNDERLYING
_CertJpg.ScaleToFit(792, 611)
doc.Add(_CertJpg)
cb.BeginText()
cb.SetFontAndSize(Californian, 36)
cb.ShowTextAligned(PdfContentByte.ALIGN_CENTER, "CERTIFICATE OF COMPLETION", 396, 397.91, 0)
cb.SetFontAndSize(Bold_Times, 22)
cb.ShowTextAligned(PdfContentByte.ALIGN_CENTER, name, 396, 322.35, 0)
cb.SetFontAndSize(Bold_Times, 16)
cb.ShowTextAligned(PdfContentByte.ALIGN_CENTER, _hours + " Hours", 297.05, 285.44, 0)
cb.SetFontAndSize(Bold_Times, 16)
cb.ShowTextAligned(PdfContentByte.ALIGN_CENTER, _dates, 494.95, 285.44, 0)
cb.SetFontAndSize(Bold_Times, 16)
cb.ShowTextAligned(PdfContentByte.ALIGN_CENTER, "Class Attended: " + " " + _Attendance.course_ref + " -- " + _className, 396, 230.34, 0)
cb.SetFontAndSize(Copper, 16)
cb.ShowTextAligned(PdfContentByte.ALIGN_CENTER, _conf_num + _prefix + " Annual Conference " + _dates, 396, 193.89, 0)
cb.SetFontAndSize(Bold_Times, 13)
cb.ShowTextAligned(PdfContentByte.ALIGN_CENTER, _certName, 396, 175.69, 0)
cb.SetFontAndSize(Bold_Times, 10)
cb.ShowTextAligned(PdfContentByte.ALIGN_CENTER, "xxxxxxx President", 396, 162.64, 0)
cb.EndText()
End If
doc.Close()
Return _PdfName
Else
Return "Fail"
End If
End Function
This error happens like I said any time 2 users try to generate a PDF file at the same time. Anyone know of a fix for this issue? Google has turned up countless pages about someone can't delete a file in windows because its being used. But that isn't much help.. Any ideas???
You can pretty much do two things.
Add a lock on the file and block the second (and third and fourth, etc) until the lock is cleared
Create a unique file for each instance.
I'd recommend #2. You can keep the same file name, just put the file in a unique directory. A GUID is usually the easiest for me:
Dim pdfpath As String = Path.Combine(AppDomain.CurrentDomain.BaseDirectory) + "\PDF_Files\"
pdfPath = Path.Combine(pdfPath, Guid.NewGuid.ToString())
Directory.CreateDirectory(pdfPath)
Then change your return to include the path created above.
Can you create the PDF file with a random file name to avoid the conflict in the first place?
Wrap your file access code in a lock.
lock (this)
{
//Write file
}
See Lock on MSDN
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