I have created one GUI using below code in HTA:
Sub result ( )
Dim strComputer, objShell, objExec, strPingResults, WshShell
strComputer = Trim( UCase( ComputerNameTextBox.Value ) )
Set WshShell = CreateObject("WScript.Shell")
Set objExec = WshShell.Exec("cmd.exe /c C: \Program Files (x86)\VMware\VMware vSphere CLI\bin & esxcli -s "&strComputer&" -u root -p NTMC_Admin network nic list ")
strPingResults = LCase(objExec.StdOut.ReadAll)
ResultsTextArea.Value = ""
ResultsHiddenText.Value = strComputer & vbTab
ResultsHiddenText.Value = strComputer & vbcr & vblf & strPingResults
ResultsTextArea.Value = ResultsTextArea.Value & strPingResults
CopyButton.Disabled = False
ResetButton.Disabled = False
' change mouse pointer back to default
Document.Body.Style.Cursor = "default"
End Sub
Please help me out to secure my code so that no one can see the this function under any view source.
You should try to convert your vbscript and your HTA to executables files !
(VbsEdit/HTAEdit), it's a package includes (VbsEdit 32-bit, VbsEdit 64-bit, HtaEdit 32-bit and HtaEdit 64-bit). has a good feature is to compile and convert your vbs or your HTA files into .exe and it is totaly free.
hta_code.exe extract All resources And HTA either Into Temp folder Of System Or User specified Folder.u can easily reach temp folder while hta is running and copy extracted folder to a safe location because after Hta been closed Extracted command in .exe Delete all files from temp folder.to locate hta in temp folder we can use window search by typing .hta............#teemu is right #hackoo m not sure about htaedit but i will check this out today
Related
A previous team where I work created a vbs script that can automatically start a restore of a Macrium Image File located on inserted optical media. The problem is that the Macrium Image File is now too big for one disc, and now we have it split onto 2 separate discs, so now the vbs script doesn't function the way it should.
When Automatic Restore is launched, it should detect disc 1, which ends in 00.00.mrimg and know that it is part of a multi-disc install, at which point it asks for the next disc, ending in 00-01.mrimg.
I know this probably makes no sense, especially if anyone reading is not familiar with Macrium. But I will do my best to answer any questions.
I would normally plug away and try to figure it out myself, but i'm not very familiar with VBS and the problem is pretty time sensitive. Any help I can get will be much appreciated.
Opened AutoRestore.vbs script to see if I could fix the issue, but I don't know enough about vbs to fix it.
'AutoRestore.vbs
Dim fso, d, dc, s, n , Root, u, racine, folder, folderName, restoreString, foundFile, cdDrive
Dim wipe
Dim objShell
Set objShell = WScript.CreateObject("WScript.shell")
Set fso = CreateObject("Scripting.FileSystemObject")
Set dc = fso.Drives
foundFile = false
restoreString = "00-00.mrimg"
For Each d in dc
Root = d.Driveletter & ":"
racine = d.Driveletter & ":\"
u= Detect(Root)
if (( u="CD-ROM") ) then
cdDrive = cdDrive & racine & " "
if (d.isReady) then
folderName = racine & "IAS\"
Set folder = fso.GetFolder(folderName)
end if
end if
Next
If IsNull(folder) or IsEmpty(folder) Then
MsgBox "Could not locate IAS folder containing restore image." & vbCrLf & "The following optical disk drives were searched: " & cdDrive & vbCrLf & "Please verify the media is the drive or use manual restore.", 48, "Folder Not Found"
Else
For each file in folder.Files
If instr(1,file.Name, restoreString, vbTextCompare) > 0 Then
return = objShell.run("""%ProgramFiles%\macrium\diskrestore.exe""" & folderName & file.Name & " -r -g -u --targetnum 0 --reboot --eject",1,false)
foundFile = true
Exit For
End If
Next
if (foundFile = false) Then
MsgBox "Cannot locate .mrimg file in " & folderName & "." & vbCrLf & "Please use manual restore.", 48, "File Not Found"
End If
End If
Function Detect(DrivePath)
Dim fso, d, s, t
Set fso = CreateObject("Scripting.FileSystemObject")
Set d = fso.GetDrive(fso.GetDriveName(fso.GetAbsolutePathName(DrivePath)))
Select Case d.DriveType
Case 0: t = "Unknown"
Case 1: t = "Removable"
Case 2: t = "Fixed"
Case 3: t = "Network"
Case 4: t = "CD-ROM"
Case 5: t = "RAM Disk"
End Select
Detect = t
End Function
Expected Results: Run AutoRestore.vbs, the script sees the 00-00.mrimg file in IAS folder of the optical media, then prompts to insert the optical media containing the 00-01.mrimg file.
Actual Results: Run AutoRestore.vbs, then Macrium states "Backup set is not complete. At least one file may be missing."
You could first copy all the mrimg files to a temporary folder on the machine's hard drive. Once you have them all, you can then run Disk Restore with that folder instead of the CD-ROM drive.
Most of your existing code would work. After the For Each d in dc loop, you know the drive where the discs are being inserted. You could add another loop:
Dim tempFolder
Set tempFolder = fso.GetFolder("C:\AutoRestore\")
Do While MsgBox("Please insert disc and click OK. When all discs have been inserted, click Cancel", vbOKCancel, "Auto Restore") = vbOK
For Each file In folder.Files
If InStr(1, file.Name, ".mrimg") > 0 Then
' Copy file to Temp folder
fso.CopyFile file.Path, tempFolder.Path & "\", True
End If
Next
Loop
After this, you should have all the mrimg files in the tempFolder location. I am not familiar with the parameters the Marcium command expects but this is where you would specify the new folder:
objShell.run("""%ProgramFiles%\macrium\diskrestore.exe""" & tempFolder.Path & "\" & file.Name & " -r -g -u --targetnum 0 --reboot --eject",1,false)
I work in a hospital environment and right now im doing PC deployments. Part of the deployment requires us to view 2 files on a network drive looking for information regarding the old systems. They use specific ports and or TTY's to view information in each department.
I am trying to create a VBS file that can open 2 files in 2 different notepad windows. The first one opens up but the pcview.cfg keeps giving me an error. Im trying to link to the same location that the HBOWEM32 is pointed to. Can anyone solve? For security reasons I have taken out the exact location of the network drive. The code below prompts for a specific folder name which is the old pc name. After entering that data it opens the HBOWEM32 files fine but says it cannot find the other part. I Have manually looked inside the folder and the pcview.cfg file DOES exist. I just want a faster way of opening these rather than brute forcing through the run prompt.
Here is the code.
CONST strDir = "<Netowrk Location)"
Dim WshShell
set objShell = CreateObject("WScript.Shell")
set objFSO = CreateObject("Scripting.FileSystemObject")
function findFolder(strDir, strFlag)
set objFolder = objFSO.GetFolder(strDir)
for each objSubFolder in objFolder.SubFolders
if (inStr(objSubFolder.Name, strFlag)) then
findFolder = objSubFolder.Path
exit function
else
findFolder = findFolder (objSubFolder.Path, strFlag)
end if
next
end function
strFlag = inputBox("Enter Computer Name:")
strWeb = findFolder(strDir, strFlag) & "\HBOWEM32.ini"
objShell.Run strWeb
Set WshShell = CreateObject ("WScript.Shell")
WshShell.Run ("notepad.exe """ + "\\<same location as above>\Pcview.cfg""")
Use Option Explicit
Don't create variables you don't use (WshShell, objShell)
Improve your variable names (strFlag seems to be a computer name, strWeb seems to be the full specification of a file)
Don't lump different info into one variable (strWeb contains the folder path to re-use and the specific file name)
Use diagnostics output (at least while developing)
In code:
Option Explicit
...
Dim strComputer : strComputer = InputBox("Enter Computer Name:")
Dim strFolder : strFolder = findFolder(strDir, strComputer)
Dim strIniFSpec : strIniFSpec = objFSO.BuildPath(strFolder, "HBOWEM32.ini")
WScript.Echo "will run '" & strIniFSpec & "'"
objShell.Run strIniFSpec
Dim WshShell : Set WshShell = CreateObject("WScript.Shell")
Dim strCfgFSpec : strCfgFSpec = objFSO.BuildPath(strFolder, "Pcview.cfg")
Dim strCmd : strCmd = "notepad.exe """ & strCfgFSpec & """"
WScript.Echo "will run '" & strCmd & "'"
WshShell.Run strCmd
(not tested, please be carefull)
When we moved Documents and Settings folder completely from C to D drive , the product addon installation is not working , this ends up with popup windowsFolderSplit(0):C and error Folder doesn't exisit? For a systems having single partition this is working fine but only for multiple partitions this is not working
Here is the bit of vbscript code used in the installation script, Do i need to do any modification here ??
Dim windowsFolder ' For finding shortcut location
Dim windowsFolderSplit ' For isolating the WINDOWS drive
windowsFolder = fso.GetSpecialFolder(WindowsFolder)
If DEBUG = "D1" Then
MsgBox "windowsFolder:" & windowsFolder
End If
windowsFolderSplit = Split(windowsFolder, "\", -1, 1)
If DEBUG = "D1" Then
MsgBox "windowsFolderSplit(0):" & windowsFolderSplit(0)
MsgBox "windowsFolderSplit(1):" & windowsFolderSplit(1)
End If
Set docAndSetFolder = fso.GetFolder(windowsFolderSplit(0) & "\Documents and Settings")
Does it hardcoding values in to 'C' drive?
SpecialFolders (MSDN):
Dim objShell As Object
Dim strPath As String
Set objShell = Wscript.CreateObject("Wscript.Shell")
strPath = objShell.SpecialFolders("MyDocuments")
wscript.echo strPath
or optionally:
Set S = CreateObject("WScript.Shell")
Set E = S.Environment
WScript.Echo E("USERPROFILE")
I'm having a problem with Trend OfficeScan Patterns filling up the C:\ drive (no other drives available to change directories) and I'm getting a permission denied error accessing "C:\Program Files\Trend Micro\OfficeScan\PCCSRV\WSS\patterns" running the below script. As I'll be using this script for a few sites, and to make it easy to implement for my colleagues, I don't want to play around adding various permissions.
I tried changing: PatternLocation = (strValue & "WSS\patterns\") to PatternLocation = ("""" & strValue & "WSS\patterns\""") and I get 'Path not found'. Are there any VBScript experts that may be able to recommend an impersonate method to overcome the permissions denied?
' Variable to locate HLM.
const HKEY_LOCAL_MACHINE = &H80000002
Set fso = CreateObject("Scripting.FileSystemObject")
' Checks if the operating system is x86 or x64
Set objShell = CreateObject("WScript.Shell")
osType = objShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")
' The dot refers to the computer this vbscript has been run on.
strComputer = "."
' Provides connection to the registry.
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
' Checks the bit for the operating system
If osType = "x86" Then
' Checks registry for Trend folder path.
strKeyPath = "SOFTWARE\TrendMicro\OfficeScan\Service\Information"
Elseif osType = "AMD64" Then
strKeyPath = "SOFTWARE\Wow6432Node\TrendMicro\OfficeScan\service\Information"
End if
trValueName = "Local_Path"
objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
' If the registry path is empty it won't install the scheduled task and alert you.
If IsNull(strValue) Then
msgbox("Trend Micro is not installed.")
else
PatternLocation = (strValue & "WSS\patterns\") ' folder to start deleting (subfolders will also be cleaned)
OlderThanDate = DateAdd("d", -2, Date) ''# 2 days (adjust as necessary)
DeleteOldFiles PatternLocation, OlderThanDate
end if
Function DeleteOldFiles(folderName, BeforeDate)
Dim folder, file, fileCollection, folderCollection, subFolder
Set folder = fso.GetFolder(folderName)
Set fileCollection = folder.Files
For Each file In fileCollection
If file.DateLastModified < BeforeDate Then
fso.DeleteFile(file.Path)
End If
Next
Set folderCollection = folder.SubFolders
For Each subFolder In folderCollection
DeleteOldFiles subFolder.Path, BeforeDate
Next
End Function
This is the working script with a few changes for anyone who might find it useful:
'Variable to locate HLM.
const HKEY_LOCAL_MACHINE = &H80000002
Set fso = CreateObject("Scripting.FileSystemObject")
'Checks if the operating system is x86 or x64
Set objShell = CreateObject("WScript.Shell")
osType = objShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")
'The dot refers to the computer this vbscript has been run on.
strComputer = "."
'Provides connection to the registry.
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
'Checks the bit for the operating system
If osType = "x86" Then
'Checks registry for Trend folder path.
strKeyPath = "SOFTWARE\TrendMicro\OfficeScan\Service\Information"
Elseif osType = "AMD64" Then
strKeyPath = "SOFTWARE\Wow6432Node\TrendMicro\OfficeScan\service\Information"
End if
strValueName = "Local_Path"
objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
'If the registry path is empty it won't install the scheduled task and alert you.
If IsNull(strValue) Then
msgbox("Trend Micro is not installed.")
else
PatternLocation = (strValue & "WSS\patterns") ' folder to start deleting (subfolders will also be cleaned)
'msgbox(PatternLocation)
end if
startFolder = PatternLocation
OlderThanDate = DateAdd("d", -1, Date) ' 1 days
DeleteOldFiles startFolder, OlderThanDate
DeleteEmptyFolders startFolder
Function DeleteOldFiles(folderName, BeforeDate)
Dim folder, file, fileCollection, folderCollection, subFolder
Set folder = fso.GetFolder(folderName)
Set fileCollection = folder.Files
For Each file In fileCollection
If file.DateLastModified < BeforeDate Then
fso.DeleteFile(file.Path)
End If
Next
Set folderCollection = folder.SubFolders
For Each subFolder In folderCollection
DeleteOldFiles subFolder.Path, BeforeDate
Next
End Function
Function DeleteEmptyFolders(foldername)
For Each Folder In fso.GetFolder(foldername).SubFolders
DeleteEmptyFolders(Folder.Path)
If Folder.Files.Count = 0 and Folder.SubFolders.Count = 0 Then
fso.DeleteFolder(Folder.Path)
End If
Next
End Function
Is the ZIP compression that is built into Windows XP/Vista/2003/2008 able to be scripted at all? What executable would I have to call from a BAT/CMD file? or is it possible to do it with VBScript?
I realize that this is possible using WinZip, 7-Zip and other external applications, but I'm looking for something that requires no external applications to be installed.
There are VBA methods to zip and unzip using the windows built in compression as well, which should give some insight as to how the system operates. You may be able to build these methods into a scripting language of your choice.
The basic principle is that within windows you can treat a zip file as a directory, and copy into and out of it. So to create a new zip file, you simply make a file with the extension .zip that has the right header for an empty zip file. Then you close it, and tell windows you want to copy files into it as though it were another directory.
Unzipping is easier - just treat it as a directory.
In case the web pages are lost again, here are a few of the relevant code snippets:
ZIP
Sub NewZip(sPath)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Function Split97(sStr As Variant, sdelim As String) As Variant
'Tom Ogilvy
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function
Sub Zip_File_Or_Files()
Dim strDate As String, DefPath As String, sFName As String
Dim oApp As Object, iCtr As Long, I As Integer
Dim FName, vArr, FileNameZip
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
strDate = Format(Now, " dd-mmm-yy h-mm-ss")
FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"
'Browse to the file(s), use the Ctrl key to select more files
FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", _
MultiSelect:=True, Title:="Select the files you want to zip")
If IsArray(FName) = False Then
'do nothing
Else
'Create empty Zip File
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
I = 0
For iCtr = LBound(FName) To UBound(FName)
vArr = Split97(FName(iCtr), "\")
sFName = vArr(UBound(vArr))
If bIsBookOpen(sFName) Then
MsgBox "You can't zip a file that is open!" & vbLf & _
"Please close it and try again: " & FName(iCtr)
Else
'Copy the file to the compressed folder
I = I + 1
oApp.Namespace(FileNameZip).CopyHere FName(iCtr)
'Keep script waiting until Compressing is done
On Error Resume Next
Do Until oApp.Namespace(FileNameZip).items.Count = I
Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
End If
Next iCtr
MsgBox "You find the zipfile here: " & FileNameZip
End If
End Sub
UNZIP
Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
'Do nothing
Else
'Root folder for the new folder.
'You can also use DefPath = "C:\Users\Ron\test\"
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
'Make the normal folder in DefPath
MkDir FileNameFolder
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
'If you want to extract only one file you can use this:
'oApp.Namespace(FileNameFolder).CopyHere _
'oApp.Namespace(Fname).items.Item("test.txt")
MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
Yes, this can be scripted with VBScript. For example the following code can create a zip from a directory:
Dim fso, winShell, MyTarget, MySource, file
Set fso = CreateObject("Scripting.FileSystemObject")
Set winShell = createObject("shell.application")
MyTarget = Wscript.Arguments.Item(0)
MySource = Wscript.Arguments.Item(1)
Wscript.Echo "Adding " & MySource & " to " & MyTarget
'create a new clean zip archive
Set file = fso.CreateTextFile(MyTarget, True)
file.write("PK" & chr(5) & chr(6) & string(18,chr(0)))
file.close
winShell.NameSpace(MyTarget).CopyHere winShell.NameSpace(MySource).Items
do until winShell.namespace(MyTarget).items.count = winShell.namespace(MySource).items.count
wscript.sleep 1000
loop
Set winShell = Nothing
Set fso = Nothing
You may also find http://www.naterice.com/blog/template_permalink.asp?id=64 helpful as it includes a full Unzip/Zip implementation in VBScript.
If you do a size check every 500 ms rather than a item count it works better for large files. Win 7 writes the file instantly although it's not finished compressing:
set fso=createobject("scripting.filesystemobject")
Set h=fso.getFile(DestZip)
do
wscript.sleep 500
max = h.size
loop while h.size > max
Works great for huge amounts of log files.
Just for clarity: GZip is not an MS-only algorithm as suggested by Guy Starbuck in his comment from August.
The GZipStream in System.IO.Compression uses the Deflate algorithm, just the same as the zlib library, and many other zip tools. That class is fully interoperable with unix utilities like gzip.
The GZipStream class is not scriptable from the commandline or VBScript, to produce ZIP files, so it alone would not be an answer the original poster's request.
The free DotNetZip library does read and produce zip files, and can be scripted from VBScript or Powershell. It also includes command-line tools to produce and read/extract zip files.
Here's some code for VBScript:
dim filename
filename = "C:\temp\ZipFile-created-from-VBScript.zip"
WScript.echo("Instantiating a ZipFile object...")
dim zip
set zip = CreateObject("Ionic.Zip.ZipFile")
WScript.echo("using AES256 encryption...")
zip.Encryption = 3
WScript.echo("setting the password...")
zip.Password = "Very.Secret.Password!"
WScript.echo("adding a selection of files...")
zip.AddSelectedFiles("*.js")
zip.AddSelectedFiles("*.vbs")
WScript.echo("setting the save name...")
zip.Name = filename
WScript.echo("Saving...")
zip.Save()
WScript.echo("Disposing...")
zip.Dispose()
WScript.echo("Done.")
Here's some code for Powershell:
[System.Reflection.Assembly]::LoadFrom("c:\\dinoch\\bin\\Ionic.Zip.dll");
$directoryToZip = "c:\\temp";
$zipfile = new-object Ionic.Zip.ZipFile;
$e= $zipfile.AddEntry("Readme.txt", "This is a zipfile created from within powershell.")
$e= $zipfile.AddDirectory($directoryToZip, "home")
$zipfile.Save("ZipFiles.ps1.out.zip");
In a .bat or .cmd file, you can use the zipit.exe or unzip.exe tools. Eg:
zipit NewZip.zip -s "This is string content for an entry" Readme.txt src
There are both zip and unzip executables (as well as a boat load of other useful applications) in the UnxUtils package available on SourceForge (http://sourceforge.net/projects/unxutils). Copy them to a location in your PATH, such as 'c:\windows', and you will be able to include them in your scripts.
This is not the perfect solution (or the one you asked for) but a decent work-a-round.
to create a compressed archive you can use the utility MAKECAB.EXE
Here'a my attempt to summarize built-in capabilities windows for compression and uncompression - How can I compress (/ zip ) and uncompress (/ unzip ) files and folders with batch file without using any external tools?
with a few given solutions that should work on almost every windows machine.
As regards to the shell.application and WSH I preferred the jscript
as it allows a hybrid batch/jscript file (with .bat extension) that not require temp files.I've put unzip and zip capabilities in one file plus a few more features.