1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
|
Option Explicit
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim objFso
Dim objWshShell
Dim objOutputFile
Dim strCurPath
Dim strPcListFile
Dim strUnAppFile
Dim strResultsFile
Dim strResultsTime
Dim strResultsDate
Dim strPCName
Dim strTargetapp
Dim strConnectionTest
Dim strReadPCfile
Dim strReadAppfile
Dim strGetRemApps
Dim strCompApps
Dim strUnistallRet
Dim arrAppSplit
Dim arrPcnames()
Dim arrUninstallApps()
Dim arrPCappList()
Dim arrTargetApps()
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objWshShell = WScript.CreateObject("WScript.Shell")
strCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
strPcListFile = InputBox("Please enter the full path and file" & VbCrLf & "name of the file with the computer names.","Uninstall remote apps.")
If strPcListFile = "" Then
MsgBox "You must enter a filename!",vbOKOnly,"Uninstall remote apps."
WScript.Quit(0)
ElseIf Not objFso.FileExists(strPcListFile) Then
MsgBox "You must enter a valid full path and file name of the file with the computer names!",vbOKOnly,"Uninstall remote apps."
WScript.Quit(0)
Else
strUnAppFile = InputBox("Please enter the full path and file" & VbCrLf & "name of the file with the application names.","Uninstall remote apps.")
If strUnAppFile = "" Then
MsgBox "You must enter a filename!",vbOKOnly,"Uninstall remote apps."
WScript.Quit(0)
ElseIf Not objFso.FileExists(strUnAppFile) Then
MsgBox "You must enter a valid full path and file name of the file with the application names!",vbOKOnly,"Uninstall remote apps."
WScript.Quit(0)
Else
strResultsDate = Replace(FormatDateTime(date(),vbshortdate),"/","-")
strResultsTime = Replace(Replace(FormatDateTime(now(),vbLongtime),":","-")," ","")
strResultsFile = strCurPath & "\" & strResultsTime & "_" & strResultsDate & ".csv"
If objFSO.FileExists(strResultsFile) Then
ObjFSO.deleteFile(strResultsFile)
Else
Set objOutputFile = objFso.CreateTextFile(strResultsFile)
objOutputFile.Close
End If
Set objOutputFile = objFso.OpenTextFile(strResultsFile,ForWriting,TristateUseDefault)
strReadPCfile = readFileToArray(strPcListFile,arrPcnames)
strReadAppfile = readFileToArray(strUnAppFile,arrUninstallApps)
If strReadPCfile <> "completed" Then
objOutputFile.WriteLine strReadPCfile
objOutputFile.Close
WScript.Quit(0)
ElseIf strReadAppfile <> "completed" Then
objOutputFile.WriteLine strReadAppfile
objOutputFile.Close
WScript.Quit(0)
Else
For Each strPCName In arrPcnames
ReDim arrPCappList(0)
strConnectionTest = IsServerOn(strPCName)
If strConnectionTest <> "online" Then
objOutputFile.WriteLine strPCName & ",Error while connecting: " & strConnectionTest
Else
ReDim arrPCappList(0)
strGetRemApps = getRemoteApps(strPCName,arrPCappList)
If strGetRemApps <> "gotlist" Then
objOutputFile.WriteLine strPCName & ",Error while getting remote application list: " & strGetRemApps
Else
ReDim arrTargetApps(0)
strCompApps = compareArray(arrUninstallApps,arrPCappList,arrTargetApps)
If strCompApps <> "completed" Then
objOutputFile.WriteLine strPCName & ",Error while comparing application list: " & strCompApps
Else
If arrTargetApps(0) <> "noAppsToDo" Then
For Each strTargetapp In arrTargetApps
arrAppSplit = Split(strTargetapp,"'*u*'")
strUnistallRet = uninstallTarget(strPCName,strTargetapp)
If strUnistallRet <> "uninstalled" Then
objOutputFile.WriteLine strPCName & ",Error while uninstalling " & arrAppSplit(0)
Else
objOutputFile.WriteLine strPCName & "," & arrAppSplit(0) & " was successfully uninstalled"
End If
Next
Else
objOutputFile.WriteLine strPCName & ",No applications to uninstall."
End If
End If
End If
End If
Next
objOutputFile.Close
End If
End If
End If
WScript.Quit(0)
Private Function readFileToArray(strTxtFile, arrname())
Err.Clear
On Error Resume Next
Dim intFuncErr, intFuncLines
Dim objFuncTxtLines, objFuncReadFile,objFuncFso
Set objFuncFso = CreateObject("Scripting.FileSystemObject")
Set objFuncTxtLines = objFuncFso.GetFile(strTxtFile)
Set objFuncReadFile = objFuncTxtLines.OpenAsTextStream(ForReading, TristateUseDefault)
Do Until objFuncReadFile.AtEndOfStream
ReDim Preserve arrname(intFuncLines)
arrname(intFuncLines) = objFuncReadFile.ReadLine
intFuncLines = intFuncLines + 1
Loop
objFuncReadFile.Close
Set objFuncFso = Nothing
Set objFuncTxtLines = Nothing
Set objFuncReadFile = Nothing
If Err.Number <> 0 Then
readFileToArray = "Error reading file: " & strTxtFile & VbCrLf & "Description: " & Err.Description
Else
readFileToArray = "completed"
End If
On Error GoTo 0
End Function
Function getRemoteApps(strRemotePC,arrname())
Err.Clear
On Error Resume Next
Dim objFuncWMIService
Dim colFuncSoftware
Dim objFuncSoftware
Dim intFuncLines
Set objFuncWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strRemotePC & "\root\cimv2")
Set colFuncSoftware = objFuncWMIService.ExecQuery ("SELECT * FROM Win32_Product")
If colFuncSoftware.Count > 0 Then
For Each objFuncSoftware in colFuncSoftware
arrname(intFuncLines) = objFuncSoftware.Name & "'*u*'" & objFuncSoftware.IdentifyingNumber
intFuncLines = intFuncLines + 1
ReDim Preserve arrname(intFuncLines)
Next
End If
If Err.Number <> 0 Then
getRemoteApps = Err.Description
Else
getRemoteApps = "gotlist"
End If
On Error GoTo 0
End Function
Function IsServerOn(strserver)
Err.Clear
On Error Resume Next
Dim Testme
Dim strTestConn
Set Testme = GetObject("winmgmts://" & strserver & "/root/cimv2")
Set strTestConn = GetObject("winmgmts://" & strserver & "/root/default:StdRegProv")
If Err.Number <> 0 Then
IsServerOn = Err.Description
Else
IsServerOn = "online"
End If
On Error GoTo 0
End Function
Private Function compareArray(arrOne(),arrTwo(),arrReturn())
Err.Clear
On Error Resume Next
Dim strArrElement1
Dim strArrElement2
Dim intFuncLoop
intFuncLoop = 0
For Each strArrElement1 In arrOne
For Each strArrElement2 In arrTwo
If strArrElement1 = strArrElement2 Then
ReDim Preserve arrReturn(intFuncLoop)
arrReturn(intFuncLoop) = strArrElement2
intFuncLoop =intFuncLoop + 1
End If
Next
Next
If arrReturn(0) = "" Then arrReturn(0) = "noAppsToDo"
If Err.Number <> 0 Then
compareArray = Err.Description
Else
compareArray = "completed"
End If
On Error GoTo 0
End Function
Private Function uninstallTarget(strComputer,strAppInfo)
Err.Clear
On Error Resume Next
Dim objFuncWMIService
Dim colFuncSoftware
Dim objFuncSoftware
strAppInfo = Split(strAppInfo,"'*u*'")
Set objFuncWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFuncSoftware = objFuncWMIService.ExecQuery ("Select * from Win32_Product Where Name = '" & strAppInfo(0) & "' And IdentifyingNumber = '" & strAppInfo(1) & "'")
For Each objFuncSoftware in colFuncSoftware
objFuncSoftware.Uninstall()
Next
If Err.Number <> 0 Then
uninstallTarget = Err.Description
Else
uninstallTarget = "uninstalled"
End If
On Error GoTo 0
End Function
|
