How can I query the Active directory asynchronously.
I have a bit of code to get the users synchronously
Dim UserName as string = ""
Dim Password as string = ""
Dim LDAPPath As String = ""
Dim DirectoryE As DirectoryEntry = New DirectoryEntry(LDAPPath, UserName, Password)
Dim RootDSE As DirectoryServices.DirectoryEntry = globalroot
Dim objSearch As New System.DirectoryServices.DirectorySearcher(RootDSE)
Dim oResult As DirectoryServices.SearchResultCollection = Nothing
'objSearch.PropertiesToLoad.Add("uid")
'objSearch.PropertiesToLoad.Add("cn")
objSearch.Filter = "(&(objectcategory=user))"
objSearch.PageSize = 500
oResult = objSearch.FindAll
For Each ldentry As SearchResult In oResult
Console.WriteLine(ldentry.Properties("cn")(0).ToString)
Next
Console.ReadLine()
Assuming you are using .NET 4.5. Change your code to a function which returns a SearchResultCollection:
Private Function GetAllUsers() As SearchResultCollection
Dim UserName As String = ""
Dim Password As String = ""
Dim LDAPPath As String = ""
Dim DirectoryE As DirectoryEntry = New DirectoryEntry(LDAPPath, UserName, Password)
Dim RootDSE As DirectoryServices.DirectoryEntry = New DirectoryEntry("LDAP://RootDSE")
Dim objSearch As New System.DirectoryServices.DirectorySearcher(RootDSE)
Dim oResult As DirectoryServices.SearchResultCollection = Nothing
'objSearch.PropertiesToLoad.Add("uid")
'objSearch.PropertiesToLoad.Add("cn")
objSearch.Filter = "(&(objectcategory=user))"
objSearch.PageSize = 500
Return objSearch.FindAll
End Function
Then call it like this:
Private Async Sub Button15_Click(sender As Object, e As EventArgs) Handles Button15.Click
For Each ldentry As SearchResult In Await Task.Run(Function() GetAllUsers())
Console.WriteLine(ldentry.Properties("cn")(0).ToString)
Next
Console.ReadLine()
End Sub
Related
I'm trying to retrieve data from the web to desktop using vbnet, but whenever i tried to show it on datagridview it show this error.
It only succes when i only show the first column.
But when it comes to add more column it will show at first but have error like this.
And when i tried to run it again it have error like this.
The code i use :
Imports System.Net
Imports System.IO
Public Class Form1
Dim strArr() As String
Dim strArr1() As String
Dim count, c1 As Integer
Dim str, str2 As String
Private Sub DataGridView1_CellContentClick(sender As Object, e As DataGridViewCellEventArgs) Handles DataGridView1.CellContentClick
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim k As Integer = 0
Dim uri As New Uri("http://localhost/tampil.php")
If (uri.Scheme = Uri.UriSchemeHttp) Then
Dim request As HttpWebRequest = HttpWebRequest.Create(uri)
request.Method = WebRequestMethods.Http.Get
Dim response As HttpWebResponse = request.GetResponse()
Dim reader As New StreamReader(response.GetResponseStream())
Dim pagehtml As String = reader.ReadToEnd()
response.Close()
str = pagehtml
strArr = str.Split(";")
For count = 0 To strArr.GetUpperBound(0)
ReDim Preserve strArr1(k)
strArr1(k) = strArr(count)
str2 = strArr1(k)
Dim words As String() = strArr1(k).Split(New Char() {"-"c})
If str2 = "" Then
Exit For
End If
DataGridView1.Rows.Add("")
DataGridView1.Rows(DataGridView1.Rows.Count - 2).Cells(0).Value = words(0)
DataGridView1.Rows(DataGridView1.Rows.Count - 2).Cells(1).Value = words(1)
DataGridView1.Rows(DataGridView1.Rows.Count - 2).Cells(2).Value = words(2)
DataGridView1.Rows(DataGridView1.Rows.Count - 2).Cells(3).Value = words(3)
DataGridView1.Rows(DataGridView1.Rows.Count - 2).Cells(4).Value = words(4)
k += 1
Next
End If
End Sub
End Class
Data from web
Can anyone help ?
Adding a row will return the index of the new row.
You can use that when updating the cell values.
This method will add the rows as you'd expect.
If there is any chance of values being returned from the html query that have a different number of elements, you should check that.
Private Sub LoadDataGridViewFromHTML(htmlValue As String)
Dim entities() As String = htmlValue.Split(Convert.ToChar(";"))
For Each entityItem As String In entities
If Not String.IsNullOrEmpty(entityItem) Then 'check you're not dealing with an empty string
Dim entityValues() As String = entityItem.Split(Convert.ToChar("-"))
Dim newRowId As Integer = DataGridView1.Rows.Add("")
DataGridView1.Rows(newRowId).Cells(0).Value = entityValues(0)
DataGridView1.Rows(newRowId).Cells(1).Value = entityValues(1)
DataGridView1.Rows(newRowId).Cells(2).Value = entityValues(2)
DataGridView1.Rows(newRowId).Cells(3).Value = entityValues(3)
DataGridView1.Rows(newRowId).Cells(4).Value = entityValues(4)
End If
Next
End Sub
Imports System.Net
Public Class Form1
Dim fileReader As String
Dim t As String()
Dim strami As String = ""
Dim s, r As String()
Dim orfWriter As System.IO.StreamWriter
Dim local As String
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
fileReader = My.Computer.FileSystem.ReadAllText("G:\test.txt")
RichTextBox1.Text = fileReader
Dim urls() As String = RichTextBox1.Lines
Parallel.ForEach(urls, Sub(f)
If Not String.IsNullOrEmpty(f) Then
t = f.Split(",")
name = t(0)
't(1)=web address of Name
DownloadAsync(t(1))
End If
End Sub)
My.Computer.Audio.PlaySystemSound(
System.Media.SystemSounds.Asterisk)
MsgBox("All Done!")
End Sub
Function DownloadAsync(URL As String) As Task(Of Boolean)
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
Dim html As String = ""
Dim result As Boolean
Dim request As HttpWebRequest = HttpWebRequest.Create(URL)
request.AutomaticDecompression = DecompressionMethods.GZip
request.Timeout = 500
request.Method = "GET"
request.UserAgent = "Mozilla/5.0 (Macintosh; Intel Mac OS X x.y; rv:42.0) Gecko/20100101 Firefox/42.0"
Using response As Task(Of WebResponse) = request.GetResponseAsync
If response.Result IsNot Nothing Then
Using ioStream As IO.Stream = response.Result.GetResponseStream
Using sr As New System.IO.StreamReader(ioStream)
html = sr.ReadToEnd
s = html.Split(";")
r = s(0).Split(",")
'///////////////////
local = "G:\" & Name.ToString + ".csv"
orfWriter = New System.IO.StreamWriter(local, True, System.Text.Encoding.Unicode)
strami = r(0) & "," & r(1) & "," & r(2) & "," & r(3)
orfWriter.Write(strami)
orfWriter.WriteLine("")
orfWriter.Close()
End Using
result = True
End Using
End If
End Using
Return Task.FromResult(result)
Return Task.FromResult(False)
End Function
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
End Class
In this program, the information of the Urls in the "G:\test.txt" are downloaded at the same time, and I want the information to be saved in its own address, in a file with its name(i.e name=t(0)). But all information of urls are saved in only one file called the last line name of RichTextBox1.Lines. How can this problem be solved? Thank you
i got at my pc (Windows 7 and 10) 3 active LAN-Adapters.
In history I used netsh, because you can choose an adapter
netsh interface ip set address ""LAN-BRIDGED"" static 192.168.255.130 255.255.255.128 192.168.255.129", AppWinStyle.Hide, True)
But sometimes netsh doesn´t work... So thats why I don´t want to use netsh.
Now I try it by another way to change IP + Subnet + Gateway. If I only activate one of these LAN-Adapters, my code works. But if all of them active then it changes the IP at a random LAN-Adapter.
How can i choose one exactly LAN-Adapter with my code?
Option Strict On
Imports System.Net.NetworkInformation
Imports System.Management
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim LAN_Adapter As NetworkInterface
ComboBoxAdapterSelector.Items.Clear()
For Each LAN_Adapter In NetworkInterface.GetAllNetworkInterfaces()
With LAN_Adapter
ComboBoxAdapterSelector.Items.Add(.Name)
End With
Next
End Sub
Private Sub ChangechoosenIPButton_Click(sender As Object, e As EventArgs) Handles ChangechoosenIPButton.Click
ChangechoosenIP()
End Sub
Sub ChangechoosenIP()
Dim IPAddress As String = TextBoxIPAddress.Text
Dim SubnetMask As String = TextBoxSubnetMask.Text
Dim Gateway As String = TextBoxGateway.Text
If ComboBoxAdapterSelector.SelectedText = "Ethernet 2" Then
Dim objMC As ManagementClass = New ManagementClass("Win32_NetworkAdapterConfiguration")
Dim objMOC As ManagementObjectCollection = objMC.GetInstances()
For Each objMO As ManagementObject In objMOC
Try
Dim objNewIP As ManagementBaseObject = Nothing
Dim objSetIP As ManagementBaseObject = Nothing
Dim objNewGate As ManagementBaseObject = Nothing
objNewIP = objMO.GetMethodParameters("EnableStatic")
objNewGate = objMO.GetMethodParameters("SetGateways")
objNewGate("DefaultIPGateway") = New String() {Gateway}
objNewGate("GatewayCostMetric") = New Integer() {1}
objNewIP("IPAddress") = New String() {IPAddress}
objNewIP("SubnetMask") = New String() {SubnetMask}
objSetIP = objMO.InvokeMethod("EnableStatic", objNewIP, Nothing)
objSetIP = objMO.InvokeMethod("SetGateways", objNewGate, Nothing)
Catch ex As Exception
MessageBox.Show("Error : " & ex.Message)
End Try
Next objMO
ElseIf ComboBoxAdapterSelector.SelectedText = "Ethernet" Then
'.
'.
'.
ElseIf ComboBoxAdapterSelector.SelectedText = "LAN-Connection" Then
'.
'.
'.
End If
End Sub
I try this code on (LAN and Wireless)
For Each objMO As ManagementObject In objMOC
If objMO.SystemProperties("MACAddress").Value IsNot Nothing Then
'***** USE THIS
If objMO.SystemProperties("Description").Value <> "RAS Async Adapter" Then
MessageBox.Show("Caption: " & objMO.SystemProperties("Caption").Value)
'your code
End If
'***** OR THIS
'If objMO.SystemProperties("IPEnabled").Value = True And objMO.SystemProperties("DefaultIPGateway").Value IsNot Nothing Then
' MessageBox.Show("Caption: " & objMO.SystemProperties("Caption").Value)
' 'your code
'End If
End If
Next
A : Here is how to list ALL available adapters (Hardware w/without software)
Dim HardwareOnly As Boolean = True
For Each LAN_Adapter As NetworkInterface In NetworkInterface.GetAllNetworkInterfaces()
With LAN_Adapter
If HardwareOnly = True Then 'According to MAC-Address
If LAN_Adapter.GetPhysicalAddress.ToString <> "" Then
If LAN_Adapter.GetPhysicalAddress.ToString.StartsWith("00000000") = False Then
ComboBoxAdapterSelector.Items.Add(LAN_Adapter)
End If
End If
Else
ComboBoxAdapterSelector.Items.Add(LAN_Adapter)
End If
End With
Next
ComboBoxAdapterSelector.DisplayMember = "Name"
B : Now each item in ComboBoxAdapterSelector is refering to an
adapter (NetworkInterface object) 'so using If ComboBoxAdapterSelector.SelectedText = "Ethernet 2" Thenis not
recommanded 'LAN_Adapter.Name = "Ethernet 2" is not a static
field the user can change it from the Control Panel\Network and Internet\Network Connections
If ComboBoxAdapterSelector.SelectedItem IsNot Nothing Then
Dim tmpAdapter As NetworkInterface = DirectCast(ComboBoxAdapterSelector.SelectedItem, NetworkInterface)
Dim objMC As ManagementClass = New ManagementClass("Win32_NetworkAdapterConfiguration")
Dim objMOC As ManagementObjectCollection = objMC.GetInstances()
For Each objMO As ManagementObject In objMOC
'choose a static field to compare `objMO` with selected adapter => `tmpAdapter` <br>
'for example `tmpAdapter.Description` `tmpAdapter.GetPhysicalAddress` `tmpAdapter.Id` etc
If objMO.GetPropertyValue("SettingID") = tmpAdapter.Id Then
'NOW you find the object that refers to what you select in ComboBoxAdapterSelector
Dim objNewIP As ManagementBaseObject = Nothing
Dim objSetIP As ManagementBaseObject = Nothing
'your code
Exit For
End If
Next objMO
End If
been looking for a bit of code to take a screenshot and attach the screenshot to new email. I'll post what I have. It work 99%, just can't for the life of me figure out why it isn't attaching to the email.
It does everything but attach the new screenshot to the email. Is this possible?
Private Sub testStripMenuItem_Click(sender As Object, e As EventArgs) Handles testStripMenuItem.Click
Dim maxHeight As Integer = 0
Dim maxWidth As Integer = 0
For Each scr As Screen In Screen.AllScreens
maxWidth += scr.Bounds.Width
If scr.Bounds.Height > maxHeight Then maxHeight = scr.Bounds.Height
Next
Dim AllScreensCapture As New Bitmap(maxWidth, maxHeight, System.Drawing.Imaging.PixelFormat.Format24bppRgb)
Dim screenGrab As Bitmap
Dim screenSize As Size
Dim g As Graphics
Dim g2 As Graphics = Graphics.FromImage(AllScreensCapture)
Dim a As New Point(0, 0)
For Each scr As Screen In Screen.AllScreens
screenSize = New Size(scr.Bounds.Width, scr.Bounds.Height)
screenGrab = New Bitmap(scr.Bounds.Width, scr.Bounds.Height)
g = Graphics.FromImage(screenGrab)
g.CopyFromScreen(a, New Point(0, 0), screenSize)
g2.DrawImage(screenGrab, a)
a.X += scr.Bounds.Width
Next
Dim Screenshot = "C:\img.png"
If System.IO.File.Exists(Screenshot) Then
System.IO.File.Delete(Screenshot)
End If
AllScreensCapture.Save(Screenshot, System.Drawing.Imaging.ImageFormat.Jpeg)
'Email Code
Dim strUserDomain As String
Dim strCompName As String
strUserDomain = Environ$("UserDomain")
strCompName = Environ$("ComputerName")
Dim theStringBuilder As New StringBuilder()
theStringBuilder.Append("mailto:email#gmail.com.au")
theStringBuilder.Append("&subject=From Domain: " & strUserDomain & ". Computer Name: " & strCompName)
theStringBuilder.Append("&attach=" & Screenshot)
Process.Start(theStringBuilder.ToString())
End Sub
Alternative to sending through an installed mail client...
' Some of these may come from the form or user settings or wherever
Private Const MailSenderEmail As String = ""
Private Const MailSenderName As String = ""
Private Const MailRecipient As String = ""
Private Const MailSubject As String = ""
Private Const MailBody As String = ""
Private Const MailHost As String = ""
Private Const MailPort As String = ""
Private Const MailUser As String = ""
Private Const MailPass As String = ""
Private Const MailEnableSsl As Boolean = False
Private Sub testStripMenuItem_Click(sender As Object, e As EventArgs) Handles testStripMenuItem.Click
'
' Your code to capture the screen
'
Dim Screenshot = "C:\img.png"
If System.IO.File.Exists(Screenshot) Then
System.IO.File.Delete(Screenshot)
End If
AllScreensCapture.Save(Screenshot, System.Drawing.Imaging.ImageFormat.Jpeg)
' Send the email with Screenshot attached
Using MailMessage As New Net.Mail.MailMessage
With MailMessage
.From = New Net.Mail.MailAddress(MailSenderEmail, MailSenderName)
.To.Add(MailRecipient)
.Subject = MailSubject
.Body = MailBody
.Attachments.Add(New Net.Mail.Attachment(Screenshot))
End With
With New Net.Mail.SmtpClient
.Host = MailHost
.Port = MailPort
.EnableSsl = MailEnableSsl
Select Case True
Case String.IsNullOrWhiteSpace(MailUser)
Case String.IsNullOrWhiteSpace(MailPass)
Case Else
.Credentials = New Net.NetworkCredential(MailUser, MailPass)
End Select
.Send(MailMessage)
End With
End Using
End Sub
I'm programming a tool that'll go through a lot of websites and see if they contain a text that's in a textbox.
Now I wan't to add multi threading so it goes quite a lot faster, most preferably I'd dynamically add threads.
This is my code now but it didn't work because it says index ouf of range. And I doubt it work anyways.
Dim clsThreads As New Generic.List(Of System.Threading.Thread)
Dim numberOfthreads As Integer = 1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
For Each strLine1 As String In TextBox1.Text.Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
For Each strLine2 As String In TextBox2.Text.Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
clsThreads(numberOfthreads) = New Thread(Sub() Me.request(strLine1, strLine2))
clsThreads(numberOfthreads).Name = "Thread: " + numberOfthreads.ToString
clsThreads(numberOfthreads).IsBackground = True
clsThreads(numberOfthreads).Start()
numberOfthreads = numberOfthreads + 1
If (numberOfthreads.Equals(20)) Then
numberOfthreads = 0
End If
Next
Next
End Sub
So, how do I implement multi threading in a smart way?
This is my request sub:
Public Sub request(ByVal username, ByVal mail)
Dim req As WebRequest = WebRequest.Create("http://localhost/" + username)
req.Method = "GET"
Dim res As WebResponse = req.GetResponse()
Dim dataStream As Stream = res.GetResponseStream()
Dim reader As New StreamReader(dataStream)
Dim responseFromServer As String = reader.ReadToEnd()
If responseFromServer.Contains(mail) Then
TextBox3.Text = TextBox3.Text + vbNewLine + username
End If
End Sub
End Class
Something like this?
Option Strict On
Option Explicit On
Option Infer Off
Public Class Form1
Dim ActiveThreads As New List(Of System.Threading.Thread)
Delegate Sub delRemoveThread(thread As Threading.Thread)
Sub removeThread(thread As Threading.Thread)
If Me.InvokeRequired Then
Me.Invoke(New delRemoveThread(AddressOf removeThread), thread)
Else
ActiveThreads.Remove(thread)
End If
End Sub
Private Sub Button1_Click3(sender As Object, e As EventArgs) Handles Button1.Click
For i As Integer = 1 To 20
Dim th As New Threading.Thread(New Threading.ParameterizedThreadStart(Sub()
request("username", "mail")
removeThread(Threading.Thread.CurrentThread)
End Sub))
th.Start()
Next
End Sub
Public Sub request(ByVal username As String, ByVal mail As String)
Dim req As Net.WebRequest = Net.WebRequest.Create("http://localhost/" + username)
req.Method = "GET"
Dim res As Net.WebResponse = req.GetResponse()
Dim dataStream As IO.Stream = res.GetResponseStream()
Dim reader As New IO.StreamReader(dataStream)
Dim responseFromServer As String = reader.ReadToEnd()
If responseFromServer.Contains(mail) Then
TextBox3.Text = TextBox3.Text + vbNewLine + username
End If
End Sub
End Class