Search code examples
vb.netperformancebackgroundworkerslowdown

How can I fix my backgroundworker getting progressively slower in VB.NET?


I'm working on a software that adds lines of text to different files. It uses a backgroundworker for that matter. Recently I noticed that the process of adding text gets progressively slower over time. When adding 1000 lines of text, the first 200 lines take about 10 seconds, while the next 200 lines already take around 30-40 seconds.

As you will see, there any many different options that define which file (mostly called loot tables) a line (mostly called item) will go into. It begins by checking different paramters before starting to add the items.

Private Sub bgwAddItems_DoWork(sender As Object, e As System.ComponentModel.DoWorkEventArgs) Handles bgwAddItems.DoWork
        'Begin adding items. Checks if datapack directory exists.
        If My.Computer.FileSystem.DirectoryExists(DatapackPath) Then
            'Checks if there are more than 99 Items being added while AddItemsFast is disabled and will show a warning if thats the case
            If ItemsList.Count > 99 And AddItemsFast = False Then
                Select Case MsgBox("Warning: You are trying to add 100 or more items." + vbNewLine + "This may take a long time to complete. It's recommended to enable 'Add Items Fast' to speed up the process." + vbNewLine + vbNewLine + "Are you sure you want to continue?", vbExclamation + vbYesNo, "Warning")
                    Case Windows.Forms.DialogResult.Yes
                        WriteToLog("Adding 100+ items with normal method, this may take a while!", "Warning")

                        'Sets ItemAddMode. This should be redundant in this case, despite of this I will still leave it there to be save
                        If AddItemsFast = True Then
                            ItemAddMode = "Fast"
                        Else
                            ItemAddMode = "Normal"
                        End If

                        'Resets variables used to detect duplicates
                        IgnoreDuplicates = False
                        DuplicateDetected = False

                        WriteToLog("Preparing to add multiple items.", "Info")

                        'Calculate ProgressStep
                        ProgressStep = 100 / ItemsList.Count

                        'Start adding the items
                        AddMultipleItems()

                        'Set result after items where added.
                        AddItemResult = "success"
                    Case Windows.Forms.DialogResult.No
                        WriteToLog("Cancelled adding 100+ items.", "Info")
                End Select
            Else
                'Sets ItemAddMode
                If AddItemsFast Then
                    ItemAddMode = "Fast"
                Else
                    ItemAddMode = "Normal"
                End If

                'Resets variables used to detect duplicates
                IgnoreDuplicates = False
                DuplicateDetected = False

                'Start the corresponding method for adding items depending on the amount. Will also calculate ProgressStep and post result afterwards.
                If ItemsList.Length = 1 Then
                    Item = ItemsList(0)
                    WriteToLog("Preparing to add a single item.", "Info")
                    ProgressStep = 100 / ItemsList.Count
                    CallAddItem()
                    AddItemResult = "success"
                ElseIf ItemsList.Length = 0 Then
                Else
                    WriteToLog("Preparing to add multiple items.", "Info")
                    ProgressStep = 100 / ItemsList.Count
                    AddMultipleItems()
                    AddItemResult = "success"
                End If
            End If
        Else
            MsgBox("Please enter a datapack path!", MsgBoxStyle.Critical, "Error")
        End If
    End Sub

A few more checks depending on the selected version...

Private Sub CallAddItem()

        'Disable the creative-only options if 'creative-only' is generally disabled
        If CreativeOnly = False Then
            CommandBlock = False
            OtherCreativeOnlyItem = False
            SpawnEgg = False
        End If

        'Beginn adding items for the specific version if string is not empty

        If String.IsNullOrEmpty(Item) = False Then

            If DatapackVersion = "Version 1.16.2 - 1.16.5" Then

                'Add item to loot tables for 1 item
                If NormalItem And (ItemAddMode = "Normal" Or ItemAddMode = "Fast") Then
                    AddItem(Item, "1", "1.16", "main")
                End If

            ElseIf DatapackVersion = "Version 1.17 - 1.17.1" Then

                If NormalItem And (ItemAddMode = "Normal" Or ItemAddMode = "Fast") Then
                    AddItem(Item, "1", "1.17", "main")
                End If

            ElseIf DatapackVersion = "Version 1.18 - 1.18.2" Then

                'Add item to loot tables for 1 item
                If NormalItem And (ItemAddMode = "Normal" Or ItemAddMode = "Fast") Then
                    AddItem(Item, "1", "1.18", "main")
                End If

            ElseIf DatapackVersion = "Version 1.19 - 1.19.3" OrElse DatapackVersion = "Version 1.19.4" Then

                'Add item to loot tables for 1 item
                If NormalItem And (ItemAddMode = "Normal" Or ItemAddMode = "Fast") Then
                    AddItem(Item, "1", "1.19", "main")
                End If
            End If

            'Update And report workerprogress
            Workerprogress = Workerprogress + ProgressStep
            bgwAddItems.ReportProgress(Workerprogress)
            Invoke(Sub() tbSmallOutput.Text = Output)
            TotalItemAmount = TotalItemAmount - 1
            Invoke(Sub() lblItemsTotal.Text = "Adding items... (" + TotalItemAmount.ToString + " items remaining)")
        Else
            MsgBox("Please enter a text in the ID textbox!", MsgBoxStyle.Critical, "Error")
        End If
    End Sub

And finally, the code that actually adds the items depending on Item ID (which is the text), item amount, version and loot table (which is the file).

Private Sub AddItem(Item_ID As String, Item_Amount As Integer, Version As String, Loot_Table As String)

        'If no duplicate has been detected or duplicates are simply ignored
        If DuplicateDetected = False Or IgnoreDuplicates = True Then
            WriteToLog("-- Adding item --", "Info")
            ExceptionAddItem = ""

            'Set custom NTB tag and prefix
            If CustomNBT = True Then
                NBTtag = CustomNBTString.Replace(qm, "\" + qm) 'Fix quotiation marks in NBT tags
                WriteToLog("Adding NBT tag: " + NBTtag, "Info")
            Else
                NBTtag = "NONE"
                WriteToLog("No NBT tag selected.", "Info")
            End If

            If SamePrefix = True Then
                Prefix = SamePrefixString
                WriteToLog("Using the same prefix for all items: " + Prefix, "Info")
            Else
                WriteToLog("Not using the same prefix for all items, will read prefix from item list.", "Info")
            End If

            'Determine the full item name based on the item ID
            If SamePrefix = True Then
                FullItemName = Prefix + ":" + Item_ID
            Else
                FullItemName = Item_ID
            End If

            'Define ItemAmountPath depending on Item_Amount
            If Item_Amount = 1 Then
                ItemAmountPath = "1item\"
                WriteToLog("Item amount detected as 1, using default path for 1 item. ", "Info")
            ElseIf Item_Amount = "-1" Then
                ItemAmountPath = "randomamountsameitem\"
                WriteToLog("Item amount detected as random amount of same item, using default path for random amount of same item. ", "Info")
            ElseIf Item_Amount = "-2" Then
                ItemAmountPath = "randomamountdifitems\"
                WriteToLog("Item amount detected as random amount of different items, using default path for random amount of different items. ", "Info")
            ElseIf Item_Amount > 1 Then
                ItemAmountPath = Item_Amount.ToString + "sameitems\"
                WriteToLog("Item amount detected as bigger than 1, using path for multiple items.", "Info")
            End If


            'Check if item you want to add already exists
            If My.Computer.FileSystem.FileExists(DatapackPath + "\data\randomitemgiver\loot_tables\" + ItemAmountPath + Loot_Table + ".json") Then
                FileTemp = My.Computer.FileSystem.ReadAllText(DatapackPath + "\data\randomitemgiver\loot_tables\" + ItemAmountPath + Loot_Table + ".json")
            End If
            'If the item you want to add does not exist or duplicates are ignored add items depending on version and loot table
            If FileTemp.Contains(qm + FullItemName + qm) = False Or IgnoreDuplicates = True Then
                Try
                    If Version = "1.16" OrElse Version = "1.18" OrElse Version = "1.19" Then

                        If Item_Amount = 1 Then
                            LineRemoveLoop = 8

                            While LineRemoveLoop > 0
                                Dim EditFileLines() As String = IO.File.ReadAllLines(DatapackPath + "\data\randomitemgiver\loot_tables\1item\" + Loot_Table + ".json")
                                Dim FileStreamEditFile As New FileStream(DatapackPath + "\data\randomitemgiver\loot_tables\1item\" + Loot_Table + ".json", FileMode.Open, FileAccess.ReadWrite)
                                EditFileLastLineLength = EditFileLines.Last.Length.ToString

                                FileStreamEditFile.SetLength(FileStreamEditFile.Length - EditFileLastLineLength)
                                FileStreamEditFile.Close()

                                LineRemoveLoop = LineRemoveLoop - 1
                            End While

                            If (Loot_Table = "main" OrElse Loot_Table = "main_without_creative-only" OrElse Loot_Table = "special_xvv" OrElse Loot_Table = "special_xvx" OrElse Loot_Table = "special_vvx" OrElse Loot_Table = "special_xxv" OrElse Loot_Table = "Special_xvv" OrElse Loot_Table = "special_vxv" OrElse Loot_Table = "special_vvx" OrElse Loot_Table = "special_vxv" OrElse Loot_Table = "special_vxx") And cbCustomNBT.Checked = False Then
                                My.Computer.FileSystem.WriteAllText(DatapackPath + "\data\randomitemgiver\loot_tables\1item\" + Loot_Table + ".json", vbNewLine + "        }," + vbNewLine + "        {" + vbNewLine + "          " + qm + "type" + qm + ": " + qm + "minecraft:item" + qm + "," + vbNewLine + "          " + qm + "name" + qm + ": " + qm + FullItemName + qm + vbNewLine + ReturnArrayAsString(CodeEnd), True)
                            ElseIf (Loot_Table = "main" OrElse Loot_Table = "main_without_creative-only" OrElse Loot_Table = "special_xvv" OrElse Loot_Table = "special_xvx" OrElse Loot_Table = "special_vvx" OrElse Loot_Table = "special_xxv" OrElse Loot_Table = "Special_xvv" OrElse Loot_Table = "special_vxv" OrElse Loot_Table = "special_vvx" OrElse Loot_Table = "special_vxv" OrElse Loot_Table = "special_vxx") And cbCustomNBT.Checked = True Then
                                My.Computer.FileSystem.WriteAllText(DatapackPath + "\data\randomitemgiver\loot_tables\1item\" + Loot_Table + ".json", vbNewLine + "        }," + vbNewLine + "        {" + vbNewLine + "          " + qm + "type" + qm + ": " + qm + "minecraft:item" + qm + "," + vbNewLine + "          " + qm + "name" + qm + ": " + qm + FullItemName + qm + "," + vbNewLine + "                    " + qm + "functions" + qm + ": [" + vbNewLine + "                        {" + vbNewLine + "                            " + qm + "function" + qm + ": " + qm + "set_nbt" + qm + "," + vbNewLine + "                            " + qm + "tag" + qm + ": " + qm + NBTtag + qm + vbNewLine + "                        }" + vbNewLine + "                    ]" + vbNewLine + ReturnArrayAsString(CodeEnd), True)
                            ElseIf Loot_Table = "suspicious_stews" OrElse Loot_Table = "enchanted_books" OrElse Loot_Table = "potions" OrElse Loot_Table = "splash_potions" OrElse Loot_Table = "lingering_potions" OrElse Loot_Table = "tipped_arrows" Then
                                My.Computer.FileSystem.WriteAllText(DatapackPath + "\data\randomitemgiver\loot_tables\1item\" + Loot_Table + ".json", vbNewLine + "        }," + vbNewLine + "        {" + vbNewLine + "          " + qm + "type" + qm + ": " + qm + "minecraft:item" + qm + "," + vbNewLine + "          " + qm + "name" + qm + ": " + qm + FullItemName + qm + "," + vbNewLine + "                    " + qm + "functions" + qm + ": [" + vbNewLine + "                        {" + vbNewLine + "                            " + qm + "function" + qm + ": " + qm + "set_nbt" + qm + "," + vbNewLine + "                            " + qm + "tag" + qm + ": " + qm + NBTtag + qm + vbNewLine + "                        }" + vbNewLine + "                    ]" + vbNewLine + ReturnArrayAsString(CodeEnd), True)
                            ElseIf Loot_Table = "goat_horns" And Version = "1.19" Then
                                My.Computer.FileSystem.WriteAllText(DatapackPath + "\data\randomitemgiver\loot_tables\1item\" + Loot_Table + ".json", vbNewLine + "        }," + vbNewLine + "        {" + vbNewLine + "          " + qm + "type" + qm + ": " + qm + "minecraft:item" + qm + "," + vbNewLine + "          " + qm + "name" + qm + ": " + qm + FullItemName + qm + "," + vbNewLine + "                    " + qm + "functions" + qm + ": [" + vbNewLine + "                        {" + vbNewLine + "                            " + qm + "function" + qm + ": " + qm + "set_nbt" + qm + "," + vbNewLine + "                            " + qm + "tag" + qm + ": " + qm + NBTtag + qm + vbNewLine + "                        }" + vbNewLine + "                    ]" + vbNewLine + ReturnArrayAsString(CodeEnd), True)
                            End If

                        End if

                  End if

                Catch Exception As Exception
                    ExceptionAddItem = Exception.Message
                End Try

                'If not exception was found show completion message, otherwise show exception
                If String.IsNullOrEmpty(ExceptionAddItem) Then
                    Output = "Succesfully added " + FullItemName + " to selected loot tables in Version " + Version + " (NBT: " + NBTtag + ")"
                    WriteToLog("Added item " + FullItemName + " to loot table " + Loot_Table + " with amount " + Item_Amount.ToString, "Info")
                Else
                    Output = "Error: " + ExceptionAddItem
                    WriteToLog("Error when adding item: " + ExceptionAddItem, "Error")
                End If

            Else
                'If duplicate exists show option to either ignore it or cancel 
                WriteToLog("Detected duplicate When adding item.", "Info")
                Select Case MsgBox("The item you are trying To add (" + FullItemName + ") already exists In the datapack." + vbNewLine + "Are you sure you want To add it again? This will result In duplicates.", vbExclamation + vbYesNo, "Warning")
                    Case Windows.Forms.DialogResult.Yes
                        WriteToLog("Ignoring warning, adding duplicate.", "Info")
                        IgnoreDuplicates = True
                        AddItem(Item_ID, Item_Amount, Version, Loot_Table)
                    Case Windows.Forms.DialogResult.No
                        WriteToLog("Not adding duplicate, cancelling.", "Info")
                        IgnoreDuplicates = False
                        DuplicateDetected = True
                        Output = "Cancelled adding " + FullItemName + " To " + Loot_Table + " In Version " + Version + " (NBT: " + NBTtag + ")"
                End Select
            End If
        End If

I know this is a lot of code but It would be great if anyone could help me figure out what's causing the backgroundworker to slow down after a while. I've cut out some parts of the code that aren't used. In case these code extracts arent enough, here is the full file: https://github.com/Seeloewen/Random-Item-Giver-Updater/blob/main/Random%20Item%20Giver%20Updater/frmMain.vb


Solution

  • Figured it out thanks to all the helpful comments. My method which wrote to a log caused the issue, as it wrote to the log file multiple times for each item. This caused a massive slowdown.