I want VBScript to upload and download a file using FTP without using ActiveX program.
Notice please give me download code alone and upload code alone and must upload file not folder.
For example:
Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
path = "test.txt"
FTPUpload(path)
Sub FTPUpload(path)
On Error Resume Next
Const copyType = 16
waitTime = 80000
FTPUser = "user"
FTPPass = "pass"
FTPHost = "www.domain.com"
FTPDir = "/htdocs/"
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "#" & FTPHost & FTPDir
Set objFTP = oShell.NameSpace(strFTP)
'objFTP.NewFolder "FTP Backup"
If objFSO.FileExists(path) Then
Set objFile = objFSO.getFile(path)
strParent = objFile.ParentFolder
Set objFolder = oShell.NameSpace(strParent)
Set objItem = objFolder.ParseName(objFile.Name)
Wscript.Echo "Uploading file " & objItem.Name & " to " & strFTP
objFTP.CopyHere objItem, copyType
End If
If objFSO.FolderExists(path) Then
Set objFolder = oShell.NameSpace(path)
Wscript.Echo "Uploading folder " & path & " to " & strFTP
objFTP.CopyHere objFolder.Items, copyType
End If
If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Description
End If
WScript.Sleep waitTime
End Sub
Related
Hi I have the following script
Set oShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Path to file or folder to upload
Source0 = "C:\Users\User\Desktop\Work\CRC01\8BR01547\61000856"
FTPUpload(Source0)
Sub FTPUpload(Source0)
On Error Resume Next
'Copy Options: 16 = Yes to All
Const copyType = 16
'FTP Wait Time in ms
waitTime = 80000
FTPUser = "Martin"
FTPPass = ""
FTPHost = "PC247"
FTPDir0 = "/Martin/61000856"
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "#" & FTPHost & FTPDir0
Set objFTP = oShell.NameSpace(strFTP)
'Make new folder on FTP site
'objFTP.NewFolder "FTP Backup"
'Upload single file
If objFSO.FileExists(Source0) Then
Set objFile = objFSO.getFile(Source0)
strParent = objFile.ParentFolder
Set objFolder = oShell.NameSpace(strParent)
Set objItem = objFolder.ParseName(objFile.Name)
Wscript.Echo "Uploading file " & objItem.Name & " to " & strFTP
objFTP.CopyHere objItem, copyType
End If
'Upload all files in folder
If objFSO.FolderExists(Source0) Then
'Code below can be used to upload entire folder
Set objFolder = oShell.NameSpace(Source0)
Wscript.Echo "Uploading folder " & Source0 & " to " & strFTP
objFTP.CopyHere objFolder.Items, copyType
End If
If Err.Number <> 0 Then
Wscript.Echo "Error: " & Err.Description
End If
'Wait for upload
WScript.Sleep waitTime
End Sub
Could someone please help on how to make it so that I can provide a list of sources and it copys the folders over to the FTP server. Also How to I fix the overwrite confirmation popup that still happens even if the copytype is set too 16
I had to create a folder in FTP server using VBScript. Now I can save the local file in my machine to a folder in FTP server. But I have to create a folder in FTP using VBScript code and should save the local file to that folder. Can anyone help me solve this issue? The code I used is given below.
Set objFSO = Wscript.CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Shell.Application")
path ="D:\imgs\images (2).jpg"
FTPUpload(path)
Sub FTPUpload(path)
Const copyType = 16
waitTime = 10000
FTPUser = "ftp_username"
FTPPass = "ftp_password"
FTPHost = "ipaddress"
FTPDir = "/ftpDirectory/"
strFTP = "ftp://" & FTPUser & ":" & FTPPass & "#" & FTPHost & FTPDir
Set objFTP = oShell.NameSpace(strFTP)
If objFSO.FileExists(path) Then
Set objFile = objFSO.getFile(path)
strParent = objFile.ParentFolder
Set objFolder = oShell.NameSpace(strParent)
Set objItem = objFolder.ParseName(objFile.Name)
WScript.Echo "Uploading file " & objItem.Name & " to " & strFTP
objFTP.CopyHere objItem, copyType
End If
'WScript.Echo "Uploaded Successfully"
Can the following WinSCP VBScript file be modified to allow proxy connection?
'###########################################################################
'# Function: MISC_FTPUpload
'#
'# Description:
'# Uses the FSO object to FTP a file to a remote server
'#
'# Parameters:
'# (in) sSite - The site to FTP to
'# (in) sUsername - The username to log in with
'# (in) sPassword - The password to log in with
'# (in) sLocalFile - The Locally stored file to FTP to the remote server
'# (in) sRemotePath - The path to store the file in, on the remote server
'#
'# (out) - sError - The error output
'#
'# Return:
'# True - File successfully sent
'# False - File not successfully sent
'###########################################################################
Function MISC_FTPUpload(byVal sSite, byVal sUsername, byVal sPassword, byVal sLocalFile, byVal sRemotePath, byRef sError)
'This script is provided under the Creative Commons license located
'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
'be used for commercial purposes with out the expressed written consent
'of NateRice.com
Const OpenAsDefault = -2
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2
Dim oFTPScriptFSO
Dim oFTPScriptShell
Dim sOriginalWorkingDirectory
Dim sFTPScript
Dim sFTPTemp
Dim bRetCode
Dim sFTPTempFile
Dim oFTPScript
Dim sResults
Dim sOut
Dim sCmd
LOG_Write "MISC_FTPUpload called at: " & Now
Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
Set oFTPScriptShell = CreateObject("WScript.Shell")
sRemotePath = Trim(sRemotePath)
sLocalFile = Trim(sLocalFile)
'----------Path Checks---------
'Here we will check the path, if it contains
'spaces then we need to add quotes to ensure
'it parses correctly.
If InStr(sRemotePath, " ") > 0 Then
If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
sRemotePath = """" & sRemotePath & """"
End If
End If
If InStr(sLocalFile, " ") > 0 Then
If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
sLocalFile = """" & sLocalFile & """"
End If
End If
'Check to ensure that a remote path was
'passed. If it's blank then pass a "\"
If Len(sRemotePath) = 0 Then
'Please note that no premptive checking of the
'remote path is done. If it does not exist for some
'reason, Unexpected results may occur.
sRemotePath = "\"
End If
'Check the local path and file to ensure
'that either the a file that exists was
'passed or a wildcard was passed.
If InStr(sLocalFile, "*") Then
If InStr(sLocalFile, " ") Then
sError = "Error: Wildcard uploads do not work if the path contains a space." & vbNewLine & "This is a limitation of the Microsoft FTP client."
LOG_Write sError
MISC_FTPUpload = False
Exit Function
End If
ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
'nothing to upload
sError = "Error: File Not Found."
LOG_Write sError
MISC_FTPUpload = False
Exit Function
End If
'--------END Path Checks---------
'build input file for ftp command
sFTPScript = sFTPScript & "option batch on" & vbCRLF
sFTPScript = sFTPScript & "option confirm off"& vbCrLf
sFTPScript = sFTPScript & "option transfer binary" & vbCrLf
sFTPScript = sFTPScript & "open sftp://" & sUsername & ":" & sPassword & "#" & sSite & vbCrLf
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCrLf
sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
sFTPScript = sFTPScript & "close" & vbCrLf
sFTPScript = sFTPScript & "exit" & vbCrLf
LOG_Write "Script for FTP File: " & vbNewLine & sFTPScript
sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
LOG_Write "FTP Input file stored at: " & sFTPTempFile
'Write the input file for the ftp command
'to a temporary file.
Set oFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
oFTPScript.WriteLine(sFTPScript)
oFTPScript.Close
Set oFTPScript = Nothing
sCmd = """C:\Program Files\WinSCP\WinSCP.com"" -script=" & sFTPTempFile
MISC_RunCmd sCmd, sOut, sError
LOG_Write sOut
Wscript.Sleep 1000
' Get rid of temp file used for input to sftp
oFTPScriptFSO.DeleteFile(sFTPTempFile)
'Check results of transfer.
If sError = "" And InStr(sOut, "binary") >0 And InStr(sOut, "100%") >0 Then
MISC_FTPUpload = True
Else
sError = "Error: " & sError
LOG_Write sError
MISC_FTPUpload = False
End If
Set oFTPScriptFSO = Nothing
Set oFTPScriptShell = Nothing
End Function
'###########################################################################
'# Function: MISC_FTPDownload
'#
'# Description:
'# Uses the FSO object to FTP a file from a remote server
'#
'# Parameters:
'# (in) sSite - The site to FTP from
'# (in) sUsername - The username to log in with
'# (in) sPassword - The password to log in with
'# (in) sLocalPath - The path to store the file in, on the local drive
'# (in) sLocalPath - The path to get the file from, on the remote drive
'# (in) sRemoteFile - The remotely stored file to FTP to the local drive
'#
'# (out) - sError - The error output
'#
'# Return:
'# True - File successfully retrieved
'# False - File not successfully retrieved
'###########################################################################
Function MISC_FTPDownload(byVal sSite, byVal sUsername, byVal sPassword, byVal sLocalPath, byVal sRemotePath, byVal sRemoteFile, byRef sError)
'This script is provided under the Creative Commons license located
'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
'be used for commercial purposes with out the expressed written consent
'of NateRice.com
Const OpenAsDefault = -2
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2
Dim oFTPScriptFSO
Dim oFTPScriptShell
Dim sOriginalWorkingDirectory
Dim sFTPScript
Dim sFTPTemp
Dim sFTPTempFile
Dim bRetCode
Dim oFTPScript
Dim sResults
Dim sCmd
Dim sOut
LOG_Write "MISC_FTPDownload called at: " & Now
Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
Set oFTPScriptShell = CreateObject("WScript.Shell")
sRemotePath = Trim(sRemotePath)
sLocalPath = Trim(sLocalPath)
'----------Path Checks---------
'Here we will check the remote path, if it contains
'spaces then we need to add quotes to ensure
'it parses correctly.
If InStr(sRemotePath, " ") > 0 Then
If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
sRemotePath = """" & sRemotePath & """"
End If
End If
'Check to ensure that a remote path was
'passed. If it's blank then pass a "\"
If Len(sRemotePath) = 0 Then
'Please note that no premptive checking of the
'remote path is done. If it does not exist for some
'reason. Unexpected results may occur.
sRemotePath = "\"
End If
'If the local path was blank. Pass the current
'working direcory.
If Len(sLocalPath) = 0 Then
sLocalPath = oFTPScriptShell.CurrentDirectory
End If
If Not oFTPScriptFSO.FolderExists(sLocalPath) Then
'destination not found
sError = "Error: Local Folder Not Found."
LOG_Write sError
MISC_FTPDownload = False
Exit Function
End If
sOriginalWorkingDirectory = oFTPScriptShell.CurrentDirectory
oFTPScriptShell.CurrentDirectory = sLocalPath
'--------END Path Checks---------
'build input file for ftp command
sFTPScript = sFTPScript & "option batch on" & vbCRLF
sFTPScript = sFTPScript & "option confirm off"& vbCrLf
sFTPScript = sFTPScript & "option transfer binary" & vbCrLf
sFTPScript = sFTPScript & "open sftp://" & sUsername & ":" & sPassword & "#" & sSite & vbCrLf
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCrLf
sFTPScript = sFTPScript & "get " & sRemoteFile & vbCRLF
sFTPScript = sFTPScript & "close" & vbCrLf
sFTPScript = sFTPScript & "exit" & vbCrLf
LOG_Write "Script for FTP File: " & vbNewLine & sFTPScript
sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
LOG_Write "FTP Input file stored at: " & sFTPTempFile
'Write the input file for the ftp command
'to a temporary file.
Set oFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
oFTPScript.WriteLine(sFTPScript)
oFTPScript.Close
Set oFTPScript = Nothing
sCmd = """C:\Program Files\WinSCP\WinSCP.com"" -script=" & sFTPTempFile
MISC_RunCmd sCmd, sOut, sError
LOG_Write sOut
Wscript.Sleep 1000
' Get rid of temp file used for input to sftp
oFTPScriptFSO.DeleteFile(sFTPTempFile)
'Check results of transfer.
If sError = "" And InStr(sOut, "binary") >0 And InStr(sOut, "100%") >0 Then
MISC_FTPDownload = True
Else
sError = "Error: " & sError
LOG_Write sError
MISC_FTPDownload = False
End If
Set oFTPScriptFSO = Nothing
Set oFTPScriptShell = Nothing
End Function
The proxy would have to act as a Man in the Middle for this. SSH (the protocol SCP uses for data transfer) was designed to prevent this.
On the line, where you add the open command:
sFTPScript = sFTPScript & "open sftp://" & sUsername & ":" & sPassword & "#" & sSite & vbCrLf
... add the -rawsettings switch followed by the options relevant for your kind of proxy:
For example:
sFTPScript = ... & " -rawsettings ProxyMethod=3 ProxyHost=proxy" & vbCrLf
For details refer to:
https://winscp.net/eng/docs/scriptcommand_open
https://winscp.net/eng/docs/rawsettings
To use the proxy, first use the WINSCP GUI to connect specifying the proxy details. This will add the details of proxy in the configuration file (which is in the same directory as winscp.com) and then it should work. You can then pass the path of this configuration file to your execute process task and call the WINSCP.com executable.
**
Hi!
I was wondering if someone tried something similar, I have some code merged with a lot of glue...but as i'm a newby in vbs I can be sure that most of it is wrong. Basically I wanted to save a lot time during built-in admin accounts review /update with an automatic vbscript for this task.
I have like 6 account names and each one with an specific passwords.
I'm not 100% sure of which local account name is being used into each server but that might be something that i will need to verify manually or try to see if I can use another file where this script will read the possible accounts names and passwords and use some kind of brute force
Here is what I have :**
**update 8-29-12 a (deleted)
**update 8-29-12 b "THIS ONE IS WORKING..but i need to test & use cpau for NDC's"
Option Explicit
Dim strExcelPath, objExcel, objSheet, intRow, strUserDN, strPassword, comp
Dim objUser
' Spreadsheet file.
strExcelPath = "c:\List.xls"
' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
On Error GoTo 0
' Open spreadsheet.
On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Spreadsheet cannot be opened: " & strExcelPath
Wscript.Quit
End If
On Error GoTo 0
' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
intRow = 2
Do While objSheet.Cells(intRow, 1).Value <> ""
comp = objSheet.Cells(intRow, 1).Value
strUserDN = objSheet.Cells(intRow, 2).Value
strPassword = objSheet.Cells(intRow, 3).Value
On Error Resume Next
Set objuser = GetObject ("WinNT://" & comp & "/" & strUserDN & ",user")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Data NOT found: "
Else
objUser.SetPassword strPassword
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Password NOT set for: " & strUserDN
Else
End If
End If
intRow = intRow + 1
Loop
' Close the workbook.
objExcel.ActiveWorkbook.Close
' Quit Excel.
objExcel.Application.Quit
Wscript.Echo "Done"
My option "B" could be start over using something like this:
#echo off
for /F "delims=" %%i in (servers.txt) do (
psexec \%%i NET USER > %%i.txt
)
**
There might hundreds of ways to solve this and the my idea it's avoid having someone manually modifying the admin passwords for the servers listed and not listed in the AD after one month.
Any help would be appreciated.
Regards
This code will list the local users for one computer, specified by the variable server, and then print the user id of each user.
server = "YourServerName"
Set oComputer = GetObject("WinNT://" & server & "")
oComputer.Filter = Array("User")
For Each oUser in oComputer
WScript.Echo oUser.Name
Next
'Objective: check multiple servers for admin accounts status and report to html file
Set iFSO = CreateObject("Scripting.FilesyStemObject")
Set oFSO = CreateObject("Scripting.FilesyStemObject")
InputFile = WScript.Arguments.Named("servers")
if len(InputFile) < 1 then
wscript.echo "Error: Servers Parameter not found" & vbCrLf
show_usage
wscript.quit
end if
Outputfile= InputFile & "_guest_admins_" + cstr(Month(now()))+"_"+cstr(day(now()))+".htm"
if not ofso.FileExists(inputfile) then
wscript.echo "Error: Server list file not Found."
wscript.quit
end if
Set ofile = ofso.createTextFile(OutputFile, True)
Set ifile = iFSO.OpenTextFile(inputfile)
ofile.writeline "<html>" & html_head & "<body>"
ofile.writeline "<table border=1 cellpadding=1 cellspacing=0>"
ofile.writeline o
ofile.writeline "<tr><td>Hostname</td><td>User</td><td>Disabled</td><td>Locked</td><td>Expiration Date</td><td>Flags</td><td>BuiltIn</td></tr>"
Do until ifile.AtEndOfLine
Computer = ifile.ReadLine
if ping(Computer) then
Builtin = ""
if Check_WMI(Computer) then
Builtin = GetBuiltInAccount(Computer)
else
Builtin = "WMI Fail"
end if
strt = now
wscript.echo "Checking Users for server: " & Computer
on error resume next
Set objGroup = GetObject("WinNT://" & Computer & "/Administrators,group")
if err.number <> 0 then
wscript.echo "GetObject WinNT Failed"
ofile.writeline "<tr><td>" & computer & "</td><td colspan=6 align=center>GetObject WinNT Fail: "& err.number &"</td></tr>"
else
on error goto 0
For Each objUser in objGroup.Members
ofile.writeline GetUserNT(computer, objUser.Name, Builtin)
Next
wscript.echo "Elapsed Time: " & datediff("s", strt, now) & " seconds"
end if
else
wscript.echo computer & " does not reply ping"
ofile.writeline "<tr><td>" & computer & "</td><td colspan=6 align=center>No Ping Reply</td></tr>"
end if
Loop
ofile.writeline "</table>"
ofile.writeline "</body></html>"
function ping(target)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colPingedComputers = objWMIService.ExecQuery("Select * from Win32_PingStatus Where Address = '"& target & "'")
For each objComputer in colPingedComputers
' If the status code is Null or Not 0 then the ping failed
If IsNull( objComputer.StatusCode ) Or objComputer.StatusCode <> 0 Then
' Set the function to return Boolean FALSE
Ping = False
Else
' Set the function to return Boolean TRUE
Ping = True
End If
Next
end function
sub show_usage
wscript.echo "Usage: cscript chkusers /servers:list.txt" & vbcrlf
wscript.echo vbtab & "/servers Parameter is a Text File one Servername per Line" & vbcrlf
wscript.echo "Notes: This script generates an html report of server admin accounts."
wscript.echo " Results are saved in a file named + date + htm extension."
wscript.echo " Output example filename: list_guest_admins_" + cstr(Month(now()))+"_"+cstr(day(now()))+".htm"
end sub
Function Check_WMI(strServer)
On Error Resume Next ' error handling off
' create object reference, connect to namespace root\default
Set oCimOmId = GetObject("winmgmts:"& strServer & "\root\default:__cimomidentification=#")
' Test whether WMI is present or not.
If Err <> 0 then
Check_WMI= true
else
Check_WMI= false
end if
on error goto 0
end function
Sub EnumNameSpaces(strNameSpace)
'call enumnamespaces("root")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\" & strNameSpace)
Set colNameSpaces = objWMIService.InstancesOf("__NAMESPACE")
For Each objNameSpace In colNameSpaces
Call EnumNameSpaces(strNameSpace & "\" & objNameSpace.Name)
Next
End Sub
function CSS
tt = "<style type=""text/css"">" & vbcrlf
tt=tt & " body {font-family:Verdana;font-size: 10px;color: #49403B;background: #EFEFEF;}" & vbcrlf
tt=tt & "table {font-family:Verdana;font-size: 12px; empty-cells:show; }" & vbcrlf
tt=tt & "</style>" & vbcrlf
CSS = tt
end function
function html_head
tt="<head>" & vbcrlf
tt=tt & CSS
html_head = tt & "</head>" & vbcrlf
end function
function GetUserNT(strComputer, usr, bltin)
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
o=""
On Error Resume Next
Set objUser = GetObject("WinNT:// " & strComputer & "/" & usr & " ")
o=o& "<tr><td>"& strcomputer &"</td><td>"& usr &"</td>"
if len(objUser.AccountDisabled) = 0 then exit function
o=o& "<td> "& StrDisabled(objUser.AccountDisabled) &"</td>"
o=o& "<td> "& StrLocked(objUser.IsAccountLocked) &"</td>"
o=o& "<td> "
o=o& objUser.Get("UserFlags") AND ADS_UF_DONT_EXPIRE_PASSWD
o=o& "</td>"
o=o& "<td> "
o=o& objUser.AccountExpirationDate
o=o& "</td>"
if lcase(bltin) = lcase(usr) then
o=o & "<td> Built-In</td>"
elseif instr(bltin, "[[Fail]]") > 0 then
o=o & "<td> "& bltin &"</td>"
else
o=o & "<td> </td>"
end if
o = o & "</tr>"
GetUserNT = o
end function
function StrLocked(str)
if str = "True" then
StrLocked = "Locked"
else
StrLocked = "Unlocked"
end if
end function
function StrDisabled(str)
if str = "True" then
StrDisabled = "Disabled"
else
StrDisabled = "Enabled"
end if
end function
function GetUsers(strComputer,grp,usr)
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_UserAccount Where name = '"& usr &"'")
o=""
For Each objItem in colItems
o=o& "<tr>"
o=o& "<td>" & strComputer & "</td>"
o=o& "<td>" & grp & "</td>"
o=o& "<td>" & objItem.AccountType & "</td>"
o=o& "<td>" & objItem.Caption & "</td>"
o=o& "<td>" & objItem.Description & "</td>"
o=o& "<td>" & objItem.Disabled & "</td>"
o=o& "<td>" & objItem.Domain & "</td>"
o=o& "<td>" & objItem.FullName & "</td>"
o=o& "<td>" & objItem.LocalAccount & "</td>"
o=o& "<td>" & objItem.Lockout & "</td>"
o=o& "<td>" & objItem.Name & "</td>"
o=o& "<td>" & objItem.PasswordChangeable & "</td>"
o=o& "<td>" & objItem.PasswordExpires & "</td>"
o=o& "<td>" & objItem.PasswordRequired & "</td>"
o=o& "<td>" & objItem.SID & "</td>"
o=o& "<td>" & objItem.SIDType & "</td>"
o=o& "<td>" & objItem.Status & "</td>"
o=o& "</tr>"
Next
on error goto 0
GetUsers = o
end function
Function getlcl(srvname)
Set objComputer = GetObject("WinNT://" & srvname & "/Administrators,group")
wscript.echo "Local Accounts on " & srvname
wscript.echo "-------------------------------------------------"
For Each objUser in objComputer.Members
Wscript.Echo vbTab & objUser.Name
Next
wscript.echo "-------------------------------------------------"
end Function
function GetBuiltInAccount(strComputer)
on error resume next
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
if err.number <> 0 then
GetBuiltInAccout = "Get Object WMI [[Fail]]: " & err.number & ":: " & err.description
err.clear
exit function
end if
on error goto 0
on error resume next
Set colAccounts = objWMIService.ExecQuery("Select * From Win32_UserAccount Where Domain = '" & strComputer & "'")
if err.number <> 0 then
GetBuiltInAccout = "WMI_ExecQuery [[Fail]]: " & err.number & ":: " & err.description
err.clear
exit function
end if
on error goto 0
on error resume next
For Each objAccount in colAccounts
if err.number <> 0 then
GetBuiltInAccout = "WMI_ExecQuery_ForEachAccount [[Fail]]: " & err.number & ":: " & err.description
wscript.echo "WMI_ExecQuery_ForEachAccount [[Fail]]: " & err.number & ":: " & err.description
err.clear
exit function
end if
on error goto 0
If Left (objAccount.SID, 6) = "S-1-5-" and Right(objAccount.SID, 4) = "-500" Then
GetBuiltInAccount = objAccount.Name
exit function
End If
Next
end function
Special instructions
For Domain servers:
Create a batch/cmd file (something like admins.cmd) containing the line below:
cscript admin.vbs /servers:list.txt
For Standalone server:
-Download CPAU.exe
Create a batch/cmd file (something like adminsNDC.cmd) conteninig the line below:
CPAU -u %COMPUTERNAME%\administrator -p mypassword -ex "cscript.exe Admins.vbs /servers:list.txt" -nowarn
-Local Admin report v1-
Instructions
For Domain servers:
1-Add the servers to be scaned into: "list.txt"
2-Run/create a scheduled task for "one" of the following files :
admins.cmd <-------> (you will get: |Hostname|User| Disabled |Locked |Expiration Date| Flags |BuiltIn |)
3-Check the html report(you can sent it to excel through IE)
For a Standalone server:
1-Add the server to be scaned into: "list.txt"
2-Edit the account name and password info into adminsNDC.cmd
3-Run adminsNDC.cmd <-------> (you will get: |Hostname|User| Disabled |Locked |Expiration Date| Flags |BuiltIn |)
3-Check the html report
After getting a report of the servers and accounts, this script could be used to perform password's update.
Option Explicit
Dim strExcelPath, objExcel, objSheet, intRow, strUserDN, strPassword, comp
Dim objUser
' Spreadsheet file.
strExcelPath = "c:\List.xls"
' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
On Error GoTo 0
' Open spreadsheet.
On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Spreadsheet cannot be opened: " & strExcelPath
Wscript.Quit
End If
On Error GoTo 0
' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
intRow = 2
Do While objSheet.Cells(intRow, 1).Value <> ""
comp = objSheet.Cells(intRow, 1).Value
strUserDN = objSheet.Cells(intRow, 2).Value
strPassword = objSheet.Cells(intRow, 3).Value
On Error Resume Next
Set objuser = GetObject ("WinNT://" & comp & "/" & strUserDN & ",user")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Data NOT found: "
Else
objUser.SetPassword strPassword
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Password NOT set for: " & strUserDN
Else
End If
End If
intRow = intRow + 1
Loop
' Close the workbook.
objExcel.ActiveWorkbook.Close
' Quit Excel.
objExcel.Application.Quit
Wscript.Echo "Done"
I'm using the following code to try to stop a service. I can display the service state using WScript.Echo objService.State so I know I have the right service name and that it can find it and determine its state as running or stopped but when I run this script I get an Error on Line 51: Error Not Found Code 80041002 (see screenshot)
The line of code at 51 is:
objService.StopService()
Where am I going wrong? I can stop and start this via the command line using sc.exe and am able to control other services ie Alerter but as soon as I try to control this particular service it fails.
Thanks
EDIT The full code from the script (Thanks Brandon Moretz who pointed out
that I hadn't posted the full code so
the Line number didn't mean anything &
I have changed the StartService() back
to Stop as it originally was so now you have more to go on. Sorry!)
' 1. Check that the latest backup zip exists and store its name in LBZ (LatestBackupZip)
' 2. Stop the Livecontent Service
' 3. Remove .dbx, .lck and .log files from DataFolder
' 4. restart the service
' 5. Restore the database
Dim fileNewest
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
'Set ImportFldr = fso.GetFolder("C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data\Import")
Set ImportFldr = fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data\export")
'Set DataFldr = fso.GetFolder("C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data")
Set DataFldr = fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data")
For Each aFile In ImportFldr.Files
sExtension = fso.GetExtensionName(aFile.Name)
If sExtension = "log" Then
'Msgbox "The file extension is a " & sExtension
Else
'Msgbox "The file extension is a " & sExtension
If fileNewest = "" Then
Set fileNewest = aFile
Else
'If fileNewest.DateCreated < aFile.DateCreated Then
If CDate(fileNewest.DateCreated) < CDate(aFile.DateCreated) Then
Set fileNewest = aFile
End If
End If
End If
Next
Msgbox "The Newest File in the folder is " & fileNewest.Name & chr(13) & "Size: " & fileNewest.Size & " bytes" & chr(13) & "Was last modified on " & FileNewest.DateLastModified
' Change to /Data
'WScript.Echo WshShell.CurrentDirectory
WshShell.CurrentDirectory = DataFldr
'WScript.Echo WshShell.CurrentDirectory
' Stop the Livecontent service
strComputer = "."
Dim objService
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery _
("Select * from Win32_Service where Name = 'LiveContent'")
For Each objService in colServiceList
WScript.Echo objService.State
If objService.State = "Running" Then
objService.StopService()
'Wscript.Sleep 5000
End If
Next
'Dim objShell
'Set objShell = CreateObject("WScript.Shell")
'objShell.Run "%comspec% /k c: & cd ""C:\Program Files (x86)\XyEnterprise\SDL LiveContent\"" & """"loaddb RESTORE -'Dlc.file=C:\PROGRA~2\XYENTE~1\SDLLIV~1\data\Import\" & fileNewest.Name & " -Dlc.pswd=N2kAs72z"""""
LATEST EDIT
I have taken your code and still can't get it to work. I noticed that the line:
Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")
was missing a \ at "winmgmts:\" which I have added and I like your check to see if there is an (x86) directory as I am testing this on a 32bit server but will move it over to a 64 when it is ready so that will work nicely.
Also this section didn't work:
If fso.FolderExists( "C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data" ) Then
Set DataFldr= fso.GetFolder("C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data")
Else If fso.GetFolder("C:\Program diles\XyEnterprise\SDL LiveContent\data") Then
Set DataFldr= fso.GetFolder("C:\Program diles\XyEnterprise\SDL LiveContent\data")
End If
But did if I changed the ElseIf fso.GetFolder to fso.FolderExists
The script runs fine if I comment out Line 78
objService.StopService()
But as soon as I uncomment it I get an error:
Line: 78
Char: 9
Error: Not found
Code: 80041002
Source: SWbemObjectEx
But the Service can be found as the line: WScript.Echo objService.State Echos its state to the screen.
Really confuzzled now.
' 1. Check that the latest backup zip exists and store its name in LBZ (LatestBackupZip)
' 2. Stop the Livecontent Service
' 3. Remove .dbx, .lck and .log files from DataFolder
' 4. restart the service
' 5. Restore the database
Dim fileNewest
Dim ImportFldr
Dim DataFldr
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
If fso.FolderExists( "C:\Program Files\XyEnterprise\SDL LiveContent\data\Import" ) Then
Set ImportFldr = fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data\Import")
Else
WScript.Echo "Warning: Import Directory can not be found"
End If
If fso.FolderExists( "C:\Program Files\XyEnterprise\SDL LiveContent\data\export" ) Then
Set ImportFldr = fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data\export")
Else
WScript.Echo "Warning: Export Directory can not be found"
End If
If fso.FolderExists( "C:\Program Files\XyEnterprise\SDL LiveContent\data" ) Then
Set DataFldr= fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data")
Else
WScript.Echo "Warning: Data Directory can not be found"
End If
For Each aFile In ImportFldr.Files
sExtension = fso.GetExtensionName(aFile.Name)
If sExtension = "log" Then
'Msgbox "The file extension is a " & sExtension
Else
'Msgbox "The file extension is a " & sExtension
If fileNewest = "" Then
Set fileNewest = aFile
Else
If fileNewest.DateCreated < aFile.DateCreated Then
If CDate(fileNewest.DateCreated) < CDate(aFile.DateCreated) Then
Set fileNewest = aFile
End If
End If
End If
End If
Next
'Msgbox "The Newest File in the folder is " & fileNewest.Name & chr(13) & "Size: " & fileNewest.Size & " bytes" & chr(13) & "Was last modified on " & FileNewest.DateLastModified
' Change to /Data
WScript.Echo WshShell.CurrentDirectory
WshShell.CurrentDirectory = DataFldr
WScript.Echo WshShell.CurrentDirectory
' Stop the Livecontent service
strComputer = "."
Dim objService
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery _
("Select * from Win32_Service where Name = 'LiveContent'")
For Each objService in colServiceList
WScript.Echo objService.State
If objService.State = "Running" Then
objService.StopService()
WScript.Echo objService.State
Wscript.Sleep 5000
End If
Next
EDIT 2
After very extensive testing we have come to the conclusion that there is nothing wrong with the script, it is just that this particular service will not stop with this method.
To this end we have moved on and are now using
objShell.Run "sc start LiveContent"
And this works a treat.
Thanks to Brandon for your help.
There are a couple of minor issues:
1.) Not checking for if a folder exists for calling get folder, this is what was causing your 'Not Found' error.
2.) Non-matching If ... Then & End statements in your file loop. (I would probably choose a better editor for vbscript, programmers notepad and notepad++ are very useful.)
3.) The StartService() / StopService() mix-up I mentioned previously.
' 1. Check that the latest backup zip exists and store its name in LBZ (LatestBackupZip)
' 2. Stop the Livecontent Service
' 3. Remove .dbx, .lck and .log files from DataFolder
' 4. restart the service
' 5. Restore the database
Dim fileNewest
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Dim ImportFldr
If fso.FolderExists( "C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data\Import" ) Then
Set ImportFldr = fso.GetFolder("C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data\Import")
Else If fso.FolderExists( "C:\Program Files\XyEnterprise\SDL LiveContent\data\export" ) Then
Set ImportFldr = fso.GetFolder("C:\Program Files\XyEnterprise\SDL LiveContent\data\export")
End If
Dim DataFldr
If fso.FolderExists( "C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data" ) Then
Set DataFldr= fso.GetFolder("C:\Program Files (x86)\XyEnterprise\SDL LiveContent\data")
Else If fso.GetFolder("C:\Program diles\XyEnterprise\SDL LiveContent\data") Then
Set DataFldr= fso.GetFolder("C:\Program diles\XyEnterprise\SDL LiveContent\data")
End If
For Each aFile In ImportFldr.Files
sExtension = fso.GetExtensionName(aFile.Name)
If sExtension = "log" Then
'Msgbox "The file extension is a " & sExtension
Else
'Msgbox "The file extension is a " & sExtension
If fileNewest = "" Then
Set fileNewest = aFile
Else
If fileNewest.DateCreated < aFile.DateCreated Then
If CDate(fileNewest.DateCreated) < CDate(aFile.DateCreated) Then
Set fileNewest = aFile
End If
End If
End If
End If
Next
Msgbox "The Newest File in the folder is " & fileNewest.Name & chr(13) & "Size: " & fileNewest.Size & " bytes" & chr(13) & "Was last modified on " & FileNewest.DateLastModified
' Change to /Data
'WScript.Echo WshShell.CurrentDirectory
WshShell.CurrentDirectory = DataFldr
'WScript.Echo WshShell.CurrentDirectory
' Stop the Livecontent service
strComputer = "."
Dim objService
Set objWMIService = GetObject("winmgmts:\" & strComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery _
("Select * from Win32_Service where Name = 'LiveContent'")
For Each objService in colServiceList
WScript.Echo objService.State
If objService.State = "Running" Then
objService.StopService()
'Wscript.Sleep 5000
End If
Next
'Dim objShell
'Set objShell = CreateObject("WScript.Shell")
'objShell.Run "%comspec% /k c: & cd ""C:\Program Files (x86)\XyEnterprise\SDL LiveContent\"" & """"loaddb RESTORE -'Dlc.file=C:\PROGRA~2\XYENTE~1\SDLLIV~1\data\Import\" & fileNewest.Name & " -Dlc.pswd=N2kAs72z"""""
After very extensive testing we have come to the conclusion that there is nothing wrong with the script as it starts and stops other services, it is just that this particular service will not stop with this method.
To this end we have moved on and are now using
objShell.Run "sc start LiveContent"
And this works a treat.
Thanks to Brandon for your help.