selenium sendkeys alternative to send emoji - vba

Sendkeys method does not support emojis in selenium basic so I am trying to use a workaround. The workaround I tried works in www.google.com but does not work in the second example.
First example- works OK.
Public bot As New Selenium.Chromedriver
Public Sub Test_google_search()
Dim ele As WebElement
Dim myVar As String
bot.Start
bot.Get "https://www.google.com/"
Set ele = bot.FindElementByName("q")
myVar = "test"
Call MySendKeys(myVar, ele, "value")
bot.Quit
End Sub
2.second sub does not work
Public bot As New Selenium.Chromedriver
Public Sub test(ByVal Row As Long)
Dim Textw As String
Dim Message As String
Dim ele As WebElement
Message = "/html/body/div[1]/div/div/div[4]/div/footer/div[1]/div[2]/div/div[2]"
Textw = "this is a test"
bot.FindElementByXPath(Message, timeout:=60000).Click
Set ele = bot.FindElementByXPath(Message, timeout:=60000)
Call MySendKeys(Textw, ele, "value")
End Sub
''SendKeys that allow to send emoji
Public Sub MySendKeys(ByVal myVar As String, ByVal ele As WebElement, ByVal myAttribute As String)
Dim attrScript As String
attrScript = "arguments[0].setAttribute('" & myAttribute & "','" & myVar & "')"
bot.ExecuteScript attrScript, ele
End Sub
HTML:
<div tabindex="-1" class="_1JAUF _2x4bz"><div class="OTBsx"
style="visibility: visible">הקלד/י הודעה</div><div class="_2_1wd
copyable-text selectable-text" contenteditable="true" data-tab="6"
dir="rtl" spellcheck="true"></div></div>

Related

Find inactive windows vpn name

How do I find the name of all inactive Windows VPN adapters? I'm working on a VPN app that should list all VPN connections, whether active or inactive. I'm using the NetworkInterface class to list all adapters. It correctly shows the active or inactive Ethernet 2 adapter (used for OpenVPN), and correctly shows the active VPN L2TP connection, but will not list the inactive VPN L2TP adapter name. Are there other (preferably not too obsolete) .Net (or non .Net) classes I could use? I would like to programmaticaly do this, otherwise I could have the option for the user to set the name (I have code to connect, monitor, or disconnect the Windows VPN adapter by name). Any help would be appreciated. Thanks in advance.
Here is the solution I found:
Public Class VPN
Public name As String
Public type As String
Public status As String
Public ip As String
End Class
Public Function GetWindowsVPNs() As List(Of VPN)
Dim vpn_names As String()
Dim vpns As New RAS
Dim strVpn As String
Dim active As Boolean = False
Dim conIPstr As String = ""
Dim vpnCheck As New clsVPN
Dim vpnList As New List(Of VPN)
vpn_names = vpns.GetConnectionsNames()
For Each strVpn In vpn_names
Dim vpn As New VPN
vpn.name = strVpn
vpn.type = "Windows VPN"
active = False
vpnCheck.ConName = vpn.name
active = vpnCheck.CheckConnection()
If active = True Then
vpn.status = "Active"
Try
conIPstr = GetMyIPstr()
Catch e As Exception
MessageBox.Show("Error: Function GetConnectionList: Error returning IP Address" & vbCrLf & vbCrLf & e.Message)
End Try
vpn.ip = conIPstr
Else
vpn.status = "Not Active"
vpn.ip = "No IP Address"
End If
vpnList.Add(vpn)
Next
Return vpnList
End Function
Private Function GetMyIPstr() As String
Dim client As New WebClient
Dim s As String = "No IP Address"
'// Add a user agent header in case the requested URI contains a query.
client.Headers.Add("user-agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR1.0.3705;)")
Dim baseurl As String = "http://checkip.dyndns.org/"
' with proxy server only:
Dim proxy As IWebProxy = WebRequest.GetSystemWebProxy()
proxy.Credentials = CredentialCache.DefaultNetworkCredentials
client.Proxy = proxy
Dim data As Stream
Try
data = client.OpenRead(baseurl)
Catch ex As Exception
MsgBox("open url " & ex.Message)
Exit Function
End Try
Dim reader As StreamReader = New StreamReader(data)
s = reader.ReadToEnd()
data.Close()
reader.Close()
s = s.Replace("<html><head><title>Current IP Check</title></head><body>", "").Replace("</body></html>", "").ToString()
s = s.Replace("Current IP Address: ", "")
s = s.Replace(vbCr, "").Replace(vbLf, "")
Return s
End Function
Imports System.Linq
Imports System.Net.NetworkInformation
Public Class clsVPN
Public Delegate Sub delPing()
Public Delegate Sub delConnect()
Public Delegate Sub delIdle()
Public Delegate Sub delDisconnect()
Public Delegate Sub delStatus(blnConnected As Boolean)
Public Event Ping As delPing
Public Event Con As delConnect
Public Event Discon As delDisconnect
Public Event Idle As delIdle
Public Event StatusChanged As delStatus
Public strRASPhone As String = "C:\WINDOWS\system32\rasphone.exe"
Public strIPAddress As String = ""
Public strVPNCon As String = ""
Public blnConnected As Boolean = False
Dim file As String = "C : \Users\Tom\AppData\Roaming\Microsoft\Network\Connections\Pbk\rasphone.pbk"
Protected Sub OnStatusChanged(blnConnected As Boolean)
RaiseEvent StatusChanged(blnConnected)
End Sub
Protected Sub OnDisconnect()
RaiseEvent Discon()
End Sub
Protected Sub OnPing()
RaiseEvent Ping()
End Sub
Protected Sub OnIdle()
RaiseEvent Idle()
End Sub
Protected Sub OnConnect()
RaiseEvent Con()
End Sub
Public ReadOnly Property Connected() As Boolean
Get
Return blnConnected
End Get
End Property
Public Property ConName() As String
Get
Return strVPNCon
End Get
Set(strValue As String)
strVPNCon = strValue
End Set
End Property
Public Function Test() As Boolean
Dim blnSucceed As Boolean = False
OnPing()
Dim p As New Ping()
If p.Send(strIPAddress).Status = IPStatus.Success Then
blnSucceed = True
Else
blnSucceed = False
End If
p = Nothing
If blnSucceed <> blnConnected Then
blnConnected = blnSucceed
OnStatusChanged(blnConnected)
End If
OnIdle()
Return blnSucceed
End Function
Public Function Connect() As Boolean
Dim blnSucceed As Boolean = False
Dim optionstr As String = "-f " & file & " -d "
OnConnect()
'MessageBox.Show("strVPNCon = " )
'Process.Start(strRASPhone, Convert.ToString(" -f ") & file & Convert.ToString(" -d ") _
' & strVPNCon)
optionstr = ""
Dim wait As Boolean = True
ProcessExec(strRASPhone, optionstr & strVPNCon, wait)
Application.DoEvents()
System.Threading.Thread.Sleep(5000)
Application.DoEvents()
blnSucceed = True
OnIdle()
Return blnSucceed
End Function
Public Function Disconnect() As Boolean
Dim blnSucceed As Boolean = False
Dim optionstr As String = "-h "
OnDisconnect()
optionstr = ""
Dim wait As Boolean = True
ProcessExec(strRASPhone, optionstr & strVPNCon, wait)
Application.DoEvents()
System.Threading.Thread.Sleep(8000)
Application.DoEvents()
blnSucceed = True
OnIdle()
Return blnSucceed
End Function
Public Function CheckConnection() As Boolean
Dim niVPN As NetworkInterface() =
NetworkInterface.GetAllNetworkInterfaces
Dim blnExist As Boolean =
niVPN.AsEnumerable().Any(Function(x) x.Name = ConName)
If blnExist Then
'MessageBox.Show("VPN Exists")
Else
' MessageBox.Show("VPN Does Not Exist")
End If
Return blnExist
End Function
Public Sub ProcessExec(processarg As String, param As String, wait As Boolean)
' Start the child process.
Dim p As New ProcessStartInfo
' Redirect the output stream of the child process.
p.FileName = processarg
p.Arguments = param
p.UseShellExecute = True
p.WindowStyle = ProcessWindowStyle.Normal
Dim proc As Process = Process.Start(p)
' Do Not wait for the child process to exit before
' reading to the end of its redirected stream.
If wait = True Then
proc.WaitForExit()
End If
End Sub
End Class
Imports System.Runtime.InteropServices
Public Class RAS
Private Const MAX_PATH As Integer = 260 + 1
Private Const MAX_RAS_ENTRY_NAMES As Integer = 256 + 1
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)>
Public Structure RASENTRYNAME
Public dwSize As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_RAS_ENTRY_NAMES)>
Public szEntryName As String
Public dwFlags As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=MAX_PATH)>
Public szPhonebook As String
End Structure
Private Declare Auto Function RasEnumEntries Lib "rasapi32.dll" (
ByVal reserved As String,
ByVal phonebook As String,
<[In](), Out()> ByVal RasEntries() As RASENTRYNAME,
ByRef BufferSize As Integer,
ByRef EntryCount As Integer
) As Integer
Public Function GetConnectionsNames() As String()
Dim res As New List(Of String)
Try
Dim bufferSize As Integer = Marshal.SizeOf(GetType(RASENTRYNAME))
Dim entryCount As Integer = 1
Dim entryNames(0) As RASENTRYNAME
Dim rc As Integer
entryNames(0).dwSize = Marshal.SizeOf(GetType(RASENTRYNAME))
rc = RasEnumEntries(Nothing, Nothing, entryNames, bufferSize, entryCount)
If rc = 0 Then
' There was only one entry and it's been filled into the "dummy"
' entry that we made before calling RasEnumEntries.
res.Add(entryNames(0).szEntryName.Trim)
ElseIf rc = 603 Then
' 603 means that there are more entries than we have allocated space for.
' So, expand the entryNames array and make sure we fill in the structure size
' for every entry in the array! This is important!! Without it, you'll get 632 errors!
ReDim entryNames(entryCount - 1)
For i As Integer = 0 To entryCount - 1
entryNames(i).dwSize = Marshal.SizeOf(GetType(RASENTRYNAME))
Next
rc = RasEnumEntries(Nothing, Nothing, entryNames, bufferSize, entryCount)
For i As Integer = 0 To entryCount - 1
res.Add(entryNames(i).szEntryName.Trim)
Next
Else
' So if we get here, the call bombed. It would be a good idea to find out why here!
MsgBox("Error reading RAS connections names, error code:" & rc.ToString(), MsgBoxStyle.SystemModal)
End If
Catch ex As Exception
MsgBox("Error reading RAS connection names: " & ex.Message.ToString(), MsgBoxStyle.SystemModal)
End Try
Return res.ToArray
End Function
End Class

How to make a program that removes things form the host file VB.NET

I made a program that adds text to the system32 host file and I want a way a button can remove the selected one from the listbox and delete it from the host file here is the code to add it...
If TextBox1.Text = "" Then
MsgBox("Please Enter A Valid Website Url")
Else
path = "C:\Windows\System32\drivers\etc\hosts"
sw = New StreamWriter(path, True)
Dim sitetoblock As String = (Environment.NewLine & "127.0.0.1 " & TextBox1.Text) 'has to be www.google.com | NOT: http://www.google.com/
sw.Write(sitetoblock)
sw.Close()
ListBox1.Items.Add(TextBox1.Text)
MsgBox("Site Blocked")
End If
Thanks for your time
You can use this code to add, read and delete from windows hosts file.
Add this class to your project -
WindowsHost Class:
Public Class WindowsHost
Public ReadOnly Location As String
Private FullMap As List(Of HostMap)
Public Sub New()
Location = Environment.SystemDirectory & "\drivers\etc\hosts"
If Not System.IO.File.Exists(Location) Then
Throw New System.IO.FileNotFoundException("Host File Was Not Found", Location)
End If
FullMap = LoadCurrentMap()
End Sub
Public Function Count() As Integer
Return FullMap.Count
End Function
Public Function Item(ByVal index As Integer) As HostMap
Return New HostMap(FullMap.Item(index))
End Function
Public Sub AddHostMap(ByVal NewMap As HostMap)
FullMap = LoadCurrentMap()
FullMap.Add(NewMap)
SaveData()
End Sub
Public Sub DeleteHostMapByDomain(ByVal dom As String)
FullMap = LoadCurrentMap()
Dim Reall As Integer = 0
For i As Integer = 0 To FullMap.Count - 1 Step 1
If FullMap.Item(Reall).domain = dom Then
FullMap.RemoveAt(Reall)
Else
Reall += 1
End If
Next
SaveData()
End Sub
Public Sub DeleteHostMapByIp(ByVal ip As System.Net.IPAddress)
FullMap = LoadCurrentMap()
Dim Reall As Integer = 0
For i As Integer = 0 To FullMap.Count - 1 Step 1
If FullMap.Item(Reall).Ip.Equals(ip) Then
FullMap.RemoveAt(Reall)
Reall += 1
End If
Next
SaveData()
End Sub
Public Sub UpdateData()
FullMap = LoadCurrentMap()
End Sub
Private Function LoadCurrentMap() As List(Of HostMap)
Dim FileStream As New System.IO.StreamReader(Location)
Dim Lines() As String = FileStream.ReadToEnd.Split(New String() {Environment.NewLine}, StringSplitOptions.None)
FileStream.Close()
Dim Lst As New List(Of HostMap)
For Each line As String In Lines
If Not line.Contains("#") Then
Dim LineData() As String = line.Split({" "c}, StringSplitOptions.RemoveEmptyEntries)
If LineData.Length = 2 Then
Try
Dim temp As New HostMap(LineData(1), System.Net.IPAddress.Parse(LineData(0)))
Lst.Add(temp)
Catch ex As Exception
End Try
End If
End If
Next
Return Lst
End Function
Private Sub SaveData()
Dim Data As String = "# Windows Host Generate" & vbNewLine & "# Time: " & Now.ToString
For Each Map As HostMap In FullMap
Data = Data & vbNewLine & Map.ToString
Next
Dim w As New System.IO.StreamWriter(Location)
w.Write(Data)
w.Close()
End Sub
End Class
Public Class HostMap
Public domain As String
Public Ip As System.Net.IPAddress
Public Sub New(ByVal _dom As String, ByVal _ip As System.Net.IPAddress)
domain = _dom
Ip = _ip
End Sub
Public Sub New(ByRef map As HostMap)
domain = map.domain
Ip = map.Ip
End Sub
Public Overrides Function ToString() As String
Return Ip.ToString & " " & domain
End Function
End Class
Now you can use it like this
Dim WindowsHostSession As New WindowsHost()
WindowsHostSession.AddHostMap(New HostMap("SomeSite.com", System.Net.IPAddress.Parse("127.0.0.1"))) 'Add ip domin map to hosts file
WindowsHostSession.Item(2).domain 'Read the second ip domain map from the hosts file
WindowsHostSession.DeleteHostMapByDomain("SomeSite.com") 'Delete all maps with SomeSite.com domain from the hosts file

Writing StringBuilder Class to HTML Error: Object Required

Thanks to the wonderful teams of people at Stack Overflow, here is the following code that has been created. It works wonderfully, except for an error at the end that I cannot debunk.
Class:
Private m_arrBuffer
Private m_strDelimiter
Private Sub Class_Initialize()
m_arrBuffer = Array()
m_strDelimiter = “”
End Sub
Private Sub Class_Terminate()
m_arrBuffer = Empty
End Sub
Public Property Get Delimiter()
Delimiter = m_strDelimiter
End Property
Public Property Let Delimiter(strDelimiter)
m_strDelimiter = strDelimiter
End Property
Public Sub Append(strValue)
ReDim Preserve m_arrBuffer(UBound(m_arrBuffer) + 1)
m_arrBuffer(UBound(m_arrBuffer)) = strValue
End Sub
Public Sub AppendLine(strValue)
Me.Append strValue & vbCrLf
End Sub
Public Sub Compact()
If Not Me.Delimiter = “” Then
strOriginalDelimiter = Me.Delimiter
Me.Delimiter = “”
End If
strTemp = Me.ToString
m_arrBuffer = Array()
Me.Append strTemp
Me.Delimiter = strOriginalDelimiter
End Sub
Public Function ToArray()
ToArray = m_arrBuffer
End Function
Public Function ToString()
ToString = Join(m_arrBuffer, m_strDelimiter)
End Function
Code (credit to #Bond)
Dim sb
Set sb = New StringBuilder ' Guessing here. You haven't shown the class name.
sb.Append "some string"
sb.Append "another string"
sb.Append "a third string"
....
sb.Delimiter = "<br>"
myHtmlFile.Write sb.ToString()
I am recieving an error at myHtmlFile.Write sb.ToString() Run-time error '424': Object required.
I am not sure but I believe this is the final hurdle before I have a working code. Any advice on how to alleviate this error? Thank you.
for your problem i would say the solution would be:
This code does already assume, that the string is finished
Sub CreateAfile
Dim ie As Object, fs as object
Dim sb
Set sb = New StringBuilder ' Guessing here. You haven't shown the class name.
sb.Append "some string"
sb.Append "another string"
sb.Append "a third string"
....
sb.Delimiter = "<br>"
Set fs = CreateObject("Scripting.FileSystemObject")
Set myHtmlFile = fs.CreateTextFile("U:\temp\MyHTMLfile.htm", True)
myHtmlFile.WriteLine(sb.ToString())
myHtmlFile.Close
Set ie = CreateObject("Internetexplorer.Application")
ie.Visible = True
ie.Navigate "U:\temp\MyHTMLfile.htm"
End Sub

VB.net link extraction with HtmlAgilityPack

I was able to extract URLs with simple href tags like this:
<a href="http://www.samplesite.com">
but my problem is how do i extract a link from an href tag that looks like this?
<a href="http://www.wherecreativitygoestoschool.com/vancouver/left_right/rb_test.htm" onmousedown="return rwt(this,'','','','1','AFQjCNHvlwTxfBVEYcqGUnilAZN0uY2IXw','','0CCsQFjAA','','',event)">
Right Brain vs Left Brain Creativity <em>Test</em> at The Art Institute of <b>...</b></a>
Here is my complete code:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim webClient As New System.Net.WebClient
Dim WebSource As String = webClient.DownloadString("http://www.google.com.ph/search?hl=en&as_q=test&as_epq=&as_oq=&as_eq=&as_nlo=&as_nhi=&lr=&cr=countryCA&as_qdr=all&as_sitesearch=&as_occt=any&safe=images&tbs=ctr%3AcountryCA&as_filetype=&as_rights=#as_qdr=all&cr=countryCA&fp=1&hl=en&lr=&q=test&start=20&tbs=ctr:countryCA")
Dim doc = New HtmlAgilityPack.HtmlDocument()
doc.LoadHtml(WebSource)
Dim links = GetLinks(doc, "test")
For Each Link In links
ListBox1.Items.Add(Link.ToString())
Next
End Sub
Public Class Link
Public Sub New(Uri As Uri, Text As String)
Me.Uri = Uri
Me.Text = Text
End Sub
Public Property Text As String
Public Property Uri As Uri
Public Overrides Function ToString() As String
Return String.Format(If(Uri Is Nothing, "", Uri.ToString()))
End Function
End Class
Public Function GetLinks(doc As HtmlAgilityPack.HtmlDocument, linkContains As String) As List(Of Link)
Dim uri As Uri = Nothing
Dim linksOnPage = From link In doc.DocumentNode.Descendants()
Where link.Name = "a" _
AndAlso link.Attributes("href") IsNot Nothing _
Let text = link.InnerText.Trim()
Let url = link.Attributes("href").Value
Where url.IndexOf(linkContains, StringComparison.OrdinalIgnoreCase) >= 0 _
AndAlso uri.TryCreate(url, UriKind.Absolute, uri)
Dim Uris As New List(Of Link)()
For Each link In linksOnPage
Uris.Add(New Link(New Uri(link.url, UriKind.Absolute), link.text))
Next
Return Uris
End Function
I have noticed that my code does not extract links that ends with </a>. Is there anything i can do to modify my code that it would extract links ending with </a>?
Use following code to grab all of links having 'href' attribute from page:
Dim hNodeCol as HTMLNodeCollection = doc.DocumentNode.SelectNodes("//a[#href]")
...if you still need it, ofcourse ;)

Threading sub sending value

Hey all i have this being called:
Public Sub doStuff(ByVal what2Do As String)
Dim command As String = ""
If Trim(lanSent(1)) = "turnOffPC" Then
command = "r5"
ElseIf Trim(lanSent(1)) = "TurnOnPC" Then
command = "r3"
End If
Dim t As New Threading.Thread(AddressOf androidWS)
t.SetApartmentState(Threading.ApartmentState.STA)
t.Start()
End Sub
Private Shared Sub androidWS(ByVal command As String)
Dim arduinoWebSite As New WebBrowser
arduinoWebSite.Navigate("http://192.168.9.39:19/?r=" & command)
End Sub
And i am wondering how i can send a value to androidWS?
updated code that works
Public Sub doStuff(ByVal what2Do As String)
Dim command As String = ""
If Trim(lanSent(1)) = "turnOffPC" Then
command = "r5"
ElseIf Trim(lanSent(1)) = "TurnOnPC" Then
command = "r3"
End If
Dim t As New Threading.Thread(AddressOf androidWS)
t.SetApartmentState(Threading.ApartmentState.STA)
t.Start(command)
End Sub
Private Shared Sub androidWS(ByVal command As Object)
Dim arduinoWebSite As New WebBrowser
arduinoWebSite.Navigate("http://192.168.9.39:19/?r=" & command)
End Sub
You use the Thread.Start(Object) overload to pass data to your handler sub.
http://msdn.microsoft.com/en-us/library/6x4c42hc.aspx