Tag: vbscript

Network Shares Migration Script

Some times its just easier to use command line tools then using WMI. This simple script migrates out shared folder system into the new structure that is the teachers name with two folders underneath it.

migrate.vbs

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")

Set folder = fso.GetFolder("f:\shares\")
rcopy = "robocopy /e /zb /move /r:1 /w:1 "

For each folderIdx In folder.SubFolders
	objshell.run "net share " & folderIdx.Name & " \\servername /delete", 1 , true
	if instr(1,folderIdx.Name,"_drop",1) <> 0 then
		fteacher = replace(folderIdx.Name,"_drop","",1,-1,1)
		objshell.run rcopy & folderIdx.path & " f:\transportshare\" & fteacher & "_transport\DropBox\", 1, true
	elseif instr(1,folderIdx.Name,"_ffs",1) <> 0 then
		fteacher = replace(folderIdx.Name,"_ffs","",1,-1,1)
		objshell.run rcopy & folderIdx.path & " f:\transportshare\" & fteacher & "_transport\FFS\", 1, true
	end if
Next

vbscript logon script

Our old logon script from 2002

'****************************************************************
'* Logon Script 2k      *
'* This should be the end to multiple logon scripts *
'* This will be the logon script for all labs.  *
'* ps. Nothing is a cure all.    *
'* Its written in vbscript http://msdn.microsoft.com *
'*        *
'* Stephen@2k2     *
'* Edited by:      *
'*  Robert *  
'*      and                                         *
'*  Mike *
'****************************************************************

'Date Modified Feb 6, 2002
On error resume next
Dim WshNetwork, WshSHell, Return, Desktop, HKCU
Set WshNetwork = WScript.CreateObject("WScript.Network")
Set WshShell = WScript.CreateObject("Wscript.Shell")
Desktop=WshShell.SpecialFolders("Desktop")
username=left(WshNetwork.Computername,3)
dim number

'Novell Drive Mappings.
call winmap("l:","\\Thurston_w\vol1","lab")

'return=WshShell.run ("subst p: /d", 0, true) 
'return=WshShell.run("subst p: c:\temp", 0, true)

'Citrix Applications
call shortcut("CITRIX APPS","%userprofile%\application data\icaclient\CITRIX APPS.lnk","C:\Program Files\Internet Explorer\")

'Just put your commands for what lab ur in.
Select Case username
Case "PUB"
 Wshnetwork.addwindowsprinterconnection("\\ginger\pub4000")
 Wshnetwork.setdefaultprinter("\\ginger\pub4000")
 If right(WSHNetwork.Computername,2) <> 30 Then
  Wshnetwork.addwindowsprinterconnection("\\ginger\puboki8")
 End if
 call winmap("n:","\\ginger\shared","lab")
 Call shortcut("Paint Shop Pro","L:\XPAPPS\Paint Shop Pro\Psp.exe","L:\XPAPPS\Paint Shop Pro")
Case "MHK"
 Wshnetwork.addwindowsprinterconnection("\\ginger\mhk5m")
 wshnetwork.setdefaultprinter("\\ginger\mhk5m")
 call winmap("n:","\\ginger\shared","lab")
Case "NUR"
 Wshnetwork.addwindowsprinterconnection("\\ginger\nur4000")
 wshnetwork.setdefaultprinter("\\ginger\nur4000")
 call winmap("n:","\\ginger\shared","lab")
 call shortcut("Inventor","C:\Program Files\Autodesk\Inventor 5.3\Bin\Inventor.exe","C:\Program Files\Autodesk\Inventor 5.3\Bin")
Case "BPM"
 Wshnetwork.addwindowsprinterconnection("\\ginger\bpm4000")
 wshnetwork.setdefaultprinter("\\ginger\bpm4000")
 If right(WSHNetwork.Computername,2) < number =" right(WshNetwork.Computername,2)" number = "03"> 32 Then
  Wshnetwork.addwindowsprinterconnection("\\ginger\don4000")
 End if
Case "LRN"
 Wshnetwork.addwindowsprinterconnection("\\ginger\lrn4000")
 Wshnetwork.setdefaultprinter("\\ginger\lrn4000")
 call winmap("n:","\\ginger\shared","lab") 
 call shortcut("EVE 2","C:\Program Files\EVE2\eve2.exe","C:\Program Files\EVE2")
 call shortcut("SPSS11","C:\Program Files\SPSS\spsswin.exe","C:\Program Files\SPSS")
Case "DON"
 Wshnetwork.addwindowsprinterconnection("\\ginger\don4000")
 Wshnetwork.setdefaultprinter("\\ginger\don4000")
 If right(WSHNetwork.Computername,2) <> 25 Then
  Wshnetwork.addwindowsprinterconnection("\\ginger\dtp4M")
  Wshsetdefaultprinter("\\ginger\dtp4M")
 End if 
 call winmap("n:","\\ginger\shared",username)
 call shortcut("Quark Xpress","L:\XPAPPS\QuarkXPress\QuarkXPress Passport.exe","L:\XPAPPS\QuarkXPress\QuarkXPress Passport.exe")
 call shortcut("SHARED","N:\SHARE2147\","N:\SHARE2147\")
 call shortcut("PAGEMAKER","C:\Program Files\Adobe\PageMaker 7.0\Pm70.exe","C:\Program Files\Adobe\PageMaker 7.0")
 call shortcut("PHOTOSHOP","C:\Program Files\Adobe\Photoshop 7.0\Photoshop.exe","C:\Program Files\Adobe\Photoshop 7.0")
 call shortcut("SPSS11","C:\Program Files\SPSS\spsswin.exe","C:\Program Files\SPSS") 
 Call shortcut("Paint Shop Pro","L:\XPAPPS\Paint Shop Pro\Psp.exe","L:\XPAPPS\Paint Shop Pro")
 call shortcut("EVE","%userprofile%\application data\icaclient\EVE2.lnk","c:\program files\citrix\ica client\")
Case "CAD"
 Wshnetwork.addwindowsprinterconnection("\\ginger\cad4000")
 wshnetwork.setdefaultprinter("\\ginger\cad4000")
 Wshnetwork.addwindowsprinterconnection("\\ginger\cad700")
 
 If right(WSHNetwork.Computername,2) > 6 Then
  Call shortcut("DB UNLOCK","C:\Program Files\Manufacturers Technologies\Costimator\DbUnlock.exe","C:\Program Files\Manufacturers Technologies\Costimator\")
  Call shortcut("COSTIMATOR","C:\Program Files\Manufacturers Technologies\Costimator\MTIMain.exe","C:\Program Files\Manufacturers Technologies\Costimator\")
 End if
 call winmap("n:","\\ginger\shared","lab")
 Call shortcut("POM","C:\program files\POMwin32\pom32start.exe","C:\program files\POMwin32\pom32start.exe")
 Call shortcut("Solidworks","C:\program files\solidworks\sldworks.exe","C:\program files\solidworks\")
Case "PHY"
 Wshnetwork.addwindowsprinterconnection("\\ginger\phy4000")
 wshnetwork.setdefaultprinter("\\ginger\phy4000")
 'G: Drive for the Genetics program
 call winmap("g:","\\island\dfs\vol1\xpapps\genetics","lab")
 'genetics software needs diff to run diff is called karyo.exe
 call shortcut("Karyotypes","L:\XPAPPS\GENETICSa\karyopw.exe","L:\XPAPPS\GENETICSa")
 call shortcut("Sky","C:\Program Files\Software Bisque\TheSky\SKY.exe","C:\Program Files\Software Bisque\TheSky")
 call shortcut("Genetics","L:\XPAPPS\GENETICS\Genetics\Start Genetics.exe","L:\XPAPPS\GENETICS\genetics")
 call winmap("n:","\\ginger\shared","lab")
 call shortcut("SHARED","N:\SHARE2107\","N:\SHARE2107\")
Case Else
End Select
'************************************************************************************************************
'*                                             FUNCTIONS          *
'************************************************************************************************************
Function unmap(drv)
  Dim fso
  Set fso = CreateObject("Scripting.FileSystemObject")
  If fso.DriveExists(drv) Then WshNetwork.removeNetworkDrive drv & ":"
End Function

Function winmap(drive,dest,user)
unmap(drive)
Wshnetwork.mapnetworkdrive drive, dest, false, user, ""
End Function

Function shortcut(name,dest,working)
Set shelllink = wshshell.createshortcut(desktop & "\" & name &".lnk")
shelllink.targetpath= dest
shelllink.workingdirectory= working
shelllink.windowstyle = 1
shelllink.save
End Function

F-Prot Antivirus Update

This is a old script i wrote back in 2002 to automatically update F-Prot antivirus in a lab environment.

'OBSOLETE they finally have a update program.
'Here for example



'****************************************************************
'* Command Com Autoupdate 2k2 Script   *
'*        *
'*        *
'* Its written in vbscript http://msdn.microsoft.com *
'*        *
'* Stephen Cattaneo @2k2     *
'* Edited by:      *
'*        *
'****************************************************************
On error resume next
'Over all notes
'Remeber to give full register rights to the bellow registry keys,
'In the policy allow to run Windows installer patches w/ elevated permissions
Dim WshShell, date, currdate, latestdate
Set WshShell = WScript.CreateObject("WScript.Shell")


'Set to name of current deff file.
update="\latest.msp"

'Location of update directory
location="\\island\dfs\antivirus"

'Get version info
deffversion()

'Set update location
WshShell.RegWrite "HKCR\Installer\Products\C02C1A9B2ADAA1C47BD127BE4F886559\SourceList\LastUsedSource", "n;1;" & location, "REG_EXPAND_SZ"
WshShell.RegWrite "HKCR\Installer\Products\C02C1A9B2ADAA1C47BD127BE4F886559\SourceList\Net\1", location, "REG_EXPAND_SZ"

if currdate < latestdate then wshshell.run(location & update & " /q")

Function deffversion()
   Dim fso, c, n
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set c = fso.GetFile("C:\Program Files\Common Files\Command Software Shared\Scanner\sign.def")
   Set n = fso.GetFile(location & update)   
   currdate = c.DateLastModified   
   latestdate = n.DateLastModified   
End Function

Hidden Logon Script

This little vbscript wrapper will let you start a logon script hidden. Our logon scripts are batch and perl files and they all start with the black box. If you launch the script like hidelaunch.vbs logon.bat it will start the logon script hidden.

Set wshShell = CreateObject("WScript.Shell")
set args = wscript.arguments

command = ""

for each strArg in args
 command = strArg + " "
next

wshshell.run command, 0, false

iMail aliases.txt to csv converter.

This will convert iMails aliases.txt file to a csv to import into outlook or similar.

'Convert imail alias.txt to something that is not useless.

Const ForReading = 1, ForWriting = 2, ForAppending = 8 

Set filesys = CreateObject("Scripting.FileSystemObject")
Set filetxt = filesys.OpenTextFile("aliases.txt", ForReading) 

Set filetxtOUT = filesys.OpenTextFile("aliasesOUT.csv", ForWriting, TRUE) 
Set filetxtBAD = filesys.OpenTextFile("aliasesBAD.txt", ForWriting, TRUE) 

'get name
Set nameRegex = New RegExp
nameRegex.IgnoreCase = True
nameRegex.Pattern = """(.*?)"""

'get email
Set emailRegex = New RegExp
emailRegex.IgnoreCase = True
emailRegex.Pattern = "<(.*?)>"

filetxtOUT.WriteLine "Name, Email Address"
Do until filetxt.AtEndofStream
 txtline = filetxt.Readline
 
 'get name if 0 name is bad
 Set namevar = nameRegex.Execute(txtline)
 if namevar.Count = 0 then
  name = ""
 else
  name = namevar(0).Value
 end if

 'get email address if 0 email is bad
 Set emailvar = emailRegex.Execute(txtline)
 if emailvar.Count = 0 then
  email = ""
 else
  email = emailvar(0).Value
 end if

 'record bad lines to bad file
 if namevar.count = 0 AND emailvar.count = 0 then
  filetxtBAD.writeline txtline
 else
  if len(name) > 2 then
   filetxtOUT.writeline name & "," & email
  else
   filetxtOUT.writeline """" & name & """," & email
  end if
 end if
 
  
  
loop

filetxt.Close
msgbox "DONE"

Serv-U Helm3 Quota Interface

'Serv-u Account Management
ver="V2.0"
'servudiskq.vbs

'Server Settings
'Helm SQL/MSDE Server Location
HelmDB="vicky\helm"

'Serv-U Domain Instance, this is located in the registry
SUDomain=1

'ServuDaemon File Location
ServuDaemon="C:\Program Files\Serv-U\ServUDaemon.ini"

'Operations: True is for enabled, Fales is for disabled.
'This will enabled writing the quota to the serv-u registry
SetQuota=True
'This will enabled or disabled the account based on the user account status
SetStatus=True

WScript.Echo "Serv-u Helm Qouta " & ver

'Check if Serv-U ini Exists.
Set filesys = CreateObject("Scripting.FileSystemObject")
If NOT filesys.Fileexists(ServUDaemon) Then
 wscript.echo "ERROR... ServuDaemon.ini does not exist"
 Set filesys = nothing
 wscript.quit(5)
end if

'Check for Servu-Domain In Registry
Set objShell = WScript.CreateObject("WScript.Shell")
SUDomainChk=""
On Error Resume Next
SUDomainChk=objShell.RegRead("HKLM\SOFTWARE\Cat Soft\Serv-U\Domains\DomainList\" & SUDomain)
On Error Goto 0
If SUDomainChk = "" Then
 wscript.echo "ERROR... Serv-U Domain Not Found"
 Set objshell = nothing
 wscript.quit(5)
end if

Set rsOBJ = CreateObject ("ADODB.Recordset")
strConnect = "Driver={SQL Server}; Server=" & HelmDB & "; Database=helmdb;"

'Open Helm
WScript.Echo "Connecting to Helm Database..."
rsOBJ.Open "Select FTPAccount.FTPUserName, COALESCE(HostDomain.CurrentDiskspaceUsage,0) AS CurrentDiskSpaceUsage, SUM(Limit.LimitValue) AS DSTotal, Account.AccountStatus From FTPAccount,HostDomain,Package, Limit, Account WHERE FTPAccount.DomainId=HostDomain.DomainId  AND HostDomain.PackageId = Package.PackageId  AND Limit.LimitPropertyId=3 AND Package.AccountNumber = Account.AccountNumber AND(Package.PackageTypeId=Limit.ItemId OR HostDomain.PackageId=Limit.ItemId) GROUP BY FTPAccount.FTPUserName, HostDomain.CurrentDiskspaceUsage, Account.AccountStatus", strConnect
Do While Not rsOBJ.EOF
 CurrentDiskSpace_Bytes=rsObj("CurrentDiskspaceUsage")
 
 'Error Checking
 WScript.Echo "Found User " & rsObj("FTPUserName") & " Used/Total " & FormatNumber(cstr(rsObj("CurrentDiskspaceUsage"))/1024) & "MB/" & FormatNumber(cstr(rsObj("DSTotal"))) & "MB"
 
 If rsObj("AccountStatus") = 0 Then
  wscript.echo vbTab & "Account is Enabled"
  If SetStatus Then
   objShell.RegWrite "HKLM\SOFTWARE\Cat Soft\Serv-U\Domains\" & SUDomain & "\UserSettings\" & rsObj("FTPUserName") & "\Enable", "1", "REG_SZ"
   wscript.echo vbTab & "Writing Account Status"
  else
   wscript.echo vbTab & "Skipping Status..."
  end if
 else 
  wscript.echo vbTab & "Account is Disabled"
  If SetStatus then
   objShell.RegWrite "HKLM\SOFTWARE\Cat Soft\Serv-U\Domains\" & SUDomain & "\UserSettings\" & rsObj("FTPUserName") & "\Enable", "0", "REG_SZ"
   wscript.echo vbTab & "Writing Account Status, Account Disabled"
  else
   wscript.echo vbTab & "Skipping Status..."
  end if
 end if    

 If SetQuota Then
  'Update Serv-U Registry
  SUQuota="1|" & cstr(rsObj("DSTotal"))*1048576 & "|" & cstr(rsObj("CurrentDiskspaceUsage"))*1024
  objShell.RegWrite "HKLM\SOFTWARE\Cat Soft\Serv-U\Domains\" & SUDomain & "\UserSettings\" & rsObj("FTPUserName") & "\DiskQuota", SUQuota, "REG_SZ"
  WScript.Echo vbTab & "Writing Serv-u Qouta for " & rsObj("FTPUserName")
 else
  Wscript.Echo vbTab & "Skipping Quota..."
 end if
 rsOBJ.MoveNext
loop

objShell.run "cmd /c echo ReloadSettings=True >> """ & ServuDaemon & """",0
Wscript.Echo "Forcing Serv-U to reload settings."
Wscript.echo "Done."

'Close Us Down
rsOBJ.Close
set rsObj = nothing
Set filesys = nothing
set objshell = nothing
WScript.quit

This is an OLD vb script that I wrote for HELM3 to read the FTP users and their quota from a SQL database and writes the data to the registry to enforce the quota from the FTP Server.

Dynamic VBS printer mapping

VBscript that reads the users info property in AD for a list of printers to map.

On error resume next
Set WshNetwork = Wscript.CreateObject("Wscript.Network")
set oUser = GetObject("LDAP://CN=" & WshNetwork.username & ",OU=Users,DC=Domain,DC=Local")
Printers=split(oUser.Get("info"),VbCrLf)
first=True
For i = LBound(Printers) to UBound(Printers)
  If first = True Then
   WshNetwork.AddWindowsPrinterConnection(trim(Printers(i)))
   WshNetwork.SetDefaultPrinter(trim(Printers(i)))
   first=False
  Else
   WshNetwork.AddWindowsPrinterConnection(trim(Printers(i)))
  End If
Next