HTA Script
Hej Kan i hjælpe mig med nedenstående script.Jeg kan ikke få strComputer til at virke i nogle af subs i dette HTA script med tabs. Der meldes desuden fejl i forbindelse med Data.area1. Desuden vil danske tegn æøå ikke godtages, men den tror jeg at jeg har løsningen på.
Fejlene er først begyndt efter at jeg har indsat tabs i dette hta, uden kører scriptet som det skal.
<html>
<HTA:APPLICATION
APPLICATIONNAME="PC Updater"
SCROLL="yes"
SINGLEINSTANCE="yes"
>
<head>
<title>Updater</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<body bgcolor=buttonface scroll=no topmargin=5>
<style type="text/css">
Body {Background-Color: #363636}
div,td{cursor:default;font-size:9pt;}
</style>
<script language=VBScript>
FUNCTION Window_Onload
Window.resizeTo 1100,800
End FUNCTION
sub windows_onload
strComputer = MachineName.value
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const OverwriteExisting = True
end sub
Sub TabStrip_Change()
select case TabStrip.Value
case 0
Page6.style.visibility = "hidden"
Page5.style.visibility = "hidden"
Page4.style.visibility = "hidden"
Page3.style.visibility = "hidden"
Page2.style.visibility = "hidden"
Page1.style.visibility = "hidden"
Page0.style.visibility = "visible"
case 1
Page0.style.visibility = "hidden"
Page1.style.visibility = "visible"
Page2.style.visibility = "hidden"
Page3.style.visibility = "hidden"
Page4.style.visibility = "hidden"
Page5.style.visibility = "hidden"
Page6.style.visibility = "hidden"
case 2
Page0.style.visibility = "hidden"
Page1.style.visibility = "hidden"
Page2.style.visibility = "visible"
Page3.style.visibility = "hidden"
Page4.style.visibility = "hidden"
Page5.style.visibility = "hidden"
Page6.style.visibility = "hidden"
case 3
Page0.style.visibility = "hidden"
Page1.style.visibility = "hidden"
Page2.style.visibility = "hidden"
Page3.style.visibility = "visible"
Page4.style.visibility = "hidden"
Page5.style.visibility = "hidden"
Page6.style.visibility = "hidden"
case 4
Page0.style.visibility = "hidden"
Page1.style.visibility = "hidden"
Page2.style.visibility = "hidden"
Page3.style.visibility = "hidden"
Page4.style.visibility = "visible"
Page5.style.visibility = "hidden"
Page6.style.visibility = "hidden"
case 5
Page0.style.visibility = "hidden"
Page1.style.visibility = "hidden"
Page2.style.visibility = "hidden"
Page3.style.visibility = "hidden"
Page4.style.visibility = "hidden"
Page5.style.visibility = "visible"
Page6.style.visibility = "hidden"
case 6
Page0.style.visibility = "hidden"
Page1.style.visibility = "hidden"
Page2.style.visibility = "hidden"
Page3.style.visibility = "hidden"
Page4.style.visibility = "hidden"
Page5.style.visibility = "hidden"
Page6.style.visibility = "visible"
end select
end sub
sub CopyFiles
strComputer = MachineName.Value
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const OverwriteExisting = True
'================================Specifikation af filer og folder der skal kopieres til remote Pc begynd=========================
'++++++++++++++++++++Function Copy File(s)++++++++++++++++++++++++++++++++++++++++++++
'''''''''''''''''''''Copy File 1''''''''''''''''''''''''''''''''''''''''''''
strCopyFile1 = "Files_Folders\Files\Tnsnames.ora" 'Linie 138-175
strCopyFile1_1 = "" 'Linie 138-175
strFileRemotePath1 = "\C$\Oracle\network\Admin\" 'Linie 138-175
strFileFullPath1 = "C:\\Oracle\\network\\Admin\\Tnsnames.ora" 'Linie 138-175
strFileName1 = "Tnsnames.ora" 'Linie 138-175
''''''''''''''''''''''Copy File 2'''''''''''''''''''''''''''''''''''''''''''
strCopyFile2 = "Files_Folders\Files\Operator_New.lnk" 'Linie 138-175
strCopyFile2_1 = "Files_Folders\Update af Operator_New.lnk" 'Linie 138-175
strFileRemotePath2 = "\C$\Documents and Settings\All Users\Desktop\" 'Linie 138-175
strFileFullPath2 = "C:\\Documents and Settings\\All Users\\Desktop\\Operator_New.lnk" 'Linie 138-175
strFileName2 = "Operator_New.lnk" 'Linie 138-175
'''''''''''''''''''''''Copy File 3''''''''''''''''''''''''''''''''''''''''''
strCopyFile3 = "Files_Folders\Files\Operator BckNew.lnk" 'Linie 183-220
strCopyFile3_1 = "Files_Folders\Update af Operator_BckNew.lnk" 'Linie 183-220
strFileRemotePath3 = "\C$\Documents and Settings\All Users\Desktop\" 'Linie 183-220
strFileFullPath3 = "C:\\Documents and Settings\\All Users\\Desktop\\Operator_BckNew.lnk" 'Linie 183-220
strFileName3 = "Operator_BckNew.lnk" 'Linie 183-220
'''''''''''''''''''''''Copy File 4''''''''''''''''''''''''''''''''''''''''''
strCopyFile4 = "Files_Folders\Files\test4.txt" 'Linie 228-265
strCopyFile4_1 = "Files_Folders\test4.vbs" 'Linie 228-265
strFileRemotePath4 = "\C$\test\" 'Linie 228-265
strFileFullPath4 = "C:\\test\\test4.txt" 'Linie 228-265
strFileName4 = "test4.txt" 'Linie 228-265
'''''''''''''''''''''''Copy File 5''''''''''''''''''''''''''''''''''''''''''
strCopyFile5 = "Files_Folders\Files\test5.txt" 'Linie 273-310
strCopyFile5_1 = "Files_Folders\test5.vbs" 'Linie 273-310
strFileRemotePath5 = "\C$\test\" 'Linie 273-310
strFileFullPath5 = "C:\\test\\test5.txt" 'Linie 273-310
strFileName5 = "test5.txt" 'Linie 273-310
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'================================Specifikation af filer og folder der skal kopieres til remote Pc slut=========================
' ************************************************************************************************************************
'Kopiering af fil 1 hvis checked
' ************************************************************************************************************************
If CopyFile1.checked Then
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery("Select * From CIM_DataFile Where Name = '" & strFileFullPath1 & "'")
If colFiles.Count = 0 Then
'strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
strHTML = strHTML & "<Font color = black>Her tjekkes om filen (" & strFileName1 & ") eksisterer i den følgende sti: (" & strFileRemotePath1 & ") p?remote computer <b>(" & strComputer & ")</b></font></Br>"
strHTML = strHTML & "<br>"
strHTML = strHTML & "<td><Font color = black>Filen (" & strFileName1 & ") eksisterede IKKE. Filen (" & strFileName1 & ") er nu kopieret til remote computer <b>(" & strComputer & ")</b> </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
objFSO.CopyFile (strCopyFile1), _
"\\" & strComputer & strFileRemotePath1, OverWriteExisting
'#######################Kopiering af VBS Fil###########################################
'objFSO.CopyFile (strCopyFile1_1), _
'"\\" & strComputer & strFileRemotePath1, OverWriteExisting
'#######################Kopiering af VBS Fil Slut######################################
Else
' #####################################################################################
' Tjek om filen eksisterer i stien, hvis detter er tilfældet overskrives den med en
' ny version, for at sikre at evt. ædringer er med.
' #####################################################################################
strHTML = strHTML & "<br>"
strHTML = strHTML & "<Font color = black>Filen (" & strFileName1 & ") eksisterede i stien: (" & strFileRemotePath1 & ") p?remote computer <b>(" & strComputer & ")</b>. Filen er nu blevet overskrevet </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
objFSO.CopyFile (strCopyFile1), _
"\\" & strComputer & strFileRemotePath1, OverWriteExisting
'#######################Kopiering af VBS Fil###########################################
'objFSO.CopyFile (strCopyFile1_1), _
'"\\" & strComputer & strFileRemotePath1, OverWriteExisting
'#######################Kopiering af VBS Fil Slut######################################
End If
End If
' ************************************************************************************************************************
'Kopiering af fil 1 hvis checked afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
'Kopiering af fil 2 hvis checked
' ************************************************************************************************************************
If CopyFile2.checked Then
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery("Select * From CIM_DataFile Where Name = '" & strFileFullPath2 & "'")
If colFiles.Count = 0 Then
'strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
strHTML = strHTML & "<Font color = black>Her tjekkes om filen (" & strFileName2 & ") eksisterer i den f鴏gende sti: (" & strFileRemotePath2 & ") p?remote computer <b>(" & strComputer & ")</b></font></Br>"
strHTML = strHTML & "<br>"
strHTML = strHTML & "<td><Font color = black>Filen (" & strFileName2 & ") eksisterede IKKE. Filen (" & strFileName2 & ") er nu kopieret til remote computer <b>(" & strComputer & ")</b> </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
objFSO.CopyFile (strCopyFile2), _
"\\" & strComputer & strFileRemotePath2, OverWriteExisting
'#######################Kopiering af VBS Fil###########################################
objFSO.CopyFile (strCopyFile2_1), _
"\\" & strComputer & strFileRemotePath1, OverWriteExisting
'#######################Kopiering af VBS Fil Slut######################################
Else
' #####################################################################################
' Tjek om filen eksisterer i stien, hvis detter er tilf鎙det overskrives den med en
' ny version, for at sikre at evt. 鎛dringer er med.
' #####################################################################################
strHTML = strHTML & "<br>"
strHTML = strHTML & "<Font color = black>Filen (" & strFileName2 & ") eksisterede i stien: (" & strFileRemotePath2 & ") p?remote computer <b>(" & strComputer & ")</b>. Filen er nu blevet overskrevet </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
objFSO.CopyFile (strCopyFile2), _
"\\" & strComputer & strFileRemotePath2, OverWriteExisting
'#######################Kopiering af VBS Fil###########################################
objFSO.CopyFile (strCopyFile2_1), _
"\\" & strComputer & strFileRemotePath2, OverWriteExisting
'#######################Kopiering af VBS Fil Slut######################################
End If
End If
' ************************************************************************************************************************
'Kopiering af fil 2 hvis checked afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
'Kopiering af fil 3 hvis checked
' ************************************************************************************************************************
If CopyFile3.checked Then
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery("Select * From CIM_DataFile Where Name = '" & strFileFullPath3 & "'")
If colFiles.Count = 0 Then
'strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
strHTML = strHTML & "<Font color = black>Her tjekkes om filen (" & strFileName3 & ") eksisterer i den f鴏gende sti: (" & strFileRemotePath3 & ") p?remote computer <b>(" & strComputer & ")</b></font></Br>"
strHTML = strHTML & "<br>"
strHTML = strHTML & "<td><Font color = black>Filen (" & strFileName3 & ") eksisterede IKKE. Filen (" & strFileName3 & ") er nu kopieret til remote computer <b>(" & strComputer & ")</b> </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
objFSO.CopyFile (strCopyFile3), _
"\\" & strComputer & strFileRemotePath3, OverWriteExisting
'#######################Kopiering af VBS Fil###########################################
objFSO.CopyFile (strCopyFile3_1), _
"\\" & strComputer & strFileRemotePath3, OverWriteExisting
'#######################Kopiering af VBS Fil Slut######################################
Else
' #####################################################################################
' Tjek om filen eksisterer i stien, hvis detter er tilf鎙det overskrives den med en
' ny version, for at sikre at evt. 鎛dringer er med.
' #####################################################################################
strHTML = strHTML & "<br>"
strHTML = strHTML & "<Font color = black>Filen (" & strFileName3 & ") eksisterede i stien: (" & strFileRemotePath3 & ") p?remote computer <b>(" & strComputer & ")</b>. Filen er nu blevet overskrevet </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
objFSO.CopyFile (strCopyFile3), _
"\\" & strComputer & strFileRemotePath3, OverWriteExisting
'#######################Kopiering af VBS Fil###########################################
objFSO.CopyFile (strCopyFile3_1), _
"\\" & strComputer & strFileRemotePath3, OverWriteExisting
'#######################Kopiering af VBS Fil Slut######################################
End If
End If
' ************************************************************************************************************************
'Kopiering af fil 3 hvis checked afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
'Kopiering af fil 4 hvis checked
' ************************************************************************************************************************
If CopyFile4.checked Then
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery("Select * From CIM_DataFile Where Name = '" & strFileFullPath4 & "'")
If colFiles.Count = 0 Then
'strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
strHTML = strHTML & "<Font color = black>Her tjekkes om filen (" & strFileName4 & ") eksisterer i den f鴏gende sti: (" & strFileRemotePath4 & ") p?remote computer <b>(" & strComputer & ")</b></font></Br>"
strHTML = strHTML & "<br>"
strHTML = strHTML & "<td><Font color = black>Filen (" & strFileName4 & ") eksisterede IKKE. Filen (" & strFileName4 & ") er nu kopieret til remote computer <b>(" & strComputer & ")</b> </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
objFSO.CopyFile (strCopyFile4), _
"\\" & strComputer & strFileRemotePath4, OverWriteExisting
'#######################Kopiering af VBS Fil###########################################
objFSO.CopyFile (strCopyFile4_1), _
"\\" & strComputer & strFileRemotePath4, OverWriteExisting
'#######################Kopiering af VBS Fil Slut######################################
Else
' #####################################################################################
' Tjek om filen eksisterer i stien, hvis detter er tilf鎙det overskrives den med en
' ny version, for at sikre at evt. 鎛dringer er med.
' #####################################################################################
strHTML = strHTML & "<br>"
strHTML = strHTML & "<Font color = black>Filen (" & strFileName4 & ") eksisterede i stien: (" & strFileRemotePath4 & ") p?remote computer <b>(" & strComputer & ")</b>. Filen er nu blevet overskrevet </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
objFSO.CopyFile (strCopyFile4), _
"\\" & strComputer & strFileRemotePath4, OverWriteExisting
'#######################Kopiering af VBS Fil###########################################
objFSO.CopyFile (strCopyFile4_1), _
"\\" & strComputer & strFileRemotePath4, OverWriteExisting
'#######################Kopiering af VBS Fil Slut######################################
End If
End If
' ************************************************************************************************************************
'Kopiering af fil 4 hvis checked afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
'Kopiering af fil 5 hvis checked afsluttet
' ************************************************************************************************************************
If CopyFile5.checked Then
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService.ExecQuery("Select * From CIM_DataFile Where Name = '" & strFileFullPath5 & "'")
If colFiles.Count = 0 Then
'strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
strHTML = strHTML & "<Font color = black>Her tjekkes om filen (" & strFileName5 & ") eksisterer i den f鴏gende sti: (" & strFileRemotePath5 & ") p?remote computer <b>(" & strComputer & ")</b></font></Br>"
strHTML = strHTML & "<br>"
strHTML = strHTML & "<td><Font color = black>Filen (" & strFileName5 & ") eksisterede IKKE. Filen (" & strFileName5 & ") er nu kopieret til remote computer <b>(" & strComputer & ")</b> </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
objFSO.CopyFile (strCopyFile5), _
"\\" & strComputer & strFileRemotePath5, OverWriteExisting
'#######################Kopiering af VBS Fil###########################################
objFSO.CopyFile (strCopyFile5_1), _
"\\" & strComputer & strFileRemotePath5, OverWriteExisting
'#######################Kopiering af VBS Fil Slut######################################
Else
' #####################################################################################
' Tjek om filen eksisterer i stien, hvis detter er tilf鎙det overskrives den med en
' ny version, for at sikre at evt. 鎛dringer er med.
' #####################################################################################
strHTML = strHTML & "<br>"
strHTML = strHTML & "<Font color = black>Filen (" & strFileName5 & ") eksisterede i stien: (" & strFileRemotePath5 & ") p?remote computer <b>(" & strComputer & ")</b>. Filen er nu blevet overskrevet </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
objFSO.CopyFile (strCopyFile5), _
"\\" & strComputer & strFileRemotePath5, OverWriteExisting
'#######################Kopiering af VBS Fil###########################################
objFSO.CopyFile (strCopyFile5_1), _
"\\" & strComputer & strFileRemotePath5, OverWriteExisting
'#######################Kopiering af VBS Fil Slut######################################
End If
End If
End Sub
' ************************************************************************************************************************
'Kopiering af fil 5 hvis checked
' ************************************************************************************************************************
'~~~~~~~~~~~~~~~~~~~~~~~~~HTML OUTPUT TIL HTA FIL BEGYNDT~~~~~~~~~~~~~~~~~~~~~~~~~
DataArea1.InnerHTML = strHTML
'~~~~~~~~~~~~~~~~~~~~~~~~~HTML OUTPUT TIL HTA FIL AFSLUTTET~~~~~~~~~~~~~~~~~~~~~~~
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
Sub CopyFolder
strComputer = MachineName.Value
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const OverwriteExisting = True
'++++++++++++++++++++Function Copy Folder(s)++++++++++++++++++++++++++++++++++++++++++++
'''''''''''''''''''''''Copy Folder 1''''''''''''''''''''''''''''''''''''''''''
strCopyFolder1 = "Files_Folders\Folders\New" 'Linie 318-348
strRemoteFolder1 = ("\\" & strComputer & "\C$\operator\bin\new") 'Linie 318-348
strFolderName1 = "NEW" 'Linie 318-348
'''''''''''''''''''''''Copy Folder 2''''''''''''''''''''''''''''''''''''''''''
strCopyFolder2 = "Files_Folders\Folders\bcknew" 'Linie 356-386
strRemoteFolder2 = ("\\" & strComputer & "\C$\operator\bin\bcknew") 'Linie 356-386
strFolderName2 = "bcknew" 'Linie 356-386
'''''''''''''''''''''''Copy Folder 3''''''''''''''''''''''''''''''''''''''''''
strCopyFolder3 = "\\fraafp0002.fl.d\login\policyuser" 'Linie 394-424
strRemoteFolder3 = ("\\" & strComputer & "\C$\policyuser") 'Linie 394-424
strFolderName3 = "policyuser" 'Linie 394-424
'''''''''''''''''''''''Copy Folder 4''''''''''''''''''''''''''''''''''''''''''
strCopyFolder4 = "Files_Folders\Folders\test1" 'Linie 432-462
strRemoteFolder4 = ("\\" & strComputer & "\C$\test\test1") 'Linie 432-462
strFolderName4 = "test1" 'Linie 432-462
'''''''''''''''''''''''Copy Folder 5''''''''''''''''''''''''''''''''''''''''''
strCopyFolder5 = "Files_Folders\test2" 'Linie 470-500
strRemoteFolder5 = ("\\" & strComputer & "\C$\test\test2") 'Linie 470-500
strFolderName5 = "test2" 'Linie 470-500
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ************************************************************************************************************************
'Kopiering af folder1 hvis checked
' ************************************************************************************************************************
If CopyFolder1.checked Then
If objFSO.FolderExists(strRemoteFolder1) Then
strHTML = strHTML & "<Font color = black>Folderen (" & strFolderName1 & ") er i stien (" & strRemoteFolder1 & ") p?remote computer <b>(" & strComputer & ")</b>, folderen bliver slettet og kopieret ind igen med evt, nye rettelser.</font></Br>"
objFSO.DeleteFolder strRemoteFolder1
objFSO.CopyFolder strCopyFolder1 , strRemoteFolder1, True
Else
strHTML = strHTML & "<td><Font color = black>Folderen (" & strRemoteFolder1 & ") eksisterer Ikke. Den vil nu blive kopieret ind p?remote computer <b>(" & strComputer & ")</b></font></Br>"
objFSO.CopyFolder strCopyFolder1 , strRemoteFolder1, True
End If
' #####################################################################################
' Tjek om folderen der blev kopieret ind nu ogs?er kopieret til destination
' #####################################################################################
If objFSO.FolderExists(strRemoteFolder1) Then
strHTML = strHTML & "<br>"
strHTML = strHTML & "<td><Font color = black>Folderen (" & strFolderName1 & ") er blevet kopieret ind til f鴏genden sti (" & strRemoteFolder1 & ") p?remote computer <b>(" & strComputer & ")</b> </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
Else
strHTML = strHTML & "<td><Font color = black>Folderen (" & strFolderName1 & ") eksisterer Ikke i stien (" & strRemoteFolder1 & ") p?remote computer <b>(" & strComputer & ")</b> Tjek for evt. fejl</font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
End If
End If
' ************************************************************************************************************************
'Kopiering af folder1 hvis checked afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
'Kopiering af folder2 hvis checked
' ************************************************************************************************************************
If CopyFolder2.checked Then
If objFSO.FolderExists(strRemoteFolder2) Then
strHTML = strHTML & "<Font color = black>Folderen (" & strFolderName2 & ") er i stien (" & strRemoteFolder2 & ") p?remote computer <b>(" & strComputer & ")</b>, folderen bliver slettet og kopieret ind igen med evt, nye rettelser.</font></Br>"
objFSO.DeleteFolder strRemoteFolder2
objFSO.CopyFolder strCopyFolder2 , strRemoteFolder2, True
Else
strHTML = strHTML & "<td><Font color = black>Folderen (" & strRemoteFolder2 & ") eksisterer Ikke. Den vil nu blive kopieret ind p?remote computer <b>(" & strComputer & ")</b></font></Br>"
objFSO.CopyFolder strCopyFolder2 , strRemoteFolder2, True
End If
' #####################################################################################
' Tjek om folderen der blev kopieret ind nu ogs?er kopieret til destination
' #####################################################################################
If objFSO.FolderExists(strRemoteFolder2) Then
strHTML = strHTML & "<br>"
strHTML = strHTML & "<td><Font color = black>Folderen (" & strFolderName2 & ") er blevet kopieret ind til f鴏genden sti (" & strRemoteFolder2 & ") p?remote computer <b>(" & strComputer & ")</b> </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
Else
strHTML = strHTML & "<td><Font color = black>Folderen (" & strFolderName2 & ") eksisterer Ikke i stien (" & strRemoteFolder2 & ") p?remote computer <b>(" & strComputer & ")</b> Tjek for evt. fejl</font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
End If
End If
' ************************************************************************************************************************
'Kopiering af folder2 hvis checked afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
'Kopiering af Folder3 hvis checked
' ************************************************************************************************************************
If CopyFolder3.checked Then
If objFSO.FolderExists(strRemoteFolder3) Then
strHTML = strHTML & "<Font color = black>Folderen (" & strFolderName3 & ") er i stien (" & strRemoteFolder3 & ") p?remote computer <b>(" & strComputer & ")</b>, folderen bliver slettet og kopieret ind igen med evt, nye rettelser.</font></Br>"
objFSO.DeleteFolder strRemoteFolder3
objFSO.CopyFolder strCopyFolder3 , strRemoteFolder3, True
Else
strHTML = strHTML & "<td><Font color = black>Folderen (" & strRemoteFolder3 & ") eksisterer Ikke. Den vil nu blive kopieret ind p?remote computer <b>(" & strComputer & ")</b></font></Br>"
objFSO.CopyFolder strCopyFolder3 , strRemoteFolder3, True
End If
' #####################################################################################
' Tjek om folderen der blev kopieret ind nu ogs?er kopieret til destination
' #####################################################################################
If objFSO.FolderExists(strRemoteFolder3) Then
strHTML = strHTML & "<br>"
strHTML = strHTML & "<td><Font color = black>Folderen (" & strFolderName3 & ") er blevet kopieret ind til f鴏genden sti (" & strRemoteFolder3 & ") p?remote computer <b>(" & strComputer & ")</b> </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
Else
strHTML = strHTML & "<td><Font color = black>Folderen (" & strFolderName3 & ") eksisterer Ikke i stien (" & strRemoteFolder3 & ") p?remote computer <b>(" & strComputer & ")</b> Tjek for evt. fejl</font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
End If
End If
' ************************************************************************************************************************
'Kopiering af Folder3 hvis checked afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
'Kopiering af Folder4 hvis checked
' ************************************************************************************************************************
If CopyFolder4.checked Then
If objFSO.FolderExists(strRemoteFolder4) Then
strHTML = strHTML & "<Font color = black>Folderen (" & strFolderName4 & ") er i stien (" & strRemoteFolder4 & ") p?remote computer <b>(" & strComputer & ")</b>, folderen bliver slettet og kopieret ind igen med evt, nye rettelser.</font></Br>"
objFSO.DeleteFolder strRemoteFolder4
objFSO.CopyFolder strCopyFolder4 , strRemoteFolder4, True
Else
strHTML = strHTML & "<td><Font color = black>Folderen (" & strRemoteFolder4 & ") eksisterer Ikke. Den vil nu blive kopieret ind p?remote computer <b>(" & strComputer & ")</b></font></Br>"
objFSO.CopyFolder strCopyFolder4 , strRemoteFolder4, True
End If
' #####################################################################################
' Tjek om folderen der blev kopieret ind nu ogs?er kopieret til destination
' #####################################################################################
If objFSO.FolderExists(strRemoteFolder4) Then
strHTML = strHTML & "<br>"
strHTML = strHTML & "<td><Font color = black>Folderen (" & strFolderName4 & ") er blevet kopieret ind til f鴏genden sti (" & strRemoteFolder4 & ") p?remote computer <b>(" & strComputer & ")</b> </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
Else
strHTML = strHTML & "<td><Font color = black>Folderen (" & strFolderName4 & ") eksisterer Ikke i stien (" & strRemoteFolder4 & ") p?remote computer <b>(" & strComputer & ")</b> Tjek for evt. fejl</font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
End If
End If
' ************************************************************************************************************************
'Kopiering af Folder4 hvis checked afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
'Kopiering af Folder5 hvis checked
' ************************************************************************************************************************
If CopyFolder5.checked Then
If objFSO.FolderExists(strRemoteFolder5) Then
strHTML = strHTML & "<Font color = black>Folderen (" & strFolderName5 & ") er i stien (" & strRemoteFolder5 & ") p?remote computer <b>(" & strComputer & ")</b>, folderen bliver slettet og kopieret ind igen med evt, nye rettelser.</font></Br>"
objFSO.DeleteFolder strRemoteFolder5
objFSO.CopyFolder strCopyFolder5 , strRemoteFolder5, True
Else
strHTML = strHTML & "<td><Font color = black>Folderen (" & strRemoteFolder5 & ") eksisterer Ikke. Den vil nu blive kopieret ind p?remote computer <b>(" & strComputer & ")</b></font></Br>"
objFSO.CopyFolder strCopyFolder5 , strRemoteFolder5, True
End If
' #####################################################################################
' Tjek om folderen der blev kopieret ind nu ogs?er kopieret til destination
' #####################################################################################
If objFSO.FolderExists(strRemoteFolder5) Then
strHTML = strHTML & "<br>"
strHTML = strHTML & "<td><Font color = black>Folderen (" & strFolderName5 & ") er blevet kopieret ind til f鴏genden sti (" & strRemoteFolder5 & ") p?remote computer <b>(" & strComputer & ")</b> </font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
Else
strHTML = strHTML & "<td><Font color = black>Folderen (" & strFolderName5 & ") eksisterer Ikke i stien (" & strRemoteFolder5 & ") p?remote computer <b>(" & strComputer & ")</b> Tjek for evt. fejl</font></Br>"
strHTML = strHTML & "<Font color =blue>*******************************************************************************************************************************</font></Br>"
End If
End If
' ************************************************************************************************************************
'Kopiering af Folder5 hvis checked afsluttet
' ************************************************************************************************************************
'~~~~~~~~~~~~~~~~~~~~~~~~~HTML OUTPUT TIL HTA FIL BEGYNDT~~~~~~~~~~~~~~~~~~~~~~~~~
DataArea1.InnerHTML = strHTML
'~~~~~~~~~~~~~~~~~~~~~~~~~HTML OUTPUT TIL HTA FIL AFSLUTTET~~~~~~~~~~~~~~~~~~~~~~~
End Sub
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
Sub ExecuteAPP
'++++++++++++++++++++Function Execute Applications++++++++++++++++++++++++++++++++++++++
'''''''''''''''''''''''Run Ipconfig /all''''''''''''''''''''''''''''''''''''''''''
strPSExecCommand1 = "Exe\psexec \\" & strComputer & " cmd.exe /C ipconfig /all > c:\IpConfigAll.txt"
strOpenPSExecFile1 = "\C$\IpConfigAll.txt"
'''''''''''''''''''''''Run Connects Machnight''''''''''''''''''''''''''''''''''''''''''
strPSExecCommand2 = "Exe\psexec \\" & strComputer & " -c Files_Folders\BAT\machnight.bat"
'''''''''''''''''''''''Lock Remote Workstation''''''''''''''''''''''''''''''''''''''''''
strPsexecCopyFile3 = "Files_Folders\VBS\lock_workstation.vbs"
strPsexecFileRemotePath3 = "\C$\"
strPSExecCommand3 = "Exe\psexec \\" & strComputer & " cscript.exe /nologo C:\lock_workstation.vbs"
'''''''''''''''''''''''set Proxy Settings''''''''''''''''''''''''''''''''''''''''''
strPsexecCopyFile4 = ""
strPsexecFileRemotePath4 = ""
strPSExecCommand4 = ""
'''''''''''''''''''''''xxxxxxxxxxxxxx''''''''''''''''''''''''''''''''''''''''''
strVbsCmd5 = "cscript c:\test\test5.vbs"
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ************************************************************************************************************************
' ExecuteAPP1
' ************************************************************************************************************************
If ExecuteApp1.checked Then
Set objShell = CreateObject("WScript.Shell")
objShell.Run strPSExecCommand1
Set oShell = CreateObject("WScript.Shell")
' sleep approx. 10 seconds
oShell.Run "ping.exe -n 10 127.0.0.1", 0, True
strOpenPSExecFile1 = "\\" & strComputer & strOpenPSExecFile1
Set objShell = CreateObject("WScript.Shell")
strPSECommand1 = "explorer " & strOpenPSExecFile1
Set objExecObject = objShell.Exec(strPSECommand1)
End if
' ************************************************************************************************************************
' ExecuteAPP1 afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
' ExecuteAPP2
' ************************************************************************************************************************
If ExecuteApp2.checked Then
Set objShell = CreateObject("WScript.Shell")
objShell.Run strPSExecCommand2
End if
' ************************************************************************************************************************
' ExecuteAPP2 afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
' ExecuteAPP3
' ************************************************************************************************************************
If ExecuteApp3.checked Then
objFSO.CopyFile (strPsexecCopyFile3), _
"\\" & strComputer & strPsexecFileRemotePath3, OverWriteExisting
Set objShell = CreateObject("WScript.Shell")
objShell.Run strPSExecCommand3
End if
' ************************************************************************************************************************
' ExecuteAPP3 afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
' ExecuteAPP4
' ************************************************************************************************************************
If ExecuteApp4.checked Then
objFSO.CopyFile (strPsexecCopyFile4), _
"\\" & strComputer & strPsexecFileRemotePath4, OverWriteExisting
Set objShell = CreateObject("WScript.Shell")
objShell.Run strPSExecCommand4
End if
' ************************************************************************************************************************
' ExecuteAPP4 afsluttet
' ************************************************************************************************************************
' ************************************************************************************************************************
' ExecuteAPP5
' ************************************************************************************************************************
If ExecuteApp5.checked Then
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
' - Her aktiveres den fil der er kopieret over p?remote PC'en
' *******************************************************************
Error = objWMIService.Create _
(strVbsCmd5, null, null, _
intProcessID)
End if
' ************************************************************************************************************************
' ExecuteAPP5 afsluttet
' ************************************************************************************************************************
'~~~~~~~~~~~~~~~~~~~~~~~~~HTML OUTPUT TIL HTA FIL BEGYNDT~~~~~~~~~~~~~~~~~~~~~~~~~
DataArea1.InnerHTML = strHTML
'~~~~~~~~~~~~~~~~~~~~~~~~~HTML OUTPUT TIL HTA FIL AFSLUTTET~~~~~~~~~~~~~~~~~~~~~~~
End Sub
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
Sub OpenFolder
strComputer = MachineName.Value
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const OverwriteExisting = True
'++++++++++++++++++++Funtion Open Remote Folder(s)++++++++++++++++++++++++++++++++++++++++++++
StrOpenFolder1 = "\C$\Operator\Bin\New"
strOpenFolder2 = "\C$\Operator\Bin\BckNew"
strOpenFolder3 = "\C$\PolicyUser"
strOpenFolder4 = "\C$\Program Files"
strOpenFolder5 = "\C$\"
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' **********************************************************************
'OpenFolder1
' **********************************************************************
If OpenFolder1.checked Then
strHostName = "\\" & strComputer & strOpenFolder1
Set objShell = CreateObject("WScript.Shell")
strCommand = "explorer " & strHostName
Set objExecObject = objShell.Exec(strCommand)
strHtml = strHtml & "<td><Font color = black>Folderen " & strOpenFolder1 & " er nu 錬net fra remote PC (" & strComputer &") </font></Br>"
strHtml = strHtml & "<Font color = #FFEF3F>---------------------------------------------------------------------------------------------------------------------</font></Br>"
End if
' **********************************************************************
'OpenFolder1 afsluttet
' **********************************************************************
' **********************************************************************
'OpenFolder2
' **********************************************************************
If OpenFolder2.checked Then
strHostName = "\\" & strComputer & strOpenFolder2
Set objShell = CreateObject("WScript.Shell")
strCommand = "explorer " & strHostName
Set objExecObject = objShell.Exec(strCommand)
strHtml = strHtml & "<td><Font color = black>Folderen " & strOpenFolder2& " er nu 錬net fra remote PC (" & strComputer &") </font></Br>"
strHtml = strHtml & "<Font color = #FFEF3F>---------------------------------------------------------------------------------------------------------------------</font></Br>"
End if
' **********************************************************************
'OpenFolder2 afsluttet
' **********************************************************************
' **********************************************************************
'OpenFolder3
' **********************************************************************
If OpenFolder3.checked Then
strHostName = "\\" & strComputer & strOpenFolder3
Set objShell = CreateObject("WScript.Shell")
strCommand = "explorer " & strHostName
Set objExecObject = objShell.Exec(strCommand)
strHtml = strHtml & "<td><Font color = black>Folderen " & strOpenFolder3& " er nu 錬net fra remote PC (" & strComputer &") </font></Br>"
strHtml = strHtml & "<Font color = #FFEF3F>---------------------------------------------------------------------------------------------------------------------</font></Br>"
End if
' **********************************************************************
'OpenFolder3 afsluttet
' **********************************************************************
' **********************************************************************
'OpenFolder4
' **********************************************************************
If OpenFolder4.checked Then
strHostName = "\\" & strComputer & strOpenFolder4
Set objShell = CreateObject("WScript.Shell")
strCommand = "explorer " & strHostName
Set objExecObject = objShell.Exec(strCommand)
strHtml = strHtml & "<td><Font color = black>Folderen " & strOpenFolder4& " er nu 錬net fra remote PC (" & strComputer &") </font></Br>"
strHtml = strHtml & "<Font color = #FFEF3F>---------------------------------------------------------------------------------------------------------------------</font></Br>"
End if
' **********************************************************************
'OpenFolder4 afsluttet
' **********************************************************************
' **********************************************************************
'OpenFolder5
' **********************************************************************
If OpenFolder5.checked Then
strHostName = "\\" & strComputer & strOpenFolder5
Set objShell = CreateObject("WScript.Shell")
strCommand = "explorer " & strHostName
Set objExecObject = objShell.Exec(strCommand)
strHtml = strHtml & "<td><Font color = black>Folderen " & strOpenFolder5& " er nu 錬net fra remote PC (" & strComputer &") </font></Br>"
strHtml = strHtml & "<Font color = #FFEF3F>---------------------------------------------------------------------------------------------------------------------</font></Br>"
End if
' **********************************************************************
'OpenFolder5 afsluttet
' **********************************************************************
'~~~~~~~~~~~~~~~~~~~~~~~~~HTML OUTPUT TIL HTA FIL BEGYNDT~~~~~~~~~~~~~~~~~~~~~~~~~
DataArea1.InnerHTML = strHTML
'~~~~~~~~~~~~~~~~~~~~~~~~~HTML OUTPUT TIL HTA FIL AFSLUTTET~~~~~~~~~~~~~~~~~~~~~~~
End Sub
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
Sub FolderRights
strComputer = MachineName.Value
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const OverwriteExisting = True
'++++++++++++++++++++Function Change remote Folder Rights ++++++++++++++++++++++++++++++++++++++++++++
'''''''''''''''''''''''Change Folder rights 1''''''''''''''''''''''''''''''''''''''''''
strXcacls = "Files_Folders\VBS\XCACLS.vbs"
strModifyRights1 = "Files_Folders\VBS\ModifyVoloViewRights.vbs"
strRightsExecute1 = "cscript c:\ModifyVoloViewRights1.vbs"
strModifyRightsPath1 = "\C$\"
strOpenFile1 = """\C$\Volo View Express.txt"""
'''''''''''''''''''''''Change Folder rights 2''''''''''''''''''''''''''''''''''''''''''
strModifyRights2 = "Files_Folders\VBS\ModifyNewRights.vbs"
strRightsExecute2 = "cscript c:\ModifyNewRights.vbs"
strModifyRightsPath2 = "\C$\"
strOpenFile2 = """\C$\New.txt"""
'''''''''''''''''''''''Change Folder rights 3''''''''''''''''''''''''''''''''''''''''''
strModifyRights3 = "Files_Folders\VBS\ModifyVoloViewRights.vbs"
strRightsExecute3 = "cscript c:\ModifyVoloViewRights.vbs"
strModifyRightsPath3 = "\C$\"
strOpenFile3 = """\C$\Volo View Express.txt"""
'''''''''''''''''''''''Change Folder rights 4''''''''''''''''''''''''''''''''''''''''''
strModifyRights4 = "Files_Folders\VBS\ModifyVoloViewRights.vbs"
strRightsExecute4 = "cscript c:\ModifyVoloViewRights.vbs"
strModifyRightsPath4 = "\C$\"
strOpenFile4 = """\C$\Volo View Express.txt"""
'''''''''''''''''''''''Change Folder rights 5''''''''''''''''''''''''''''''''''''''''''
strModifyRights5 = "Files_Folders\VBS\ModifyVoloViewRights.vbs"
strRightsExecute5 = "cscript c:\ModifyVoloViewRights.vbs"
strModifyRightsPath5 = "\C$\"
strOpenFile5 = """\C$\Volo View Express.txt"""
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' **********************************************************************
'ModifyRights1
' **********************************************************************
If ModifyRights1.checked Then
objFSO.CopyFile (strXcacls), _
"\\" & strComputer & strModifyRightsPath1, OverWriteExisting
objFSO.CopyFile (strModifyRights1), _
"\\" & strComputer & strModifyRightsPath1, OverWriteExisting
'-----------------------------------------------------------------------------------------------------------------------
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
Error = objWMIService.Create _
(strRightsExecute1, null, null, _
intProcessID)
Set oShell = CreateObject("WScript.Shell")
' sleep approx. 25-30 seconds
oShell.Run "ping.exe -n 26 127.0.0.1", 0, True
strOpenFile1 = "\\" & strComputer & strOpenFile1
Set objShell = CreateObject("WScript.Shell")
strCommand1 = "explorer " & strOpenFile1
Set objExecObject = objShell.Exec(strCommand1)
End If
' **********************************************************************
'ModifyRights1 afsluttet
' **********************************************************************
' **********************************************************************
'ModifyRights2
' **********************************************************************
If ModifyRights2.checked Then
objFSO.CopyFile (strXcacls), _
"\\" & strComputer & strModifyRightsPath2, OverWriteExisting
objFSO.CopyFile (strModifyRights2), _
"\\" & strComputer & strModifyRightsPath2, OverWriteExisting
'-----------------------------------------------------------------------------------------------------------------------
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
Error = objWMIService.Create _
(strRightsExecute2, null, null, _
intProcessID)
Set oShell = CreateObject("WScript.Shell")
' sleep approx. 25-30 seconds
oShell.Run "ping.exe -n 26 127.0.0.1", 0, True
strOpenFile2 = "\\" & strComputer & strOpenFile2
Set objShell = CreateObject("WScript.Shell")
strCommand2 = "explorer " & strOpenFile2
Set objExecObject = objShell.Exec(strCommand2)
End If
' **********************************************************************
'ModifyRights2 afsluttet
' **********************************************************************
' **********************************************************************
'ModifyRights3
' **********************************************************************
If ModifyRights3.checked Then
objFSO.CopyFile (strXcacls), _
"\\" & strComputer & strModifyRightsPath3, OverWriteExisting
objFSO.CopyFile (strModifyRights3), _
"\\" & strComputer & strModifyRightsPath3, OverWriteExisting
'-----------------------------------------------------------------------------------------------------------------------
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
Error = objWMIService.Create _
(strRightsExecute3, null, null, _
intProcessID)
Set oShell = CreateObject("WScript.Shell")
' sleep approx. 25-30 seconds
oShell.Run "ping.exe -n 26 127.0.0.1", 0, True
strOpenFile3 = "\\" & strComputer & strOpenFile3
Set objShell = CreateObject("WScript.Shell")
strCommand3 = "explorer " & strOpenFile3
Set objExecObject = objShell.Exec(strCommand3)
End If
' **********************************************************************
'ModifyRights3 afsluttet
' **********************************************************************
' **********************************************************************
'ModifyRights4
' **********************************************************************
If ModifyRights4.checked Then
objFSO.CopyFile (strXcacls), _
"\\" & strComputer & strModifyRightsPath4, OverWriteExisting
objFSO.CopyFile (strModifyRights4), _
"\\" & strComputer & strModifyRightsPath4, OverWriteExisting
'-----------------------------------------------------------------------------------------------------------------------
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
Error = objWMIService.Create _
(strRightsExecute4, null, null, _
intProcessID)
Set oShell = CreateObject("WScript.Shell")
' sleep approx. 25-30 seconds
oShell.Run "ping.exe -n 26 127.0.0.1", 0, True
strOpenFile4 = "\\" & strComputer & strOpenFile4
Set objShell = CreateObject("WScript.Shell")
strCommand4 = "explorer " & strOpenFile4
Set objExecObject = objShell.Exec(strCommand4)
End If
' **********************************************************************
'ModifyRights4 afsluttet
' **********************************************************************
' **********************************************************************
'ModifyRights5
' **********************************************************************
If ModifyRights5.checked Then
objFSO.CopyFile (strXcacls), _
"\\" & strComputer & strModifyRightsPath5, OverWriteExisting
objFSO.CopyFile (strModifyRights5), _
"\\" & strComputer & strModifyRightsPath5, OverWriteExisting
'-----------------------------------------------------------------------------------------------------------------------
Set objWMIService = GetObject _
("winmgmts:\\" & strComputer & "\root\cimv2:Win32_Process")
Error = objWMIService.Create _
(strRightsExecute5, null, null, _
intProcessID)
Set oShell = CreateObject("WScript.Shell")
' sleep approx. 25-30 seconds
oShell.Run "ping.exe -n 26 127.0.0.1", 0, True
strOpenFile5 = "\\" & strComputer & strOpenFile5
Set objShell = CreateObject("WScript.Shell")
strCommand5 = "explorer " & strOpenFile5
Set objExecObject = objShell.Exec(strCommand5)
End If
' **********************************************************************
'ModifyRights5 afsluttet
' **********************************************************************
'~~~~~~~~~~~~~~~~~~~~~~~~~HTML OUTPUT TIL HTA FIL BEGYNDT~~~~~~~~~~~~~~~~~~~~~~~~~
DataArea1.InnerHTML = strHTML
'~~~~~~~~~~~~~~~~~~~~~~~~~HTML OUTPUT TIL HTA FIL AFSLUTTET~~~~~~~~~~~~~~~~~~~~~~~
End Sub
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
Sub RegRights
strComputer = MachineName.Value
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Const OverwriteExisting = True
'++++++++++++++++++++Function Change HKU Registry key/value++++++++++++++++++++++++++++++++++++++++++++
'''''''''''''''''''''''Change HKU Registry key/value 1''''''''''''''''''''''''''''''''''''''''''
strHKUPath1 = "\control Panel\Desktop"
strNewRegKey1 = "AutoEndTasks"
strNewRegValue1 = "1"
'''''''''''''''''''''''Change HKU Registry key/value 2''''''''''''''''''''''''''''''''''''''''''
strHKUPath2 = "\SOFTWARE\Microsoft\windows\CurrentVersion\Internet Settings"
strNewRegKey2 = "AutoConfigURL"
strNewRegValue2 = "http://bluecoatpacfile.afeas.com/bluecoatpacfile/pacfile.pac"
strHKUPath2_1 = "\SOFTWARE\Microsoft\windows\CurrentVersion\Internet Settings"
strNewRegKey2_1 = "AutoConfigProxy"
strNewRegValue2_1 = "wininet.dll"
'''''''''''''''''''''''Change HKU Registry key/value 3''''''''''''''''''''''''''''''''''''''''''
strHKUPath3 = ""
strNewRegKey3 = ""
strNewRegValue3 = ""
'''''''''''''''''''''''Change HKU Registry key/value 4''''''''''''''''''''''''''''''''''''''''''
strHKUPath4 = ""
strNewRegKey4 = ""
strNewRegValue4 = ""
'''''''''''''''''''''''Change HKU Registry key/value 5''''''''''''''''''''''''''''''''''''''''''
strHKUPath5 = ""
strNewRegKey5 = ""
strNewRegValue5 = ""
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' **********************************************************************
'Change HKU Registry Key/Value 1
' **********************************************************************
If HKUKeyValue1.checked Then
Const HKU1 = &H80000003
' set registry object
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & _
"\root\default:StdRegProv")
objRegistry.EnumKey HKU1, "", arrSubKeys
' loop through all SIDs
For Each subkey In arrSubKeys
' count SID length
strKeyLen = Len(subkey)
' if SID length is longer than 16, then is a user account
If strKeyLen > 16 Then
' filter out '_classes' SIDs
If Not Right(subkey,8) = "_Classes" Then
' get HKU\SID values
nRet = objRegistry.GetStringValue(_
HKU1, subkey & "\Software\Microsoft\Windows\CurrentVersion\Explorer", _
"Logon User Name", strUserName1)
strHtml = strHtml & "<td><Font color = #FFFFFF><B>" & subkey & " : Logon User Name : " & strUserName1 & "</B></font></Br>"
' get AutoEndTasks value before
nRet = objRegistry.GetStringValue(_
HKU1, subkey & strHKUPath1, _
strNewRegKey1, strOldRegValue1)
strHtml = strHtml & "<td><Font color = #FFFFFF><B>" & subkey & strNewRegKey1 & " Nuv鎟ende REG_SZ Value = " & strOldRegValue1 & "</B></font></Br>"
nRet = objRegistry.GetStringValue(HKU1, strHKUPath1, strNewRegKey1, strUserName)
' Set AutoEndTasks value after
nRet = objRegistry.SetStringValue(HKU1, subkey & strHKUPath1, _
strNewRegKey1, strNewRegValue1)
strHtml = strHtml & "<td><Font color = #FFFFFF><B>" & subkey & strNewRegKey1 &" Ny REG_SZ V鎟di = " & strNewRegValue1 & "</B></font></Br>"
End If
End If
next
End if
' **********************************************************************
'Change HKU Registry Key/Value 1 afsluttet
' **********************************************************************
' **********************************************************************
'Change HKU Registry Key/Value 2
' **********************************************************************
If HKUKeyValue2.checked Then
Const HKU2 = &H80000003
' set registry object
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & _
"\root\default:StdRegProv")
objRegistry.EnumKey HKU2, "", arrSubKeys
' loop through all SIDs
For Each subkey In arrSubKeys
' count SID length
strKeyLen = Len(subkey)
' if SID length is longer than 16, then is a user account
If strKeyLen > 16 Then
' filter out '_classes' SIDs
If Not Right(subkey,8) = "_Classes" Then
' get HKU\SID values
nRet = objRegistry.GetStringValue(_
HKU2, subkey & "\Software\Microsoft\Windows\CurrentVersion\Explorer", _
"Logon User Name", strUserName2)
strHtml = strHtml & "<td><Font color = #FFFFFF><B>" & subkey & " : Logon User Name : " & strUserName2 & "</B></font></Br>"
' get AutoConfigURL value before
nRet = objRegistry.GetStringValue(_
HKU2, subkey & strHKUPath2, _
strNewRegKey2, strOldRegValue2)
strHtml = strHtml & "<td><Font color = #FFFFFF><B>" & subkey & strNewRegKey2 & " Nuv鎟ende REG_SZ Value = " & strOldRegValue2 & "</B></font></Br>"
' get AutoConfigProxy value before
nRet = objRegistry.GetStringValue(_
HKU2, subkey & strHKUPath2_1, _
strNewRegKey2_1, strOldRegValue2_1)
strHtml = strHtml & "<td><Font color = #FFFFFF><B>" & subkey & strNewRegKey2_1 & " Nuv鎟ende REG_SZ Value = " & strOldRegValue2_1 & "</B></font></Br>"
nRet = objRegistry.GetStringValue(HKU2, strHKUPath2, strNewRegKey2, strUserName)
nRet = objRegistry.GetStringValue(HKU2, strHKUPath2_1, strNewRegKey2_1, strUserName)
' Set AutoConfigURL value after
nRet = objRegistry.SetStringValue(HKU2, subkey & strHKUPath2, _
strNewRegKey2, strNewRegValue2)
strHtml = strHtml & "<td><Font color = #FFFFFF><B>" & subkey & strNewRegKey2 &" Ny REG_SZ V鎟di = " & strNewRegValue2 & "</B></font></Br>"
' Set AutoConfigProxy value after
nRet = objRegistry.SetStringValue(HKU2, subkey & strHKUPath2_1, _
strNewRegKey2_1, strNewRegValue2_1)
strHtml = strHtml & "<td><Font color = #FFFFFF><B>" & subkey & strNewRegKey2_1 &" Ny REG_SZ V鎟di = " & strNewRegValue2_1 & "</B></font></Br>"
End If
End If
next
End if
' **********************************************************************
'Change HKU Registry Key/Value 2 afsluttet
' **********************************************************************
' **********************************************************************
'Change HKU Registry Key/Value 3
' **********************************************************************
If HKUKeyValue3.checked Then
Const HKU3 = &H80000003
' set registry object
Set objRegistry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & _
"\root\default:StdRegProv")
objRegistry.EnumKey HKU3, "", arrSubKeys
' loop through all SIDs
For Each subkey In arrSubKeys
' count SID length
strKeyLen = Len(subkey)
' if SID length is longer than 16, then is a user account
If strKe
