scripts.team-holm.net
Hovedsiden
VisualBasic Scripts
Script Snutter


Her har jeg med noen script snutter som er nyttige å bruke eller modifisere når man skriver andre nye scripts. Scriptene og navnene på dem er for det meste selvforklarende.

arrayLength.vbs
Function arrLength(oArray) 
   Dim itemCount, itemIndex
   itemCount = 0 
   For itemIndex = 0 To UBound(oArray) 
      If Not(oArray(itemIndex)) = Empty Then 
         itemCount = itemCount + 1 
      End If 
   Next 
   arrLength = itemCount-1
End Function

runAnotherScript.vbs
Dim strCmd, oExecObject, oShell, strResults

strCmd = "cscript scriptToRun.vbs"
Set oShell = CreateObject("WScript.Shell")
Set oExecObject = oShell.Exec(strCmd)

'Vis resultatet:
Do Until oExecObject.StdOut.AtEndOfStream
   strResults = oExecObject.StdOut.ReadAll
Loop

listFiles.vbs
'Lister alle filer i en mappe, sFolder.

On Error Resume Next

Dim oFSO, oFolder, arrFiles, sFolder    
Set oFSO = CreateObject("Scripting.FileSystemObject")  
sFolder = "m:\Program Files\Common Files\"
Set oFolder = oFSO.GetFolder(sFolder)  
Set arrFiles = oFolder.Files
For each strFile In arrFiles
   Wscript.Echo strFile
Next

pauseScript.vbs
Sub pauseScript(strSecondMessage)
   Dim strMessage, Input

   strMessage = vbNewLine & strSecondMessage & vbNewLine & vbNewLine & _
   "Trykk ENTER for å fortsette." 
   Wscript.StdOut.Write strMessage
   'Desverre pause scriptet bare en gang, 
   'med mindre man enten også eller i stedet bruker msgBox
   'msgBox strMessage
   WScript.Echo "Trykk ENTER for å fortsette." & vbNewLine & _
   "(CTRL-C) for å avbryte."
   Do While Not WScript.StdIn.AtEndOfLine
      Input = WScript.StdIn.Read(1)
   Loop
End Sub

getTSProfilePathFromADUser.vbs
' **************************************************************************************
' Atle Holm - 15.05.2011 
' Henter Terminal Services Profile Path fra AD bruker gitt som argument til funksjonen.
' ************************************************************************************** 
Function getTSProfilePath(strUser)
   On Error Resume Next
   Dim objRoot, sDC, sDC2, ors, objUser, oConnection, oCommand, dnsArray, i, strQuery, ldap
   Dim strBase, strFilter, strAttributes,
   
   Set objRoot = GetObject("LDAP://rootDSE")
   sDC = objRoot.Get("dnshostName")
   
   dnsArray = Split(sDC,".")
   For i = 1 to Ubound(dnsArray)
      If i = 1 Then 
         sDC2 = "dc=" & dnsArray(i)
      Else
         sDC2 = sDC2 & ",dc=" & dnsArray(i)
      End If
   Next

   strBase = ""
   strFilter = "(&(objectClass=user)(sAMAccountName=" & strUser & "))"
   strAttributes = "sAMAccountName,cn,distinguishedName"
   strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
   Set oConnection = CreateObject("ADODB.Connection")
   Set oCommand = CreateObject("ADODB.Command")
   Set ors = createobject("ADODB.Recordset")

   oConnection.Provider = "ADsDSOObject"
   oConnection.Open "ADs Provider"
   oCommand.ActiveConnection = oConnection
   oCommand.CommandText = strQuery
   oCommand.Properties("Page Size") = 99
   
   Set ors = oCommand.Execute
   If Err.Number then
      Wscript.Echo "Error 0x" & CStr(Hex(Err.Number)) & " ocurred during the query."
      If Err.Description <> "" Then
         Wscript.Echo "Error description: " & Err.Description & "."
      End If
      Err.Clear
      Exit Function
   End If
   
   Do Until objRecordSet.EOF
      ldap = ors.fields("distinguishedName").Value
      Set objUser = GetObject("LDAP://" & ldap)
      If objUser.sAMAccountName = strUser Then
         GetFileServer = objUser.TerminalServicesProfilePath
         Exit Function
      End If
      ors.MoveNext
   Loop
End Function

Perl
VisualBasic
BASH
Powershell