I am working on a project where I need to modify a script used for network documentation. The current script that we use is a modified version of SYDI, found here. What I would like to do is add to this script the ability to execute a netstat -an and have it returned with the rest of the report. I was curious if anyone has used WMI and VBScript to return netstat information and how it might be able to be incorporated into this script.
NOTE: I am not trying to promote a product and I am not affiliated with the SYDI project.
You could run netstat and capture the result like the script here under, but much info is also available from activeX but the i would need to know what information you need exactly.
set sh = CreateObject("Wscript.Shell")
set Connections = CreateObject("Scripting.Dictionary")
call Main()
Function Main()
call GetConnections()
call ProcessConnections()
End Function
Function GetConnections()
i = 0
set shExec = sh.Exec("netstat -f")
Do While Not shExec.StdOut.AtEndOfStream
Line = shExec.StdOut.ReadLine()
If Instr(Line, "TCP") <> 0 Then
Set Connection = New NetworkConnection
Connection.ParseText(Line)
call Connections.Add(i, Connection)
i = i + 1
End If
Loop
End Function
Function ProcessConnections()
For Each ConnectionID in Connections.Keys
wscript.echo ConnectionID & Connections(ConnectionID).RemoteIP
Next
End Function
Class NetworkConnection
Public Protocol
Public LocalIP
Public LocalPort
Public RemoteIP
Public RemotePort
Public Sub ParseText(Line)
dim i
For i = 5 to 2 Step -1
Line = Replace(Line, String(i, " "), " ")
Next
Line = Replace(Line, ":", " ")
Line = Right(Line, Len(Line) - 1)
Line = Split(Line, " ")
Protocol = Line(0)
LocalIP = Line(1)
LocalPort = Line(2)
RemoteIP = Line(3)
RemotePort = Line(4)
End Sub
Private Sub Class_Initialize
'MsgBox "Initialized NetworkConnection object"
End Sub
End Class
EDIT: based on the comment of OP here a simplified version
set sh = CreateObject("Wscript.Shell")
call GetConnections()
Function GetConnections()
i = 0
set shExec = sh.Exec("netstat -an")
Do While Not shExec.StdOut.AtEndOfStream
Wscript.Echo shExec.StdOut.ReadLine()
Loop
End Function
Related
I am working on a vb.net application and I am struggling to get this function to run in parallel. This is a legacy application, I was told that it uses an event-based asynchronous pattern, but I do not exactly understand what that means for this problem.
There is a for loop that runs a function serially, but I would like to run it in parallel.
Public Function Execute() As Boolean
Dim ret As Boolean = True
' If output files are not specified, then they will be generated based on the study name
If CancelExecution Then Return CancelCleanUp()
If ValidateInputFiles() Then
If CancelExecution Then Return CancelCleanUp()
Select Case _Name
Case "Main Single"
' This is the for loop I would like to run in parallel
For Each cc As IOFile In _CCards
If ValidateOutputFiles(cc.FileName) Then
ret = RunModel(cc)
If CancelExecution Then Return CancelCleanUp()
Else
ret = False
End If
Next
' The other Cases are irrelevant
End Select
Else
ret = False
End If
Return ret
End Function
Private Function RunModel(cCard As IOFile) As Boolean
Dim uFile As String
Dim ret As Boolean = True
If CancelExecution Then Return CancelCleanUp()
' create the uconfiguration file
If _RunNumber > 0 Then
uFile = MakeUFile(cCard, _InputFiles, _OutputFiles, _RunNumber)
Else
uFile = MakeUFile(cCard, _InputFiles, _OutputFiles)
End If
' Input: was not part of the vb 6 IInputModel class, but added in this version
' Main: delete files mainmodel is about to create (even the optional files) (calls CleanUpSingleRun)
ret = KillIOFiles(_OutputFiles)
' execute the application
If File.Exists(uFile) Then
Dim arg As String = """" & uFile & """"
If _Name = "Main Single Sensitivity" Then
' 7/27/2105 add an argument for either single or production run - this is a single run module
arg = arg & " SINGLE" & " " & "NOVIZ"
End If
ret = RunApplication(arg)
Else
Return False
End If
'execute? did it terminate properly?
' kill the ufile
Try
File.Delete(uFile)
Dim cleanupFiles = Directory.GetFiles(_SensitivityFolder).Where(Function(e) e.Contains(".spw") Or Path.GetFileName(e).StartsWith("SIMU")).ToList()
For Each fileToDelete As String In cleanupFiles
File.Delete(fileToDelete)
Next
' clean up temp combined files
If CombinedFile <> "" Then System.IO.File.Delete(CombinedFile)
Catch ex As Exception
End Try
ret = VerifyOutputFiles(cCard.FileName)
Return ret
End Function
Any help is very much appreciated, thank you for taking the time to read my post.
I am trying to create 100 printer ports using a csv file that has IPAddress. I am spinning through this file using VB 2008 and then calling a function to create the port. The first port gets created fine but when program gets second address and passes it to function gets an unspecified error.
call to the function
MakePort("IP_" & ln, ln)
Private Function MakePort(ByVal lPrinterName As String, ByVal _ lHostAddress As String)
Dim res As Boolean = False
Dim objWMIService As WbemScripting.SWbemServices = GetObject("winmgmts:")
Dim objNewPort = objWMIService.Get("WIN32_TCPIPPrinterPort").SpawnInstance_
Try
objNewPort.Name = lPrinterName
objNewPort.Protocol = 1
objNewPort.HostAddress = lHostAddress
objNewPort.PortNumber = "6101"
objNewPort.SNMPEnabled = False
objNewPort.Put_()
res = True
Catch ex As Exception
res = False
MsgBox(ex.Message)
End Try
objNewPort.Name = ""
objNewPort.Protocol = ""
objNewPort.HostAddress = ""
objNewPort.PortNumber = ""
objNewPort = Nothing
objWMIService = Nothing
Return res
End Function
On the Line objNewPort.Name = lPrinterName in second pass is where the Unspecified Error occurs.
Looking to save someone time by not having them manually type in the ports
This actually worked for me. Powershell script.
$PrinterList=get-content C:\scripts\printers.csv
FOREACH ($ip in $PrinterList) {
Print $I $port=[wmiclass]"Win32_TcpIpPrinterPort"
$port.psbase.scope.options.EnablePrivileges=$true
$newPort=$port.CreateInstance()
$newport.name="$ip"
$newport.Protocol=1
$newport.HostAddress=$ip
$newport.PortNumber="6101"
$newport.SnmpEnabled=$false
$newport.Put()
}
I'm trying to use IEdmEnumeratorVariable5::SetVar to update some file card variables based on user input into a windows form. My code executes, there are no error messages, the file is checked out and checked back in and the appropriate comment is added to the history; however the variables on the card are not updated.
I have verified by stepping through code at runtime that all variables are populated with the correct (as expected) data. The SetVar procedures all go off without a hitch, but the variables on the data card do not change value - even manually refreshing the folder view has no effect.
Below is my code.
This is an add-in application, written as a class-library project in VB using VS Community 2015, with target framework .NET 4.0.
In efforts to make this question more concise; immediately below I've included just the snippet of code doing the set variables work, then I've also included more code so you can get the whole picture if needed.
JUST THE TIP :
This is the code doing the set variables work:
Dim UserManager As IEdmUserMgr5 = .SourceVault
Dim User As IEdmUser5 = UserManager.GetLoggedInUser
CardComment = UserComment & CardComment
CardDate = Today().ToString("yyMMdd", Globalization.CultureInfo.InvariantCulture)
CardBy = User.Name
CardDisposition = UserDisposition
CardVariables.SetVar(DispositionVariable, "#", CardDisposition)
CardVariables.SetVar(CommentVariable, "#", CardComment)
CardVariables.SetVar(ByVariable, "#", CardBy)
CardVariables.SetVar(DateVariable, "#", CardDate)
CardVariables.Flush()
THE BROADER STROKES :
Class module level variables:
Private Structure CommandInfo
Dim SourceVault As IEdmVault11
Dim SourceCommand As EdmCmd
Dim SourceSelection As System.Array
Dim TargetTemplate As System.String
Dim VerifiedPaths As List(Of String)
End Structure
Private ReceivedCommand As CommandInfo
OnCmd procedure (caller):
Public Sub OnCmd(ByRef poCmd As EdmCmd,
ByRef ppoData As System.Array) Implements IEdmAddIn5.OnCmd
Dim CommandToRun As MenuCommand
Try
With ReceivedCommand
.SourceVault = poCmd.mpoVault
.SourceCommand = poCmd
.SourceSelection = ppoData
'Get the command structure for the command ID
Select Case poCmd.meCmdType
Case EdmCmdType.EdmCmd_Menu
CommandToRun = AvailableCommands(.SourceCommand.mlCmdID)
Case EdmCmdType.EdmCmd_CardButton
Select Case True
Case poCmd.mbsComment.ToString.ToUpper.Contains("DISPOSITION")
DispositionRequest()
Case Else : Exit Sub
End Select
Case Else : Exit Sub
End Select
'...... (End Try, End Sub, Etc.)
DispositionRequest procedure (callee):
Private Sub DispositionRequest()
Dim UserDisposition As String
Using Disposition As New DispositionForm
With Disposition
If Not .ShowDialog() = System.Windows.Forms.DialogResult.OK Then Exit Sub
Select Case True
Case .Approve.Checked
UserDisposition = "Approved"
Case .Reject.Checked
UserDisposition = "Rejected"
Case Else : Exit Sub
End Select
End With
End Using
Dim UserComment As String
Using Explanation As New DispositionExplanation
With Explanation
If Not .ShowDialog() = System.Windows.Forms.DialogResult.OK Then Exit Sub
If .ListView1.Items.Count > 0 Then
'do some stuff not relevant to this question...
End If
UserComment = .Comments.Text
End With
End Using
'This next procedure just gets a list of paths from ReceivedCommand.SourceSelection - which is just the ppoData argument from the OnCmd procedure - see code block above!
Dim RequestPaths As List(Of String) = GetSelectedFilePaths()
For Each Path As String In RequestPaths
With ReceivedCommand
Dim RequestFile As IEdmFile5 = .SourceVault.GetFileFromPath(Path)
Dim ParentFolder As IEdmFolder6 = .SourceVault.GetFolderFromPath(System.IO.Path.GetDirectoryName(Path))
Dim UnlockLater As Boolean = False
If Not RequestFile.IsLocked Then
UnlockLater = True
RequestFile.LockFile(ParentFolder.ID, .SourceCommand.mlParentWnd, CInt(EdmLockFlag.EdmLock_Simple))
End If
Dim CardVariables As IEdmEnumeratorVariable5 = RequestFile.GetEnumeratorVariable
'We allow users to re-disposition a request so we want to keep any previous disposition information so it is not lost
Dim CardComment As String = String.Empty
Dim CardBy As String = String.Empty
Dim CardDate As String = String.Empty
Dim CardDisposition As String = String.Empty
Dim Success As Boolean
Const CommentVariable As String = "DispComm"
Const ByVariable As String = "DisposedBy"
Const DateVariable As String = "DisposedDate"
Const DispositionVariable As String = "Disposition"
Success = CardVariables.GetVar(DispositionVariable, "#", CardDisposition)
If Success Then
Success = CardVariables.GetVar(CommentVariable, "#", CardComment)
If Success Then Success = CardVariables.GetVar(ByVariable, "#", CardBy)
If Success Then Success = CardVariables.GetVar(DateVariable, "#", CardDate)
If Success Then CardComment = "Previously dispositioned as: """ & CardDisposition & """ by: " & CardBy & " on: " & CardDate & vbNewLine &
"---------Previous disposition explanation---------" & vbNewLine & CardComment
End If
Dim UserManager As IEdmUserMgr5 = .SourceVault
Dim User As IEdmUser5 = UserManager.GetLoggedInUser
CardComment = UserComment & CardComment
CardDate = Today().ToString("yyMMdd", Globalization.CultureInfo.InvariantCulture)
CardBy = User.Name
CardDisposition = UserDisposition
CardVariables.SetVar(DispositionVariable, "#", CardDisposition)
CardVariables.SetVar(CommentVariable, "#", CardComment)
CardVariables.SetVar(ByVariable, "#", CardBy)
CardVariables.SetVar(DateVariable, "#", CardDate)
CardVariables.Flush()
If UnlockLater Then RequestFile.UnlockFile(lParentWnd:= .SourceCommand.mlParentWnd,
bsComment:="Dispositioned as " & CardDisposition,
lEdmUnlockFlags:=0)
.SourceVault.RefreshFolder(ParentFolder.LocalPath)
End With
Next
End Sub
From the documentation:
bsCfgName : Name of configuration or layout to which to store the variable value; empty string for folders and file types that do not support configurations
I was working with a virtual file, which did not support configurations.
I saw a C example working with a virtual file and they were passing null references, so I reread the documentation and saw that excerpt above, so I changed my code from "#" to String.Empty for the mboconfiguration argument and now it is working!
CardVariables.SetVar(DispositionVariable, String.Empty, CardDisposition)
CardVariables.SetVar(CommentVariable, String.Empty, CardComment)
CardVariables.SetVar(ByVariable, String.Empty, CardBy)
CardVariables.SetVar(DateVariable, String.Empty, CardDate)
CardVariables.Flush()
I'm trying to get the ip address of my local PC, and one one of my other PCs it gets the v4 address fine, but on this one the code:
Dns.GetHostEntry(Dns.GetHostName).AddressList(0).ToString()
returns what I guess is a IPv6 address:
fe80::9c09:e2e:4736:4c62%11
How do I get the IPv4 address?
Disclaimer- I don't have IPv6 installed and there is probably a much better way to do this, but what does the following return:
Dns.GetHostEntry(Dns.GetHostName()).AddressList
.Where(a => !a.IsIPv6LinkLocal && !a.IsIPv6Multicast && !a.IsIPv6SiteLocal)
.First()
.ToString();
Edit - didn't notice you were asking in VB, so I've tried translating it to:
Dim s As String = Dns.GetHostEntry(Dns.GetHostName()).AddressList _
.Where(Function(a As IPAddress) Not a.IsIPv6LinkLocal AndAlso Not a.IsIPv6Multicast AndAlso Not a.IsIPv6SiteLocal) _
.First() _
.ToString()
This may blow up, so don't treat it as production code.
Here's my solution for getting a routable IPv4 IP without using an external service:
Function GetLocalIP() As String
Dim IPList As System.Net.IPHostEntry = System.Net.Dns.GetHostEntry(System.Net.Dns.GetHostName)
For Each IPaddress In IPList.AddressList
'Only return IPv4 routable IPs
If (IPaddress.AddressFamily = Sockets.AddressFamily.InterNetwork) AndAlso (Not IsPrivateIP(IPaddress.ToString)) Then
Return IPaddress.ToString
End If
Next
Return ""
End Function
Function IsPrivateIP(ByVal CheckIP As String) As Boolean
Dim Quad1, Quad2 As Integer
Quad1 = CInt(CheckIP.Substring(0, CheckIP.IndexOf(".")))
Quad2 = CInt(CheckIP.Substring(CheckIP.IndexOf(".") + 1).Substring(0, CheckIP.IndexOf(".")))
Select Case Quad1
Case 10
Return True
Case 172
If Quad2 >= 16 And Quad2 <= 31 Then Return True
Case 192
If Quad2 = 168 Then Return True
End Select
Return False
End Function
Note that my code is also verifying that the range is routable (IsPrivateIP). You can remove or modify that part if you are looking for something else.
I used a combined Cmd/Visual Basic code and it worked :
Dim ResString As String = "result.txt"
If File.Exists("result.txt") Then
File.Delete("result.txt")
End If
Shell("cmd.exe /c cd " & Application.StartupPath & " && ipconfig >> " & ResString & "&& exit", AppWinStyle.NormalFocus)
Dim Ipv4 As String
Dim Ipv4Found As Boolean = False
Dim Ipv4Char As Integer = 43
Dim Ipv4Str As String
Threading.Thread.Sleep(1500)
'Wait some seconds to create "result.txt"
Dim Ipv4Reader As StreamReader
Ipv4Reader = File.OpenText("result.txt")
Do Until Ipv4Found = True
Ipv4Str = Ipv4Reader.ReadLine()
If Not Ipv4Str = Nothing Then
If Ipv4Str.Contains("IPv4") Then
Try
Ipv4 = Ipv4Str.Chars(Ipv4Char)
Do Until Ipv4Char = 60
Ipv4Char = Ipv4Char + 1
Ipv4 = Ipv4 & Ipv4Str.Chars(Ipv4Char)
'Read results step by step
Loop
Catch ex As Exception
End Try
MsgBox("Your IPv4 Address is " & Ipv4)
Ipv4Found = True
Ipv4Reader.Close()
End If
Else
End If
Loop
If your computer language is english you may have some unusual characters in the IPv4 String ( My pc is actually in Italian )
I think you should use this:
Dim tmpHostName As String = System.Net.Dns.GetHostName()
myIPaddress = System.Net.Dns.GetHostByName(tmpHostName).AddressList(0).ToString()
GetHostByName is obsolete but this is the way to get the IPv4. Why? Because the getbyhostname function is created before IPv6 so the function get only the IPv4 connection, not the fe80::9c09:e2e:4736:4c62%11.
Something maybe fun is this little function that'll show all IP addresses on your computer:
Public Function getOwnIp() As String
Dim hostIP As IPHostEntry = Dns.GetHostEntry(Dns.GetHostName())
Dim position As Integer = 0
Dim ip As String = Nothing
While ipList < hostIP.AddressList.Length
ip += hostIP.AddressList(position).ToString & vbCrLf
position += 1
End While`enter code here`
Return ip
End Function
I was looking for the answer to this question myself and I could not find one suitable to my needs. I managed to experiment with various answers across the net until I came up with this (works great!). Just thought I would share since this post is the top result via Google.
''''Routine to fetch IPv4 Network addresses for all local network interfaces.
Dim adapters As NetworkInterface() = NetworkInterface.GetAllNetworkInterfaces()
Dim adapter As NetworkInterface
For Each adapter In adapters
Dim properties As IPInterfaceProperties = adapter.GetIPProperties()
If properties.UnicastAddresses.Count > 0 Then
For Each unicastadress As UnicastIPAddressInformation In properties.UnicastAddresses
Dim ip As IPAddress = unicastadress.Address
If ip.AddressFamily = AddressFamily.InterNetwork Then
ComboBox1.Items.Add(ip.ToString)
End If
Next unicastadress
End If
Next adapter
You first need to import the system namespace into your application and then create an instance of the System.Net.NetworkInformation.IPAddressInformation and use it as such
Example
Imports system.data.sqlclient
imports system
Public class Form1
Dim IPAdd As System.Net.NetworkInformation.IPAddressInformation
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
MsgBox("My IP Address is " & IPAdd.Address.ToString)
End Sub
End Class
Dim localIp As IPHostEntry = Dns.GetHostEntry(Dns.GetHostName())
txtLocal.Text = localIp.AddressList(1).ToString
Notice that I changed the (0) index to (1).
This one works on my side
Dim IPaddressList = System.Net.Dns.GetHostEntry(System.Net.Dns.GetHostName()).AddressList
Dim IPaddrPC As String = ""
For Each item In IPaddressList
If item.AddressFamily = Net.Sockets.AddressFamily.InterNetwork Then
IPaddrPC = item.Address.ToString
Exit For
End If
Next
Is there any way, in either VBA or C# code, to get a list of the existing macros defined in a workbook?
Ideally, this list would have a method definition signatures, but just getting a list of the available macros would be great.
Is this possible?
I haven't done vba for Excel in a long time, but if I remember well, the object model for the code was inaccessible through scripting.
When you try to access it, you receive the following error.
Run-time error '1004':
Programmatic access to Visual Basic Project is not trusted
Try:
Tools | Macro | Security |Trusted Publisher Tab
[x] Trust access to Visual Basic Project
Now that you have access to the VB IDE, you could probably export the modules and make a text search in them, using vba / c#, using regular expressions to find sub and function declarations, then delete the exported modules.
I'm not sure if there is an other way to do this, but this should work.
You can take a look the following link, to get started with exporting the modules.
http://www.developersdex.com/vb/message.asp?p=2677&ID=%3C4FCD0AE9-5DCB-4A96-8B3C-F19C63CD3635%40microsoft.com%3E
This is where I got the information about giving thrusted access to the VB IDE.
Building on Martin's answer, after you trust access to the VBP, you can use this set of code to get an array of all the public subroutines in an Excel workbook's VB Project. You can modify it to only include subs, or just funcs, or just private or just public...
Private Sub TryGetArrayOfDecs()
Dim Decs() As String
DumpProcedureDecsToArray Decs
End Sub
Public Function DumpProcedureDecsToArray(ByRef Result() As String, Optional InDoc As Excel.Workbook) As Boolean
Dim VBProj As Object
Dim VBComp As Object
Dim VBMod As Object
If InDoc Is Nothing Then Set InDoc = ThisWorkbook
ReDim Result(1 To 1500, 1 To 4)
DumpProcedureDecsToArray = True
On Error GoTo PROC_ERR
Set VBProj = InDoc.VBProject
Dim FuncNum As Long
Dim FuncDec As String
For Each VBComp In VBProj.vbcomponents
Set VBMod = VBComp.CodeModule
For i = 1 To VBMod.countoflines
If IsSubroutineDeclaration(VBMod.Lines(i, 1)) Then
FuncDec = RemoveBlanksAndDecsFromSubDec(RemoveAsVariant(VBMod.Lines(i, 1)))
If LCase(Left(VBMod.Lines(i, 1), Len("private"))) <> "private" Then
FuncNum = FuncNum + 1
Result(FuncNum, 1) = FindToLeftOfString(InDoc.Name, ".") '
Result(FuncNum, 2) = VBMod.Name
Result(FuncNum, 3) = GetSubName(FuncDec)
Result(FuncNum, 4) = VBProj.Name
End If
End If
Next i
Next VBComp
PROC_END:
Exit Function
PROC_ERR:
GoTo PROC_END
End Function
Private Function RemoveCharFromLeftOfString(TheString As String, RemoveChar As String) As String
Dim Result As String
Result = TheString
While LCase(Left(Result, Len(RemoveChar))) = LCase(RemoveChar)
Result = Right(Result, Len(Result) - Len(RemoveChar))
Wend
RemoveCharFromLeftOfString = Result
End Function
Private Function RemoveBlanksAndDecsFromSubDec(TheLine As String) As String
Dim Result As String
Result = TheLine
Result = RemoveCharFromLeftOfString(Result, " ")
Result = RemoveCharFromLeftOfString(Result, " ")
Result = RemoveCharFromLeftOfString(Result, "Public ")
Result = RemoveCharFromLeftOfString(Result, "Private ")
Result = RemoveCharFromLeftOfString(Result, " ")
RemoveBlanksAndDecsFromSubDec = Result
End Function
Private Function RemoveAsVariant(TheLine As String) As String
Dim Result As String
Result = TheLine
Result = Replace(Result, "As Variant", "")
Result = Replace(Result, "As String", "")
Result = Replace(Result, "Function", "")
If InStr(1, Result, "( ") = 0 Then
Result = Replace(Result, "(", "( ")
End If
RemoveAsVariant = Result
End Function
Private Function IsSubroutineDeclaration(TheLine As String) As Boolean
If LCase(Left(RemoveBlanksAndDecsFromSubDec(TheLine), Len("Function "))) = "function " Or LCase(Left(RemoveBlanksAndDecsFromSubDec(TheLine), Len("sub "))) = "sub " Then
IsSubroutineDeclaration = True
End If
End Function
Private Function GetSubName(DecLine As String) As String
GetSubName = FindToRightOfString(FindToLeftOfString(DecLine, "("), " ")
End Function
Function FindToLeftOfString(FullString As String, ToFind As String) As String
If FullString = "" Then Exit Function
Dim Result As String, ToFindPos As Integer
ToFindPos = InStr(1, FullString, ToFind, vbTextCompare)
If ToFindPos > 0 Then
Result = Left(FullString, ToFindPos - 1)
Else
Result = FullString
End If
FindToLeftOfString = Result
End Function
Function FindToRightOfString(FullString As String, ToFind As String) As String
If FullString = "" Then Exit Function
Dim Result As String, ToFindPos As Integer
ToFindPos = InStr(1, FullString, ToFind, vbTextCompare)
Result = Right(FullString, Len(FullString) - ToFindPos + 1 - Len(ToFind))
If ToFindPos > 0 Then
FindToRightOfString = Result
Else
FindToRightOfString = FullString
End If
End Function