Xpcom error when using AutoJSContext with GeckoFX 29.0 VB.NET - vb.net

I'm using GeckoFX 29.0 with AutoJSContext and when i launch my app, it gives me the following error :
Xpcom.Initialize must be called before using of any xulrunner/gecko-fx services
I understand that i must initialize Xpcom before calling AutoJS but in my code XPcom(xullrunner) is initialize before the Sub named "GeckoFxError"
Sub New()
InitializeComponent()
Gecko.Xpcom.Initialize(Environment.CurrentDirectory + "/xulrunner")
Gecko.GeckoPreferences.Default("extensions.blocklist.enabled") = False
Timer1.Enabled = True
End Sub
Sub New1()
Dim _memoryService = Xpcom.GetService(Of nsIMemory)("#mozilla.org/xpcom/memory-service;1")
_memoryService.HeapMinimize(False)
End Sub
Private Sub GeckoFXerror(sender As Object, e As Gecko.JavascriptErrorEventArgs) Handles GeckoWebBrowser1.JavascriptError
Dim text As String = "window.alert = function(){};"
Dim text2 As String = "window.confirm = function(){};"
Dim text3 As String = "window.open = function(){};"
Dim text4 As String = "window.prompt = function(){};"
Using context As AutoJSContext = New AutoJSContext(GeckoWebBrowser1.Window.JSContext)
Dim result As String = ""
context.EvaluateScript(text, result)
End Using
Using context As AutoJSContext = New AutoJSContext(GeckoWebBrowser1.Window.JSContext)
Dim result As String = ""
context.EvaluateScript(text2, result)
End Using
Using context As AutoJSContext = New AutoJSContext(GeckoWebBrowser1.Window.JSContext)
Dim result As String = ""
context.EvaluateScript(text3, result)
End Using
Using context As AutoJSContext = New AutoJSContext(GeckoWebBrowser1.Window.JSContext)
Dim result As String = ""
context.EvaluateScript(text4, result)
End Using
End Sub
Thanks for your help and i think it's easy to solve but i haven't found any solution in more than one hour

Put your Gecko.Xpcom.Initialize(Environment.CurrentDirectory + "/xulrunner") before calling InitializeComponent() and it should work.

Related

Dynamically Add UserControl to Form

I would like to dynamically add a usercontrol to a form in VB.Net. I will be pulling the UserControl name (String) from a database and if that UserControl exists in the project I would like it to be added to the form.
I know how to programmatically add usercontrols to a form, but I am not sure how when using a string for the name.
Dim userContName As UserControl = dtModules.Rows(k).Item("uc_Name")
Panel1.Controls.Add(userContName)
I attempted this soultion
Public Sub LoadGroups()
dtModules = Tbl_GroupModulesTableAdapter1.GetDataBy_spGetModuleByGroup(grp.Name)
For k = 0 To dtModules.Rows.Count - 1
If grp.Name = dtModules.Rows(k).Item("Module_Group") Then
Dim fullyQualifiedClassName As String = dtModules.Rows(k).Item("Module_Name")
If fullyQualifiedClassName = Nothing Then
Else
Dim o = fetchInstance(fullyQualifiedClassName)
Dim b = CType(o, Control)
grp.Controls.Add(b)
End If
End If
Next
End Sub
Public Function fetchInstance(ByVal fullyQualifiedClassName As String) As Object
Dim nspc As String = fullyQualifiedClassName.Substring(0, fullyQualifiedClassName.LastIndexOf("."c))
Dim o As Object = Nothing
Try
For Each ay In Assembly.GetExecutingAssembly().GetReferencedAssemblies()
If (ay.Name = nspc) Then
o = Assembly.Load(ay).CreateInstance(fullyQualifiedClassName)
Exit For
End If
Next
Catch
End Try
Return o
End Function
Ok got it to work with this;
Dim ucName As String = Projectname.UserControlName
Dim newType As Type = Type.[GetType](ucName, True, True)
Dim o As Object = Activator.CreateInstance(newType)
Form.Controls.Add(o)
Once I got this it was pretty simple! thanks for the feedback!

read specific values from text file

I have the following visual basic code, which is part of a custom class. I want a simple and effective way(use little computer resources) to assign the "value1" value(100) to "_field1","value2" value(8) to "_field2" etc. Any nice ideas? thanks
Private Sub readcrnFile()
'read files and assing values to the properties
Dim sr As New IO.StreamReader(_fileName)
_field1 = sr.ReadToEnd()
_field2 = sr.ReadToEnd()
_field3 = sr.ReadToEnd()
sr.Close()
End Sub
where _fileName is a full path to a text file which looks like this:
value1: 100
value2: 8
value3: 80
Private Sub readcrnFile()
Dim lines = File.ReadLines(_fileName)
For Each line In lines
Dim val = line.Split(":")(1).Trim
'do something with val?
Next
End Sub
Returning a dictionary is trivial:
Private Sub readcrnFile()
Dim dict = File.ReadLines(_fileName).Select(Function(line) line.Split(":")).ToDictionary(Function(parts) parts(0).Trim, Function(parts) parts(1).Trim)
Debug.WriteLine(dict("value1")) 'will print 100
End Sub
Change your _field1, _field2 and _field3 variables to a List(Of String) (i.e. named field) and access to each field using its index (field(0), field(1), field(2)).
Dim field As New List(Of String)
Private Sub readcrnFile()
For Each line In File.ReadAllLines(_filename)
For i = 1 To 3
If line.Contains("value" & i) Then
field.Add(line.Substring(line.IndexOf(":") + 2))
End If
Next
Next
End Sub

Matlab - Catia connection error

I need to set up live connection between Catia and Matlab so I can send parameters values to my parametric design in Catia and read some other parameters and measures.
This is my sollution:
First I create:
VB NET (*.dll)
Public Class CatiaLinkLibrary
Dim CATIA As Object
Dim rootproduct
Sub StartCatia()
CATIA = CreateObject("CATIA.Application")
End Sub
Sub CloseCatia()
CATIA.Quit()
End Sub
Sub Visible(ByRef mode As Integer)
If mode = 1 Or mode = 0 Then
CATIA.Visible = mode
End If
End Sub
Sub OpenFile(ByRef filename As String)
CATIA.Documents.Open(filename)
rootproduct = CATIA.ActiveDocument.Product()
End Sub
Function GetMass() As Double
Return rootproduct.Analyze.Mass()
End Function
Function GetVolume() As Double
Return rootproduct.Analyze.Volume()
End Function
Function GetArea() As Double
Return rootproduct.Analyze.WetArea()
End Function
Function GetGravityCenter()
Dim gravitycenter(2)
rootproduct.Analyze.GetGravityCenter(gravitycenter)
GetGravityCenter = gravitycenter
End Function
Function GetIntertia()
Dim inertia(8)
rootproduct.Analyze.GetInertia(inertia)
GetIntertia = inertia
End Function
Sub ChangeParameter(ByRef parameterName As String, ByRef Value As Double)
Dim pd As Object
Dim part As Object
Dim parameters As Object
Dim length As Object
pd = CATIA.ActiveDocument
part = pd.Part
parameters = part.Parameters
length = parameters.Item(parameterName)
length.Value = Value
part.Update()
End Sub
Function GetParameter(ByRef parameterName As String) As Double
Dim pd As Object
Dim part As Object
Dim parameters As Object
Dim length As Object
pd = CATIA.ActiveDocument
part = pd.Part
parameters = part.Parameters
length = parameters.Item(parameterName)
Return length.Value()
End Function
Sub closeDoc(ByRef name As String)
Dim windows As Object
Dim window As Object
Dim doc As Object
windows = CATIA.Windows
window = windows.Item(name)
window.Activate()
window.Close()
doc = CATIA.ActiveDocument
doc.Close()
End Sub
Sub activeDoc(ByRef name As String)
Dim windows As Object
Dim window As Object
Dim doc As Object
windows = CATIA.Windows
window = windows.Item(name)
window.Activate()
doc = CATIA.ActiveDocument
End Sub
Function GetArea2() As Double
Dim pd As Object
Dim part As Object
Dim bodys As Object
Dim body As Object
Dim spabench As Object
Dim mymeas As Object
pd = CATIA.ActiveDocument
part = pd.Part
bodys = part.Bodies
body = bodys.Item("PartBody")
spabench = pd.GetWorkbench("SPAWorkbench")
mymeas = spabench.GetMeasurable(body)
Return mymeas.Area
End Function
End Class
Then, in Matlab I have class that wraps around this *dll:
Matlab class:
classdef CatiaLink < handle
properties
catia;
end
methods
function obj = CatiaLink()
%modify this path to your .NET DLL
NET.addAssembly('C:\DOKTORAT\Modele Geometryczne\CatiaLinkLibrary\CatiaLinkLibrary\bin\Debug\CatiaLinkLibrary.dll');
obj.catia = CatiaLinkLibrary.CatiaLinkLibrary;
obj.catia.StartCatia;
disp('Catia started')
end
function Visible(obj,mode)
obj.catia.Visible(mode);
end
function Quit(obj)
obj.catia.CloseCatia;
end
function Open(obj,filename)
obj.catia.OpenFile(filename);
end
function mass = GetMass(obj)
mass = obj.catia.GetMass;
end
function vol = GetVolume(obj)
vol = obj.catia.GetVolume;
end
function area = GetArea(obj)
area = obj.catia.GetArea;
end
function cog = GetCenterOfGravity(obj)
tmp = obj.catia.GetGravityCenter;
cog = [tmp(1),tmp(2),tmp(3)];
end
function inertia = GetInertia(obj)
tmp = obj.catia.GetIntertia;
inertia = [tmp(1), tmp(2), tmp(3); ...
tmp(4), tmp(5), tmp(6); ...
tmp(7), tmp(8), tmp(9)];
end
function setParameter(obj, parameterName, Value)
obj.catia.ChangeParameter(parameterName, Value);
end
function val = getParameter(obj, parameterName)
val = obj.catia.GetParameter(parameterName);
end
function closeDoc(obj, name)
obj.catia.closeDoc(name);
end
function activeDoc(obj, name)
obj.catia.activeDoc(name);
end
function area = getArea2(obj)
area = obj.catia.GetArea2;
end
end
end
So in my program I create Catia object by Catia = CatiaLink.
And than I use it like 10000 or even more times to set and get parameters.
Everything works just fine up to around couple thousand times and than I get error:
Error using CatiaLink/setParameter (line 42)
Message: No more threads can be created in the system. (Exception from
HRESULT: 0x800700A4)
Source: mscorlib
HelpLink:
Can someone explain what is happening? And how to prevent this?
It looks like you're never calling Catia.Quit()

vb.net - How to Declare new task as SUB with parameters

As you know we have a new syntax in vb.net with possibility to create inline tasks so we could run it asynchronously.
This is the correct code:
Dim testDeclaring As New Task(Sub()
End Sub)
testDeclaring.Start()
but now I need to pass a parameter in the subroutine and I can't find correct syntax for that.
Is it possible any way?
It's not possible. However, you could just use the parameters from the current scope:
Public Function SomeFunction()
Dim somevariable as Integer = 5
Dim testDeclaring As New Task(Sub()
Dim sum as integer = somevariable + 1 ' No problems here, sum will be 6
End Sub)
testDeclaring.Start()
End Function
If you want to pass a parameter you could do this
Dim someAction As Action(Of Object) = Sub(s As Object)
Debug.WriteLine(DirectCast(s, String))
End Sub
Dim testDeclaring As New Task(someAction, "tryme")
testDeclaring.Start()
Dont know if you looking for this:
Dim t As Task = New Task(Sub() RemoveBreakPages(doc))
Sub RemoveBreakPages(ByRef doc As Document)
Dim paragraphs As NodeCollection = doc.GetChildNodes(NodeType.Paragraph, True)
Dim runs As NodeCollection = doc.GetChildNodes(NodeType.Run, True)
For Each p In paragraphs
If CType(p, Paragraph).ParagraphFormat().PageBreakBefore() Then
CType(p, Paragraph).ParagraphFormat().PageBreakBefore = False
End If
Next
End Sub
Regards.

Passing radio button parameter to another function in vb.net

I have 2 functions, one is SaveData() and the other is SendEmail()
in the SaveData() the radio buttons that are selected are saved, and the SendMail() is called at the end.
in the SendMail() the radio buttons are "tested" and then one of two emails is sent out based on the radio choices.
The problem I am having is passing the parameters correctly. I have tried several different method but the parameters are not being sent to SendMail()
The radio buttons are Yes/No questions
Any thoughts on why the parameters are not being passed?
Here is what I have:
Protected Function SaveData()
...
Q1 = Me.rblnewqst1.SelectedValue
Q2 = Me.rblnewqst2.SelectedValue
Q3 = Me.rblnewqst3.SelectedValue
Q4 = Me.rblnewqst4.SelectedValue
Q5 = Me.rblnewqst5.SelectedValue
....
and the SendEmail() is
Protected Sub SendEmail(ByVal rblnewqst1 As Object, ByVal rblnewqst2 As Object, ByVal rblnewqst3 As Object, ByVal rblnewqst4 As Object, ByVal rblnewqst5 As Object)
If rblnewqst1.SelectedValue = 2 Or rblnewqst2.SelectedValue = 2 Or rblnewqst3.SelectedValue = 2 Or rblnewqst4.SelectedValue = 2 Or rblnewqst5.SelectedValue = 2 Then
Dim sResponseFromName As String = "ex#example.com"
Dim sResponseToName As String = txtEmail.Text
Dim sResponseSubject As String = "Denied"
Dim sResponseBody As String = "Message>"
Try
Dim mm As New MailMessage(sResponseFromName, sResponseToName)
Dim SMTP As New SmtpClient
SMTP.DeliveryMethod = SmtpDeliveryMethod.PickupDirectoryFromIis
mm.Subject = sResponseSubject
mm.Body = sResponseBody
mm.IsBodyHtml = True
Try
SMTP.Send(mm)
Catch exSmtpException As SmtpException
Dim stemp As String = exSmtpException.Message.ToString
End Try
Catch ex As ApplicationException
Dim stemp As String = ex.InnerException.Message.ToString
End Try
Else
Dim sResponseFromName As String = "ex#example.com"
Dim sResponseToName As String = txtEmail.Text
Dim sResponseSubject As String = "Accepted"
Dim sResponseBody As String = "MESSAGE....."
Try
Dim mm As New MailMessage(sResponseFromName, sResponseToName)
Dim SMTP As New SmtpClient
SMTP.DeliveryMethod = SmtpDeliveryMethod.PickupDirectoryFromIis
mm.Subject = sResponseSubject
mm.Body = sResponseBody
mm.IsBodyHtml = True
Try
SMTP.Send(mm)
Catch exSmtpException As SmtpException
Dim stemp As String = exSmtpException.Message.ToString
End Try
Catch ex As ApplicationException
Dim stemp As String = ex.InnerException.Message.ToString
End Try
End If
End Sub
Like HardCode mentioned in his comments, I do recommend you always work with Option Explicit and Option Strict on.
The first thing I would do is alter the way the SendMail part works, to take the values from the radio buttons. Your If is checking against and integer value, so I would use Integer as the type.
So something more like:
Protected Sub SendEmail(ByVal q1 As Integer, ByVal q2 As Integer)
If q1 = 2 Or q2 = 2 Then
etc...
End IF
I shortened the list so I didn't have to type as much. In general I think it is better practice to send values than entire objects, unless you need the entire control for a specific reason. Also, sending object isn't something I recommend doing unless you have no other choice.
The other thing I would recommend, to test it, is setting a break point just inside the sendEmail Sub, use quick watch to see what the actual objects/types are that are being sent to your method that you are checking.