Posts Tagged VB Script

VB Script to automate unzipping files in Windows System

The following VB Script can be used to automate unzipping zip files in Windows OS.

sub unzipfile(zipfile)
	'The location of the zip file.
	ZipFile= ".\" & zipfile & ".zip"
	'The folder the contents should be extracted to.
	ExtractTo=".\" & zipfile

	'If the extraction location does not exist create it.
	Set fso = CreateObject("Scripting.FileSystemObject")
	If fso.FolderExists(ExtractTo) Then 
		fso.DeleteFolder ExtractTo
		fso.CreateFolder(ExtractTo)
	end if 
	'If NOT fso.FolderExists(ExtractTo) Then
	'   fso.CreateFolder(ExtractTo)
	'End If

	' the following two lines are required to expand the relative path to absolute path
	' otherwise, an error message will pop up and say "object is required"
	sSourceFile = fso.GetAbsolutePathName(ZipFile)
	sTargetDir = fso.GetAbsolutePathName(ExtractTo)

	'Extract the contants of the zip file.
	set objShell = CreateObject("Shell.Application")
	set FilesInZip=objShell.NameSpace(sSourceFile).items
    objShell.NameSpace(sTargetDir).CopyHere(FilesInZip)
	Set fso = Nothing
	Set objShell = Nothing
end sub
Share

Tags: , , ,

Create an MS Access database by ASP VBScript

I’ve been dreaming of creating MS Access databases through VBScript for ASP server for a long time.  But I did not know how to create AutoNumber field. I spent two nights at home to write this vbscrip because I got a bad cold and did not go to office. At the beginning, I tried to use ADO functions to fullfil this goal. I failed. Until the last moment when I almost gave up. I read the SQL help in Access thoroughly and found the following information for data type in equivalent ANSI SQL Data Types of Microsoft Jet SQL reference.

ANSI SQL
data type
Microsoft Jet
SQL data type
Synonym Microsoft SQL
Server data type
BIT, BIT VARYING BINARY (See Notes) VARBINARY,
BINARY VARYING
BIT VARYING
BINARY, VARBINARY
Not supported BIT (See Notes) BOOLEAN, LOGICAL, LOGICAL1, YESNO BIT
Not supported TINYINT INTEGER1, BYTE TINYINT
Not supported COUNTER (See Notes) AUTOINCREMENT (See Notes)
Not supported MONEY CURRENCY MONEY
DATE, TIME, TIMESTAMP DATETIME DATE, TIME  (See Notes) DATETIME
Not supported UNIQUEIDENTIFIER GUID UNIQUEIDENTIFIER
DECIMAL DECIMAL NUMERIC, DEC DECIMAL
REAL REAL SINGLE, FLOAT4, IEEESINGLE REAL
DOUBLE PRECISION, FLOAT FLOAT DOUBLE, FLOAT8, IEEEDOUBLE, NUMBER (See Notes) FLOAT
SMALLINT SMALLINT SHORT, INTEGER2 SMALLINT
INTEGER INTEGER LONG, INT, INTEGER4 INTEGER
INTERVAL Not supported Not supported
Not supported IMAGE LONGBINARY,  GENERAL, OLEOBJECT IMAGE
Not supported TEXT  (See Notes) LONGTEXT, LONGCHAR, MEMO, NOTE, NTEXT (See Notes) TEXT
CHARACTER, CHARACTER VARYING, NATIONAL CHARACTER, NATIONAL CHARACTER VARYING CHAR (See Notes) TEXT(n), ALPHANUMERIC,  CHARACTER, STRING, VARCHAR, CHARACTER VARYING, NCHAR, NATIONAL CHARACTER, NATIONAL CHAR, NATIONAL CHARACTER VARYING, NATIONAL CHAR VARYING (See Notes) CHAR, VARCHAR, NCHAR, NVARCHAR

That is very important information. Now I know the SQL data type for autonumber is counter/AUTOINCREMENT. I created a SQL query in Access and tried it to see whether it works. That is true it worked well. Then I modified my creating database class and tested through internet. Perfect. It works. Here I list the source code for this class and the testing code. To be noticed, the meta database was created under MS Access 2000. So you need use MS Access 2000 to run the demo code. But you can create your meta database in MS Access 97/2000/XP, then you can use this class under these environments.

<%
Option Explicit

Class OFCDB
Public DBName
Public MetaDBName
Public MetaTableName
Private Conn, MetaConn
Private RS
Private SQL
Private TableName(10)
Private NumTables

Private Sub Class_Initialize()
MetaDBName = "OFC.MDB"
DBName = "test.mdb"
MetaTableName = "tblMeta"
End Sub

Private Sub Class_Terminate()
RS.close
MetaConn.Close
Conn.Close
End Sub

' get table names
Private sub GetTableName
dim i
sql = "SELECT distinct myTableName FROM " & MetaTableName & ";"
Set rs= Server.CreateObject("ADODB.Recordset")
rs.open sql, MetaConn, 1, 1
' the array, TableName, is predifined that has 10 elements
' if the actual number of tables greater than 10
' redim the array to accommodate more table name
if rs.recordcount > 10 then redim TableName(rs.recordcount)
i = 1
do while not (rs.eof or rs.bof)
TableName(i)=rs("myTableName")
rs.movenext
i = i + 1
loop
NumTables = i -1
rs.close
set rs=nothing
End Sub

' Create a new database
Public Sub NewDB
Dim appAccess, dbs
Dim strDB
dim i,j

' Initialize string to database path.
strDB = server.mappath(DBNAME)
' Create new instance of Microsoft Access.
Set appAccess = CreateObject("Access.Application.9")
' Open database in Microsoft Access window.
appAccess.NewCurrentDatabase strDB
' Get Database object variable.
Set dbs = appAccess.CurrentDb

' Create tables according to definitions in META DataBese
OpenMetaDB
GetTableName
for i = 1 to NumTables
' Create new table.
sql = "SELECT distinct * FROM " & MetaTableName & " WHERE mytablename= '" & TableName(i) & "';"
Set rs= Server.CreateObject("ADODB.Recordset")
rs.open sql, MetaConn, 1, 1
SQL = "CREATE TABLE " & TableName(i) & " ("
j = 1
do while not (rs.eof or rs.bof)
' create SQL command
if j > 1 then SQL = SQL + ", "
SQL = SQL + rs("myFieldName") + " " + rs("myFieldType") + " "
if rs("myFieldSize")<>0 then SQL = SQL + "(" + cstr(rs("myFieldSize")) +")"
if rs("myPrimarykey") then SQL =SQL + " Primary key "
' move to next record
rs.movenext
j = j + 1
loop
SQL = SQL + ");"
rs.close
set rs=nothing
dbs.Execute SQL
next
CloseMetaDB
' close the new created database
appAccess.CloseCurrentDataBase
set dbs = Nothing
appAccess.Quit
Set appAccess = Nothing
End Sub

Private Sub OpenMetaDB
dim ConnStr
connstr = "DBQ="+server.mappath(MetaDBName)+";defaultdir=;DRIVER={Microsoft Access Driver (*.mdb)};"
set MetaConn=server.createobject("ADODB.Connection")
MetaConn.open connstr
End Sub

Private Sub CloseMetaDB
MetaConn.close
set MetaConn = nothing
End Sub

Public Sub OpenDB
Dim ConnStr
connstr = "DBQ="+server.mappath(DBName)+";defaultdir=;DRIVER={Microsoft Access Driver (*.mdb)};Username=;Password=;"
set conn=server.createobject("ADODB.Connection")
conn.open connstr
End Sub

Public Sub CloseDB
conn.close
set conn = nothing
End Sub

End Class
%>
<html>
<body>
<%
Dim myOFCDB
Set MyOFCDB = New OFCDB
MyOFCDB.DBName = "test1.mdb"
MyOFCDB.NewDB
%>
Test1.mdb has been created successfully in your web server.
</body>
</html>

Download source code –dbcreate

Share

Tags: , , , , ,

Automatically cleaning up your hard disk

Windows applications usually creates backup or temporary files in different directories on your hard drive. Some of them are automatically erased by corresponding applications while others stay in your hard drive for a long time if not forever. These files are garbage in your hard drive. It is hard to clean them up at one time. You have to use Windows Explorer to find and delete them manually. Windows Script Host provides us a potential to write a short script to execute repetitive jobs.

After I read an article in PC Magazine, I wrote a Windows script file to clean my hard disk. The following VB script file can clean Windows temporary folder, recycle bin, and three specific temporary files with the extensions of .~, .BAK, and .$$$. It runs in the background. You can put it on your desktop. If you need to clean your hard drive, just double click it. The source code is listed below.

Option Explicit
Dim FSO, WshShell, WSHShellENV, TempFolder, Recycled
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
set WshShell = WScript.CreateObject("WScript.Shell")
Set WSHShellENV = WshShell.Environment("PROCESS")
set TempFolder = FSO.GetFolder(WSHShellENV("TEMP"))
ClearFolder TempFolder
Set Recycled = FSO.GetFolder("C:\recycled")
ClearFolder Recycled
DoDir FSO.GetFolder("c:\")
WScript.Echo "Cleaning job finished"

Sub DoDir(Folder)
   Dim i, File, SubFolder, fstr, pos
   Dim Findstr(2)
   Findstr(0) = ".$$$"
   Findstr(1) = ".BAK"
   Findstr(2) = ".~??"
   For Each File In Folder.Files
      FStr = UCase(File.Path)
      Pos = 0
      for i = 0 to 2
      	if instr(FStr, FindStr(i)) > 0 then
      	   File.delete
      	   Exit For
      	End if
      Next
   Next
   For Each SubFolder in Folder.SubFolders
      DoDir SubFolder
   Next
End Sub

Sub ClearFolder(Folder)
   Dim File, SubFolder
   For each file in Folder.Files
   	File.delete(True)
   next
   For Each SubFolder in Folder.SubFolders
      SubFolder.Delete(True)
   Next
End Sub

Reference

Share

Tags: , , , , ,

Mapping network drives in LAN

In Windows, there are a number of script files with different file extensions as the following:

  • .bat,.cmd MS-DOS/Windows batch file MS-DOS operating system batch file
  • .asp ASP page Active Server Page file
  • .html HTML file Web page
  • .js JScript file Windows script
  • .vbs VBScript file Windows script
  • .wsf Windows Script Host file Container or project file for a Windows script; supported by WSH 2.0 and later.
  • .wsh Windows Script Host files, supported by WSH 1.0 and later.

Each script type meets different needs and has strengths and weaknesses. If you are familiar with DOS, I am sure you know DOS batch files. If you wrote webpages, you may be familiar with HTML, ASP, and/or JS/VBS. If you work with Windows itself, you should be familiar with WSH or WSF. WSF file is more powerful script file that can include several scripts to achieve different, but related functions. WSF file must run under WSH 2.0 and later. If your OS is Windows 2000/Me or later, you already have it. Otherwise, you need go to Microsoft.COM to download a latest version of Windows Script Host.

In the lab I am working, there are a cluster of 11 computers. I used to setup the network drives for each machine individually. The process is tedious and error-prone. I turned to Windows Script Host to write a script project (see following source code) an distributed it to all machines. This script project includes three functional scripts: (1) list all current network drive mapping; (2) remove all current network drive mapping; (3) map all available network drive with fixed drive name.

Although this script is useful, you need run it every time after you reboot your computer. That is nconvenient, especially when you have a cluster of computers. I put a register key to Windows registry. The register key is as the below.

REGEDIT4
[HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run]
“MapNetDrives”=”c:\\windows\\wscript //job:map c:\\windows\\network.wsf”

To be aware of that the script file (network.wsf) should be put under Windows folder to make the registry key work. After this is done, the computer will map all available network drives every time after computers are rebooted.

If you’d like put a shortcut on your desktop to run the mapping function, you need create a shortcut for the script file and put it on the desktop first. Then you should modify the shortcut property. Change the Target textbox to the following string.

C:\WINDOWS\wscript.exe //job:map C:\WINDOWS\network.wsf

If you’d like put a shortcut link on the desktop to remove network drives, you should change the Target textbox to the following string.

C:\WINDOWS\wscript.exe //job:remove C:\WINDOWS\network.wsf

Ok, this is all what I have for automatically mapping network drives. Source code is listed below. Enjoy!

<package>
   <job id="list">
      <script language="VBScript">
         CRLF = chr(13) & chr(10)
         Set oNet = WScript.CreateObject("WScript.Network")
         Set oDrives = oNet.EnumNetworkDrives
         sString = "Network drive mappings:" + CRLF
         if oDrives.Count = 0 then
            sString = sString + "No network drives."
         else
            For i = 0 to oDrives.Count - 1 Step 2
               sString = sString + "Drive " & oDrives.Item(i) & " = " & oDrives.Item(i+1) + CRLF
            Next
         end if
         Wscript.Echo sString
      </script>
   </job>
   <job id="remove">
      <script language="VBScript">
 	 Dim oNet
	 Set oNet = WScript.CreateObject("WScript.Network")
         Set oDrives = oNet.EnumNetworkDrives
         For i = 0 to oDrives.Count - 1 Step 2
            oNet.RemoveNetworkDrive oDrives.Item(i)
         Next
      </script>
   </job>
   <job id="map">
      <script language="VBScript">
        on error resume next
        dim allmap(12,2)
        allmap(0,1) = "D:"
        allmap(0,2) = "\\lamco_7\maincdrom"
        allmap(1,1) = "E:"
        allmap(1,2) = "\\lamco_7\zip250"
        allmap(2,1) = "G:"
        allmap(2,2) = "\\lamco_7\main-c"
        allmap(3,1) = "M:"
        allmap(3,2) = "\\lamco_1\c"
        allmap(4,1) = "N:"
        allmap(4,2) = "\\lamco_2\c"
        allmap(5,1) = "O:"
        allmap(5,2) = "\\lamco_3\c"
        allmap(6,1) = "P:"
        allmap(6,2) = "\\lamco_4\c"
        allmap(7,1) = "Q:"
        allmap(7,2) = "\\lamco_5\c"
        allmap(8,1) = "R:"
        allmap(8,2) = "\\lamco_6\c"
        allmap(9,1) = "S:"
        allmap(9,2) = "\\lamco_8\c"
        allmap(10,1) = "T:"
        allmap(10,2) = "\\lamco_9\c"
        allmap(11,1) = "U:"
        allmap(11,2) = "\\lamco_10\c"
        allmap(12,1) = "V:"
        allmap(12,2) = "\\lamco_11\c"

        Set oNet = WScript.CreateObject("WScript.Network")
        Set oDrives = oNet.EnumNetworkDrives
        For i = 0 to oDrives.Count - 1 Step 2
            oNet.RemoveNetworkDrive oDrives.Item(i)
        Next
	Set oShell = CreateObject("WScript.Shell")
	ComputerName = UCase(oNet.ComputerName)
	for i = 0 to 12
	   mapStr = UCase(allmap(i,2))
	   pos = inStr(mapStr,ComputerName)
	   if pos>0 then
	   	oShell.Exec("%comspec% /c subst " & allmap(i,1) & " c:\")
	   else
	   	oNet.MapNetworkDrive allmap(i,1), allmap(i,2),"false","","1d2s3z4$"
	   end if
	next
      </script>
   </job>
</package>

We have to change the code every time the network drive mapping updated. In order to separate the data from the code, the above code was improved and now it can read into a text file that includes all network mapping information. The following is the improved code.

'//////////////////////////////////////////////
'//  Author: Zhanshan Dong
'//  Writen in 2001
'//  Modified in 2003, 2004, 2006
'//////////////////////////////////////////////
<package comment="Created by Zhanshan Dong">
<job id="list">
	<script language="VBScript">
		On Error Resume Next
		CRLF = chr(13) & chr(10)
		Set oNet = WScript.CreateObject("WScript.Network")
		Set oDrives = oNet.EnumNetworkDrives
		sString = "Network drive mappings:" + CRLF
		IF oDrives.Count = 0 THEN
			sString = sString + "No network drives."
		Else 
			For i = 0 to oDrives.Count - 1 Step 2
				sString = sString + "Drive " & oDrives.Item(i) & " = " & oDrives.Item(i+1) + CRLF
			Next
		End if
		Wscript.Echo sString
	</script>
</job>
<job id="remove">
	<script language="VBScript">
		On Error Resume Next
		Dim oNet
		Set oNet = WScript.CreateObject("WScript.Network")
		Set oDrives = oNet.EnumNetworkDrives
		For i = 0 to oDrives.Count - 1 Step 2
			oNet.RemoveNetworkDrive oDrives.Item(i)
		Next
	</script>
</job>
<job id="map">
	<script language="VBScript">
		On Error Resume Next
		Const ForReading = 1
		Dim AllMap(26,1)
		Dim oFSO  ' file system object
		Dim oTFS  ' textfile stream
		Dim oNet ' net work object
		Dim i, j, nDrive
		Dim temp, temp1
		Set oFSO = CreateObject("Scripting.FileSystemObject")
		Set oTFS = oFSO.OpenTextFile("DriveMap.Txt", ForReading)
		i = 0
		Do While oTFS.AtEndOfStream <> True
			temp = trim(oTFS.ReadLine)
			temp2 = left(temp,1)
			temp1 = split(temp, ",")
			if (temp2<>"'") and (temp1(0) <> "") then
				AllMap(i, 0) = temp1(0) + ":"
				AllMap(i, 1) = temp1(1)
				i = i + 1
			end if
		Loop
		nDrive = i
		'wscript.echo ndrive
		Set oNet = WScript.CreateObject("WScript.Network")
		FOR i = 0 TO nDrive - 1
			'wscript.echo i & ":" + allmap(i,0)+ "=" + allmap(i,1)
			oNet.MapNetworkDrive allmap(i,0), allmap(i,1), "1d2s3z4$"
		NEXT
	</script>
</job>
</package>

The text file can have multiple rows. Each row includes a network mapping information. First part is a driver letter you want to map to and the second is the network URI. Here is an example.

Z,\\sapphire\samba

You can download the files here – network.zip

Share

Tags: , , , ,