VBScript: Zip & Organize Files by Year / Month

Organizing large amounts of files can be a real pain in the ass! If you’ve ever had the need to organize large numbers of files then you probably had a script or really wish your had a script to do this incredibly boring and monotonous task.

I had just such a task in my role as a site reliability engineer for a set of load balanced IIS web servers a couple of years ago. I needed to archive the IIS web server log files by server / year / month.

The VBScript I’m sharing with you in this article, archives two kinds of files for the example. In this example they live in the same folder but most likely in the real world they won’t so adjust the script to your needs. I just show you two ways to parse the date out of files named differently.

  1. IIS Log File
  2. Custom CSV Log File

This example does not delete the original file after a copy has been moved to the zip folder. You can add that later or just manually delete all the files after they are all moved to zipped files.

From the example you should be able to figure out to implement this in your own use case. Good luck!

Organizing Files Using VBScript

This is one of my favorite VBScripts even though I did not write all of it myself. I’ve left credit in the comments for the zip file code I borrowed and implemented in this solution.

VBScript Code

'File System Object Prep
Const ForReading = 1
Const ForWriting = 2

sFolder = InputBox("Enter log folder path:","Select a Log Folder to Compress","C:\inetpub\logs\LogFiles\W3SVC3")
Set oFSO = CreateObject("Scripting.FileSystemObject")

For Each oFile In oFSO.GetFolder(sFolder).Files

	on error resume next
	'Breakdown file name
    strFileType = Right(oFile.Name,3)

	if strFileType = "csv" then
		strTemp = Replace(Mid(oFile.Name,20,Len(oFile.Name)-4),".csv","")
		arrDate = Split(strTemp,"_")
		iYear = Left(arrDate(0),2)
		iMonth = arrDate(1)
		if Len(iMonth) < 2 then
			iMonth = "0" & iMonth
		end if
		CheckValue = arrDate(1)
		CurrentMonth = Mid(DatePart("yyyy", Now()),3,2) & DatePart("m", Now())

        if iYear & iMonth = CurrentMonth and (strFileType = "log" OR strFileType = "csv")	then
            'Do not process current month file, only archive previous months
             'msgbox("Skipping " & sFolder & "\" & oFile.Name)
        else
            WindowsZip sFolder & "\" & oFile.Name, sFolder & "\" & iYear & iMonth & ".zip"
		end if
	end if
 
    if strFileType = "log" then	
		iYear = Mid(oFile.Name,5,2)
		iMonth = Mid(oFile.Name, 7,2)
		CheckValue = iYear & iMonth
		CurrentMonth = Mid(DatePart("yyyy", Now()),3,2) & DatePart("m", Now())

        if iYear & iMonth = CurrentMonth and (strFileType = "log" OR strFileType = "csv")	then
            'Do not process current month file, only archive previous months
            'msgbox("Skipping " & sFolder & "\" & oFile.Name)
        else
            WindowsZip sFolder & "\" & oFile.Name, sFolder & "\" & iYear & iMonth & ".zip"
        end if
	end if

Next

Function WindowsUnZip(sUnzipFileName, sUnzipDestination)
 '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 oUnzipFSO = CreateObject("Scripting.FileSystemObject")
  If Not oUnzipFSO.FolderExists(sUnzipDestination) Then
    oUnzipFSO.CreateFolder(sUnzipDestination)
  End If

  With CreateObject("Shell.Application")
       .NameSpace(sUnzipDestination).Copyhere .NameSpace(sUnzipFileName).Items
  End With

  Set oUnzipFSO = Nothing
End Function

'To Test Windows Zip Function Separately 
'WindowsZip "C:\test\test2.txt","C:\test\test.zip"

Function WindowsZip(sFile, sZipFile)
  '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 oZipShell = CreateObject("WScript.Shell") 
  Set oZipFSO = CreateObject("Scripting.FileSystemObject")

  If Not oZipFSO.FileExists(sZipFile) Then
    NewZip(sZipFile)
  End If


  Set oZipApp = CreateObject("Shell.Application")
  sZipFileCount = oZipApp.NameSpace(sZipFile).items.Count
  aFileName = Split(sFile, "\")
  sFileName = (aFileName(Ubound(aFileName)))

  'listfiles
  sDupe = False

  For Each sFileNameInZip In oZipApp.NameSpace(sZipFile).items
    If LCase(sFileName) = LCase(sFileNameInZip) Then
      sDupe = True
      Exit For
    End If
  Next
 
  If Not sDupe Then
    oZipApp.NameSpace(sZipFile).Copyhere sFile
    'Keep script waiting until Compressing is done
    On Error Resume Next
    sLoop = 0
    Do Until sZipFileCount < oZipApp.NameSpace(sZipFile).Items.Count
      Wscript.Sleep(100)
      sLoop = sLoop + 1
    Loop
    On Error GoTo 0
  End If
End Function

Sub NewZip(sNewZip)
  '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 oNewZipFSO = CreateObject("Scripting.FileSystemObject")
  Set oNewZipFile = oNewZipFSO.CreateTextFile(sNewZip)

  oNewZipFile.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
  oNewZipFile.Close

  Set oNewZipFSO = Nothing
  Wscript.Sleep(500)
End Sub


How to Build Your Own Website Uptime Monitoring Script using VBScript: Part 1

Website Uptime Monitoring: The Basics

There are lots of website uptime monitoring services out there but all the components you need to build your own website monitoring tool can be found in good ole’ Microsoft VBScript.

Stop laughing, I’m not kidding!

In this article, I’ll share with you some scripts and tips I’ve used successfully in the past for monitoring website uptime even if your website is running in a complex load balanced enterprise environment which some of mine are.

VBScript Components for Uptime Monitor

Most people don’t know that VBScript can make Ajax HTTP calls but it can.

We will use VBScript’s ability to make Ajax HTTP calls to our website to see if it responds then put some simple logic around that response to log the results in a text/csv file.

It really is amazingly simple once you get all the code components together.

The ISWebSiteUp Function

The ISWebsiteUp function takes a URL string and makes an Ajax HTTP call to see if we get a HTTP code 200 or 404 returned meaning website loaded OK.

Once we get our 200 or 404 HTTP response code that, script returns true in the form of a text message box or if script times out you’ll get a false in an error message box.

You might be saying to yourself about now, what about the 404 response code for page not found. Yes, you might want to add some more code to handle that differently than a 2oo OK response but for this script, we just want to know if server is up. If we are pointing to a page at the root of a domain, we don’t typically get 404 errors in reality.

The Script Code

To use this code, copy it in to a text file and save it with a .vbs file extension for VBScript. Once you have the .vbs file, double click on it and you should get a message box with the names of the logged in user on the specified Windows PC on your network.


'isWebsiteUp: Takes String URL 
'isWebsiteUp: Returns strMessage in Message Box
Function isWebsiteUp(strURL)

	On Error Resume Next

	Set http = CreateObject("MSXML2.ServerXMLHTTP")
 	'Set http = CreateObject("Microsoft.XmlHttp")
	http.open "GET", strURL, False
	http.send ""

	'Only check for error of the HTTP Get request for 200 or 404 code returned. If any status is returned then the server is up
	if http.responseText <> "" AND err.number = 0 then
		'Commented out showing the response text. Use this for troubleshooting or exploring.
		'msgbox(http.responseText)
		isWebsiteUp = true
		strMessage = "is up"
	else
		isWebsiteUp = false
		strMessage = "is down"
	end if
	Set http = Nothing	

	msgbox(strURL & ":" & strMessage)
	err.clear
End Function

call isWebsiteUp("https://www.google.com") 

What the Web Server Sees in the HTTP call: WinHTTPRequest User Agent

The VBScript Ajax HTTP call to the web server presents itself as a web browser asking for the home page.

In the server logs a server admin may see this “User Agent” in their logs.

Mozilla/4.0 (compatible; Win32; WinHttp.WinHttpRequest.5)

Script Errors & Blocked HTTP Calls

This script works out of the box. Google is the most open website in the world in terms of IPs that their servers accept traffic from as they are in the business of collecting data about everything including every system that connects to it.

Other web servers, like ones I run, may not be so forgiving. Many server admins use many tools at their disposal to filter HTTP request at various levels.

Here are some examples of tools Windows Server Admin have at their disposal to block or filter your script from connecting to their web servers.

Windows Server Admin Tools for Handling HTTP Traffic

  • Firewall IP Restrictions (Window Server Admin)
  • HTTP Response Filtering (IIS Application Server Admin)
  • IP Restrictions (IIS Application Server Admin)

VBScript WMI: How to Get Computer Serial Number from Local or Remote Windows PC

This Windows WMI script using VBScript, retrieves the serial number of the local or networked computer.

To use this code, copy it in to a text file and save it with a .vbs file extension for VBScript. Once you have the .vbs file, double click on it and you should get a message box with the names of the logged in user on the specified Windows PC on your network.

Windows WMI VBScript

Function GetComputerSerialNumber(strComputer)
	Set objWMIService = GetObject("winmgmts:" _
		& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 

	Set colComputer = objWMIService.ExecQuery _
		("SELECT * FROM Win32_ComputerSystemProduct",,48)
	 
	For Each objComputer in colComputer
		GetComputerSerialNumber = objComputer.IdentifyingNumber
	Next	
	
End Function

'strComputer = "XPS1234"
strComputer = "."

' Pass a . to run this on your own PC or add a string value for another on your network
call msgbox(GetComputerSerialNumber(strComputer))

VBScript WMI: How to Get Logged in User from a Windows PC

If your in need of finding out who is logged on to a specific Windows PC on your network, run the VBScript below.

When executed, you’ll see a message box with the name of the account currently logged in the computer specified.

The VBScript Code

To use this code, copy it in to a text file and save it with a .vbs file extension for VBScript. Once you have the .vbs file, double click on it and you should get a message box with the names of the logged in user on the specified Windows PC on your network.

Function GetLoggedinUser(strComputer)
	Set objWMIService = GetObject("winmgmts:" _
		& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 

	Set colComputer = objWMIService.ExecQuery _
		("Select * from Win32_ComputerSystem")
	 
	For Each objComputer in colComputer
		Wscript.Echo "Logged-on user: " & objComputer.UserName
	Next	
	
End Function

' Pass a . to run this on your own PC or add a string value name for PC on your network
'strComputer = "XPS1234"
strComputer = "."

call msgbox(GetLoggedinUser(strComputer))

Stay tuned for more scripts in upcoming blog posts!

Hope this helps somebody!
~Cyber Abyss

VBScript WMI: Get List of Administrators from Windows PC

I’m breaking down a large VBScript I wrote as part of a larger computer inventory system prototype I built for what later became a much larger company.

This project was a big time investment for me that provided a lot of value to the company until they went out and purchased a commercial product and even then, the commercial product had things it did not do as well as my prototype.

The scanning volume eventually got so big that I had to run copies of the script on different parts of Active Directory at the same time to try and scale the scanning of computers on the network with all the data being stored in a SQL database backend.

This script and others I’ll be sharing in this series were contained within a loop of Active Directory computer records for a good size enterprise with about 10,000 desktops and laptops for some Active Directory OUs.

This script leverages Windows Management Instrumentation (WMI) to query what’s going on with this Windows network PC.

The first piece of code I’m sharing is for querying the Windows WMI to get a list of Administrators from a Windows PC. This code was used as part of a project to determine if any computers had unauthorized admin accounts we didn’t know about.

GetAdminstrators Function

To use this code, copy it in to a text file and save it with a .vbs file extension for VBScript. Once you have the .vbs file, double click on it and you should get a message box with the names of the admin accounts from the target device.

Function GetAdministrators(strComputerName)
On Error Resume Next

    Dim objWMIService, strQuery, colItems, Path, strMembers, strAdminList, iCounter
	iCounter = 0
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputerName & "\root\cimv2")
    strQuery = "select * from Win32_GroupUser where GroupComponent = " & chr(34) & "Win32_Group.Domain='" & strComputerName & "',Name='Administrators'" & Chr(34)
    Set ColItems = objWMIService.ExecQuery(strQuery,,48)
    strMembers = ""
    For Each Path In ColItems
		Dim strMemberName, NamesArray, strDomainName, DomainNameArray
        NamesArray = Split(Path.PartComponent,",")
		strMemberName = Replace(Replace(NamesArray(1),Chr(34),""),"Name=","")
		DomainNameArray = Split(NamesArray(0),"=")
        strDomainName = Replace(DomainNameArray(1),Chr(34),"")
        If strDomainName <> strComputerName Then
            strMemberName = strDomainName & "\" & strMemberName
			if iCounter = 0 then
				strAdminList =  strMemberName
			else
				strAdminList = strAdminList & " > " & strMemberName 
			end if
			iCounter = iCounter + 1
			
        End If
	Next
	
	GetAdministrators = strAdminList
End Function
' Pass a . to run this on your own PC or add a string value for another on your network
call msgbox(GetAdministrators("."))
call msgbox(GetAdministrators("NetworkComputer1"))

Stay tuned for more scripts in upcoming blog posts!

Hope this helps somebody!
~Cyber Abyss

VBScript Error – MSXML3.dll error ‘800C0005’

This is a popular re-post from my old Blogger blog.

I’m working on  a website up-time monitoring script.

After I had my initial prototype working, I received more requirements for logging output to CSV in addition to storing output in Access DB and decided to add CPU usage percentages to the logging.

Once I had all that done, I started getting odd errors when solution should be detecting a down-time event.

Testing the script with older version of Microsoft.XmlHttp had issues where certain but not all websites the script would call were incorrectly displaying HTTP status code 404 but a 200 OK was really sent back verified by using Fiddler.  Very odd behavior.

The error is related to VBScript’s use of the older version of the Microsoft.XmlHttp object.

The Code

Function isPortalOffline(strURL)
 'Set WshShell = WScript.CreateObject("WScript.Shell")
 Set http = CreateObject("Microsoft.XmlHttp")

 http.open "GET", strURL, False
 http.send 
 
 'Only check for error of the http Get request
 if err.Number <> 0 Then
  isPortalOffline = True
 Else
  'Wscript.Echo "error" & Err.Number & ": " & Err.Description
  isPortalOffline = False
 End If

 'Clear the error after setting isPortalOffline
 err.clear
 'set WshShell = Nothing
 Set http = Nothing 

 ReportError("isPortalOffline")
End Function

Error: MSXML3.dll error ‘800C0005’ The System cannot locate the resource

Changed MSXML Objects.

The Fixed Code

Replaced Microsoft.XmlHttp with MSXML2.ServerXMLHTTP.

Function isPortalOffline(strURL)
 'Set WshShell = WScript.CreateObject("WScript.Shell")
 Set http = CreateObject("MSXML2.ServerXMLHTTP")

 http.open "GET", strURL, False
 http.send
 
 'Only check for error of the http Get request
 if err.Number <> 0 Then
  isPortalOffline = True
 Else
  'Wscript.Echo "error" & Err.Number & ": " & Err.Description
  isPortalOffline = False
 End If

 'Clear the error after setting isPortalOffline
 err.clear
 'set WshShell = Nothing
 Set http = Nothing 

 ReportError("isPortalOffline")
End Function

This resolved my issues!

I hope this helps someone. 🙂

Classic ASP: How to Do Parameterized Queries to Help Prevent SQL Injection

I’m a professional web developer who has spent 20+ years working in Classic ASP.

I work in modern stacks too but I still actively develop in Classic ASP on a side hustle project that is too expensive to re-write at this time.

This article focuses on an example of classic ASP SQL injection prevention using a basic parameterized query done in Classic ASP VBScript.

I’ve included links to all my references below.

Please note the first code example won’t work without translation of the ADO property, “adCmdText”, constant.

You can find the “adCmdText” reference in the adovbs.inc (include file) that contains all the ADO Constants we use for commands like the “adCmdText”.  None of the other sources mentioned that at all. 

I’ve added a second code example that should allow you to ditch the need for the include file and just enter an enumeration of the CommandType. 

ADOVBS.INC Example: 

'---- CommandTypeEnum Values ----
Const adCmdUnknown = &H0008
Const adCmdText = &H0001
Const adCmdTable = &H0002
Const adCmdStoredProc = &H0004

<%
 set rs = Server.CReateObject("ADODB.Recordset")
 set cmd1  = Server.CreateObject("ADODB.Command")
 Set conn = Server.CreateObject("ADODB.Connection")
 conn.Open [Connection String Value]
 cmd1.ActiveConnection = conn //connection object already created
 cmd1.CommandText = "SELECT * FROM [table] where ID = ?"
 cmd1.CommandType = adCmdText
 'cmd1.Prepared = True ' only needed if u plan to reuse this command often
 cmd1.Parameters.Refresh
 cmd1.Parameters(0).Value = "55"
 set rs = cmd1.Execute
 While NOT rs.eof
  Response.Write(rs("ID") & "
")
  rs.MoveNext
 Wend
 Set rs = Nothing
 Set conn = Nothing
%>
Can also be written replacing constant adCmdText with acceptable enumeration of 1 for the CommandType.
<%
set rs = Server.CReateObject("ADODB.Recordset")
set cmd1  = Server.CreateObject("ADODB.Command")
Set conn = Server.CreateObject("ADODB.Connection")
conn.Open [Connection String Value]
cmd1.ActiveConnection = conn //connection object already created
cmd1.CommandText = "SELECT * FROM [table] where ID = ?"
cmd1.CommandType = 1
'cmd1.Prepared = True ' only needed if u plan to reuse this command often
cmd1.Parameters.Refresh
cmd1.Parameters(0).Value = "55"
set rs = cmd1.Execute
While NOT rs.eof
    Response.Write(rs("ID") & "
")
    rs.MoveNext
Wend
Set rs = Nothing
Set conn = Nothing
%>

References:

CommandType Enumeration

https://www.w3schools.com/asp/prop_comm_commandtype.asp

Parameters Collection (ADO)

https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/parameters-collection-ado?view=sql-server-2017

https://blogs.technet.microsoft.com/neilcar/2008/05/23/sql-injection-mitigation-using-parameterized-queries-part-2-types-and-recordsets/

https://stackoverflow.com/questions/7654446/parameterized-query-in-classic-asp/9226886#9226886