I found one code which auto-change proxies from own text file located in computer.
Now I would like to rather this get path from my own URL where I store my private list of proxies, so what I have to change in the code please? and could also someone explain why? thank you.
Imports System
Imports System.Runtime.InteropServices
Imports System.IO
Imports Microsoft.VisualBasic
Imports System.Timers
Public Class Form1
Dim FILE_NAME As String = "C:\Users\name\Documents\proxylist.txt"
Dim label As String
Public proxy(2000) As String
Public index As Integer = 0
Public max_proxys As Integer = 0
Dim a As String
Dim start_check As Integer = 0
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
If (start_check > 0) Then
index = 0
Do While index <> max_proxys
proxy(index) = ""
index = index + 1
Loop
If TextBox3.Text = "" Then
FILE_NAME = "C:\Users\name\Documents\proxylist.txt"
End If
End If
If TextBox3.Text <> "" Then
FILE_NAME = TextBox3.Text
End If
Try
Dim reader As StreamReader = My.Computer.FileSystem.OpenTextFileReader(FILE_NAME)
index = 0
Do While reader.Peek <> -1
a = reader.ReadLine
proxy(index) = a.ToString
index = index + 1
Loop
max_proxys = index
reader.Close()
Catch ex As Exception
MessageBox.Show("File Not Found")
Timer1.Stop()
End Try
label = "true"
index = 0
TextBox1.Text = proxy(0)
If TextBox2.Text = "" Then
Timer1.Interval = 1000 'ms
Else
Try
Dim a As Integer = Convert.ToDecimal(TextBox2.Text)
Timer1.Interval = a * 1000 'ms
Catch ex As Exception
MessageBox.Show(ex.Message & "Please Enter Valid Time in Seconds ")
If Timer1.Enabled Then
Timer1.Stop()
End If
End Try
End If
start_check = 1
Timer1.Start()
End Sub
Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
label = "false"
End Sub
Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
Dim clsProxy As New IEProxy
clsProxy.DisableProxy()
End Sub
Private Sub Timer1_Tick_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Timer1.Stop()
TextBox1.Text = proxy(index)
index = index + 1
Dim clsProxy As New IEProxy
If clsProxy.SetProxy(TextBox1.Text) Then
MessageBox.Show("Proxy successfully enabled.", "Success", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
MessageBox.Show("Error enabling proxy.", "Failed", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End If
If index >= max_proxys Then
index = 0
End If
If label.Equals("false") Then
Timer1.Stop()
End If
End Sub
End Class
Public Class IEProxy
Public Enum Options
INTERNET_PER_CONN_FLAGS = 1
INTERNET_PER_CONN_PROXY_SERVER = 2
INTERNET_PER_CONN_PROXY_BYPASS = 3
INTERNET_PER_CONN_AUTOCONFIG_URL = 4
INTERNET_PER_CONN_AUTODISCOVERY_FLAGS = 5
INTERNET_OPTION_REFRESH = 37
INTERNET_OPTION_PER_CONNECTION_OPTION = 75
INTERNET_OPTION_SETTINGS_CHANGED = 39
PROXY_TYPE_PROXY = &H2
PROXY_TYPE_DIRECT = &H1
End Enum
<StructLayout(LayoutKind.Sequential)> _
Private Class FILETIME
Public dwLowDateTime As Integer
Public dwHighDateTime As Integer
End Class
<StructLayout(LayoutKind.Explicit, Size:=12)> _
Private Structure INTERNET_PER_CONN_OPTION
<FieldOffset(0)> Dim dwOption As Integer
<FieldOffset(4)> Dim dwValue As Integer
<FieldOffset(4)> Dim pszValue As IntPtr
<FieldOffset(4)> Dim ftValue As IntPtr
Public Function GetBytes() As Byte()
Dim b(12) As Byte
BitConverter.GetBytes(dwOption).CopyTo(b, 0)
Select Case dwOption
Case Options.INTERNET_PER_CONN_FLAGS
BitConverter.GetBytes(dwValue).CopyTo(b, 4)
Case Options.INTERNET_PER_CONN_PROXY_BYPASS
BitConverter.GetBytes(pszValue.ToInt32()).CopyTo(b, 4)
Case Options.INTERNET_PER_CONN_PROXY_SERVER
BitConverter.GetBytes(pszValue.ToInt32()).CopyTo(b, 4)
End Select
Return b
End Function
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Private Class INTERNET_PER_CONN_OPTION_LIST
Public dwSize As Integer
Public pszConnection As String
Public dwOptionCount As Integer
Public dwOptionError As Integer
Public pOptions As IntPtr
End Class
<StructLayout(LayoutKind.Sequential)> _
Private Class INTERNET_PROXY_INFO
Public dwAccessType As Integer
Public lpszProxy As IntPtr
Public lpszProxyBypass As IntPtr
End Class
Private Const ERROR_INSUFFICIENT_BUFFER = 122
Private Const INTERNET_OPTION_PROXY = 38
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
<DllImport("wininet.dll")> _
Private Shared Function InternetSetOption(ByVal hInternet As IntPtr, _
ByVal dwOption As Integer, _
ByVal lpBuffer As INTERNET_PER_CONN_OPTION_LIST, _
ByVal dwBufferLength As Integer) As Boolean
End Function
<DllImport("kernel32.dll")> _
Private Shared Function GetLastError() As Integer
End Function
Public Function SetProxy(ByVal proxy_full_addr As String) As Boolean
Dim bReturn As Boolean
Dim list As New INTERNET_PER_CONN_OPTION_LIST
Dim dwBufSize As Integer = Marshal.SizeOf(list)
Dim opts(3) As INTERNET_PER_CONN_OPTION
Dim opt_size As Integer = Marshal.SizeOf(opts(0))
list.dwSize = dwBufSize
list.pszConnection = ControlChars.NullChar
list.dwOptionCount = 3
'set flags
opts(0).dwOption = Options.INTERNET_PER_CONN_FLAGS
opts(0).dwValue = Options.PROXY_TYPE_DIRECT Or Options.PROXY_TYPE_PROXY
'set proxyname
opts(1).dwOption = Options.INTERNET_PER_CONN_PROXY_SERVER
opts(1).pszValue = Marshal.StringToHGlobalAnsi(proxy_full_addr)
'set override
opts(2).dwOption = Options.INTERNET_PER_CONN_PROXY_BYPASS
opts(2).pszValue = Marshal.StringToHGlobalAnsi("local")
Dim b(3 * opt_size) As Byte
opts(0).GetBytes().CopyTo(b, 0)
opts(1).GetBytes().CopyTo(b, opt_size)
opts(2).GetBytes().CopyTo(b, 2 * opt_size)
Dim ptr As IntPtr = Marshal.AllocCoTaskMem(3 * opt_size)
Marshal.Copy(b, 0, ptr, 3 * opt_size)
list.pOptions = ptr
'Set the options on the connection
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_PER_CONNECTION_OPTION, list, dwBufSize)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
'Notify existing Internet Explorer instances that the settings have changed
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_SETTINGS_CHANGED, Nothing, 0)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
'Flush the current IE proxy setting
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_REFRESH, Nothing, 0)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
Marshal.FreeHGlobal(opts(1).pszValue)
Marshal.FreeHGlobal(opts(2).pszValue)
Marshal.FreeCoTaskMem(ptr)
Return bReturn
End Function
Public Function DisableProxy() As Boolean
Dim bReturn As Boolean
Dim list As New INTERNET_PER_CONN_OPTION_LIST
Dim dwBufSize As Integer = Marshal.SizeOf(list)
Dim opts(0) As INTERNET_PER_CONN_OPTION
Dim opt_size As Integer = Marshal.SizeOf(opts(0))
list.dwSize = dwBufSize
list.pszConnection = ControlChars.NullChar
list.dwOptionCount = 1
opts(0).dwOption = Options.INTERNET_PER_CONN_FLAGS
opts(0).dwValue = Options.PROXY_TYPE_DIRECT
Dim b(opt_size) As Byte
opts(0).GetBytes().CopyTo(b, 0)
Dim ptr As IntPtr = Marshal.AllocCoTaskMem(opt_size)
Marshal.Copy(b, 0, ptr, opt_size)
list.pOptions = ptr
'Set the options on the connection
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_PER_CONNECTION_OPTION, list, dwBufSize)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
'Notify existing Internet Explorer instances that the settings have changed
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_SETTINGS_CHANGED, Nothing, 0)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
'Flush the current IE proxy setting
bReturn = InternetSetOption(IntPtr.Zero, Options.INTERNET_OPTION_REFRESH, Nothing, 0)
If Not bReturn Then
Debug.WriteLine(GetLastError)
End If
Marshal.FreeCoTaskMem(ptr)
Return bReturn
End Function
End Class
Maybe just download your url to the FILE_NAME location in your form's load event. Be warned that if there is a file at FILE_NAME, this sub I provide you will overwrite it.
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim YourURL As String = "http://www.yoururl.com/filename.ext"
Using w As New System.Net.WebClient
w.DownloadFile(YourURL, FILE_NAME)
End Using
End Sub
Related
I'm trying to get the IP address of the connected client but I don't know what I doing wrong. Where I can find it? I think near Sub AcceptClient. I was trying to convert cClient to string, but it always results to True or False. I'm trying to get the argument ar from cClient, which gives me an empty result.
Client.Client.RemoteEndPoint doesn't work or I can't use it correctly.
Form1.vb from Server project
Imports System.IO, System.Net, System.Net.Sockets
Public Class Form1
Dim Listener As TcpListener
Dim Client As TcpClient
Dim ClientList As New List(Of ChatClient)
Dim sReader As StreamReader
Dim cClient As ChatClient
Sub xLoad() Handles Me.Load
Listener = New TcpListener(IPAddress.Any, 3818)
Timer1.Start()
Listener.Start()
xUpdate("Server Started", False)
Listener.BeginAcceptTcpClient(New AsyncCallback(AddressOf AcceptClient), Listener)
End Sub
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
''Set view property
ListView1.View = View.Details
ListView1.GridLines = True
ListView1.FullRowSelect = True
'Add column header
ListView1.Columns.Add("Adres IP", 120)
ListView1.Columns.Add("Nazwa użytkownika", 120)
End Sub
Sub AcceptClient(ByVal ar As IAsyncResult)
cClient = New ChatClient(Listener.EndAcceptTcpClient(ar))
AddHandler(cClient.MessageRecieved), AddressOf MessageRecieved
AddHandler(cClient.ClientExited), AddressOf ClientExited
ClientList.Add(cClient)
xUpdate("New Client Joined", True)
Listener.BeginAcceptTcpClient(New AsyncCallback(AddressOf AcceptClient), Listener)
End Sub
Sub MessageRecieved(ByVal Str As String)
xUpdate(Str, True)
End Sub
Sub ClientExited(ByVal Client As ChatClient)
ClientList.Remove(Client)
xUpdate("Client Exited", True)
End Sub
Delegate Sub _xUpdate(ByVal Str As String, ByVal Relay As Boolean)
Sub xUpdate(ByVal Str As String, ByVal Relay As Boolean)
On Error Resume Next
If InvokeRequired Then
Invoke(New _xUpdate(AddressOf xUpdate), Str, Relay)
Else
Dim nStart As Integer
Dim nLast As Integer
If Str.Contains("</>") Then
nStart = InStr(Str, "</></>") + 7
nLast = InStr(Str, "<\><\>")
Str = Mid(Str, nStart, nLast - nStart)
'dzielenie strina po odpowiednim syymbolu na przed i po symbolu :D
Dim mystr As String = Str
Dim cut_at As String = ","
Dim x As Integer = InStr(mystr, cut_at)
Dim string_before As String = mystr.Substring(0, x - 1)
Dim string_after As String = mystr.Substring(x + cut_at.Length - 1)
Dim otherItems As String() = {string_after}
ListView1.Items.Add(string_before).SubItems.AddRange(otherItems) 'use SubItems
ElseIf Str.Contains("<A>") Then
nStart = InStr(Str, "<A>") + 4
nLast = InStr(Str, "<B>")
Str = Mid(Str, nStart, nLast - nStart)
ListBox2.Items.Add(Str & vbNewLine)
Else
TextBox1.AppendText(Str & vbNewLine)
If Relay Then Send(Str & vbNewLine)
End If
End If
End Sub
Private Sub TextBox2_KeyDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles TextBox2.KeyDown
If e.KeyCode = Keys.Enter Then
e.SuppressKeyPress = True
xUpdate("Server Says: " & TextBox2.Text, True)
TextBox2.Clear()
End If
End Sub
Sub Send(ByVal Str As String)
For i As Integer = 0 To ClientList.Count - 1
Try
ClientList(i).Send(Str)
Catch
ClientList.RemoveAt(i)
End Try
Next
End Sub
End Class
ChatClient.vb from Server project
Imports System.Net.Sockets, System.IO
Public Class ChatClient
Public Event MessageRecieved(ByVal Str As String)
Public Event ClientExited(ByVal Client As ChatClient)
Private sWriter As StreamWriter
Public Client As TcpClient
Sub New(ByVal xclient As TcpClient)
Client = xclient
client.GetStream.BeginRead(New Byte() {0}, 0, 0, AddressOf Read, Nothing)
End Sub
Private Sub Read()
Try
Dim sr As New StreamReader(Client.GetStream)
Dim msg As String = sr.ReadLine()
RaiseEvent MessageRecieved(msg)
Client.GetStream.BeginRead(New Byte() {0}, 0, 0, New AsyncCallback(AddressOf Read), Nothing)
Catch
RaiseEvent ClientExited(Me)
End Try
End Sub
Public Sub Send(ByVal Message As String)
sWriter = New StreamWriter(Client.GetStream)
sWriter.WriteLine(Message)
sWriter.Flush()
End Sub
End Class
You can get the IP address from the underlying socket by converting the Socket.RemoteEndPoint property into an IPEndPoint:
Dim Address As IPAddress = CType(cClient.Client.Client.RemoteEndPoint, IPEndPoint).Address
MessageBox.Show(Address.ToString()) 'Example.
I Try to save all the items from a list box with MY.SETTINGS
And Retrieved again on load
But it seems i made an error but i cannot figure out what.
its give 2 error
This is the errors
Error 3 'itemmd5' is not a member of 'MediaAdsAntivirus.My.MySettings'.
Error 2 'myitems' is not a member of 'MediaAdsAntivirus.My.MySettings'.
For this errors i just figure out i forgot to add it on settings
but now i just have a new error
This Is My New Error
Error 2 Value of type 'System.Windows.Forms.ListBox.ObjectCollection' cannot be converted to 'String'.
And i need to load them on loadfrom
How Can I List All Items Again In To It
This Is My Code:
Imports System.IO
Imports System.Security
Imports System.Security.Cryptography
Imports System.Text
Imports System.Net
Public Class form15
Dim md5hashindexer = 1
Dim md5namesave = "Hashes"
#Region "Atalhos para o principal hash_generator função"
Function md5_hash(ByVal file_name As String)
Return hash_generator("md5", file_name)
End Function
Function sha_1(ByVal file_name As String)
Return hash_generator("sha1", file_name)
End Function
Function sha_256(ByVal file_name As String)
Return hash_generator("sha256", file_name)
End Function
#End Region
Function hash_generator(ByVal hash_type As String, ByVal file_name As String)
Dim hash
If hash_type.ToLower = "md5" Then
hash = MD5.Create
ElseIf hash_type.ToLower = "sha1" Then
hash = SHA1.Create()
ElseIf hash_type.ToLower = "sha256" Then
hash = SHA256.Create()
Else
MsgBox("Type de hash inconnu : " & hash_type, MsgBoxStyle.Critical)
Return False
End If
Dim hashValue() As Byte
Dim fileStream As FileStream = File.OpenRead(file_name)
fileStream.Position = 0
hashValue = hash.ComputeHash(fileStream)
Dim hash_hex = PrintByteArray(hashValue)
fileStream.Close()
Return hash_hex
End Function
Public Function PrintByteArray(ByVal array() As Byte)
Dim hex_value As String = ""
Dim i As Integer
For i = 0 To array.Length - 1
hex_value += array(i).ToString("X2")
Next i
Return hex_value.ToLower
End Function
Private Sub BT_Parcourir_Click(sender As System.Object, e As System.EventArgs) Handles BT_Parcourir.Click
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim path As String = OpenFileDialog1.FileName
TB_path.Text = path
LB_md5.Text = md5_hash(path)
LB_sha1.Text = sha_1(path)
LB_sha256.Text = sha_256(path)
ListBox1.Items.Add(LB_md5.Text)
ListBox1.SelectedIndex += 1
Dim itemmd5 = LB_sha256.Text
Dim itemname = md5namesave + md5hashindexer
For Each line As String In ListBox1.Items
itemmd5 = My.Settings.myitems
My.Settings.itemmd5 = ListBox1.Items
Next
End If
End Sub
Private Sub LB_sha256_Click(sender As Object, e As EventArgs) Handles LB_sha256.Click
End Sub
Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs)
End Sub
Private Sub form15_Load(sender As Object, e As EventArgs) Handles MyBase.Load
End Sub
End Class
I finally decide to save in txt file and load The data again from it
This Is The Working Code
Imports System.IO
Imports System.Security
Imports System.Security.Cryptography
Imports System.Text
Imports System.Net
Public Class form15
Dim md5hashindexer = 1
#Region "Atalhos para o principal hash_generator função"
Function md5_hash(ByVal file_name As String)
Return hash_generator("md5", file_name)
End Function
Function sha_1(ByVal file_name As String)
Return hash_generator("sha1", file_name)
End Function
Function sha_256(ByVal file_name As String)
Return hash_generator("sha256", file_name)
End Function
#End Region
Function hash_generator(ByVal hash_type As String, ByVal file_name As String)
Dim hash
If hash_type.ToLower = "md5" Then
hash = MD5.Create
ElseIf hash_type.ToLower = "sha1" Then
hash = SHA1.Create()
ElseIf hash_type.ToLower = "sha256" Then
hash = SHA256.Create()
Else
MsgBox("Type de hash inconnu : " & hash_type, MsgBoxStyle.Critical)
Return False
End If
Dim hashValue() As Byte
Dim fileStream As FileStream = File.OpenRead(file_name)
fileStream.Position = 0
hashValue = hash.ComputeHash(fileStream)
Dim hash_hex = PrintByteArray(hashValue)
fileStream.Close()
Return hash_hex
End Function
Public Function PrintByteArray(ByVal array() As Byte)
Dim hex_value As String = ""
Dim i As Integer
For i = 0 To array.Length - 1
hex_value += array(i).ToString("X2")
Next i
Return hex_value.ToLower
End Function
Private Sub BT_Parcourir_Click(sender As System.Object, e As System.EventArgs) Handles BT_Parcourir.Click
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim path As String = OpenFileDialog1.FileName
TB_path.Text = path
LB_md5.Text = md5_hash(path)
LB_sha1.Text = sha_1(path)
LB_sha256.Text = sha_256(path)
ListBox1.Items.Add(LB_md5.Text)
ListBox1.SelectedIndex += 1
Dim itemmd5 = LB_sha256.Text
'For Each line As String In ListBox1.Items
'My.Settings.itemsmd5 = itemmd5
'md5hashindexer += 1
'Next
End If
Dim sb As New System.Text.StringBuilder()
For Each o As Object In ListBox1.Items
sb.AppendLine(o)
Next
System.IO.File.WriteAllText("c:\checkedfilesmd5.txt", sb.ToString())
End Sub
Private Sub LB_sha256_Click(sender As Object, e As EventArgs) Handles LB_sha256.Click
End Sub
Private Sub TextBox1_TextChanged(sender As Object, e As EventArgs)
End Sub
Private Sub form15_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim lines() As String = IO.File.ReadAllLines("c:\checkedfilesmd5.txt")
ListBox1.Items.AddRange(lines)
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim sb As New System.Text.StringBuilder()
For Each o As Object In ListBox1.Items
sb.AppendLine(o)
Next
System.IO.File.WriteAllText("c:\checkedfilesmd5.txt", sb.ToString())
MsgBox("Dados Guardados")
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim lines() As String = IO.File.ReadAllLines("c:\checkedfilesmd5.txt")
ListBox1.Items.AddRange(lines)
End Sub
Private Sub Label6_Click(sender As Object, e As EventArgs) Handles Label6.Click
ListBox1.Items.Clear()
End Sub
Private Sub Label7_Click(sender As Object, e As EventArgs) Handles Label7.Click
MsgBox("Atençao Voce Vai Apagar Todos Os Dados Ja Escaneados")
ListBox1.Items.Clear()
System.IO.File.Delete("c:\checkedfilesmd5.txt")
End Sub
End Class
i'm having an issue with setting a variable to the return value of a function i made i can't seem to be able to get it to work and i get no errors or feedback from visual studios even in strict mode
Imports System.Net
Imports System.IO
Imports System.ComponentModel
Public Class Form2
Dim i As Integer
Public CleanSearchTexts As String()
Dim count As Integer = 0
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If BackgroundWorker1.IsBusy = False Then
i = RichTextBox1.Lines.Count
i = i - 1
BackgroundWorker1.RunWorkerAsync()
Else
MsgBox("Threads are busy")
End If
End Sub
Private Sub StartThreads()
Dim SearchText As String
For count = count To i
SearchText = LineFunc(count)
count += 1
SearchText = CType(Ask_Query(SearchText), String)
SearchText = CType(Bing_Query(SearchText), String)
SearchText = CType(Yahoo_Query(SearchText), String)
Dim thread_count As String = CType(Process.GetCurrentProcess().Threads.Count - 20, String)
Label_T(thread_count)
Threading.Thread.Sleep(500)
If SearchText.Contains("All_Query:Yes") Then
SearchText = SearchText.Replace("All_Query:Yes", "")
RTB(SearchText)
End If
Next
End Sub
Private Delegate Sub UpdateStatus(ByVal s As String)
Private Delegate Sub UpdateLabel(ByVal thread_count As String)
Public Delegate Function GetTextBox(ByVal index As Integer) As String
Public Function LineFunc(ByVal index As Integer) As String
If InvokeRequired Then
Invoke(New GetTextBox(AddressOf LineFunc), index)
Else
Dim indexSearchText As String
indexSearchText = RichTextBox1.Lines(index)
Return indexSearchText
End If
End Function
Public Sub RTB(ByVal s As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateStatus(AddressOf RTB), New Object() {s})
Else
RichTextBox2.AppendText(Environment.NewLine & s)
End If
End Sub
Public Sub Label_T(ByVal thread_count As String)
If Me.InvokeRequired Then
Me.Invoke(New UpdateLabel(AddressOf Label_T), New Object() {thread_count})
Else
Label3.Text = "Threads Running: " + thread_count
End If
End Sub
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
BackgroundWorker1.WorkerSupportsCancellation = True
BackgroundWorker1.WorkerReportsProgress = True
Dim count As Integer
Dim num As Integer = CInt(TextBox1.Text) - 1
For count = 0 To num
Dim thread = New Threading.Thread(AddressOf StartThreads)
thread.IsBackground = True
thread.Name = "Web Thread #" + CType(count, String)
thread.Start()
Threading.Thread.Sleep(500)
Next
End Sub
Private Sub BackgroundWorker1_RunWorkerCompleted(sender As Object, e As RunWorkerCompletedEventArgs) Handles BackgroundWorker1.RunWorkerCompleted
MsgBox("Work is done")
End Sub
End Class
the issue is clearly with either the line getting function or the for count
i have tested the function by adding a button and doing the process of setting a variable to the return and msgboxing it and it works perfectly not only that when i breakpoint it it shows it's returning the right output but its just not setting it for whatever reason in this sub
Public Sub StartThreads(ByVal List As Object)
Dim List2 As String() = CType(List, String())
For Each dork As String In List2
dork = CType(Ask_Query(dork), String)
dork = CType(Bing_Query(dork), String)
dork = CType(Yahoo_Query(dork), String)
Dim thread_count As String = CType(Process.GetCurrentProcess().Threads.Count - 20, String)
Label_T(thread_count)
Threading.Thread.Sleep(500)
If dork.Contains("All_Query:Yes") Then
dork = dork.Replace("All_Query:Yes", "")
RTB(dork)
End If
Next
End Sub
and here is the function
Public Delegate Function GetTextBox(ByVal index As Integer) As String
Public Function LineFunc(ByVal index As Integer) As String
If InvokeRequired Then
Invoke(New GetTextBox(AddressOf LineFunc), index)
Else
Dim indexSearchText As String
indexSearchText = RichTextBox1.Lines(index)
Return indexSearchText
End If
End Function
Update: List Split Func
Public Function splitData(ByVal width As Integer, ByVal dd As List(Of String)) As List(Of List(Of String))
Dim dds As New List(Of List(Of String))
Dim numberOfLists As Integer = (dd.Count \ width)
For i As Integer = 0 To numberOfLists
Dim newdd As List(Of String)
newdd = dd.Skip(i * width).Take(width).ToList()
dds.Add(newdd)
Next i
Return dds
End Function
Updated Background Worker
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
BackgroundWorker1.WorkerSupportsCancellation = True
BackgroundWorker1.WorkerReportsProgress = True
Dim dds As New List(Of String)
GetList(dds)
Dim num As Integer = CInt(TextBox1.Text)
Dim ThreadCount As Integer = CInt(TextBox1.Text)
If ThreadCount > 1 Then
ThreadCount -= 1
End If
Dim RTBLines As Integer = RTB_Lines()
num = CInt(RTBLines / num)
num = CInt(Math.Ceiling(num))
Dim splitdd As List(Of List(Of String)) = CType(splitData(num, dds), List(Of List(Of String)))
For count = 0 To ThreadCount
Dim ListArray As String() = splitdd(count).ToArray
Dim newthread As New Thread(AddressOf StartThreads)
newthread.Name = "Web Thread #" + CType(count, String)
newthread.Start(ListArray)
Threading.Thread.Sleep(500)
Next
End Sub
I'm creating a Quiz Application in VB and the quiz app reads the questions from a text file which is already created and it has got some questions in it.
1
Q.Who won the WorldCup last time?
I Don't know
May be he knows
Who knows
Who cares?
2
Question 2
Answer A
Answer B
Answer C
Answer D
3
Question 3
Ans 1
Ans 2
Ans 3
Ans 4
The first line is the question number,the second line is the question,lines 3 - 6 represents the answer choices.Now I have created a Form for quiz and when the next button is pressed it should display the next question i.e,After the first question it should go to Question 2 and print accordingly.But unfortunately i'm unable to calculate the logic to go to next question.
Public Class Quiz
<DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As IntPtr
End Function
Dim SCORE As Integer = 0
Dim val As Integer = 30
Dim QUES As Integer = 0
Dim Line As Integer = 1
Dim allLines As List(Of String) = New List(Of String)
Dim TextFilePath As String = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "Quiz.txt")
Private Sub Quiz_Load(sender As Object, e As EventArgs) Handles MyBase.Load
ProgressBar1.Minimum = 0
ProgressBar1.Maximum = 30
Timer1.Enabled = True
Next_Prev_Ques(Line + QUES)
End Sub
Public Function Next_Prev_Ques(quesno As Integer) As Integer
Line = quesno
Using file As New System.IO.StreamReader(TextFilePath)
Do While Not file.EndOfStream
allLines.Add(file.ReadLine())
Loop
End Using
QUES = ReadLine(Line, allLines)
Label1.Text = ReadLine(Line + 1, allLines)
RadioButton1.Text = ReadLine(Line + 2, allLines)
RadioButton2.Text = ReadLine(Line + 3, allLines)
RadioButton3.Text = ReadLine(Line + 4, allLines)
RadioButton4.Text = ReadLine(Line + 5, allLines)
Return Line
End Function
Public Function ReadLine(lineNumber As Integer, lines As List(Of String)) As String
Return lines(lineNumber - 1)
End Function
Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
ProgressBar1.Value += 1
val -= 1
Label2.Text = val & " Sec"
If ProgressBar1.Value = ProgressBar1.Maximum Then
Timer1.Enabled = False
End If
If ProgressBar1.Value > 25 Then
SendMessage(ProgressBar1.Handle, 1040, 2, 0)
End If
End Sub
Private Sub Quiz_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
Form1.Close()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
MsgBox(Line + QUES + 5)
Next_Prev_Ques(Line + QUES + 4)
Me.Refresh()
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Next_Prev_Ques(Line + QUES + 5)
End Sub
The function Next_Prev_Ques Should run accordingly but its not.Can anyone post the correct code?
Below is some code that uses serialization to get the same results. You can create a class called Questions and properties on it like questionnumber, question and answer, store the data into a xml file and retrieve them with string methods. Check the code below:
The code for the class
Public Class clsQuestions
Private _Number As String
Private _Question As String
Private _Answer As String
Public Property Number() As String
Get
Number = _Number
End Get
Set(ByVal Value As String)
_Number = Value
End Set
End Property
Public Property Question() As String
Get
Question = _Question
End Get
Set(ByVal Value As String)
_Question = Value
End Set
End Property
Public Property Answer() As String
Get
Answer = _Answer
End Get
Set(ByVal Value As String)
_Answer = Value
End Set
End Property
End Class
The code for the form
Imports System.IO
Imports System.Xml.Serialization
Public Class Form1
Dim numQuestions() As String
Dim questions() As String
Dim answersGroup() As String
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Label1.Text = ""
Label2.Text = ""
Label3.Text = ""
Main()
End Sub
Private Sub Main()
Dim p As New clsQuestions
p.Number = "1,2,3,4,5,6,7,8,9,10"
p.Question = "Question 1,Question 2,Question 3," &
"Question 4,Question 5,Question 6,Question 7," &
"Question 8,Question 9,Question 10"
p.Answer = "Answer 1.1,Answer 1.2,Answer 1.3,Answer 1.4;" &
"Answer 2.1,Answer 2.2,Answer 2.3,Answer 2.4;" &
"Answer 3.1,Answer 3.2,Answer 3.3,Answer 3.4;" &
"Answer 4.1,Answer 4.2,Answer 4.3,Answer 4.4;" &
"Answer 5.1,Answer 5.2,Answer 5.3,Answer 5.4;" &
"Answer 6.1,Answer 6.2,Answer 6.3,Answer 6.4;" &
"Answer 7.1,Answer 7.2,Answer 7.3,Answer 7.4;" &
"Answer 8.1,Answer 8.2,Answer 8.3,Answer 8.4;" &
"Answer 9.1,Answer 9.2,Answer 9.3,Answer 9.4;" &
"Answer 10.1,Answer 10.2,Answer 10.3,Answer 10.4"
'Serialize object to a text file.
Dim objStreamWriter As New StreamWriter("C:\Users\Username\Documents\Questions.xml")
Dim x As New XmlSerializer(p.GetType)
x.Serialize(objStreamWriter, p)
objStreamWriter.Close()
'Deserialize text file to a new object.
Dim objStreamReader As New StreamReader("C:\Users\Username\Documents\Questions.xml")
Dim p2 As New clsQuestions
p2 = x.Deserialize(objStreamReader)
objStreamReader.Close()
numQuestions = p2.Number.Split(",")
questions = p2.Question.Split(",")
answersGroup = p2.Answer.Split(";")
End Sub
Private Sub btnNext_Click(sender As Object, e As EventArgs) Handles btnNext.Click
Static x As Integer
If x <= questions.Length - 1 Then
Label1.Text = ""
Label2.Text = ""
Label3.Text = ""
arrayIndex(x)
x += 1
End If
End Sub
Private Sub arrayIndex(ByVal num As Integer)
Label1.Text = numQuestions(num)
Label2.Text = questions(num)
Dim answers() As String
answers = answersGroup(num).Split(",")
For Each item As String In answers
Label3.Text &= item & Environment.NewLine
Next
End Sub
End Class
I am making a simple tcp communication program just to send strings I keep reciving
Only one usage of each socket address (protocol/network address/port) is normally permitted
I have run the exact same code on windows 8, in witch case it works fine, but on 7 i get this error.( I need it to run on 7)
here is my code( It is a fake virus not intended for any harm):
{
Imports IWshRuntimeLibrary
Public Class Form1
Dim virus As Boolean = False
'Public IsClosing As Boolean = False
Private _Server As New TcpCommServer(AddressOf UpdateUI)
Private _Server2 As New TcpCommServer(AddressOf UpdateUI2)
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
_Server.Start(32800)
_Server2.Start(32801)
If My.Settings.autostart = False Then
Dim startupPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Startup)
Dim executablePath As String = System.Diagnostics.Process.GetCurrentProcess().MainModule.FileName
Dim executableName As String = System.Diagnostics.Process.GetCurrentProcess().MainModule.ModuleName
'create shortcut
Dim Shell As WshShell
Dim Link As WshShortcut
Try
Shell = New WshShell
Link = CType(Shell.CreateShortcut(startupPath & "\" & executableName & ".lnk"), IWshShortcut)
Link.TargetPath = executablePath
Link.Save()
Catch ex As Exception
MsgBox(ex.Message)
End Try
My.Settings.autostart = True
ElseIf My.Settings.autostart = True Then
End If
End Sub
Private Function BytesToString(ByVal data() As Byte) As String
Dim enc As New System.Text.UTF8Encoding()
BytesToString = enc.GetString(data)
End Function
Private Function StrToByteArray(ByVal text As String) As Byte()
Dim encoding As New System.Text.UTF8Encoding()
StrToByteArray = encoding.GetBytes(text)
End Function
Private Function BytesToString2(ByVal data() As Byte) As String
Dim enc2 As New System.Text.UTF8Encoding()
BytesToString2 = enc2.GetString(data)
End Function
Private Function StrToByteArray2(ByVal text As String) As Byte()
Dim encoding2 As New System.Text.UTF8Encoding()
StrToByteArray2 = encoding2.GetBytes(text)
End Function
Public Sub UpdateUI(ByVal bytes() As Byte, ByVal sessionID As Int32, ByVal dataChannel As Integer)
If Me.InvokeRequired() Then
' InvokeRequired: We're running on the background thread. Invoke the delegate.
Me.Invoke(_Server.ServerCallbackObject, bytes, sessionID, dataChannel)
Else
' We're on the main UI thread now.
If dataChannel = 1 Then
Me.lbtextinput.Text = (BytesToString(bytes))
ElseIf dataChannel = 255 Then
Dim tmp = ""
Dim msg As String = BytesToString(bytes)
Dim dontReport As Boolean = False
' _Server as finished sending the bytes you put into sendBytes()
If msg.Length > 3 Then tmp = msg.Substring(0, 3)
If tmp = "UBS" Then ' User Bytes Sent.
Dim parts() As String = Split(msg, "UBS:")
msg = "Data sent to session: " & parts(1)
End If
End If
End If
End Sub
Public Sub UpdateUI2(ByVal bytes() As Byte, ByVal sessionID As Int32, ByVal dataChannel As Integer)
If Me.InvokeRequired() Then
' InvokeRequired: We're running on the background thread. Invoke the delegate.
Me.Invoke(_Server2.ServerCallbackObject, bytes, sessionID, dataChannel)
Else
' We're on the main UI thread now.
If dataChannel = 1 Then
MsgBox(BytesToString2(bytes))
ElseIf dataChannel = 255 Then
Dim tmp = ""
Dim msg As String = BytesToString2(bytes)
Dim dontReport As Boolean = False
' _Server as finished sending the bytes you put into sendBytes()
If msg.Length > 3 Then tmp = msg.Substring(0, 3)
If tmp = "UBS" Then ' User Bytes Sent.
Dim parts() As String = Split(msg, "UBS:")
msg = "Data sent to session: " & parts(1)
End If
End If
End If
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If lbtextinput.Text = "Start Virus" Then
virus = True
ElseIf lbtextinput.Text = "Stop Virus" Then
virus = False
End If
End Sub
Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
If virus = True Then
Form2.Show()
Else
Form2.Hide()
End If
End Sub
End Class
} Form1
Now a linked class {
Imports System.IO
Imports System.Runtime.InteropServices
Public Class clsAsyncUnbuffWriter
Public Class clsSystemInfo
Private Class WinApi
<DllImport("kernel32.dll")> _
Public Shared Sub GetSystemInfo(<MarshalAs(UnmanagedType.Struct)> ByRef lpSystemInfo As SYSTEM_INFO)
End Sub
<StructLayout(LayoutKind.Sequential)> _
Public Structure SYSTEM_INFO
Friend uProcessorInfo As _PROCESSOR_INFO_UNION
Public dwPageSize As UInteger
Public lpMinimumApplicationAddress As IntPtr
Public lpMaximumApplicationAddress As IntPtr
Public dwActiveProcessorMask As IntPtr
Public dwNumberOfProcessors As UInteger
Public dwProcessorType As UInteger
Public dwAllocationGranularity As UInteger
Public dwProcessorLevel As UShort
Public dwProcessorRevision As UShort
End Structure
<StructLayout(LayoutKind.Explicit)> _
Public Structure _PROCESSOR_INFO_UNION
<FieldOffset(0)> _
Friend dwOemId As UInteger
<FieldOffset(0)> _
Friend wProcessorArchitecture As UShort
<FieldOffset(2)> _
Friend wReserved As UShort
End Structure
End Class
Public Shared Function GetPageSize() As Integer
Dim sysinfo As New WinApi.SYSTEM_INFO()
WinApi.GetSystemInfo(sysinfo)
Return CInt(sysinfo.dwPageSize)
End Function
End Class
Private target As FileStream
Private inputBuffer As MemoryStream
Private bufferSize As Integer
Private running As Boolean
Private writing As Boolean
Private readWait As Threading.ManualResetEvent
Private writeWait As Threading.ManualResetEvent
Private finishedWriting As Threading.ManualResetEvent
Private totalWritten As Int64
Private writeTimer As Stopwatch
Public Function GetTotalBytesWritten() As Int64
Return totalWritten
End Function
Public Function IsRunning() As Boolean
Return running
End Function
Public Sub Close()
writing = False
writeWait.Set()
finishedWriting.WaitOne()
readWait.Set()
End Sub
Public Function GetActiveMiliseconds() As Int64
Try
Return writeTimer.ElapsedMilliseconds
Catch ex As Exception
Return 0
End Try
End Function
Public Shared Function GetPageSize() As Integer
Return clsSystemInfo.GetPageSize
End Function
Public Sub New(ByVal dest As String, _
Optional ByVal unbuffered As Boolean = False, _
Optional ByVal _bufferSize As Integer = (1024 * 1024), _
Optional ByVal setLength As Int64 = 0)
bufferSize = _bufferSize
Dim options As FileOptions = FileOptions.SequentialScan
If unbuffered Then options = FileOptions.WriteThrough Or FileOptions.SequentialScan
readWait = New Threading.ManualResetEvent(False)
writeWait = New Threading.ManualResetEvent(False)
finishedWriting = New Threading.ManualResetEvent(False)
readWait.Set()
writeWait.Reset()
finishedWriting.Reset()
target = New FileStream(dest, _
FileMode.Create, FileAccess.Write, FileShare.None, GetPageSize, options)
If setLength > 0 Then target.SetLength(setLength)
totalWritten = 0
inputBuffer = New MemoryStream(bufferSize)
running = True
writing = True
writeTimer = New Stopwatch
Dim asyncWriter As New Threading.Thread(AddressOf WriteThread)
With asyncWriter
.Priority = Threading.ThreadPriority.Lowest
.IsBackground = True
.Name = "AsyncCopy writer"
.Start()
End With
End Sub
Public Function Write(ByVal someBytes() As Byte, ByVal numToWrite As Integer) As Boolean
If Not running Then Return False
If numToWrite < 1 Then Return False
If numToWrite > inputBuffer.Capacity Then
Throw New Exception("clsAsyncUnbuffWriter: someBytes() can not be larger then buffer capacity")
End If
If (inputBuffer.Length + numToWrite) > inputBuffer.Capacity Then
If inputBuffer.Length > 0 Then
readWait.Reset()
writeWait.Set()
readWait.WaitOne()
If Not running Then Return False
inputBuffer.Write(someBytes, 0, numToWrite)
End If
Else
inputBuffer.Write(someBytes, 0, numToWrite)
End If
Return True
End Function
Private Sub WriteThread()
Dim bytesThisTime As Int32 = 0
Dim internalBuffer(bufferSize) As Byte
writeTimer.Stop()
writeTimer.Reset()
writeTimer.Start()
Do
writeWait.WaitOne()
writeWait.Reset()
bytesThisTime = CInt(inputBuffer.Length)
Buffer.BlockCopy(inputBuffer.GetBuffer, 0, internalBuffer, 0, bytesThisTime)
inputBuffer.SetLength(0)
readWait.Set()
target.Write(internalBuffer, 0, bytesThisTime)
totalWritten += bytesThisTime
Loop While writing
' Flush inputBuffer
If inputBuffer.Length > 0 Then
bytesThisTime = CInt(inputBuffer.Length)
Buffer.BlockCopy(inputBuffer.GetBuffer, 0, internalBuffer, 0, bytesThisTime)
target.Write(internalBuffer, 0, bytesThisTime)
totalWritten += bytesThisTime
End If
running = False
writeTimer.Stop()
finishedWriting.Set()
Try
target.Close()
target.Dispose()
Catch ex As Exception
End Try
inputBuffer.Close()
inputBuffer.Dispose()
inputBuffer = Nothing
internalBuffer = Nothing
target = Nothing
GC.GetTotalMemory(True)
End Sub
End Class
} Public Class clsAsyncUnbuffWriter
Now I do have one more chunk of code but it wont fit so I will post it later. all these chunks call to each other.
please help.