So when I visit my page and I set the video mode using this:
$("#pushStreamButton").click(function () {
if (initialized) {
var channelSelected = $("#channelSelect").val();
var gameNameEntered = $("#gameName").val();
var channelNameEntered = $("#channelName").val();
if (gameNameEntered.length < 1) return;
$("#goLiveWindow").dialog("close");
serverHub.server.setVideoMode(channelSelected, gameNameEntered, "", channelNameEntered);
}
});
and this is in the backend
Public Sub setVideoMode(ByVal mode As String, ByVal details As String, ByVal socialMessage As String, ByVal channel As String)
Dim user As FrontPageUser = Connections.matchFirst(Connections.frontPageUsers, Context.ConnectionId)
If user Is Nothing Then Return
If mode = "youtube" Then
Try
My.Computer.FileSystem.DeleteFile(HttpContext.Current.Server.MapPath("/images/streamavatar.gif"))
Catch Ex As Exception
Console.Write(Ex)
End Try
End If
This functions as expected, it does it's job, however I have a button that reverts the channel back to the default youtube
$("#stopStreamButton").click(function () {
serverHub.server.setVideoMode("youtube", "", "", "");
});
After changing the channel using the first button, clicking the second button doesn't do anything, it doesn't even seem to attempt to execute the command, which is bizarre. However if I reload the page the button functions correctly and the channel is reverted.
This issue also isn't present when using SSE/longpolling/foreverframe, only when using websockets as the transport. I'm treading relatively unknown waters with websockets, and I've tried debugging the javascript and the backend code - the javascript doesn't seem to execute correctly, but it doesn't spout any errors, and it never reaches the backend.
If anybody knows why this happens and could explain where I'm going wrong, it'd be appreciated.
Additional: after digging further, it actually appears to stop all functions from the java side and after a while it seems to disconnect and force a refresh, not sure what is causing it, but I know it has to be related to websockets.
edit --
Upon debugging cause, it appears to be linked to another function which sends a push notification to subscribers, when I disable this function it works without hanging and blocking commands, but when this function is initialized it hangs, seemingly after the function has completed
Shared Function sendPushFox(username, pushDetails) As String
Dim avatar = Utils.getAvatarPath(username)
If avatar.Contains("/forum/download/file.php?avatar=") OrElse avatar.Contains("/images/solaire.png") Then
Try
My.Computer.Network.DownloadFile("https://foo.com" & avatar, HttpContext.Current.Server.MapPath("/images/streamavatar.gif"))
Catch ex As Exception
ChatProcessor.postNewMessage(Nothing, Nothing, ChatMessage.MessageType.Channel_Mod, "Problem downloading streamer avatar." & ex.ToString)
End Try
Else
Try
My.Computer.Network.DownloadFile(avatar, HttpContext.Current.Server.MapPath("/images/streamavatar.gif"))
Catch ex As Exception
ChatProcessor.postNewMessage(Nothing, Nothing, ChatMessage.MessageType.Channel_Mod, "Problem downloading streamer avatar." & ex.ToString)
End Try
End If
Dim query As String = "SELECT subscribeid FROM custom_user_data WHERE NOT subscribeid = ' ';"
Dim connection As New MySqlConnection(Utils.connectionString) : connection.Open()
Dim command As MySqlCommand = New MySqlCommand(query, connection)
Dim reader As MySqlDataReader = command.ExecuteReader()
Dim regList As New List(Of String)
Do While reader.Read
regList.Add(reader.GetString(0))
' IO.File.AppendAllText(Utils.serverPath & "errorlog.txt", reg1)
Loop
connection.Close()
Dim query2 As String = "SELECT p256dh FROM custom_user_data WHERE NOT p256dh = ' ';"
Dim connection2 As New MySqlConnection(Utils.connectionString) : connection2.Open()
Dim command2 As MySqlCommand = New MySqlCommand(query2, connection2)
Dim reader2 As MySqlDataReader = command2.ExecuteReader()
Dim regList2 As New List(Of String)
Do While reader2.Read
regList2.Add(reader2.GetString(0))
' IO.File.AppendAllText(Utils.serverPath & "errorlog.txt", reg1)
Loop
connection2.Close()
Dim query3 As String = "SELECT authsecret FROM custom_user_data WHERE NOT authsecret = ' ';"
Dim connection3 As New MySqlConnection(Utils.connectionString) : connection3.Open()
Dim command3 As MySqlCommand = New MySqlCommand(query3, connection3)
Dim reader3 As MySqlDataReader = command3.ExecuteReader()
Dim regList3 As New List(Of String)
Do While reader3.Read
regList3.Add(reader3.GetString(0))
' IO.File.AppendAllText(Utils.serverPath & "errorlog.txt", reg1)
Loop
connection3.Close()
Dim reg1 = regList.ToArray
Dim reg2 = regList2.ToArray
Dim reg3 = regList3.ToArray
Dim payload = "{ ""title"": ""foo bar"", ""body"": """ & username.name.ToString & " playing " & pushDetails.ToString & """, ""icon"" : ""https://foo.com/images/streamavatar.gif"" }"
For i As Integer = 0 To reg1.Length - 1
Dim webPushClient = New WebPushClient()
Dim subject = "https://foo.com"
Dim vapidKeys As VapidDetails = VapidHelper.GenerateVapidKeys()
Dim vapidDetails = New VapidDetails(subject, vapidKeys.PublicKey, vapidKeys.PrivateKey)
Try
Console.WriteLine("Public {0}", vapidKeys.PublicKey)
Console.WriteLine("Private {0}", vapidKeys.PrivateKey)
Dim subscription = New PushSubscription(reg1(i), reg2(i), reg3(i))
webPushClient.SetGCMAPIKey("key here")
webPushClient.SendNotification(subscription, payload, vapidDetails)
Catch Ex As Exception
Console.Write(Ex)
End Try
Next
Return Nothing
End Function
So, it's a clash with websockets, since it functions on longpolling and etc but I'm still not sure why, and it only affects the user who calls the function.
Strangely enough this appears to hang after the "next" which happens here
For i As Integer = 0 To reg1.Length - 1
webPushClient.SetGCMAPIKey("key here")
webPushClient.SendNotification(subscription, payload, vapidDetails)
Next
it functions completely fine, but once it reaches the end of the for, it just never continues, it does literally nothing after Next, no errors, nothing happens, set breaks and results are as expected, I'm just baffled as to why it doesn't continue, and only using websockets trasports, longpolling and etc is fine
I actually figured this out, it turns out that websockets don't like the non asynchronous communication made from the command
webPushClient.SendNotification(subscription, payload, vapidDetails)
Fortunately the webPush lib has an async and changing it to
webPushClient.SendNotificationAsync(subscription, payload, vapidDetails)
fixed everything.
Related
New here, sorry if I missed something...
I'm trying to display a local html file in WebBrowser1 that contains javascript that retrieves data from the internet.
The graphs are not displayed, only the title. It works fine in Edge, IE, Firefox and Chrome on my computer. If I load the website on the internet and log in, the graphs is displayed. But I have to use the file from a local html page because it is customized for my purpose. What have I missed?
Imports System.IO
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
WebBrowser1.ScriptErrorsSuppressed = True
Dim filePath As String
filePath = Application.StartupPath & "\Winningtemp.html"
WebBrowser1.Url = New Uri(filePath)
WebBrowser1.Refresh()
End Sub
The HTML-file Winningtemp.html:
<body>
<script type="text/javascript" id="***">
Script follows here... Can't show the code, sorry...
</script>
</body>
I'm using Visual Studio Express 2017.
Screenshot
It seems to be caused by a low WebBrowser Emulation version.
Private Sub sub_WebBrowser_lastVersionEmulation(Optional ByVal IsDefaultVersion As Boolean = False)
'WebBrowser Emulation
Try
Dim VersionCode As Integer
Dim Version As String = ""
Dim ieVersion As Object = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("Software\Microsoft\Internet Explorer").GetValue("svcUpdateVersion")
If ieVersion Is Nothing Then
ieVersion = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("Software\Microsoft\Internet Explorer").GetValue("Version")
End If
If ieVersion IsNot Nothing Then
Version = ieVersion.ToString.Substring(0, ieVersion.ToString.IndexOf("."c))
Select Case Version
Case "7"
VersionCode = 7000
Case "8"
VersionCode = 8888
Case "9"
VersionCode = 9999
Case "10"
VersionCode = 10001
Case Else
If CInt(Version) >= 11 Then
VersionCode = 11001
Else
Throw New Exception("IE Version not supported")
End If
End Select
Else
Throw New Exception("Registry error")
End If
Dim AppName As String = ""
''AppName = My.Application.Info.AssemblyName
AppName = System.Diagnostics.Process.GetCurrentProcess().ProcessName
Dim sRoot As String = "HKEY_CURRENT_USER\"
Dim sKEY As String = "Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION"
If IsDefaultVersion = False Then
'Check if the right emulation is set
'if not, Set Emulation to highest level possible on the user machine
Dim CurrentSetting As String = CStr(Microsoft.Win32.Registry.CurrentUser.OpenSubKey(sKEY).GetValue(AppName & ".exe"))
If CurrentSetting Is Nothing OrElse CInt(CurrentSetting) <> VersionCode Then
Microsoft.Win32.Registry.SetValue(sRoot & sKEY, AppName & ".exe", VersionCode)
Microsoft.Win32.Registry.SetValue(sRoot & sKEY, AppName & ".vshost.exe", VersionCode)
End If
Else
'Default Version
Microsoft.Win32.Registry.SetValue(sRoot & sKEY, AppName & ".exe", 10001)
Microsoft.Win32.Registry.SetValue(sRoot & sKEY, AppName & ".vshost.exe", 10001)
End If
Catch ex As Exception
'skip
End Try
End Sub
I am designing a vba code that allows users to input a set of technical drawing numbers and create a packet from it. I have run into a problem when dealing with autocad files. Because our company has AutoCAD LT I am unable to utilize the api, thus I am using adobe's PDFMaker api to convert the files directly to pdf. Unfortunately the settings for pdfMaker are rather limited so I need to parse through the outputted pdf packet and print it in black and white (monochrome). I currently have a subroutine that opens the packet and prints the necessary pages, however, it only prints black and white if I specifically open up acrobat and select my "Monochrome" configuration in the advanced settings. Is there a way to send the command (I believe it's in javascript?) to set this color configuration and set the size option to fit? Here is my code.
Public xlBook As Workbook
Public xlSheet As Worksheet
Public LastRow As Integer
Public ItemNumber As String
Public Vin5 As String
Public Vin As String
Public FullPath As String
Sub PdfFormat()
Dim strMakeFile As String
Dim LastRow As Integer
Set xlBook = ActiveWorkbook
Set xlSheet = xlBook.Sheets(1)
ItemNumber = Range("E1")
Vin5 = Range("F1")
Vin = ItemNumber & "0" & Vin5
FullPath = "\\eastfile\Departments\Engineering\MACROS\New Packet Output\" & Vin & "\"
strMakeFile = FullPath & Vin & ".pdf"
LastRow = Range("A" & xlSheet.Rows.Count).End(-4162).Row
Dim AcroExchApp As New Acrobat.AcroApp
Dim AcroExchAVDoc As New Acrobat.AcroAVDoc
Dim AcroExchPDDoc As Acrobat.AcroPDDoc
Dim OpenError As Boolean
Dim PrintError As Boolean
OpenError = AcroExchAVDoc.Open(strMakeFile, "")
!!!!!CODE FOR PRINTER SETTINGS HERE!!!!!
PrintError = AcroExchAVDoc.PrintPagesSilentEx(0, 5, 3, 1, 1, 0, 0, 0, -5)
Debug.Print "Open Error: " & Not (OpenError)
Debug.Print "Print Error: " & Not (PrintError)
Debug.Print Vin
AcroExchApp.CloseAllDocs
End Sub
Thank you for your time
The print parameters in Acrobat you can find in the Acro-js helpfile for example here: Acro JS setting print options
With VBS/VBA there are 2 ways to use it. With the help of Acro-Form API you can execute js-code more or less direkt. Here I gave a simple example: Execute Acro js from VBA/VBS
The other way is to use the JS-Object, which lets you use transformed js-code via VBA/VBS Ole connection. That's documented in the Adobe Acrobat IAC Reference.
How that works you can see in the following example, where I use jso for setting some print parameters. Change the given print parameters to that what you need or search in the Acro JS helfile for some other example and execute it via above described way direct. Good luck, Reinhard
'// print dropped files with printParameter
set WshShell = CreateObject ("Wscript.Shell")
set fs = CreateObject("Scripting.FileSystemObject")
Set objArgs = WScript.Arguments
if objArgs.Count < 1 then
msgbox("Please drag a file on the script")
WScript.quit
end if
'contact Acrobat
Set gApp = CreateObject("AcroExch.App")
gApp.show 'comment or take out to work in hidden mode
'open via Avdoc and print
for i=0 to objArgs.Count - 1
FileIn = ObjArgs(i)
Set AVDoc = CreateObject("AcroExch.AVDoc")
If AVDoc.Open(FileIn, "") Then
Set PDDoc = AVDoc.GetPDDoc()
Set JSO = PDDoc.GetJSObject
jso.print false, 0, 0, true
set pp = jso.getPrintParams
pp.printerName = "hp deskjet 990c"
pp.firstPage = 0 '-> Zero based (firstPage = 0)
pp.lastPage = 5 '-> Zero based (pageCount - 1)
pp.interactive = pp.constants.interactionLevel.automatic '-> no print dialog
pp.pageHandling = pp.constants.handling.booklet
pp.booklet.duplexMode = pp.constants.bookletDuplexModes.BothSides
pp.booklet.binding = pp.constants.bookletBindings.LeftTall
jso.print(pp)
gApp.CloseAllDocs
end if
next
gApp.hide
gApp.exit
MsgBox "Done!"
Quit()
Sub Quit()
Set JSO = Nothing
Set PDDoc = Nothing
Set gApp = Nothing
Wscript.quit
End Sub
I am currently working on a VBA code that retrieves the top file from this website (http://infopost.bwpmlp.com/Posting/default.aspx?Mode=Display&Id=27&tspid=100000). I am able to click on the button using Javascript in my code, and I am able to click on open after the download is kicked off. However, I am having trouble saving the file. Because the workbook is being pulled from a website there really isn't a way to set it to the active workbook that I can think of. Currently when I do ActiveWorkbook.SaveAs the code is saving the blank workbook that I am testing the code out of. The file I downloaded seems to not open until the entire code is done running even after I try putting in breaks. Anyone have any ideas? My code is below. Thanks!
Option Explicit
Dim ie As InternetExplorer
Dim h As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Sub Texas_Gas()
Application.DisplayAlerts = True
Dim ie As Object
Dim IeHandle As Long, FileDownloadHandle As Long, OpenButtonHandle As Long, IePopupBarHandle As Long
Dim AutoMode As Boolean, FileDownloadClassicPopup As Boolean, DownloadComplete As Boolean
Dim Timeout As Date
Dim strSPICE As String, strLink As String
Dim PopupGap As Integer, i As Integer
Set ie = CreateObject("InternetExplorer.Application")
DownloadComplete = False
FileDownloadClassicPopup = False
FileDownloadHandle = 0
IePopupBarHandle = 0
With ie
.Visible = True
.navigate "http://infopost.bwpmlp.com/Posting/default.aspx? Mode=Display&Id=27&tspid=100000"
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
End With
ie.document.parentWindow.execScript "javascript:WebForm_DoPostBackWithOptions(new WebForm_PostBackOptions(""dgITMatrix:0:lnkBtnDownload"", """", true, """", """", false, true))"
Dim o As IUIAutomation
Dim e As IUIAutomationElement
Dim iCnd As IUIAutomationCondition
Set o = New CUIAutomation
h = ie.Hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
If h = 0 Then Exit Sub
Set e = o.ElementFromHandle(ByVal h)
Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Open")
Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke
ActiveWorkbook.SaveAs "I:\Cap_Rel\raw_scrapes\Texas_Gas_Transmission\parsed\Texas_Gas_Transmission_CapRel" & Format(Date - 1, "yyyymmdd") & "MACRO", FileFormat:=xlCSV
End Sub
In my code below , my ("OnClick") is not firing. Does anyone know why?
e.Row.Cells(1).Attributes("OnClick") = "window.location.href='MachineSweepLite.aspx?AreaID='" _
+ GridView1.DataKeys(e.Row.RowIndex).Values("ID").ToString()
Protected Sub GridView1_RowDataBound(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.GridViewRowEventArgs) Handles GridView1.RowDataBound
If e.Row.RowType = DataControlRowType.DataRow Then
e.Row.Cells(1).Attributes("onmouseover") = "this.style.cursor='hand';this.style.textDecoration='underline';"
e.Row.Cells(1).Attributes("onmouseout") = "this.style.textDecoration='none';"
Dim Index As Integer = e.Row.RowIndex
e.Row.Cells(1).Attributes("OnClick") = "window.location.href='MachineSweepLite.aspx?AreaID='" + GridView1.DataKeys(e.Row.RowIndex).Values("ID").ToString
End If
End Sub
Edit above.
You have a error in your attribute, as you are adding the value of the ID after the closing single quote...
For example, if the ID was 12, you're sending this to the browser...
window.location.href='MachineSweepLite.aspx?AreaID='12
Note that the 12 is not part of the URL.
You should have the following instead...
e.Row.Cells(1).Attributes("onclick") =
string.Format("window.location.href='MachineSweepLite.aspx?AreaID={0}';",
GridView1.DataKeys(e.Row.RowIndex).Values("ID").ToString())
Also note, as of .NET 4.0 it is unnecessary to have the _ character when spanning over multiple lines.
e.Row.Attributes("onClick") = "CallFunction('" & Convert.ToString(GridView1.DataKeys(e.Row.RowIndex).Values("ID")) & "');"
JS code:
function CallFunction(val)
{
// do your login here
}
I am running a simple program in which you enter a user number into a text box, click the submit button, and then the program is supposed to go to a database look up the number you entered and display that rows information. Simple enough.
The problem is I keep getting the error that Xml.XmlDataDocument() is obsolete. I've googled this issue, which led me to here, but the replacements suggested do not work within my program.
Also, I have not studied VB and this is for an XML class.
I've double checked my code for any errors and do not see anything. But, I could be missing the forest for the trees. Would like to have another set of eyes take a look at my code to see if I've missed something, or to offer up a replacement for the Xml.XmlDataDocument() line.
Thank you in advance for any help you can offer.
Here is the code I am using:
Javascript for the onClick event
<script language="javascript" type="text/javascript">
function btnSearch_onclick() {
var docSubmit = new ActiveXObject("MSXML2.DOMDocument");
docSubmit.loadXML("<?xml version='1.0'?><request><customerID>" + txtCustID.value + "</customerID></request>")
var objSocket = new ActiveXObject("MSXML2.XMLHTTP");
objSocket.open("POST", "Lookup.aspx", false)
objSocket.send(docSubmit)
alert(objSocket.responseXML.xml)
lblFirstName.innerHTML = objSocket.responseXML.selectSingleNode("//FirstName").firstChild.nodeValue
lblLastName.innerHTML = objSocket.responseXML.selectSingleNode("//LastName").firstChild.nodeValue
lblAddress.innerHTML = objSocket.responseXML.selectSingleNode("//Address").firstChild.nodeValue
lblCity.innerHTML = objSocket.responseXML.selectSingleNode("//City").firstChild.nodeValue
lblState.innerHTML = objSocket.responseXML.selectSingleNode("//State").firstChild.nodeValue
lblZip.innerHTML = objSocket.responseXML.selectSingleNode("//Zip").firstChild.nodeValue
}
</script>
And here is the VB code:
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim docReceived As New System.Xml.XmlDataDocument()
docReceived.Load(Request.InputStream)
Dim CustomerID = docReceived.SelectSingleNode("//customerID").FirstChild.Value
Dim myConnection As New System.Data.OleDb.OleDbConnection
Dim myConnectionString As String
myConnectionString = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & _
Server.MapPath("customer.mbd")
myConnection.ConnectionString = myConnectionString
Dim strSQL As String
strSQL = "Select * From CustomerInfo where CustomerID = " & CustomerID
Dim myAdapter As New System.Data.OleDb.OleDbDataAdapter(strSQL, myConnection)
Dim myDataSet As New System.Data.DataSet("CustomerInfo")
Dim intRecords As Integer
intRecords = myAdapter.Fill(myDataSet, "Customer")
Response.ContentType = "text/xml"
If intRecords > 0 Then
myDataSet.WriteXml(Response.OutputStream)
Else
Response.Write("<?xml version='1.0'?><customer><FirstName>Not Found</FirstName><LastName>***</LastName><Address>***</Address><City>***</City><State>***</State><Zip>***</Zip><Phone>***</Phone><Email>***</Email></customer>")
End If
myDataSet.WriteXml(Response.OutputStream)
myConnection.Close()
myAdapter.Dispose()
myConnection.Dispose()
End Sub
XmlDataSet is obsolete. As you can see on the msdn it may even be removed in the next version of the .NET Framework ([ObsoleteAttribute("XmlDataDocument class will be removed in a future release.")]
). In your case I don't think you need it at all. The easies fix seems to be to use just XmlDocument. I believe you won't have to change anything else in your code but this line
Dim docReceived As New System.Xml.XmlDataDocument()
to:
Dim docReceived As New System.Xml.XmlDocument()