DZone Snippets: VBScript code

Automatically restarting an application in Windows

thinkulum (Andy Culbertson) — Sat, 18 Aug 2007 19:48:38 GMT

This script will start a program and automatically relaunch it if it closes. It's a stripped down version of the script in JSI Tip 9635: How can I start an application, and automatically restart it if the user ends it?.



Set WshShell = CreateObject("WScript.Shell")

Do While True

 WshShell.Run """""", 1, True

Loop

The pairs of double quotes inside the quoted string prevent "file not found" errors if the path contains spaces. The Run method is documented here, in case you want to change the window style (the second argument).

RecordSet to tab-separated values

mrclay (Steve Clay) — Wed, 07 Mar 2007 21:51:49 GMT



Function TSV(rs)

	Dim field

	For Each field In rs.Fields

		TSV = TSV & field.Name & VBTab

	Next

	TSV = Left(TSV, Len(TSV) - 1) & vbCr & rs.GetString()

End Function

The rows are separated by vbCr ("\r" in most languages).
The first row is the field names.

Unix time

mrclay (Steve Clay) — Wed, 07 Mar 2007 21:43:08 GMT



Function UnixTime(gmtHrsOffset)

	UnixTime = DateDiff("s", "1/1/1970 00:00:00", Now()) - (3600 * gmtHrsOffset)

End Function



Repsonse.Write(UnixTime(-5)) 'E.S.T.

Adding in the GMT offset allowed this to match PHP's time() function on a separate server.

Vbscript Array sort in alphabetical order

spearmahj (j) — Wed, 03 Jan 2007 09:59:03 GMT

// sort vbscript array



<%

dim arrSortOut(8)

arrSortOut(0)="xCount"

arrSortOut(1)="zExec"

arrSortOut(2)="yFinance"

arrSortOut(3)="HR"

arrSortOut(4)="IT "

arrSortOut(5)="!aaaLegal"

arrSortOut(6)="Liberman"

arrSortOut(7)="Martha"

arrSortOut(8)="Regis"



for x=0 to 8

response.write arrSortOut(x)&"
"

next



response.write "
"



for i = UBound(arrSortOut) - 1 To 0 Step -1

    for j= 0 to i

        if arrSortOut(j)>arrSortOut(j+1) then

            temp=arrSortOut(j+1)

            arrSortOut(j+1)=arrSortOut(j)

            arrSortOut(j)=temp

        end if

    next

next 





for x=0 to 8

response.write arrSortOut(x)&"
"

next



%>

Write all ASP page variables

spearmahj (j) — Tue, 02 Jan 2007 04:38:18 GMT

// description of your code here



<%

  Response.Write "Server Variables" & "

"

For Each strName in Request.ServerVariables

  Response.Write strName & " - " & Request.ServerVariables(strName) & "
"

Next



  Response.Write "Session Variables" & "

"

For Each strName in Session.Contents

  Response.Write strName & " - " & Session.Contents(strName) & "
"

Next



  Response.Write "Form Variables" & "

"

For Each strName in request.form

  Response.Write strName & " - " & request.form(strName) & "
"

Next



  Response.Write "String Variables" & "

"

For Each strName in request.querystring

  Response.Write strName & " - " & request.querystring(strName) & "
"

Next

%>

ADSI show ActiveDirectory distribution group members in a given OU by group

ryanbriones (Ryan Briones) — Thu, 21 Dec 2006 21:20:55 GMT



On Error Resume Next



strServerName = "MYDC01"

strDomain = "mydomain.local"

strContainer = "OU=Distribution Lists"



arrDomain = Split(strDomain, ".", -1)

For i = 0 to UBound(arrDomain)

	arrDomain(i) = "DC=" & arrDomain(i)

Next

strLDAPDomain = Join(arrDomain, ",")

strContainer = strContainer & "," & strLDAPDomain



Wscript.StdOut.WriteLine("Group Name,Members")

Set oContainer = GetObject("LDAP://" & strServerName & "/" & strContainer)

 

For Each oChild in oContainer

    Wscript.StdOut.WriteLine oChild.CN & ","



    Set oGroup = GetObject("LDAP://" & strServerName & "/" & oChild.Name & "," & strContainer)

    oGroup.GetInfo

    arrMemberOf = oGroup.GetEx("member")

	

    If Err.Number = 0 Then

    For Each strMember in arrMemberOf

        Set oMember = GetObject("LDAP://" & strServerName & "/" & strMember)

        Wscript.StdOut.WriteLine("," & oMember.CN)

        Set oMember = nothing

    Next

    Else

        Wscript.StdOut.Writeline ","

        Err.Clear

    End If

	

    Wscript.StdOut.WriteLine ""

    Set oGroupList = nothing

Next

File System Object VBScript

millerjohneric (John Miller) — Thu, 07 Dec 2006 04:40:38 GMT

vbscript class wrapper to expose file system object methods and properties.



CLASS FSOBJ

dim FSO, f, f1, fc, s

dim  nso

Sub Class_Initialize()

   Set FSO = CreateObject("Scripting.FileSystemObject")

   Set nso = CreateObject("WScript.Network")

End Sub



Sub Class_Terminate()

   Set FSO = Nothing

   Set nso = Nothing

End Sub

Property Get GetFolder(folderspec) 

Set GetFolder = FSO.GetFolder(folderspec)

End Property

Property Get GetFile(filespec)

Set GetFile = FSO.GetFile(filespec)

End Property

Property Get GetFileSize(filespec) 



Set f = FSO.GetFile(filespec)

GetFileSize = f.Size

End Property

Property Get GetComputerName() 

 GetComputerName = nso.computername

End Property



Function FolderExists(folderspec)

   Set FSO = CreateObject("Scripting.FileSystemObject")

   FolderExists = FSO.FolderExists(folderspec)

End Function

Function FileExists(pathNfilespec)

    'folderspec = Left(pathNfilespec, Len(pathNfilespec) - InStrRev(pathNfilespec, "\") + 1)

    'filespec = Right(pathNfilespec, InStrRev(pathNfilespec, "\") - 1)

   Set FSO = CreateObject("Scripting.FileSystemObject")

   'FolderExists = fso.FolderExists(folderspec)

   FileExists = FSO.FileExists(pathNfilespec)

End Function

Function FileDelete(pathNfilespec)

    'folderspec = Left(pathNfilespec, Len(pathNfilespec) - InStrRev(pathNfilespec, "\") + 1)

    'filespec = Right(pathNfilespec, InStrRev(pathNfilespec, "\") - 1)

   Set FSO = CreateObject("Scripting.FileSystemObject")

   If FSO.FileExists(pathNfilespec) = True Then

   FSO.DeleteFile pathNfilespec, True

   End If

End Function

Function ShowFileAccessInfo(filespec)

  Set FSO = CreateObject("Scripting.FileSystemObject")

If FSO.FolderExists(folderspec) = True Then

    Set f = FSO.GetFile(filespec)

  s = f.path & "
"

  s = s & "Created: " & f.DateCreated & "
"

  s = s & "Last Accessed: " & f.DateLastAccessed & "
"

  s = s & "Last Modified: " & f.DateLastModified

  ShowFileAccessInfo = s

End If

End Function

Function FileModified(pathNfilespec)

    'folderspec = Left(pathNfilespec, Len(pathNfilespec) - InStrRev(pathNfilespec, "\") + 1)

    'filespec = Right(pathNfilespec, InStrRev(pathNfilespec, "\") - 1)

   Set FSO = CreateObject("Scripting.FileSystemObject")

     Set f = FSO.GetFile(pathNfilespec)

   If FSO.FileExists(pathNfilespec) = True Then

   FileModified = f.DateLastModified

   End If

End Function

Function FileAccessed(pathNfilespec)

    'folderspec = Left(pathNfilespec, Len(pathNfilespec) - InStrRev(pathNfilespec, "\") + 1)

    'filespec = Right(pathNfilespec, InStrRev(pathNfilespec, "\") - 1)

   Set FSO = CreateObject("Scripting.FileSystemObject")

     Set f = FSO.GetFile(pathNfilespec)

   If FSO.FileExists(pathNfilespec) = True Then

   FileAccessed = f.DateLastAccessed

   End If

End Function

Sub AddNewFolder(path, folderName)

Dim nf

   Set FSO = CreateObject("Scripting.FileSystemObject")

   Set f = FSO.GetFolder(path)

   Set fc = f.SubFolders

   If folderName <> "" Then

      Set nf = fc.Add(folderName)

   Else

      Set nf = fc.Add("New Folder")

   End If

End Sub





Function ShowFileList(folderspec)



   Dim FSO, f, f1, fc, s



   Set FSO = CreateObject("Scripting.FileSystemObject")



   Set f = FSO.GetFolder(folderspec)



   Set fc = f.FILES



   For Each f1 In fc



      s = s & f1.Name



      s = s & vbTab



   Next



   ShowFileList = s



End Function

Sub FILES(FolderNPath)



   Dim FSO, f, f1, fc, s



   Set FSO = CreateObject("Scripting.FileSystemObject")



   Set f = FSO.GetFolder(FolderNPath)



   Set fc = f.FILES



   For Each f1 In fc

    

   Next

End Sub

Sub CopyFile(Source , Destination , Overwrite )

    

FSO.CopyFile Source, Destination, Overwrite

End Sub



END CLASS

VBScript Rot13

dondi (Dondi) — Tue, 26 Sep 2006 00:40:46 GMT

// description of your code here



Public Function encrypt(strInput As String)

    Dim n As Integer, i As Integer

    n = 13

    For i = 1 To Len(strInput)

        Mid(strInput, i, 1) = Chr(Asc(Mid(strInput, i, 1)) + n)

    Next i

    encrypt = strInput

End Function

 

 

Public Function decrypt(strInput As String)

    Dim n As Integer, i As Integer

    n = 13

    For i = 1 To Len(strInput)

        Mid(strInput, i, 1) = Chr(Asc(Mid(strInput, i, 1)) - n)

    Next i

    decrypt = strInput

End Function

vbscript include function

DeekGeek () — Thu, 29 Jun 2006 20:12:18 GMT

This is a vbscript include function, useful for reusing files in a file library. Honestly, I don't remember where I found this, so if you know, post the attribution in a comment, please.



' VBScript "Include" routine

Sub Include(sInstFile)

	On Error Resume Next



	Dim oFSO, f, s



	Set oFSO = CreateObject("Scripting.FileSystemObject")

	If oFSO.FileExists(sInstFile) Then

		Set f = oFSO.OpenTextFile(sInstFile)

		s = f.ReadAll

		f.Close

		ExecuteGlobal s

	End If



	Set oFSO = Nothing

	Set f = Nothing

End Sub

Find the count of a given character in a text string

Deane () — Thu, 23 Mar 2006 22:34:18 GMT

ASP / VBScript offers no built-in functionality for this.



CharacterCount = Len(MyString) - Len(Replace(MyString, TargetCharacter, ""))