I m trying to understand and modifying a network discovery program..if somebody help me understand the following code i'd be obliged
Dim DomainEntry As New DirectoryEntry("WinNT://" & workGroup.Trim())
DomainEntry.Children.SchemaFilter.Add("computer")
X = 5 : Y = 5 : Count = 1
For Each Machine As DirectoryEntry In DomainEntry.Children
Dim CompNode As New TreeNode(), CompInfo(1) As String
CompInfo(0) = Machine.Name
Dim Tempaddr As System.Net.IPHostEntry = Nothing
Try
Tempaddr = DirectCast(Dns.GetHostByName(Machine.Name), System.Net.IPHostEntry)
Dim TempAd As System.Net.IPAddress() = Tempaddr.AddressList, str As String = ""
For Each TempA As IPAddress In TempAd
CompInfo(1) = TempA.ToString()
Next
Catch ex As Exception
CompInfo(1) = ""
End Try
Hopefully this helps:
''//The variable "workGroup" holds your Active Directory domain name
''//The "DomainEntry" variable will represent the root of your Active Directory hierarchy
Dim DomainEntry As New DirectoryEntry("WinNT://" & workGroup.Trim())
''//Tell the "DomainEntry" variable to only look at "computer" objects
DomainEntry.Children.SchemaFilter.Add("computer")
''//These variables are not used
X = 5 : Y = 5 : Count = 1
''//Loop through all of the computers in the domain
For Each Machine As DirectoryEntry In DomainEntry.Children
''//First variable is not used, second is an array with two parts
Dim CompNode As New TreeNode(), CompInfo(1) As String
''//Set the first part of the array to the machine name
CompInfo(0) = Machine.Name
''//The next block tries to get the machine IP by looking it up in DNS. It can fail at several points so it gets wrapped in a try/catch just in case
Dim Tempaddr As System.Net.IPHostEntry = Nothing
Try
''//Try getting the machine IP
Tempaddr = DirectCast(Dns.GetHostByName(Machine.Name), System.Net.IPHostEntry)
''//A machine can have several IP addresses so this gets a full list of them
Dim TempAd As System.Net.IPAddress() = Tempaddr.AddressList, str As String = ""
''//Most machines will probably have just one IP address, but just in case this code takes the last one that it finds
For Each TempA As IPAddress In TempAd
''//Set the second part of our array to the IP address
CompInfo(1) = TempA.ToString()
Next
Catch ex As Exception
''//If this is hit then there was a problem getting the IP address so set it to blank
CompInfo(1) = ""
End Try
Next
This is a program for reading a local Active Directory. "WinNT://workgroup" is the address of the directory.
The next line
DomainEntry.Children.SchemaFilter.Add("computer")
Indicates that you're only interested in items of type "computer". From there on, you're creating a two dimensional array which represents the computers with the machine name in the zeroth element, and the IP address of the machine in the second. If there is more than one IP entry for the machine, the array will contain the last one.
Related
I have a small question here , I have two Textboxes in VB.Net.
Textbox1 value will be entered by user. for example Textbox1 = 10.200.1.1
I want to auto subtract 100 from the 2nd octet and put the value in Textbox2
Textbox2 = 10.100.1.1
Is that doable in VB.Net?
You can use the IPAddress class of .NET to solve this:
Dim ip As System.Net.IPAddress = Nothing
'parse the IP address from user input to make sure the input is valid and check for IPv4.
If System.Net.IPAddress.TryParse(TextBox1.Text, ip) AndAlso ip.AddressFamily = Net.Sockets.AddressFamily.InterNetwork Then
Dim ipBytes() As Byte = ip.GetAddressBytes
'just subtract 100 on the 2nd octet if higher or equals 100.
If ipBytes(1) >= 100 Then
ipBytes(1) = ipBytes(1) - 100
End If
'create the new IP address from modified octets.
ip = New System.Net.IPAddress(ipBytes)
TextBox2.Text = ip.ToString()
End If
Let's split on period, then convert the second to integer, and reduce it by 100, convert it back to a string, and recombine the parts into a whole:
Dim ip = ip1TextBox.Text;
Dim bits = ip.Split("."c)
Dim octet2 = Convert.ToInt32(bits(1))
octet2 -= 100
bits(1) = octet2.ToString()
Dim newIp = string.Join(".", bits)
I do get a lot of help from this website searching for a solution but at this point I'm completely stuck. I'm not a programmer, still was able to get that far.
The idea of my little project is to download newest version of a program (folder) from FTP server. Unzip files and update current program folder with new files. But before that backup the exiting program folder to a different FTP address.
What I'm struggling with is a way they post program versions (folders) on FTP:
folder structure on FTP
I can't really predict what would be the next folder to download because e.g. for program version:
7.6.16
it might be:
WERSJA_NOWY_TEMPLATE_7.6.17
or
WERSJA_NOWY_TEMPLATE_7.7.01
what ever is being released.
There is an ini file on C drive that holds the current program version. I was able to retrieve that information by reading the line, removing the unnecessary characters and splitting the string:
Dim wersja1 As String = File.ReadAllLines("C:\Windows\file.ini").FirstOrDefault(Function(x) x.Contains("WERSJA="))
Dim characterToRemove1 As String = "WERSJA="
Dim wersja2 As String = Replace(wersja1, characterToRemove1, "")
Dim characterToRemove2 As String = "T"
Dim wersja3 As String = Replace(wersja2, characterToRemove2, "")
Dim wersja4 As String() = wersja3.Split(New Char() {"."c})
Dim w1 As String = wersja4(0)
Dim w2 As String = wersja4(1)
Dim w3 As String = wersja4(2)
e.g. from a line:
WERSJA=7.6.5T
I get:
w1 = 7
w2 = 6
w3 = 5
Then I change the last one (w3) to a two digits number (because of the way folders are named on FTP):
If w3 < 10 Then
w3 = "0" & w3
Else
w3 = w3
End If
So if:
w3 = 5 >> I get 05
w3 = 16 >> I get 16
So far, so good.
In the next step I would like to see a filtered list of program versions (folders) in a ListBox or 2 ListBoxes. I would like to filter the list to see only folder with a bigger number than the current program version, so I can choose the correct one to download.
Why this way? Because if current version is e.g.
7.6.16
and there are 3 new ones e.g.:
7.6.17
7.6.18
7.7.01
I need to download all of them one by one, update program files and start the program to update sql database in order they were released. I can't skip any version on update.
Dim FTPurl As String = "ftp://xx.xx.xxx.xxx/wersje/"
Dim FTPwersja As String = "WERSJA_NOWY_TEMPLATE_*"
Dim FTPlog As String = "xxx"
Dim FTPpass As String = "yyy"
Dim clsRequest As FtpWebRequest = System.Net.WebRequest.Create(FTPurl & FTPwersja)
clsRequest.Credentials = New System.Net.NetworkCredential(FTPlog, FTPpass)
clsRequest.Method = System.Net.WebRequestMethods.Ftp.ListDirectory
Dim listResponse As FtpWebResponse = clsRequest.GetResponse
Dim reader As StreamReader = New StreamReader(listResponse.GetResponseStream())
'folder list
While reader.Peek >= 0
ListBox1.Items.Add(reader.ReadLine)
End While
'remove empty lines
For i As Integer = ListBox1.Items.Count - 1 To 0 Step -1
If ListBox1.GetItemText(ListBox1.Items(i)) = String.Empty Then
ListBox1.Items.RemoveAt(i)
End If
Next i
The above code gives me this result.
I found this code that enables filtering of ListBox but I have no clue on how to convert it to an loop so I would see only folders with bigger numbers than the current version of program:
'filter result in list box
Dim items = From it In ListBox1.Items.Cast(Of Object)()
Where it.ToString().IndexOf("7.5", StringComparison.CurrentCultureIgnoreCase) >= 0
Dim matchingItemList As List(Of Object) = items.ToList()
ListBox1.BeginUpdate()
'ListBox1.Items.Clear() 'add to list
For Each item In matchingItemList
ListBox1.Items.Remove(item) 'remove from list
'ListBox1.Items.Add(item) 'add to list
Next
ListBox1.EndUpdate()
I also have this code to catch choice and prevent crash when clicked on empty line :
Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) _
Handles ListBox1.SelectedIndexChanged
Try
Dim LB1choice = ListBox1.SelectedItem.ToString()
Label5.Text = LB1choice
Catch ex As Exception
ListBox1.SelectedIndex = 0
End Try
End Sub
The ideal would be 2 ComboBoxes where 1st would display e.g.
WERSJA_NOWY_TEMPLATE_7.6
WERSJA_NOWY_TEMPLATE_7.7
and based on the choice 2nd ComboBox would list newer subfolders in it e.g.
WERSJA_NOWY_TEMPLATE_7.6.16
WERSJA_NOWY_TEMPLATE_7.6.17
for the 1st one, and:
WERSJA_NOWY_TEMPLATE_7.7.01
for the 2nd one.
I much appreciate if anyone could help me this because it's beyond my skills.
Hi i am new to VB and in the process of learning. This error occur sometimes and doesn't occur sometimes which i find it weird.
I receive the error Index was outside the bounds of the array, that points to Button30.Text = Split(newestversion, vbCrLf)(**1**)
My motive is to read line by line from a online hosted text file.
For example,
label1.text = line 1 of the text file
label2.text = line 2 of the text file
This is very much what i want.
Here is my current code (EDITED):
Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create("direct link to my online txt file")
Dim response As System.Net.HttpWebResponse = request.GetResponse
Dim sr As System.IO.StreamReader = New System.IO.StreamReader(response.GetResponseStream)
Dim stringReader As String
stringReader = sr.ReadLine()
Button10.Text = stringReader
Dim newestversion As String = sr.ReadToEnd
Dim currentversion As String = Application.ProductVersion
Dim part() As String = Split(newestversion, vbCrLf)
If part.Length < 10 Then
' not enough items in the array. You could also throw and exception or do some other stuff here
Label10.Text = "beta"
Exit Sub
End If
'updates new episode numbers on buttons
Button20.Text = part(0)
Button30.Text = part(1)
Button40.Text = part(2)
Button50.Text = part(3)
Button60.Text = part(4)
Button70.Text = part(5)
Button80.Text = part(6)
Button90.Text = part(7)
Button100.Text = part(8)
Button110.Text = part(9)
End If
Thank You!!
You split your String for line breaks. This gives you an array, having one entry for each line in the String. However, you do not check if this array holds the amount of items you expect. You could do:
Dim newestversion As String = sr.ReadToEnd
Dim currentversion As String = Application.ProductVersion
Dim part() As String = Split(newestversion, vbCrLf)
If part.Length < 10 Then
' not enough items in the array. You could also throw and exception or do some other stuff here
MsgBox(String.Format("Array only has {0} items", part.Length))
Exit Sub
End If
'updates new episode numbers on buttons
Button20.Text = part(0)
Button30.Text = part(1)
Button40.Text = part(2)
...
Edit for the updated question
If you do have a problem like this, just approach it systematically and get as much information as you can. First you have to check if you really get the data you want from the remote source. To do that, add some logging (e.g. a MsgBox(newestversion) or a real log file). Check if the data you get is what you expect. If not, there's already a problem with your request/response code, which is a completely different problem than what I provided a solution for. If newestversion is OK, check if the splitting works by printing out the part() array. Maybe the server uses a different operating system or just uses vbCr as newline and not vbCrlf. If the splitting also works, you are done.
I am looking to implement a VBA trie-building algorithm that is able to process a substantial English lexicon (~50,000 words) in a relatively short amount of time (less than 15-20 seconds). Since I am a C++ programmer by practice (and this is my first time doing any substantial VBA work), I built a quick proof-of-concept program that was able to complete the task on my computer in about half a second. When it came time to test the VBA port however, it took almost two minutes to do the same -- an unacceptably long amount of time for my purposes. The VBA code is below:
Node Class Module:
Public letter As String
Public next_nodes As New Collection
Public is_word As Boolean
Main Module:
Dim tree As Node
Sub build_trie()
Set tree = New Node
Dim file, a, b, c As Integer
Dim current As Node
Dim wordlist As Collection
Set wordlist = New Collection
file = FreeFile
Open "C:\corncob_caps.txt" For Input As file
Do While Not EOF(file)
Dim line As String
Line Input #file, line
wordlist.add line
Loop
For a = 1 To wordlist.Count
Set current = tree
For b = 1 To Len(wordlist.Item(a))
Dim match As Boolean
match = False
Dim char As String
char = Mid(wordlist.Item(a), b, 1)
For c = 1 To current.next_nodes.Count
If char = current.next_nodes.Item(c).letter Then
Set current = current.next_nodes.Item(c)
match = True
Exit For
End If
Next c
If Not match Then
Dim new_node As Node
Set new_node = New Node
new_node.letter = char
current.next_nodes.add new_node
Set current = new_node
End If
Next b
current.is_word = True
Next a
End Sub
My question then is simply, can this algorithm be sped up? I saw from some sources that VBA Collections are not as efficient as Dictionarys and so I attempted a Dictionary-based implementation instead but it took an equal amount of time to complete with even worse memory usage (500+ MB of RAM used by Excel on my computer). As I say I am extremely new to VBA so my knowledge of both its syntax as well as its overall features/limitations is very limited -- which is why I don't believe that this algorithm is as efficient as it could possibly be; any tips/suggestions would be greatly appreciated.
Thanks in advance
NB: The lexicon file referred to by the code, "corncob_caps.txt", is available here (download the "all CAPS" file)
There are a number of small issues and a few larger opportunities here. You did say this is your first vba work, so forgive me if I'm telling you things you already know
Small things first:
Dim file, a, b, c As Integer declares file, a and b as variants. Integer is 16 bit sign, so there may be risk of overflows, use Long instead.
DIM'ing inside loops is counter-productive: unlike C++ they are not loop scoped.
The real opportunity is:
Use For Each where you can to iterate collections: its faster than indexing.
On my hardware your original code ran in about 160s. This code in about 2.5s (both plus time to load word file into the collection, about 4s)
Sub build_trie()
Dim t1 As Long
Dim wd As Variant
Dim nd As Node
Set tree = New Node
' Dim file, a, b, c As Integer : declares file, a, b as variant
Dim file As Integer, a As Long, b As Long, c As Long ' Integer is 16 bit signed
Dim current As Node
Dim wordlist As Collection
Set wordlist = New Collection
file = FreeFile
Open "C:\corncob_caps.txt" For Input As file
' no point in doing inside loop, they are not scoped to the loop
Dim line As String
Dim match As Boolean
Dim char As String
Dim new_node As Node
Do While Not EOF(file)
'Dim line As String
Line Input #file, line
wordlist.Add line
Loop
t1 = GetTickCount
For Each wd In wordlist ' for each is faster
'For a = 1 To wordlist.Count
Set current = tree
For b = 1 To Len(wd)
'Dim match As Boolean
match = False
'Dim char As String
char = Mid$(wd, b, 1)
For Each nd In current.next_nodes
'For c = 1 To current.next_nodes.Count
If char = nd.letter Then
'If char = current.next_nodes.Item(c).letter Then
Set current = nd
'Set current = current.next_nodes.Item(c)
match = True
Exit For
End If
Next nd
If Not match Then
'Dim new_node As Node
Set new_node = New Node
new_node.letter = char
current.next_nodes.Add new_node
Set current = new_node
End If
Next b
current.is_word = True
Next wd
Debug.Print "Time = " & GetTickCount - t1 & " ms"
End Sub
EDIT:
loading the word list into a dynamic array will reduce load time to sub second. Be aware that Redim Preserve is expensive, so do it in chunks
Dim i As Long, sz As Long
sz = 10000
Dim wordlist() As String
ReDim wordlist(0 To sz)
file = FreeFile
Open "C:\corncob_caps.txt" For Input As file
i = 0
Do While Not EOF(file)
'Dim line As String
Line Input #file, line
wordlist(i) = line
i = i + 1
If i > sz Then
sz = sz + 10000
ReDim Preserve wordlist(0 To sz)
End If
'wordlist.Add line
Loop
ReDim Preserve wordlist(0 To i - 1)
then loop through it like
For i = 0 To UBound(wordlist)
wd = wordlist(i)
I'm out of practice with VBA, but IIRC, iterating the Collection using For Each should be a bit faster than going numerically:
Dim i As Variant
For Each i In current.next_nodes
If i.letter = char Then
Set current = i
match = True
Exit For
End If
Next node
You're also not using the full capabilities of Collection. It's a Key-Value map, not just a resizeable array. You might get better performance if you use the letter as a key, though looking up a key that isn't present throws an error, so you have to use an ugly error workaround to check for each node. The inside of the b loop would look like:
Dim char As String
char = Mid(wordlist.Item(a), b, 1)
Dim node As Node
On Error Resume Next
Set node = Nothing
Set node = current.next_nodes.Item(char)
On Error Goto 0
If node Is Nothing Then
Set node = New Node
current.next_nodes.add node, char
Endif
Set current = node
You won't need the letter variable on class Node that way.
I didn't test this. I hope it's all right...
Edit: Fixed the For Each loop.
Another thing you can do which will possibly be slower but will use less memory is use an array instead of a collection, and resize with each added element. Arrays can't be public on classes, so you have to add methods to the class to deal with it:
Public letter As String
Private next_nodes() As Node
Public is_word As Boolean
Public Sub addNode(new_node As Node)
Dim current_size As Integer
On Error Resume Next
current_size = UBound(next_nodes) 'ubound throws an error if the array is not yet allocated
On Error GoTo 0
ReDim next_nodes(0 To current_size) As Node
Set next_nodes(current_size) = new_node
End Sub
Public Function getNode(letter As String) As Node
Dim n As Variant
On Error Resume Next
For Each n In next_nodes
If n.letter = letter Then
Set getNode = n
Exit Function
End If
Next
End Function
Edit: And a final optimization strategy, get the Integer char value with the Asc function and store that instead of a String.
You really need to profile it, but if you think Collections are slow maybe you can try using dynamic arrays?
I am trying to get country location from the ip address which I am also looking up from actual url. However for certain urls I am getting the following error:
The requested name is valid and was found in the database, but it does not have the correct associated data being resolved for
I wanted to use the following code to identify the proxy perhaps but since this is a regular console app I am not sure how to get around it. Here is my code;
For Each prod In querylist
If myfetcher.getHtml(prod, userAgent, page) Then
' The lines below I use to find proxy ip
' but error name 'Request' not declared
' Dim nowip As String
' nowip = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
' If nowip = "" Then
'nowip = Request.ServerVariables("REMOTE_ADDR")
'End If
'
If prod.Contains("http://") Then
prod = Regex.Replace(prod, "http://", "")
End If
badHost = prod
Dim ipEntry As IPHostEntry = Dns.GetHostByName(prod)
Dim IPAdd As IPAddress() = ipEntry.AddressList
Dim i As Integer = 0
For i = 0 To IPAdd.GetUpperBound(0)
number = number & "IP Address {0}:{1}" & IPAdd(i).ToString
Next
IPList.Add(prod & " " & number)
number = ""
Else
badList.Add(prod)
number = ""
End If
count = count + 1
Next
Here's a language agnostic way to do it:
do a HTTP GET for
domain2ip.net/:url
like
http://domain2ip.net/www.edresearch.co.jp
is
122.200.237.66
you can even to it from JavaScript
$.getJSON("http://domain2ip.net/google.com", callback);
Disclosure: it's my site, and open source.