I have made a SSRS Bulk reporter that queries a report from SSRS using a HTTPWebRequest and a HTTPWebResponse to get the stream and save it as a file to a PDF.
However, the client has complained that this is taking long. I have tested it, and this function is taking +- 15.5seconds. If I put a break in-between the GetResponseStream and the file-writer, and I wait for about 3 seconds before stepping to the next part, it shaves 4 seconds off the total time?
Can anyone explain this/or give some advise as to make it a bit faster?
This is the function:
Public Function ExportReport(ByVal QueryStringParameters As String, ByVal FileName As String) As String
Dim PDFName As String = ReportFolderPath & FileName & ".pdf"
'Create a http request or connecting to the report server.
Dim ReportHTTPRequest As HttpWebRequest = Nothing
'Create a http response to catch the data stream returned from the http request.
Dim ReportHTTPResponse As HttpWebResponse = Nothing
'Create a stream to read the binary data from the http reponse.
Dim ReportStream As Stream = Nothing
Dim ReportFileStream As FileStream = Nothing
'Create an array of bytes to get the binary data from the stream.
Dim ReportBytes As Byte()
Dim ReportBuffer As Integer = 204800
Dim ReportBytesRead As Integer = 0
'Create a webrequest to get the report with all the report parameters included.
ReportHTTPRequest = WebRequest.Create(ReportServerURL & QueryStringParameters)
ReportHTTPRequest.Credentials = CredentialCache.DefaultCredentials
'Get the response from the request.
ReportHTTPResponse = ReportHTTPRequest.GetResponse()
'Read the binary stream from the http response.
ReportStream = ReportHTTPResponse.GetResponseStream()
ReportBytes = New Byte(ReportBuffer) {}
ReportBytesRead = ReportStream.Read(ReportBytes, 0, ReportBuffer)
ReportFileStream = New FileStream(PDFName, FileMode.Create)
Do While ReportStream.CanRead And ReportBytesRead > 0
ReportFileStream.Write(ReportBytes, 0, ReportBytesRead)
ReportBytesRead = ReportStream.Read(ReportBytes, 0, ReportBuffer)
Loop
ReportHTTPResponse.Close()
ReportStream.Close()
ReportFileStream.Close()
Return PDFName
End Function
a magic thing that worked for me, try a buffer size of 32768
Related
Edit: Problem is solved. For some reason the Base64Encode function was putting a line break in the output string, something I didn't notice until I response.write the output and looked at the source code of the page instead of the compiled page.
I'm trying to send JSON to a remote server in order to get back a JSON response (Basically I send them data, they perform calculations based on my data and send back different data). However instead of getting data back the server tells me the request failed authentication.
The Authentication involves sending a base64 encoded string, username, and password combined. These values can change so I'm using variables to pass the information on. This does not work, however if I enter the fully encoded value as a string it does work.
Function GetAPdataPost(sSendHTML, sURL)
dim apHTTP
dim sHTTPResponse
dim API_KEY
dim API_PWD
dim auth
API_KEY = "fred"
API_PWD = "barney"
auth = Base64Encode(API_KEY & ":" & API_PWD)
Set apHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
apHTTP.Open "POST", sURL, false
apHTTP.setRequestHeader "Content-Type", "application/json; charset=UTF-8"
apHTTP.setRequestHeader "Authorization","Basic ZnJlZDpiYXJuZXk=" '<-- works
apHTTP.setRequestHeader "Authorization", "Basic " & auth '<-- doesn't work
apHTTP.setRequestHeader "Content-Length", len(sSendHTML)
apHTTP.setRequestHeader "Accept", "*/*"
apHTTP.setRequestHeader "Account-Number", "00000004"
apHTTP.setRequestHeader "Cache-Control", "no-cache"
apHTTP.setRequestHeader "Connection", "close"
On Error Resume Next
apHTTP.send sSendHTML
sHTTPResponse = apHTTP.responseText
If Err.Number = 0 Then
GetAPdataPost = sHTTPResponse
Else
GetAPdataPost = "Something went wrong: " & Err.Number
End If
On Error Goto 0
Set apHTTP = Nothing
End Function
Using the first line result in a proper response form the server, a valid JSON string with all the required data. The second line results in a JSON string saying "The request failed authentication".
So aside from typing out the Base64 encoded string how do I get a variable to be recognised as a valid string?
I should just note that I have tried surrounding auth with double quotes ("") and Chr(34) to no avail.
Edit: Base64 Encode function.
Function Base64Encode(sText)
Dim oXML, oNode
Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
Set oNode = oXML.CreateElement("base64")
oNode.dataType = "bin.base64"
oNode.nodeTypedValue =Stream_StringToBinary(sText)
Base64Encode = oNode.text
Set oNode = Nothing
Set oXML = Nothing
End Function
Function Stream_StringToBinary(Text)
Const adTypeText = 2
Const adTypeBinary = 1
'Create Stream object
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save text/string data.
BinaryStream.Type = adTypeText
'Specify charset For the source text (unicode) data.
BinaryStream.CharSet = "us-ascii"
'Open the stream And write text/string data To the object
BinaryStream.Open
BinaryStream.WriteText Text
'Change stream type To binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary
'Ignore first two bytes - sign of
BinaryStream.Position = 0
'Open the stream And get binary data from the object
Stream_StringToBinary = BinaryStream.Read
Set BinaryStream = Nothing
End Function
The Base64Encode function was putting a line break in the output string, something I didn't notice until I response.write the output and looked at the source code of the page instead of the compiled page.
Always remember to look at the raw data, not just the displayed data (i.e. not like me)
When I compare the data returned by get/messages.json to the data retrieved using the export in yammer. get/messages.json returns 6,300 records. The data export returns 10,469 records. Similar to this post I too am using the older_than parameter. There was a comment in that post that suggested a rate limit issue. I can assure you I am not exceeding the rate limit as I pause for 15 seconds after every 10 requests.
To get my incomplete 6,300 rows I...
Use the export API to get a list of all of the groups
Loop through that list of groups and download the messages for each group using https://www.yammer.com/api/v1/messages/in_group/:group_id.json
Then I use https://www.yammer.com/api/v1/messages.json with the older_than parameter to get all of the messages in the All Company feed.
The issue appears to be with step 3.
Here is the code related to step 3 outlined above:
Sub GetAllCompanyMessages()
Try
Console.WriteLine("Getting All Company Messages")
If File.Exists(allCompanyPath) Then
'delete previous
If Directory.Exists(allCompanyPath) Then
For Each oldFile As String In Directory.GetFiles(allCompanyPath)
File.Delete(oldFile)
Next
Directory.Delete(allCompanyPath)
End If
'create dir
Directory.CreateDirectory(allCompanyPath)
Else
'create dir
Directory.CreateDirectory(allCompanyPath)
'Throw New Exception("Yammer Data Export Zip Download Failed")
End If
'get first group of messages
Console.WriteLine("Getting All Company Batch 1")
Dim client As New WebClient()
client.Headers.Add("Authorization", "Bearer " & accessToken)
client.DownloadFile(allCompanyMessagesURL, allCompanyPath & "1.json")
'getOlderThanID
Dim olderThanID As Int32 = getOlderThanID(allCompanyPath & "1.json")
'get remaining messages in batches of 20
Dim i As Int32 = 2
'Dim prevOlderThanID As Int32 = 0
Dim nextOlderThanID As Int32 = olderThanID
Do Until i = 0
Console.WriteLine("Getting All Company Batch " & i & " olderthanID " & nextOlderThanID)
client = Nothing
client = New WebClient()
client.Headers.Add("Authorization", "Bearer " & accessToken)
client.DownloadFile(allCompanyMessagesURL & "?older_than=" & nextOlderThanID, allCompanyPath & i & ".json")
'prevOlderThanID = nextOlderThanID
nextOlderThanID = getOlderThanID(allCompanyPath & i & ".json")
i = i + 1
If nextOlderThanID = 0 Then
'exit loop
i = 0
End If
' HANDLES 10 REQUESTS IN 10 SECONDS LIMIT
If i >= 10 Then
If i Mod 10 = 0 Then
' CAUSES APP TO WAIT 15 SECONDS AFTER EVERY 10th REQUEST
Console.WriteLine("Sleeping for 15 seconds")
System.Threading.Thread.Sleep(15000)
End If
End If
Loop
Console.WriteLine("Concatenating All Company Batches")
Dim masterJobject As New JObject
masterJobject = JObject.Parse("{""messages"":[]}")
For Each path As String In Directory.GetFiles(allCompanyPath, "*.json")
Console.WriteLine("Concatenating All Company Batch: " & path)
'open each json get messages object and append
Dim jObj As JObject = JObject.Parse(File.ReadAllText(path))
Dim jms As New JsonMergeSettings
'beh 5.24.17 jms.MergeArrayHandling = MergeArrayHandling.Union
jms.MergeArrayHandling = MergeArrayHandling.Concat
masterJobject.Merge(jObj, jms)
'File.Delete(path)
Next
Console.WriteLine("Building Yammer-All-Company-Messages.json")
File.WriteAllText(outputJSONpath & "Yammer-All-Company-Messages.json", "{ ""messages"":" & masterJobject("messages").ToString() & "}")
Catch ex As Exception
ErrorHandler("ERROR GetAllCompanyMessages: " & ex.Message)
End Try
End Sub
Function getOlderThanID(ByVal jsonPath As String) As Int32
Dim result As Int32 = 0
Try
Dim jObj As New JObject
jObj = JObject.Parse(File.ReadAllText(jsonPath))
If CBool(jObj("meta")("older_available")) = True Then
If Not IsNothing(jObj("messages").Last()("id")) Then
result = jObj("messages").Last()("id")
End If
End If
Catch ex As Exception
ErrorHandler("ERROR getOlderThanID: " & ex.Message)
End Try
Return result
End Function
I would appreciate any insight on what the issue might be with the get/messages.json API endpoint, and how I might modify my code to resolve this issue.
There are technical limits on the number of items that will be returned from the REST API for messages. These were designed for client applications that need recent data. The best option would be use individual calls to the message endpoint from the REST API (api_url field) to fill in any gaps in your archive. Make sure everything is stored in a persistent fashion.
I have a requirement of converting a zip file from my local machine to base64.
Get/Read the path name from the excel sheet row
convert the file in the path (zip file) to base 64 string
Copy the base 64 value to next column in the excel sheet.
Tried a few but did not work.
Current Code:
Dim inByteArray, base64Encoded
inByteArray = readBytes("F:path/file.zip")
base64Encoded = encodeBase64(inByteArray)
Private Function readBytes(file)
Dim inStream
' ADODB stream object used
Set inStream = CreateObject("ADODB.Stream")
' open with no arguments makes the stream an empty container
inStream.Open
inStream.Type = TypeBinary
inStream.LoadFromFile(file)
readBytes = inStream.Read()
End Function
Private Function encodeBase64(bytes)
Dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
' Create temporary node with Base64 data type
Set EL = DM.CreateElement("tmp")
EL.DataType = "bin.base64"
' Set bytes, get encoded String
EL.NodeTypedValue = bytes
encodeBase64 = EL.Text
End Function
Error 1 in the line inStream.type = TypeBinary:
Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.
Error 2 in the line readBytes = inStream.Read():
Operation is not allowed in this context.
Error 3 in the line EL.NodeTypedValue = bytes:
Type mismatch
Looks like you got the code from here, but didn't include
Const TypeBinary = 1
Adding this will avoid the "Arguments are of the wrong type ..." error.
Perhaps careful copy will solve your other problems too.
Thanks for that :)
Further for excel sheet read and write I used the below code which helped in achieving my target. Thank you
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("F:\path")
Set ws = objWorkbook.Sheets("Sheet1")
Set ws2 = objWorkbook.Sheets("Sheet2")
rowcount = ws.usedrange.rows.count
for j = 1 to rowcount
fieldvalue = ws.cells(j,1)
inByteArray = readBytes(fieldvalue)
base64Encoded = encodeBase64(inByteArray)
ws2.cells(j,1) = base64Encoded
next
I have the following code which recieves input from an agent application I have also developed.
I am trying to trim down all the additional whitespace that comes from the agent but regardless of what I do, the result still has a length of 8192. here is what I have so far...
Private Sub HandleClientComm(ByVal client As Object)
Dim tcpClient As TcpClient = DirectCast(client, TcpClient)
Dim clientStream As NetworkStream = tcpClient.GetStream()
Dim message As Byte() = New Byte(8191) {}
Dim bytesRead As Integer
Dim result As String
While True
message = New Byte(8191) {}
bytesRead = 0
Try
bytesRead = clientStream.Read(message, 0, 8191) 'blocks until a client sends a message
Catch
bytesRead = 0
End Try
result = ""
result = System.Text.Encoding.Default.GetString(message).ToString.Trim
Logger(result.Length)
Logger("""" & result & """", "RECV")
the result.Length = 8192 and the result itself is still a large string with trailing whitespace. I have tried many things to try and get rid of it..
result = CType(result,String).Trim
result = trim(result)
The result never changes, and now I'm stuck.
Any help, appreciated of course!
Thanks
It was null bytes... This fixed it.
result = result.Trim(result.Trim(chr(0)))
I am updating an old VB6 app. Back in the day, I coded a wrapper around the mciSendString command to be able to record and playback audio. Back then, computers typically had a single audio card.
Now, many of the customers have multiple sound cards (typically a built in one and a USB headset).
I can't seem to find the API to specify which sound card to use with mciSendString. Can someone point me in the right direction?
Please check out several solutions here with sourcecode (Ergebnisse des Wettbewerbs / German):
http://www.activevb.de/rubriken/wettbewerbe/2009_september/comp_2009_september_mp3_player.html
Here some source of my project
''' <summary>
''' Return all audio devices by names
''' </summary>
Private Function ListSoundDevices(ByRef LDev As List(Of String)) As Boolean
Dim intItem As New Integer
Dim intNext As New Integer
Dim intCount As New Integer
Dim tWIC As New WaveInCaps
Dim Enc As System.Text.ASCIIEncoding = New System.Text.ASCIIEncoding()
Dim res As Boolean = False
Try
'Throw New Exception("test")
intCount = waveInGetNumDevs()
Catch ex As Exception
'no devices found
Return False
End Try
If intCount <> 0 Then
For intItem = 0 To intCount - 1
If waveInGetDevCaps(intItem, tWIC, Marshal.SizeOf(tWIC)) = MMSYSERR_NOERROR Then
If (tWIC.Formats And WAVE_FORMAT_4S16) = WAVE_FORMAT_4S16 Then
If LDev Is Nothing Then LDev = New List(Of String)
Dim B() As Byte = System.Text.Encoding.Default.GetBytes(tWIC.ProductName.ToString.ToCharArray)
LDev.Add(Enc.GetString(B, 0, B.Length))
intNext += 1
End If
End If
Next
If intNext > 0 Then res = True
End If
Return res
End Function
Use the device ID to start record and using.
Hope that helps
Microsoft has provided the answer.
To set the WaveAudio device (soundcard) used by the Multimedia Control, you must use the mciSendCommand API. The Multimedia Control does not directly provide a method to let you set the device used for playing or recording.
Dim parms As MCI_WAVE_SET_PARMS
Dim rc As Long
' Specify the soundcard. This specifies the soundcard with a deviceID
' of 0. If you have a single soundcard, then this will open it. If you
' have multiple soundcards, the deviceIDs will be 0, 1, 2, etc.
parms.wOutput = 0
' Send the MCI command to set the output device.
rc = mciSendCommand(MMControl1.DeviceID, MCI_SET, MCI_WAVE_OUTPUT, parms)