Never been to DZone Snippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

« Newer Snippets
Older Snippets »
Showing 1-10 of 13 total  RSS 

Strip HTML tags from strings using Classic ASP and regular expressions

From http://www.bpsdesigns.co.uk/tutorials/using-regular-expressions-with-classic-asp/

Function stripTags(HTMLstring)
	Set RegularExpressionObject = New RegExp
	With RegularExpressionObject
		.Pattern = "<[^>]+>"
		.IgnoreCase = True
		.Global = True
	End With
	stripTags = RegularExpressionObject.Replace(HTMLstring, "")
	Set RegularExpressionObject = nothing
End Function

Automatically restarting an application in Windows

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 """<the path to the executable file>""", 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

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

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

// 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)&"<br>"
next

response.write "<br>"

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)&"<br>"
next

%>

Write all ASP page variables

// description of your code here

<%
  Response.Write "Server Variables" & "<br><br>"
For Each strName in Request.ServerVariables
  Response.Write strName & " - " & Request.ServerVariables(strName) & "<BR>"
Next

  Response.Write "Session Variables" & "<br><br>"
For Each strName in Session.Contents
  Response.Write strName & " - " & Session.Contents(strName) & "<BR>"
Next

  Response.Write "Form Variables" & "<br><br>"
For Each strName in request.form
  Response.Write strName & " - " & request.form(strName) & "<BR>"
Next

  Response.Write "String Variables" & "<br><br>"
For Each strName in request.querystring
  Response.Write strName & " - " & request.querystring(strName) & "<BR>"
Next
%>

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

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

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 & "<br>"
  s = s & "Created: " & f.DateCreated & "<br>"
  s = s & "Last Accessed: " & f.DateLastAccessed & "<br>"
  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

// 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

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
« Newer Snippets
Older Snippets »
Showing 1-10 of 13 total  RSS