Archive - April 2012

"It is a rough road that leads to the heights of greatness." - Seneca

Index

Return Command to Variable/Popup
Simple Backup Script
Show File Extension
Copy Files with Extension I
Copy Files with Extension II
Change File Attributes
Change from DHCP to IP

Window 7 Speed Tweak
Clean/Delete Win7 Profiles
List all files in folder
Using 7Zip in VBScript
Enable Windows Auto Updates using AutoIT

Δ Monday, April 30th, 2012

Δ Return Command to Variable/Popup

How to capture a command's output

[download resource files]

Demo

Uses StdOut in a function to return the command's output

Δ [email me]

Δ Thursday, April 26th, 2012

Δ Simple Backup Script

How to backup your files

[download resource files]

Demo

Uses xcopy.exe to backup your files.

'Description- Copies any new or updated files from user selected folder
'and its subfolders to user selected backup folder
'Uses Xcopy with switches /e /q /h /k /i /y /r /d /c

Option Explicit
Dim sFldrInput1, sFldrInput2, introMsg

introMsg = msgBox("This program backs up new and changed files."& vbCrLf & "If you are copying many files it may take a few minutes."& vbCrLf & "A message will appear when copying is finished.",vbOKCancel)
If introMsg = vbCancel Then Wscript.Quit

ChooseFolder sFldrInput1,"Select the source folder: "
ChkForSystemFldr sFldrInput1
ChooseFolder sFldrInput2, "Select the backup folder: "
ChkForSystemFldr sFldrInput2
CopyFolder sFldrInput1, sFldrInput2
Wscript.Quit

sub ChooseFolder(sFldrChoice, sSelectionString)
dim objShell, objFolder, objFolderItem, strPath, msgValue
Const DESK_TOP = &H10&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
sFldrChoice = ""
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(DESK_TOP)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
    (WINDOW_HANDLE, sSelectionString, OPTIONS, strPath) 
      
If objFolder Is Nothing Then
    Wscript.Quit
End If

Set objFolderItem = objFolder.Self
sFldrChoice = objFolderItem.Path

End sub

sub CopyFolder (sSourceFldr,sBkupFldr)

Const CopyX = "xcopy "
Const sSwitches = " /e /q /h /k /i /y /r /d /c"
Const sWildCard = "\*.*"
dim sStatement
dim objWshell
Dim oIE, oIEDoc, sMsg
sStatement= copyX  & chr(34) & sSourceFldr& sWildcard & chr(34) & " " & chr(34) & sBkupFldr & chr(34) & sSwitches

'The next part is just to display a message while copying
set objWshell=Wscript.CreateObject("Wscript.Shell")
Set oIE = Wscript.CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"
do while oIE.busy : wscript.sleep 10 : loop
Set oIEDoc = oIE.Document
oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.height=200
oIE.width=300
oIE.Resizable = False
oIE.Visible = True
sMsg= "<center>Files are being copied. Please wait. Large folders may take several minutes.</center>"
oIEDoc.Body.Innerhtml= sMsg

'copy the files
objWshell.Run sStatement,7,true

Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing
set objWshell = Nothing
msgBox "Copying job done"
End sub

'This is necessary to remove trailing slash on drive letters
Sub chkForDrv(sFldrChoice)
Dim oRe, bMatch
set oRe = New RegExp
oRe.pattern = "[a-zA-Z]:\\$"
bMatch= oRe.Test(sFldrChoice)
If bMatch Then sFldrChoice= Left(sFldrChoice, 2)
End sub

Sub chkForSystemFldr(sFldrChoice)
dim msgWarn, msgValue
If Left(sFldrChoice, 1) = ":" then
msgWarn = msgBox("You have selected a special system folder. Please select a different folder", vbRetryCancel+vbCritical)
Select case msgWarn
Case vbcancel
  Wscript.Quit
Case VbRetry 
 ChooseFolder sFldrChoice,"Select a folder: "
 If Left(SfldrChoice, 1) = ":" then Wscript.Quit
 msgValue = msgBox("You selected "& sFldrChoice, vbOKCancel)
   If msgValue = vbCancel Then Wscript.Quit
   If Len(sFldrChoice) = 3 then chkForDrv sFldrChoice
End select
Else 
  msgValue = msgBox("You selected "& sFldrChoice, vbOKCancel)
  If msgValue = vbCancel Then
	Wscript.Quit
End If
If Len(sFldrChoice) = 3 then 
   chkForDrv sFldrChoice
End if

end if
End sub

Δ [email me]

Δ Sunday, April 22nd, 2012

Δ Show File Extension

How to show file extensions in current directory

[download resource files]

Demo

Shows file extension by changing reg key and refreshing.

Δ [email me]

Δ Friday, April 20th, 2012

Δ Copy Files with Extension I

How to copy files by extension

[download resource files]

Uses xcopy.exe and specified file extension to copy files.

'Description- Copies files with specified extension from user selected
'folder to user selected destination folder.
'Older versions of a file will be overwritten
'Uses Xcopy with switches /c /h /k /r /y /i /q /d
 
Option Explicit
Dim sFldrInput1, sFldrInput2, introMsg, sExtension
introMsg = msgBox("This program copies files with a specified extension."& vbCrLf & "If older file versions already exist in the destination " & vbCrLf & "folder, they will be updated."& vbCrLf & "If you are copying many files it may take a few minutes."& vbCrLf & "A message will appear when copying is finished.",vbOKCancel)
If introMsg = vbCancel Then
	Wscript.Quit
End If
ChooseFolder sFldrInput1,"Select the source folder:"
ChooseFolder sFldrInput2, "Select the destination folder:"
ChooseExtension sExtension
CopyFiles sFldrInput1, sFldrInput2, sExtension
Wscript.Quit

Set objFolderItem = objFolder.Self
sFldrChoice = objFolderItem.Path

msgValue = msgBox("You selected "& sFldrChoice, vbOKCancel)
If msgValue = vbCancel Then
	Wscript.Quit
End If
If Len(sFldrChoice) = 3 then 
   chkForDrv sFldrChoice
End if
End sub

sub CopyFiles (sSourceFldr,sBkupFldr, sExtension)

Const CopyX = "xcopy "
Const sWildCard = "\*."
Const sSwitches = " /c /h /k /r /y /i /q /d"
dim sStatement
dim objWshell
Dim oIE, oIEDoc, sMsg
sStatement= copyX  & chr(34) & sSourceFldr & sWildcard  & sExtension & chr(34) & " " & chr(34) & sBkupFldr & chr(34) & sSwitches

'copy the files
objWshell.Run sStatement,7,true

Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing
set objWshell = Nothing
msgBox "Copying job done"
End sub

Sub chkForDrv(sFldrChoice)
Dim oRe, bMatch
set oRe = New RegExp
oRe.pattern = "[a-zA-Z]:\\$"
bMatch= oRe.Test(sFldrChoice)
If bMatch Then sFldrChoice= Left(sFldrChoice, 2)
End sub

Sub ChooseExtension(sExtension)
sExtension = InputBox("Enter extension of files to be copied.", "Name of extension")
If sExtension = "" Then
    Wscript.Quit
End If
chkForDot sExtension
End sub

Sub chkForDot(sExtension) 
Dim lenExt, truncStr
lenExt = Len(sExtension)
truncStr =left(sExtension,1)
If truncStr = "." then
    sExtension = right(sExtension,lenExt-1)
End if
End sub

Δ [email me]

Δ Thursday, April 19th, 2012

Δ Copy Files with Extension II

How to copy files by extension

[download resource files]

Uses xcopy.exe and specified file extension to copy files - updated to handle
subdirectories as well.

'Description- Copies files with specified extension from user selected
'folder and its subfolders to a user selected destination folder.
'Pre-existing files of the same name will be overwritten
'if they are older than the file being copied.
'Uses Xcopy with switches /c /h /k /r /y /i /q /s /d
 
Option Explicit
Dim sFldrInput1, sFldrInput2, introMsg, sExtension
introMsg = msgBox("This program copies files with a specified extension." & vbCrLf & "Files from subfolders will also be copied." & vbCrLf & "Pre-existing files of the same name will be overwritten if they are older."& vbCrLf & "If you are copying many files it may take a few minutes."& vbCrLf & "A message will appear when copying is finished.",vbOKCancel)
If introMsg = vbCancel Then
	Wscript.Quit
End If
ChooseFolder sFldrInput1,"Select the source folder:"
ChooseFolder sFldrInput2, "Select the destination folder:"
ChooseExtension sExtension
CopyFiles sFldrInput1, sFldrInput2, sExtension
Wscript.Quit

Set objFolderItem = objFolder.Self
sFldrChoice = objFolderItem.Path

msgValue = msgBox("You selected "& sFldrChoice, vbOKCancel)
If msgValue = vbCancel Then
	Wscript.Quit
End If
If Len(sFldrChoice) = 3 then 
   chkForDrv sFldrChoice
End if
End sub

sub CopyFiles (sSourceFldr,sBkupFldr, sExtension)

Const CopyX = "xcopy "
Const sWildCard = "\*."
Const sSwitches = " /c /h /k /r /y /i /q /s /d"
dim sStatement
dim objWshell
Dim oIE, oIEDoc, sMsg
sStatement= copyX  & chr(34) & sSourceFldr & sWildcard  & sExtension & chr(34) & " " & chr(34) & sBkupFldr & chr(34) & sSwitches

'copy the files
objWshell.Run sStatement,7,true

Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing
set objWshell = Nothing
msgBox "Copying job done"
End sub

Sub chkForDrv(sFldrChoice)
Dim oRe, bMatch
set oRe = New RegExp
oRe.pattern = "[a-zA-Z]:\\$"
bMatch= oRe.Test(sFldrChoice)
If bMatch Then sFldrChoice= Left(sFldrChoice, 2)
End sub

Sub ChooseExtension(sExtension)
sExtension = InputBox("Enter extension of files to be copied.", "Name of extension")
If sExtension = "" Then
    Wscript.Quit
End If
chkForDot sExtension
End sub

Sub chkForDot(sExtension) 
Dim lenExt, truncStr
lenExt = Len(sExtension)
truncStr =left(sExtension,1)
If truncStr = "." then
    sExtension = right(sExtension,lenExt-1)
End if
End sub

Δ [email me]

Δ Tuesday, April 17th, 2012

Δ Change File Attributes

How to change file attributes

[download resource files]

Demo

Uses attrib.exe command to make changes to file attributes.

'Description- Removes Read-Only attribute for files in user selected folder
'and its subfolders
'Uses attrib -r with switch /s

Option Explicit
Dim sFldrInput, introMsg

introMsg = msgBox("This program removes read-only attributes"& vbCrLf & "from files in selected folder. It may take a few minutes."& vbCrLf & "A message will appear when copying is finished.",vbOKCancel)
If introMsg = vbCancel Then
	Wscript.Quit
End If
ChooseFolder sFldrInput,"Select the source folder: "

ChangeAttribute sFldrInput
Wscript.Quit

Set objFolderItem = objFolder.Self
sFldrChoice = objFolderItem.Path

msgValue = msgBox("You selected "& sFldrChoice, vbOKCancel)
If msgValue = vbCancel Then
	Wscript.Quit
End If
If Len(sFldrChoice) = 3 then 
   chkForDrv sFldrChoice
End if
End sub

sub ChangeAttribute (sSourceFldr)

Const AttribR = "attrib -r "
Const sSwitch = " /s"
Const sWildCard = "\*.*"
dim sStatement
dim objWshell
Dim oIE, oIEDoc, sMsg
sStatement= AttribR & chr(34) & sSourceFldr& sWildcard & chr(34) &  sSwitch

'The next part is just to display a message while copying
set objWshell=Wscript.CreateObject("Wscript.Shell")
Set oIE = Wscript.CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"
do while oIE.busy : wscript.sleep 10 : loop
Set oIEDoc = oIE.Document
oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.height=200
oIE.width=300
oIE.Resizable = False
oIE.Visible = True
sMsg= "<center>Read-only attributes being removed. Please wait. Large folders may take several minutes.</center>"
oIEDoc.Body.Innerhtml= sMsg

'remove R attribute
objWshell.Run sStatement,7,true

Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing
set objWshell = Nothing
msgBox "Attributes changed"
End sub

Sub chkForDrv(sFldrChoice)
Dim oRe, bMatch
set oRe = New RegExp
oRe.pattern = "[a-zA-Z]:\\$"
bMatch= oRe.Test(sFldrChoice)
If bMatch Then sFldrChoice= Left(sFldrChoice, 2)
Set oRe = Nothing
End sub

Δ [email me]

Δ Monday, April 16th, 2012

Δ Change from DHCP to IP

How to change settings from DHCP to static settings

[download resource files]

Uses netsh to make static changes to the interface.

Δ [email me]

Δ Thursday, April 12th, 2012

Δ Window 7 Speed Tweak

How to speed up Windows 7

[download resource files]

Uses takeown.exe, icacls.exe and applies reg key tweaks.

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\AllFilesystemObjects\shellex\ContextMenuHandlers\Copy To]
@="{C2FBB630-2971-11D1-A18C-00C04FD75D13}"
 
[HKEY_CLASSES_ROOT\AllFilesystemObjects\shellex\ContextMenuHandlers\Move To]
@="{C2FBB631-2971-11D1-A18C-00C04FD75D13}"

[HKEY_CURRENT_USER\Control Panel\Desktop]
"AutoEndTasks"="1"
"HungAppTimeout"="1000"
"MenuShowDelay"="8"
"WaitToKillAppTimeout"="2000"
"LowLevelHooksTimeout"="1000"

[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer]
"NoLowDiskSpaceChecks"=dword:00000001
"LinkResolveIgnoreLinkInfo"=dword:00000001
"NoResolveSearch"=dword:00000001
"NoResolveTrack"=dword:00000001
"NoInternetOpenWith"=dword:00000001

[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control]
"WaitToKillServiceTimeout"="2000"

[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\RemoteComputer]

[HKEY_CLASSES_ROOT\*\shell\takeownership]
@="Take ownership"
"HasLUAShield"=""
"NoWorkingDirectory"=""

[HKEY_CLASSES_ROOT\*\shell\takeownership\command]
@="cmd.exe /c takeown /f \"%1\" && icacls \"%1\" /grant administrators:F"
"IsolatedCommand"="cmd.exe /c takeown /f \"%1\" && icacls \"%1\" /grant administrators:F"

[HKEY_CLASSES_ROOT\exefile\shell\takeownership]
@="Take ownership"
"HasLUAShield"=""
"NoWorkingDirectory"=""

[HKEY_CLASSES_ROOT\exefile\shell\takeownership\command]
@="cmd.exe /c takeown /f \"%1\" && icacls \"%1\" /grant administrators:F"
"IsolatedCommand"="cmd.exe /c takeown /f \"%1\" && icacls \"%1\" /grant administrators:F"

[HKEY_CLASSES_ROOT\dllfile\shell\takeownership]
@="Take ownership"
"HasLUAShield"=""
"NoWorkingDirectory"=""

[HKEY_CLASSES_ROOT\dllfile\shell\takeownership\command]
@="cmd.exe /c takeown /f \"%1\" && icacls \"%1\" /grant administrators:F"
"IsolatedCommand"="cmd.exe /c takeown /f \"%1\" && icacls \"%1\" /grant administrators:F"

[HKEY_CLASSES_ROOT\Directory\shell\takeownership]
@="Take ownership"
"HasLUAShield"=""
"NoWorkingDirectory"=""

[HKEY_CLASSES_ROOT\Directory\shell\takeownership\command]
@="cmd.exe /c takeown /f \"%1\" /r /d y && icacls \"%1\" /grant administrators:F /t"
"IsolatedCommand"="cmd.exe /c takeown /f \"%1\" /r /d y && icacls \"%1\" /grant administrators:F /t"

Δ [email me]

Δ Tuesday, April 10th, 2012

Δ Clean/Delete Win7 Profiles

How to cleanup Win7 Profiles

[download resource files]

Goes into registry and c:\users folder to clear profiles

@ECHO OFF
:: -------------------------------------------------------------------------
:: Welcome!  This script is designed to automate the process of flushing
:: user profiles within Windows 7, while at the same time preserving
:: profiles of your choosing, including domain users.
::
:: This script is written as an example of wanting all domain users wiped
:: except for the one called "pctest".
::
:: Portions of the script that will require manual edits will be preceded
:: by instructions with these "double colon" comment marks.
::
:: Please let me know how well (or not well) this works for you or any
:: features you can think of that could be added.
::
:: -------------------------------------------------------------------------

title Windows 7 User Profile Cleaning

:: ----------
:: Add any users you wish to exclude from the wipe to the "userpreserve"
:: line below and separate them by commas.  Be careful - these are
:: case-sensitive.
:: ----------

set sharename=\\server\share

:USERPRESERVE
set userpreserve="Administrator,All Users,UpdatusUser,Default,Default User,Public,pctest"

FOR /f "tokens=*" %%a IN ('reg query "hklm\software\microsoft\windows nt\currentversion\profilelist"^|find /i "s-1-5-21"') DO CALL :REGCHECK "%%a"
GOTO VERIFY

:REGCHECK
set SPACECHECK=
FOR /f "tokens=3,4" %%b in ('reg query %1 /v ProfileImagePath') DO SET USERREGPATH=%%b %%c
FOR /f "tokens=2" %%d in ('echo %USERREGPATH%') DO SET SPACECHECK=%%d
IF ["%SPACECHECK%"]==[""] GOTO REGCHECK2
GOTO USERCHECK

:REGCHECK2
FOR /f "tokens=3" %%g in ('reg query %1 /v ProfileImagePath') DO SET USERREGPATH=%%g
GOTO USERCHECK

:USERCHECK
FOR /f "tokens=3 delims=\" %%e in ('echo %USERREGPATH%') DO SET USERREG=%%e
FOR /f "tokens=1 delims=." %%f IN ('echo %USERREG%') DO SET USERREGPARSE=%%f
ECHO %USERPRESERVE%|find /I "%USERREGPARSE%" > NUL
IF ERRORLEVEL=1 GOTO CLEAN
IF ERRORLEVEL=0 GOTO SKIP

:SKIP
ECHO Skipping user clean for %USERREG%
GOTO :EOF

:CLEAN
ECHO Cleaning user profile for %USERREG%
rmdir "C:\Users\%USERREG%" /s /q > NUL
ECHO Cleaning user registry for %USERREG%
reg delete %1 /f
IF EXIST "C:\Users\%USERREG%" GOTO RETRYCLEAN1
GOTO :EOF

:RETRYCLEAN1
ECHO Retrying clean of user profile %USERREG%
rmdir "C:\Users\%USERREG%" /s /q > NUL
IF EXIST "C:\Users\%USERREG%" GOTO RETRYCLEAN2
GOTO :EOF

:RETRYCLEAN2
ECHO Retrying clean of user profile %USERREG%
rmdir "C:\Users\%USERREG%" /s /q > NUL
GOTO :EOF

:VERIFY
FOR /f "tokens=*" %%g IN ('reg query "hklm\software\microsoft\windows nt\currentversion\profilelist"^|find /i "s-1-5-21"') DO CALL :REGCHECKV "%%g"
GOTO REPORT

:REGCHECKV
set SPACECHECKV=
FOR /f "tokens=3,4" %%h in ('reg query %1 /v ProfileImagePath') DO SET USERREGPATHV=%%h %%i
FOR /f "tokens=2" %%j in ('echo %USERREGPATHV%') DO SET SPACECHECKV=%%j
IF ["%SPACECHECKV%"]==[""] GOTO REGCHECKV2
GOTO USERCHECKV

:REGCHECKV2
FOR /f "tokens=3" %%k in ('reg query %1 /v ProfileImagePath') DO SET USERREGPATHV=%%k
GOTO USERCHECKV

:USERCHECKV
FOR /f "tokens=3 delims=\" %%l in ('echo %USERREGPATHV%') DO SET USERREGV=%%l
FOR /f "tokens=1 delims=." %%m IN ('echo %USERREGV%') DO SET USERREGPARSEV=%%m
ECHO %USERPRESERVE%|find /I "%USERREGPARSEV%" > NUL
IF ERRORLEVEL=1 GOTO VERIFYERROR
IF ERRORLEVEL=0 GOTO :EOF

:VERIFYERROR
SET USERERROR=YES
GOTO :EOF

:REPORT
IF [%USERERROR%]==[YES] (
		set RESULT=FAILURE
)		ELSE (
		set RESULT=SUCCESS
)

:: ----------
:: This is fairly optional - it's just something I added so
:: that I could keep an eye on the labs remotely to make
:: sure there weren't masses of critical errors with the
:: script failing.
::
:: If you don't want it, just comment-out or remove the
:: "net use" line.
::
:: If you do want it, then make the necessary modifications
:: to the net use to map an appropriate sharepoint.
:: ----------

net use t: %sharename%

IF EXIST "t:\labreport.txt" (
	GOTO REPORTGEN
) ELSE (
	GOTO EXIT
)

:REPORTGEN
FOR /F "tokens=*" %%n in ('echo %date:~10,4%-%date:~4,2%-%date:~7,2% %time:~0,2%-%time:~3,2%-%time:~6,2%') DO SET TDATETIME=%%n
FOR /F "tokens=14" %%o in ('ipconfig^|find "IPv4 Address"') DO SET IPNUMBER=%%o
ECHO. %RESULT%	%COMPUTERNAME%	%IPNUMBER%	%TDATETIME%>>"t:\labreport.txt"
net use t: /delete
GOTO EXIT

:EXIT
@echo on
exit /b 0

:EOF

Δ [email me]

Δ Saturday, April 7th, 2012

Δ List all files in folder

How to list files in specified folder

[download resource files]

Demo

Uses the dir command to list files.

'Description- Lists all files in a selected folder
'and (optionally its subfolders
'Uses Dir with various switches

Option Explicit
Dim sFldrInput1, sFldrInput2,introMsg, sSwitches

introMsg = msgBox ("This program creates a list of all files that are in" & vbCrLf & "a selected folder and its subfolders (if desired)." & vbCrLf & "If there are many files, it may take a few minutes."& vbCrLf & "A message will appear when the list is finished.",vbOKCancel)
If introMsg = vbCancel Then
	Wscript.Quit 
End If
ChooseFolder sFldrInput1,"Select the folder containing files to be listed"
ChooseFolder sFldrInput2, "Select the folder where list is to be put"
ChooseSubfldr sSwitches
MakeList sFldrInput1, sFldrInput2, sSwitches
Wscript.Quit

Set objFolderItem = objFolder.Self
sFldrChoice = objFolderItem.Path

msgValue = msgBox("You selected "& sFldrChoice, vbOKCancel)
If msgValue = vbCancel Then
	Wscript.Quit
End If
If Len(sFldrChoice) = 3 then 
   chkForDrv sFldrChoice
End if
End sub

Sub ChooseSubfldr(sSwitches)
dim sSubfldrYesNo
sSubfldrYesNo = msgBox("Do you want to list files in all subfolders also?", vbYesNoCancel)
Select Case sSubfldrYesNo
case vbCancel 
  Wscript.Quit
case vbNo 
  sSwitches = " /o:g"
case vbYes 
   sSwitches = " /o:g /s"
End select

End sub

Sub MakeList(sourceFldr, listFldr, sSwitches)
Const sdirCmd ="cmd /c dir "
Const sWildCard = "\*.*"
Const sRedirect =">"
dim listFile 
dim sStatement
dim objWshell
Dim oIE, oIEDoc, sMsg
listFile ="\list_of_files.txt"
sStatement = sdirCmd & chr(34) & sourceFldr & sWildcard & chr(34) & sSWitches & sRedirect & chr(34) & listFldr & listFile & chr(34)

'The next part is just to display a message while making list
set objWshell=Wscript.CreateObject("Wscript.Shell")
Set oIE = Wscript.CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"
do while oIE.busy : wscript.sleep 10 : loop
Set oIEDoc = oIE.Document
oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.height=200
oIE.width=300
oIE.Resizable = False
oIE.Visible = True
sMsg= "<center>List is being made. Please wait. Large numbers of files may take several minutes.</center>"
oIEDoc.Body.Innerhtml= sMsg
 'List the files
objWshell.Run sStatement,7,true

Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing
set objWshell = Nothing
msgBox "List has been made of files"
End sub

Sub chkForDrv(sFldrChoice)
Dim oRe, bMatch
set oRe = New RegExp
oRe.pattern = "[a-zA-Z]:\\$"
bMatch= oRe.Test(sFldrChoice)
If bMatch Then sFldrChoice= Left(sFldrChoice, 2)
Set oRe = Nothing
End sub

Δ [email me]

Δ Wednesday, April 04th, 2012

Δ Using 7Zip in VBScript

How to use 7zip in VBScript

[download resource files]

See 7Zip in action inside VBScript. This will zip and unzip.

Function Zip(sFile,sArchiveName)
  '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

Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
  Set oShell = WScript.CreateObject("Wscript.Shell")

'--------Find Working Directory--------
  aScriptFilename = Split(Wscript.ScriptFullName, "\")
  sScriptFilename = aScriptFileName(Ubound(aScriptFilename))
  sWorkingDirectory = Replace(Wscript.ScriptFullName, sScriptFilename, "")
  '--------------------------------------

'-------Ensure we can find 7za.exe------
  If oFSO.FileExists(sWorkingDirectory & "\" & "7za.exe") Then
    s7zLocation = ""
  ElseIf oFSO.FileExists("C:\Program Files\7-Zip\7za.exe") Then
    s7zLocation = "C:\Program Files\7-Zip\"
  Else
    Zip = "Error: Couldn't find 7za.exe"
    Exit Function
  End If
  '--------------------------------------

oShell.Run """" & s7zLocation & "7za.exe"" a -tzip -y """ & sArchiveName & """ " _
  & sFile, 0, True

If oFSO.FileExists(sArchiveName) Then
    Zip = 1
  Else
    Zip = "Error: Archive Creation Failed."
  End If
End Function

Function UnZip(sArchiveName,sLocation)
  '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

Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
  Set oShell = WScript.CreateObject("Wscript.Shell")

'-------Ensure we can find 7za.exe------
  If oFSO.FileExists(sWorkingDirectory & "\" & "7za.exe") Then
    s7zLocation = ""
  ElseIf oFSO.FileExists("C:\Program Files\7-Zip\7za.exe") Then
    s7zLocation = "C:\Program Files\7-Zip\"
  Else
    UnZip = "Error: Couldn't find 7za.exe"
    Exit Function
  End If
  '--------------------------------------

'-Ensure we can find archive to uncompress-
  If Not oFSO.FileExists(sArchiveName) Then
    UnZip = "Error: File Not Found."
    Exit Function
  End If
  '--------------------------------------

oShell.Run """" & s7zLocation & "7za.exe"" e -y -o""" & sLocation & """ """ & _
  sArchiveName & """", 0, True
  UnZip = 1
End Function

Δ [email me]

Δ Monday, April 2nd, 2012

Δ Enable Windows Auto Updates using AutoIT

How to enable Windows updates

[download resource files]

Use AutoIT to enable Windows updates.

Δ [email me]

About

   I'm a Computer
   Systems Engineer

   Living and Loving Life

Author