Please see the code below:
Private Shared ReadOnly log As ILog = LogManager.GetLogger(GetType(ScheduledTasks))
Private Shared TestString As String = ""
Public Shared Sub writeConsole(ByVal i As Integer)
System.Threading.Thread.Sleep(1000)
TestString = TestString & i
End Sub
Public Shared Sub ParallelTest()
Dim int1 As Integer = 1, int2 As Integer = 2, int3 As Integer = 3, int4 As Integer = 4, int5 As Integer = 5, int6 As Integer = 6, int7 As Integer = 7, int8 As Integer = 8, int9 As Integer = 9, int10 As Integer = 10
Dim list As List(Of Integer) = New List(Of Integer)
list.Add(int1)
list.Add(int2)
list.Add(int3)
list.Add(int4)
list.Add(int5)
list.Add(int6)
list.Add(int7)
list.Add(int8)
list.Add(int9)
list.Add(int10)
Dim ParallelOptions As ParallelOptions = New ParallelOptions
ParallelOptions.MaxDegreeOfParallelism = 1 ' Environment.ProcessorCount * 10
Parallel.ForEach(Of Integer)(list.AsEnumerable(),
Sub(test As Integer)
writeConsole(test)
End Sub)
MsgBox("got here")
When the code reaches the message box, TestString contains the following value: 16237594810. I would expect it to be: 12345678910. It seems to indicate that multiple threads are being used even though MaxDegreeOfParallelism is set to: 1. Why is this?
Related
I have a generic class that will sort a data object on any property that is specified. It sorts by Ascii or a Alphanumerical sort, ascending or decending. Based upon the code here which is also elsewhere.
What I would like to do is simplify the calling of this. I have to use
Data.Sort(New PropertyComparer(Of Plane)("TailNumber",
PropertyComparer(Of Plane).SortDirectionType.Ascending,
PropertyComparer(Of Plane).SortTypeType.AlphaNumeric))
Is there a way to reduce the length of the passed parameters SortDirectionType and SortTypeType?
Sub TestPropertySort()
Dim Data = GetData()
Data.Sort(New PropertyComparer(Of Plane)("TailNumber",
PropertyComparer(Of Plane).SortDirectionType.Ascending,
PropertyComparer(Of Plane).SortTypeType.AlphaNumeric))
print(Data, "Plane sort")
End Sub
Private Function GetData() As List(Of Plane)
Dim Planes As New List(Of Plane)
Planes.Add(New Plane("81192", "Shenyang J-8II"))
Planes.Add(New Plane("30+91", "Eurofighter Typhoon"))
Planes.Add(New Plane("084", "General Dynamics F-16 Fighting Falcon"))
Planes.Add(New Plane("83", "Test3"))
Planes.Add(New Plane("A16-97", "Lockheed Hudson"))
Planes.Add(New Plane("L9162", "Avro Anson"))
Planes.Add(New Plane("CH-06", "Lockheed C-130 Hercules"))
Planes.Add(New Plane("CC-06", "Test 2"))
Planes.Add(New Plane("967", "Test 1"))
Planes.Add(New Plane("966", "CASA C-212 Aviocar 300DF"))
Return Planes
End Function
Public Class PropertyComparer(Of T)
Implements IComparer(Of T)
Public Enum SortDirectionType
Descending = -1
Ascending = 1
End Enum
Public Enum SortTypeType
Ascii
AlphaNumeric
End Enum
Private SortPropertyName As String = ""
Private SortDirection As SortDirectionType
Private SortType As SortTypeType
Public Sub New(ByVal PropertyName As String)
SortPropertyName = PropertyName
SortDirection = SortDirectionType.Ascending
Me.SortType = SortTypeType.Ascii
End Sub
Public Sub New(ByVal PropertyName As String, ByVal Direction As SortDirectionType)
SortPropertyName = PropertyName
SortDirection = Direction
Me.SortType = SortTypeType.Ascii
End Sub
Public Sub New(ByVal PropertyName As String, ByVal Direction As SortDirectionType, ByVal SortType As SortTypeType)
SortPropertyName = PropertyName
SortDirection = Direction
Me.SortType = SortType
End Sub
Public Function Compare(ByVal x As T, ByVal y As T) As Integer Implements System.Collections.Generic.
IComparer(Of T).Compare
'The first thing Compare does is get the PropertyInfo record for the x and y arguments
Dim PropertyX As PropertyInfo = x.GetType().GetProperty(SortPropertyName)
If PropertyX Is Nothing Then Throw New Exception("Sorting on property '" & SortPropertyName & "' bt that property does not exist in the class")
Dim PropertyY As PropertyInfo = y.GetType().GetProperty(SortPropertyName)
If PropertyX Is Nothing Then Throw New Exception("Sorting on property '" & SortPropertyName & "' bt that property does not exist in the class")
'Obtain the value of the property using the argument's x and y and the PropertyInfo record
Dim px As Object = PropertyX.GetValue(x, Nothing)
Dim py As Object = PropertyY.GetValue(y, Nothing)
If SortType = SortTypeType.AlphaNumeric Then
Return CompareAlphaNumeric(Of String)(CType(px, String), CType(py, String)) * SortDirection
Else
'Inspects the type of the property to determine how to call the Compare method implemented at the end of the class.
'The Compare method implemented has a where predicate that limits the types of the parameter K to those that implement IComparable.
'The reason for this Is that IComparable types implement CompareTo.
If (TypeOf px Is Integer) Then Return Compare(Of Integer)(CType(px, Integer), CType(py, Integer)) * SortDirection
If (TypeOf px Is Decimal) Then Return Compare(Of Decimal)(CType(px, Decimal), CType(py, Decimal)) * SortDirection
If (TypeOf px Is Date) Then Return Compare(Of Date)(CType(px, Date), CType(py, Date)) * SortDirection
If (TypeOf px Is Double) Then Return Compare(Of Double)(CType(px, Double), CType(py, Double)) * SortDirection
If (TypeOf px Is String) Then Return Compare(Of String)(CType(px, String), CType(py, String)) * SortDirection
End If
Dim methodX As MethodInfo = PropertyX.GetType().GetMethod("CompareTo")
If (methodX Is Nothing = False) Then
Return CType(methodX.Invoke(px, New Object() {py}), Integer) * SortDirection
Else
Return 0
End If
End Function
Private Function Compare(Of K As IComparable)(ByVal x As K, ByVal y As K) As Integer
Return x.CompareTo(y)
End Function
Public Function CompareAlphaNumeric(Of K As IComparable)(ByVal X As String, ByVal Y As String) As Integer
'Validate the arguments.
If X = Nothing Then Return 0
If Y = Nothing Then Return 0
Dim LengthX As Integer = X.Length
Dim LengthY As Integer = Y.Length
Dim Marker1 As Integer = 0
Dim Marker2 As Integer = 0
'Loop over both Strings.
While Marker1 < LengthX And Marker2 < LengthY
Dim Char1 As Char = X(Marker1)
Dim Char2 As Char = Y(Marker2)
Dim TempX(LengthX) As Char
Dim IndexX As Integer = 0
Dim TempY(LengthY) As Char
Dim IndexY As Integer = 0
'Collect digits for String one.
Do
TempX(IndexX) = Char1
IndexX += 1
Marker1 += 1
If Marker1 < LengthX Then
Char1 = X(Marker1)
Else
Exit Do
End If
Loop While Char.IsDigit(Char1) = Char.IsDigit(TempX(0))
'Collect digits for String two.
Do
TempY(IndexY) = Char2
IndexY += 1
Marker2 += 1
If Marker2 < LengthY Then
Char2 = Y(Marker2)
Else
Exit Do
End If
Loop While Char.IsDigit(Char2) = Char.IsDigit(TempY(0))
'Convert to Strings.
Dim StrX = New String(TempX)
Dim StrY = New String(TempY)
'Parse Strings into Integers.
Dim Result As Integer
If Char.IsDigit(TempX(0)) And Char.IsDigit(TempY(0)) Then
Dim ThisNumericChunk = Integer.Parse(StrX)
Dim ThatNumericChunk = Integer.Parse(StrY)
Result = ThisNumericChunk.CompareTo(ThatNumericChunk)
Else
Result = StrX.CompareTo(StrY)
End If
'Return result if not equal.
If Not Result = 0 Then
Return Result
End If
End While
'Compare lengths.
Return LengthX - LengthY
End Function
End Class
I am working on a Generic Undoclass for a number of custom controls and got stuck when trying to implement undo for multiselect listboxes.
the Undo Class:
Public Class UndoClass(Of T)
Private FirstValue As T
Private PrevValue As T
Private CurrentValue As T
Private HasValue As Boolean
Public Sub Add(ByVal Item As T)
If Not HasValue Then
FirstValue = Item
PrevValue = Item
HasValue = True
ElseIf Not CurrentValue.Equals(Item) Then
If Not CurrentValue.Equals(FirstValue) Then PrevValue = CurrentValue
End If
CurrentValue = Item
End Sub
and some undo code. In the custom Listbox class I added:
dim undoing as new UndoClass(Of SelectedIndexCollection)
Protected Overrides Sub OnEnter(e As EventArgs)
undoing.add(me.SelectedIndices)
....
Protected Overrides Sub OnSelectedIndexChanged(e As EventArgs)
if me.SelectedIndex>=0 then undoing.add(me.selectedIndices)
....
The problem I encountered was that the passed "Item" did not expose the same properties as the originating SelectedIndices properties and therefore the CurrentValue.equals(item) test always fails. Although vs helpfile clearly states that the selectedIndices is a "ListBox.SelectedIndexCollection containing the indexes of the currently selected items in the control" the way I did it does not work (it works with all my other controls where I just pass their .text values as strings or .Checked values as Boolean etc...).
What did I do wrong ?
I think I found a way to solve it (just a test routine so I used function returning test info instead of methods and short variable names):
Public Class TestListClass(Of T)
Dim Current As New List(Of T)
Dim Prev As New List(Of T)
Public Function add(T1 As List(Of T)) As String
Dim s As String = String.Empty
If T1.GetType.IsGenericType Then ' better safe then sorry and we'll need that in the final version
Dim ar As Type() = T1.GetType.GenericTypeArguments
s = ar(0).ToString
End If
If Current.Count = 0 Then
For Each X As T In T1
Current.Add(X)
Next
Return "created " & s & vbNewLine
Else
If Prev.Count > 0 Then Prev.Clear()
For Each X As T In Current
Prev.Add(X)
Next
Current.Clear()
For Each X As T In T1
Current.Add(X)
Next
Return "pushed " & s & vbNewLine
End If
End Function
Public Function Listing() As String
Dim S As String = String.Empty
If Prev.Count > 0 Then
S &= "Prev= " & Enumerate(Prev) & vbNewLine
End If
If Current.Count > 0 Then
S &= "Current= " & Enumerate(Current) & vbNewLine
End If
Return S
End Function
Private Function Enumerate(T1 As List(Of T)) As String
Dim s As String = String.Empty
For I = 0 To T1.Count - 1
s &= T1.Item(I).ToString & csComa
Next
Return s
End Function
Public Function Compare(T1 As List(Of T)) As String
Dim s As String = Enumerate(T1)
If ListsSame(Current, T1) Then
s &= "is same as current! (" & Enumerate(Current) & ")"
ElseIf ListsSame(Prev, T1) Then
s &= "is same as Previous! (" & Enumerate(Prev) & ")"
Else
s &= "does not match!"
End If
Return s & vbNewLine
End Function
Private Function ListsSame(T1 As List(Of T), T2 As List(Of T)) As Boolean
Dim ok As Boolean = False
If T1.Count > T2.Count Then
ok = T1.Except(T2).Any
Else
ok = T2.Except(T1).Any
End If
Return Not ok
End Function
End Class
I had to iterate through the list in the 'add' routine as the equality operator would create a reference to the current value instead of copying the content
The test code:
Dim t1 As New TestListClass(Of Integer), l1 As New List(Of Integer), t2 As New TestListClass(Of String), l2 As New List(Of String)
Dim x1() As Integer = {1, 2, 3, 4, 5}
l1.AddRange(x1)
Me.txtResult.Text = t1.add(l1)
Dim y1() As Integer = {6, 7, 8}
Dim l11 As New List(Of Integer)
l11.AddRange(y1)
Me.txtResult.Text &= t1.add(l11)
Me.txtResult.Text &= t1.Listing
Me.txtResult.Text &= t1.Compare(l1)
Me.txtResult.Text &= t1.Compare(l11)
l11.Add(9)
Me.txtResult.Text &= t1.Compare(l11)
Dim x2() As String = {"10", "20", "30"}
l2.AddRange(x2)
Me.txtResult.Text &= t2.add(l2)
Dim y2() As String = {"a", "b", "c"}
Dim l22 As New List(Of String)
l22.AddRange(y2)
Me.txtResult.Text &= t2.add(l22)
Me.txtResult.Text &= t2.Listing
Me.txtResult.Text &= t2.Compare(l2)
Me.txtResult.Text &= t2.Compare(l22)
l22.Add("d")
Me.txtResult.Text &= t2.Compare(l22)
The output:
created System.Int32
pushed System.Int32
Prev= 1, 2, 3, 4, 5,
Current= 6, 7, 8,
1, 2, 3, 4, 5, is same as Previous! (1, 2, 3, 4, 5, )
6, 7, 8, is same as current! (6, 7, 8, )
6, 7, 8, 9, does not match!
created System.String
pushed System.String
Prev= 10, 20, 30,
Current= a, b, c,
10, 20, 30, is same as Previous! (10, 20, 30, )
a, b, c, is same as current! (a, b, c, )
a, b, c, d, does not match!
Next I intend to split the operations based on gettype.IsgenericType when selectedItem or SelectedValue is passed as base variables.
I have this function which return all TCP connections for all proccess
Declare Auto Function GetExtendedTcpTable Lib "iphlpapi.dll" (ByVal pTCPTable As IntPtr, ByRef OutLen As Integer, ByVal Sort As Boolean, ByVal IpVersion As Integer, ByVal dwClass As Integer, ByVal Reserved As Integer) As Integer
Const TCP_TABLE_OWNER_PID_ALL As Integer = 5
<StructLayout(LayoutKind.Sequential)> _
Public Structure MIB_TCPTABLE_OWNER_PID
Public NumberOfEntries As Integer 'number of rows
Public Table As IntPtr 'array of tables
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure MIB_TCPROW_OWNER_PID
Public state As Integer 'state of the connection
Public localAddress As UInteger
Public LocalPort As Integer
Public RemoteAddress As UInteger
Public remotePort As Integer
Public PID As Integer 'Process ID
End Structure
Structure TcpConnection
Public State As TcpState
Public localAddress As String
Public LocalPort As Integer
Public RemoteAddress As String
Public remotePort As Integer
Public Proc As String
End Structure
Function GetAllTCPConnections() As MIB_TCPROW_OWNER_PID()
GetAllTCPConnections = Nothing
Dim cb As Integer
GetExtendedTcpTable(Nothing, cb, False, 2, TCP_TABLE_OWNER_PID_ALL, 0)
Dim tcptable As IntPtr = Marshal.AllocHGlobal(cb)
If GetExtendedTcpTable(tcptable, cb, False, 2, TCP_TABLE_OWNER_PID_ALL, 0) = 0 Then
Dim tab As MIB_TCPTABLE_OWNER_PID = Marshal.PtrToStructure(tcptable, GetType(MIB_TCPTABLE_OWNER_PID))
Dim Mibs(tab.NumberOfEntries - 1) As MIB_TCPROW_OWNER_PID
Dim row As IntPtr
For i As Integer = 0 To tab.NumberOfEntries - 1
row = New IntPtr(tcptable.ToInt32 + Marshal.SizeOf(tab.NumberOfEntries) + Marshal.SizeOf(GetType(MIB_TCPROW_OWNER_PID)) * i)
Mibs(i) = Marshal.PtrToStructure(row, GetType(MIB_TCPROW_OWNER_PID))
Next
GetAllTCPConnections = Mibs
End If
Marshal.FreeHGlobal(tcptable)
End Function
Function MIB_ROW_To_TCP(ByVal row As MIB_TCPROW_OWNER_PID) As TcpConnection
Dim tcp As New TcpConnection
tcp.State = DirectCast(row.state, TcpState) 'a State enum is better than an int
Dim ipad As New IPAddress(row.localAddress)
tcp.localAddress = ipad.ToString
tcp.LocalPort = row.LocalPort / 256 + (row.LocalPort Mod 256) * 256
ipad = New IPAddress(row.RemoteAddress)
tcp.RemoteAddress = ipad.ToString
tcp.remotePort = row.remotePort / 256 + (row.remotePort Mod 256) * 256
Dim p As Process = Process.GetProcessById(row.PID)
tcp.Proc = p.ProcessName
p.Dispose()
Return tcp
End Function
I wan't to store only the out going connections of certain processes in a text file so I used
Sub main()
For Each Row In GetAllTCPConnections()
Dim Tcp As TcpConnection = MIB_ROW_To_TCP(Row)
Dim RemoteAddress As String = Tcp.RemoteAddress.ToString
Dim process As String = Tcp.Proc
If (process = "chrome" Or process = "Viber" Or process = "ddns") And (RemoteAddress <> "127.0.0.1") And (RemoteAddress <> "0.0.0.0") Then
Dim myFile As String = "C:\TCP.txt"
Using sw As StreamWriter = New StreamWriter(myFile)
Dim line As String = Tcp.RemoteAddress & "|" & Tcp.localAddress & "|" & Tcp.LocalPort & "|" & Tcp.Proc
sw.WriteLine(line)
MsgBox(line)
End Using
End If
Next
End Sub
msgbox works fine showing every process and out going connections that established by it but when I open
TCP.txt
file I only find one line.
So how to write the entire results (Each process with its out going connections) to the text file?
You need to set the append to text file.
You need to change:
Using sw As StreamWriter = New StreamWriter(myFile)
To
Using sw As StreamWriter = New StreamWriter(myFile, True)
By setting the true you set the append to file to true
How would I generate combinations of 2 lowercase/upercase letters/numbers in order?
Sub Main()
Dim Looper As Boolean = True
While Looper = True
'String = "aa", "Aa", "aA", "AA"
'WebClient.DownloadString("link.com/" & String")
End While
End Sub
Like this, but generate combination for String
You could loop over a string and just manipulate upper and lower case as required:
Sub Main()
Dim results as List(of String) = new List(of String)()
For Each c as Char in "ABCDEFGHIJKLMNOPQRSTUVWXYZ".ToCharArray()
results.Add(c.ToString().ToLower() & c.ToString().ToLower())
results.Add(c.ToString() & c.ToString().ToLower())
results.Add(c.ToString().ToLower() & c.ToString())
results.Add(c.ToString() & c.ToString())
Next
End Sub
This will generate a combination of two random characters, including numbers and uppercase/lowercase letters:
Public Function GetRandomString(ByVal iLength As Integer) As String
Dim sResult As String = ""
Dim rdm As New Random()
For i As Integer = 1 To iLength
sResult &= ChrW(rdm.Next(32, 126))
Next
Return sResult
End Function
Or you can do the common random string defining the valid caracters:
Public Function GenerateRandomString(ByRef iLength As Integer) As String
Dim rdm As New Random()
Dim allowChrs() As Char = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLOMNOPQRSTUVWXYZ0123456789".ToCharArray()
Dim sResult As String = ""
For i As Integer = 0 To iLength - 1
sResult += allowChrs(rdm.Next(0, allowChrs.Length))
Next
Return sResult
End Function
I need to randomize ALL the lines inside a text file and then save the unsorted lines by replacing the same text file.
How I can do all that?
Dim filepath as String = "text_path"
Dim arr() As String = File.ReadAlllines(filepath)
Dim a As Random
Dim b(str.Length) As Integer
Dim result=1, c As Integer
File.Delete(filepath)
Dim f As StreamWriter = File.AppendText(filepath)
For i = 0 To str.Length
while(result)
result = 0
c = a.Next(0, str.Length)
For j = 0 To b.Length
If b(j) = c Then result = 1
Next
end while
f.WriteLine(arr(c))
Next
f.Close()
Another take on it:
Imports System.IO
Module Module1
Sub CreateFile(destFile As String)
Using sw = New StreamWriter(destFile)
For i = 1 To 200
sw.WriteLine("Line " & i.ToString)
Next
End Using
End Sub
Function RandomList(nNumbers As Integer) As List(Of Integer)
' generate a List of numbers from 0..nNumbers-1 in a random order.
Dim ns As New List(Of Integer)
Dim rnd As New Random
For i = 0 To nNumbers - 1
ns.Insert(rnd.Next(0, i + 1), i)
Next
Return ns
End Function
Sub RandomiseFile(srcFile As String)
Dim lines = File.ReadAllLines(srcFile)
Dim nLines = lines.Count
Dim randomNumbers = RandomList(nLines)
' use a temporary file in case something goes wrong so that
' the original file is still there.
Dim tmpFile = Path.GetTempFileName()
' output the lines in a random order.
Using sw = New StreamWriter(tmpFile)
For i = 0 To nLines - 1
sw.WriteLine(lines(randomNumbers(i)))
Next
End Using
File.Delete(srcFile)
File.Move(tmpFile, srcFile)
End Sub
Sub Main()
Dim fileToUse As String = "C:\temp\makerandom.txt"
CreateFile(fileToUse)
RandomiseFile(fileToUse)
End Sub
End Module
Here is my take on it:
Dim linesList As New List(Of String)(IO.File.ReadAllLines("filepath"))
Dim newLinesList As New List(Of String)
Randomize()
While linesList.Count > 0
Dim randomIndex As Integer = Math.Floor(Rnd() * linesList.Count)
newLinesList.Add(linesList(randomIndex))
linesList.RemoveAt(randomIndex)
End While
IO.File.WriteAllLines("filepath", newLinesList.ToArray)