first question here, and its about vb.net threads. I have recently acquired a source code of a program, and I wish to make my own changes and touches to the form, but cannot seem to be able to change the maximum threads allowed. the maximum threads allowed for this program is two threads, where it goes to Netflix and logs in, bringing back the information of the account. It has a maximum of two threads, but it is also proxyless.
I included a part of code where the threadpool is, and I would love to know where to edit it whereas I can change the maximum amount of threads. I have tried looking for certain keywords, but have not found anything that would help.
Private Sub ButtonX1_Click(sender As Object, e As EventArgs) Handles ButtonX1.Click
If (Me.usernames.Count > 0) Then
If (Me.ButtonX1.Text = "Start") Then
Me.NumericUpDown1.Enabled = False
Me.ProgressBarX1.Maximum = Me.usernames.Count
Me.ProgressBarX1.Value = 0
Me.thread_status = True
Me.available = 0
Dim workerThreads As Integer = Me.NumericUpDown1.Value
ThreadPool.SetMinThreads(workerThreads, workerThreads)
ThreadPool.SetMaxThreads(workerThreads, workerThreads)
ServicePointManager.DefaultConnectionLimit = workerThreads
ServicePointManager.Expect100Continue = False
Dim str As String
For Each str In Me.usernames
ThreadPool.QueueUserWorkItem(New WaitCallback(AddressOf Me.Lam__R141), str)
Next
Me.ButtonX1.Text = "Stop"
Me.Label3.Text = "Cracking Start"
Else
Me.NumericUpDown1.Enabled = True
Me.thread_status = False
Me.ButtonX1.Text = "Start"
Me.Label3.Text = "Cracking Stop"
End If
Else
Me.Label3.Text = "Load Combolist"
End If
End Sub
Looking at it, I would suggest you change the bracket values from ThreadPool.SetMaxThreads(workerThreads, workerThreads), and you might also need to set ServicePointManager.DefaultConnectionLimit = workerThreads to equal something bigger.
Related
This is my first question in this community and I'd like some help with a school project I am doing.
I am implementing a turn system where every time you select a method to score a variable called turn increases by one so that the appropriate label is changed to the points you got that turn.
This is an example of the Ones option to score which checks all the dice and adds up all the dice which have the value one, when the Ones button is pressed it should update the current turn with the points gained. At the moment it only updates the first turns score. The second and third images are of the changes I tried making which don't work.
[Ones][1]
[Ones changed][2]
[Ones error][3]
```
Private Sub btnOnes_Click(sender As Object, e As EventArgs) Handles btnOnes.Click
Dim Nums(4) As Integer
Nums(0) = RandomNum1
Nums(1) = RandomNum2
Nums(2) = RandomNum3
Nums(3) = RandomNum4
Nums(4) = RandomNum5
For i = 0 To 4
If Nums(i) = 1 Then
OnesScore += 1
End If
Next
lblTurnValue1.Text = OnesScore
Turn += 1
btnOnes.Enabled = False
End Sub
Private Sub btnOnes_Click(sender As Object, e As EventArgs) Handles btnOnes.Click
Dim Nums(4) As Integer
Nums(0) = RandomNum1
Nums(1) = RandomNum2
Nums(2) = RandomNum3
Nums(3) = RandomNum4
Nums(4) = RandomNum5
For i = 0 To 4
If Nums(i) = 1 Then
OnesScore += 1
End If
Next
lblTurnValue1(Turn).Text = OnesScore
Turn += 1
btnOnes.Enabled = False
End Sub
Another problem I have been having is automatically updating labels as I want to make a Newbie mode for my Yahtzee game which displays the numbers beside each option to score so you know what score you are going to get before you choose.
I can't use the Ones button for clicking to represent the score because it's used for scoring the points and whenever I try double click on the label to show its code in Visual Studio it only updates in game when the person clicks the number to show their score which is not what I desire.
[Ones label][4]
Private Sub lblOnes_Click(sender As Object, e As EventArgs) Handles lblOnes.Click
lblOnes.Text = OnesScore
End Sub
In short I want to learn how to use variables within names of objects to allow for the right one to be chosen and how to update labels automatically instead of having to click them. Any resources you can provide to further my understanding of VB.NET is really helpful.
Thanks.
[1]: https://i.stack.imgur.com/zUQM6.png
[2]: https://i.stack.imgur.com/c5nJe.png
[3]: https://i.stack.imgur.com/Y3gUE.png
[4]: https://i.stack.imgur.com/BnwZ8.png
I have two forms: Act9.vb and List.vb. The code in both forms is below. I'm using vb.net "4.7.2" in visual studio.
I have been very frustrated with this program for a while now. For some reason the program only checks new clients against the first and second clients already in the list. For example, if the following entries are in the list:
╔═════════╦═════════════╗
║ ClientA ║ 32423223343 ║
╠═════════╬═════════════╣
║ ClientB ║ 23422322343 ║
╠═════════╬═════════════╣
║ ClientC ║ 23423423423 ║
╠═════════╬═════════════╣
║ ClientD ║ 43533453333 ║
╠═════════╩═════════════╣
║ etc... ║
╚═══════════════════════╝
Then if I try to modify ClientA or ClientB (pressing btnModify and then typing "ClientA"/"ClientB" in the inputbox), then it works, but if I try the same with ClientC, D, E, etc. it doesn't. I get this message: "This client doesn't exist. Please try again."
Same thing with adding new clients: it won't let me add ClientA or B twice, but if I try to add Client C more then once it doesn't realize that it's already in the multidimensional array and let's me add it a second time.
If someone knows anything that can help, please share.
Thanks in advance!
Public Class Act9
Public Clients(1, 1) As String
Public size As Integer = 0
Sub Add()
Dim tempClient As String
Dim tempTel As String
tempClient = InputBox("Please enter the clients name :", "Name")
If Duplicate(tempClient) Then
MsgBox("This client already exists")
Else
tempTel = InputBox("Please enter the client's phone number:", "Phone number")
Clients(0, size) = tempClient
Clients(1, size) = tempTel
size += 1
ReDim Preserve Clients(1, size)
End If
End Sub
Function Duplicate(ByVal tempClient As String) As Boolean
Dim output As Boolean = False
For i As Integer = LBound(Clients) To UBound(Clients)
If Clients(0, i) = tempClient Then
output = True
End If
Next
Return output
End Function
Private Sub BtnAdd_Click(sender As Object, e As EventArgs) Handles btnAdd.Click
Add()
End Sub
Private Sub btnShow_Click(sender As Object, e As EventArgs) Handles btnShow.Click
List.ShowDialog()
End Sub
Private Sub btnErase_Click(sender As Object, e As EventArgs) Handles btnErase.Click
ReDim Clients(1, size)
List.lstClients.Items.Clear()
size = 0
End Sub
Private Sub btnModify_Click(sender As Object, e As EventArgs) Handles btnModify.Click
modify()
End Sub
Sub modify(Optional who As String = Nothing)
Dim change As Boolean = False
If who = Nothing Then who = InputBox("Please enter the name of the client you wish to modify:", "Modify")
For i As Integer = LBound(Clients) To UBound(Clients)
If Clients(0, i) = who Then
Clients(0, i) = InputBox("Please enter the new name for the client:", "Name")
Clients(1, i) = InputBox("Please enter the new phone number for the client", "Phone number")
change = True
Exit For
End If
Next
If change = False Then MsgBox("This client doesn't exist. Please try again.")
End Sub
End Class
Public Class List
Private Sub List_Load(sender As Object, e As EventArgs) Handles Me.Load
lstClients.Items.Clear()
For i As Integer = 0 To Act9.size - 1
lstClients.Items.Add(Act9.Clients(0, i) & vbTab & Act9.Clients(1, i))
Next
End Sub
End Class
#Craig Told me to use breakpoints which are the perfect tools for this. I'm very grateful for the advice.
Here is how I ended up getting it to work properly:
I replaced LBound and Ubound with my variable "size" (which was already taking care of counting the size of my multidimensional array).
The For loop in "Duplicate" becomes:
For i As Integer = 0 To size
If Clients(0, i) = tempClient Then
output = True
End If
Next
The one in "Modify becomes:
For i As Integer = 0 To size
If Clients(0, i) = who Then
Clients(0, i) = InputBox("Please enter the new name for the client:", "Name")
Clients(1, i) = InputBox("Please enter the new phone number for the client", "Phone number")
change = True
Exit For
End If
Next
The reason why your original code didn't work out is because you LBound/UBound on the first dimension but your array extends on the second dimension. The first dimension is only ever 0 to 1 so you only ever checked the second dimension indexes 0 and 1 (the first two items) for the name:
For i As Integer = LBound(Clients) To UBound(Clients)
If you use
LBound(Clients, 2) to UBound(Clients, 2)
It will get the upper limit of the second dimension rather than the first. UBound uses 1-based indexing whereas VB uses 0 based. If you want the same thing in 0 based you can use
Array.GetUpperBound(Clients, 1)
to find the limit of the second dimension
Other tips:
your modify method makes the same bounding mistake
if this were programming 201 you'd probably be using a List(Of Client), Client being a class having a pair of string properties for name and tel, and an overridden equals method that compares the name of an incoming Client, so that list.Contains can be used to prevent duplicates. Eventually you'd probably override GetHashCode too and use a HashSet(Of Client). And this whole thing would actually be a lot easier. Multidimensional arrays are usually a poor storage solution for.. well.. everything
your size variable is public; it should have a capital s
your modify method is a method; it should have a capital M. All methods in .net have capital initial letters
maybe btnErase should set the size before it redims
your duplicate method checks every item in the array. It carries on checking even if it already found a duplicate item. You can skip the part where you create a Boolean and just straight Return True inside the If; your keys are always in the last place you look because you stop looking when you find them :)
perhaps if you implement a FindIndex method that takes a name and returns the index of where that person is, or -1 if it didn't find them then you can use it for both IsDuplicate (call findindex and return true if the result is greater than -1) and for Modify (find the index of the person and change them or put a message Not Found if -1 comes bac). This means you can have just one method that searches the array and you use it twice. It means you Don't Repeat Yourself - a software engineering principle we try to stick to. At the moment your duplicate and modify methods both have the same loop (with the same bug)
i'm having alot of trouble trying to get a background worker properly functioning to populate a couple of TreeView Nodes. In said TreeView i have multiple levels of Nodes. For example
FileName
Model
Test & Result.
Model refers to a MicroStation Model (CAD Drawing Program), easiest way to explain it is a Sheet within a Spreadsheet.
I'm using a FileDialog to select files, once the files are selected each filename is added to the TreeView with its own Node.
The idea is that the program will then open each file, scan each model and add a sub TreeNode under the files Node wih the type of test and the result.
The DoWork function for the Background worker is below. I have removed alot of the code to simply my post. But there are 7 "tests" that the program does, i have included 2.
In the below example, "CheckFonts" is a function that just counts the text elements in a file and returns a number.
Private Sub BackgroundWorker1_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork
For i As Integer = 0 To m_CountTo
If BackgroundWorker1.CancellationPending Then
e.Cancel = True ' Set Cancel to True
Exit For
End If
Dim sError As String = ""
Dim bBorderFound As Boolean = False
Dim oDesignFile As DesignFile
Dim oModel As ModelReference
Dim oFontNode As New TreeNode
Dim oFontResultNode As New TreeNode
For Each oNode As TreeNode In trvItems.Nodes
Dim ustn As New MicroStationDGN.Application
oDesignFile = ustn.OpenDesignFileForProgram(oNode.Text, True)
For Each oModel In oDesignFile.Models
'####### Checks for Items on Default Level #######
If bDefaultPass = True Then
Dim iDefaultItems As Long
iDefaultItems = DefaultItems(oModel)
If iDefaultItems > 0 Then
sDefaultMessage = "There are " & iDefaultItems & " items on the Default Level"
bDefaultPass = False
Else
sDefaultMessage = "There are no items on the Default Level"
bDefaultPass = True
End If
End If
'####### Checks for Non Standard Fonts #######
If bFontPass = True Then
Dim iFontCheck As Long
iFontCheck = CheckFonts(oModel)
If iFontCheck > 0 Then
sFontMessage = "There are " & iFontCheck & " Text Elements that use a Non Standard Font."
bFontPass = False
ElseIf iFontCheck = -99999 Then
sFontMessage = "There are some corrupt or invalid Fonts used in the Design File"
bFontPass = False
Else
sFontMessage = "All Text Elements use the Correct Font"
bFontPass = True
End If
End If
Next ' End Model
oFontNode = oNode.Nodes.Add("Font Check")
oFontResultNode = oFontNode.Nodes.Add("")
If bFontPass = True Then
oFontResultNode.Text = "PASS - " & sFontMessage
oFontResultNode.ImageIndex = 0
oNode.Collapse()
Else
oFontResultNode.Text = "FAIL - " & sFontMessage
bPass = False
oFontResultNode.ImageIndex = 1
oFontNode.ImageIndex = 1
oNode.Expand()
oFontNode.Expand()
End If
oDefaultItemsNode = oNode.Nodes.Add("Default Items Check")
oDefaultItemsResultNode = oDefaultItemsNode.Nodes.Add("")
If bDefaultPass = True Then
oDefaultItemsResultNode.Text = "PASS - " & sDefaultMessage
oDefaultItemsResultNode.ImageIndex = 0
oNode.Collapse()
Else
oDefaultItemsResultNode.Text = "FAIL - " & sDefaultMessage
oDefaultItemsResultNode.ImageIndex = 1
oDefaultItemsResultNode.ImageIndex = 1
oNode.Expand()
bPass = False
End If
Next ' End File
Next
End Sub
I have worked with Background Workers before but this is a bit more complex to what i have done, i understand that you cant update controls from a different thread and that Invoke is used to pass it information. But i'm confused how to do it with multiple nodes. The best example I saw was here
Adding nodes to treeview with Begin Invoke / Invoke
But with multiple nodes the code became quite confusing and didn't work. The error message keeps coming up regarding the Invoke / BeginInvoke being called.
So, i guess my main question is where i would call the Invoke command to best make use of the Background worker?
Thanks in advance!!
Here is my code,
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
For Each kthread As Thread In _threads
If kthread.Name = "123" Then
_threads.Remove(kthread)
kthread.Abort()
killedthreads += 1 'a integer
End If
Next
End Sub
I added the killedthreads integer at last as a check, vb executes the whole function good but at the last line it always throw the error said in title.
Not sure why, if killedthreads += 1 is not there then the error goes to kthread.Abort()
I had the same problem with C# with a different app earlier this year.
Edit,
Public Sub KillThread(kThread As Thread)
For i As Integer = (_threads.Count - 1) To 0 Step -1
If _threads.Item(i).Name = kThread.Name Then
_threads.Item(i).Abort()
_threads.RemoveAt(i)
End If
Next
End Sub
I did this code as Eminem said it. This gets in kThread from the running threads if something is not good or it has finished all its functions. But my problem is that, only the first thread that sends it gets abort and removed from list, others seem to get stuck once the first thread is aborted.
I create threads using,
Public Sub multiThreader(int As Integer, link As String)
Dim tCount As Integer = _threads.Count
If tCount >= Form1.ListView1.Items.Count Then
Else
Dim dy As Integer = DateTime.Now.Day
Dim mo As Integer = DateTime.Now.Month
Dim fileNum As String = dy.ToString() + "-" + mo.ToString() + "_" + int.ToString
botThread = New Thread(Sub() MainThread(fileNum, link, botThread, int.ToString()))
botThread.IsBackground = True
botThread.Name = String.Format("AutoBotThread{0}", fileNum)
_threads.Add(botThread)
botThread.Start()
End If
End Sub
and _threads is publicly, Public _threads As New List(Of Thread)
MainThread is a Public Sub which runs functions and gets return and send KillThread under certain conditions.
The problem is that you remove an item from an enumeration, before you finished iterating through it.
It's like trying to iterate from 0 to list.count, when the count changes from an iteration to another. As Bjørn-Roger Kringsjå said, you should do something like this:
For i As Integer = (_threads.count - 1) to 0 Step -1
If _threads.Item(i).Name = "123" Then
_threads.Item(i).Abort
_threads.RemoveAt(i)
killedthreads += 1 'a integer
End If
Next
By using Step -1 you make sure that an Index was out of range error will not occur, and make sure that your operations are fitted, and execute on the right order/item.
I am trying to upload a large (4MB+) file to youtube using the API in VB.NET.
Smaller files upload fine, but anything larger than about 4MB gives an error which (I think) is actually related to a timeout: The request was aborted: The request was canceled.
I have read and re-read the API doco, googled, etc looking for an example in VB.NET, but nothing seems to be out there for vb.net
A few coders have hit the same problem and the responses have all been around c# or Java - neither of which I am familiar with.
I tried different combinations of the settings.timeout and settings.maximum, but it does not seem to make a difference
Current code is:
Sub UploadYouTube(ByVal sSourceFile As String, ByVal sTitle As String, ByVal sMediaCategory As String, ByVal sDesc As String)
Dim uSettings As YouTubeRequestSettings, uRequest As YouTubeRequest, newVideo As Video, CreatedVideo As Video, VideoId As String
Dim vContentType As String = "video"
Try
uSettings = New YouTubeRequestSettings(, , , )
uRequest = New YouTubeRequest(uSettings)
newVideo = New Video()
newVideo.Title = sTitle '"Test";
newVideo.Tags.Add(New MediaCategory("Education", YouTubeNameTable.CategorySchema))
newVideo.Description = sDesc '"Testing Testing Testing"
newVideo.YouTubeEntry.Private = False
uRequest.Settings.Timeout = 60 * 60 * 1000
uRequest.Settings.Maximum = 2000000000
' Determine the content type
If sSourceFile.EndsWith(".mov") Then
vContentType = "video/quicktime"
ElseIf sSourceFile.EndsWith(".avi") Or sSourceFile.EndsWith(".mpg") Or sSourceFile.EndsWith(".mpeg") Then
vContentType = "video/mpeg"
ElseIf sSourceFile.EndsWith(".wmv") Then
vContentType = "video/x-ms-wmv"
ElseIf sSourceFile.EndsWith(".m4v") Then
vContentType = "video/m4v"
ElseIf sSourceFile.EndsWith(".mp4") Then
vContentType = "video/mp4"
ElseIf sSourceFile.EndsWith(".3gp") Then
vContentType = "video/3gpp"
End If
newVideo.YouTubeEntry.MediaSource = New MediaFileSource(sSourceFile, vContentType)
CreatedVideo = uRequest.Upload(newVideo)
VideoId = CreatedVideo.VideoId
' Save the video Id to the database!
Catch ex As Exception
debug.print("Error. MainModule.Main. " & ex.Message, 5)
End Try
End Sub
Any help is greatly appreciated
Tony
Python example : https://github.com/Mathieu69/Pitivi_Gargamel/blob/upload_merger/pitivi/uploader.py did that 3 months ago, hope it helps.
I tried to solve the timeout problem by using a backgroundworker. It works, sort of. It doesn't appear to actually be working in the background. I would think the RunWorkerAsync would start, move on to the next command, and postback. Instead it just hangs for a few minutes like it's uploading the whole 75MB file, then posts back successful. If I take away the backgroundworker and just execute the upload however, it fails like yours did. Here's my code that kind of works.
Sub up_load(s As Object, e As EventArgs)
Dim worker As BackgroundWorker = New BackgroundWorker
worker.WorkerReportsProgress = True
worker.WorkerSupportsCancellation = True
AddHandler (worker.DoWork), AddressOf begin_upload
worker.RunWorkerAsync()
lblmsg.Text = "Successfully initiated upload"
End Sub
Sub begin_upload(s As Object, e As DoWorkEventArgs)
Dim request As New YouTubeRequest(settings)
Dim vidupload As New Video()
vidupload.Title = "My Big Test Movie"
vidupload.Tags.Add(New MediaCategory("Nonprofit", YouTubeNameTable.CategorySchema))
vidupload.Keywords = "church, jesus"
vidupload.Description = "See the entire video"
vidupload.YouTubeEntry.Private = False
vidupload.YouTubeEntry.setYouTubeExtension("location", "Downers Grove, IL")
vidupload.YouTubeEntry.MediaSource = New MediaFileSource("c:\users\greg\test3.asf", "video/x-ms-wmv")
Dim createdVideo As Video = Request.Upload(vidupload)
End Sub