Jump to content
Sign in to follow this  

Visual Basic Script

Recommended Posts

copy and paste this code below into notepad. Then save the name as bar.vbs and were it says text document(*txt.) change it to save all files then save it.

 

Option Explicit

Dim oBar

Set oBar = New ProgressBar

oBar.StartBar "KOOL"

WScript.Sleep(5000)

oBar.SetLine "SWEET"

WScript.Sleep(5000)

obar.setline "WOAH"

Class ProgressBar

' This class allows the creation of an object for use in displaying a

' "progress bar" type of display to the user while the script performs

' other tasks int he background. Very usefull to show that the script

' is still working or has finished.

' Usage: First, create a new instance of the object with a unique name.

' set oMyNewProgressBar = New ProgressBar

' Then, call the object's .StartBar function with an argument of the

' initial message that you wish to display.

' oMyNewProgressBar.StartBar "This is my message. Please wait."

' Then, if you want to change the displayed message, call the object's

' .SetLine function with an argument of what you want to change the

' message to.

' oMyNewProgressBar.SetLine "This is my new message. Wait longer."

' To close the object, call it's .CloseBar function.

' oMyNewProgressBar.CloseBar

Dim sProgressBarHTAFile, sProgressBarRunFile, sProgressBarSleepFile

Dim sProgressBarMsgFile, oShell, oFSO, iBarElementCount,

 

sProgressBarHTAFileKiller

Dim sTempRoot, sProgressBarMsgTempFile, sInitialTemp, aHTATextCat,

 

oFileToWrite

Private Sub Class_Initialize()

Set oShell = CreateObject("Wscript.Shell")

Set oFSO = CreateObject("Scripting.FileSystemObject")

sTempRoot = oShell.ExpandEnvironmentStrings("%TEMP%") & "\"

ReDim aHTATextCat(0)

End Sub

 

Public Sub StartBar(sMessageToDisplay)

sInitialTemp = oFSO.GetTempName

sProgressBarHTAFile = sTempRoot & oFSO.GetBaseName(sInitialTemp) &

 

".hta"

sProgressBarRunFile = sTempRoot & oFSO.GetBaseName(sInitialTemp) &

 

".run"

sProgressBarSleepFile = sTempRoot & oFSO.GetBaseName(sInitialTemp) &

 

"sleep.vbs"

sProgressBarMsgFile = sTempRoot & oFSO.GetBaseName(sInitialTemp) &

 

".msg"

subBarCat "<html>"

subBarCat "<head>"

subBarCat "<title id=" & Chr(34) & "title" & Chr(34) & ">Please

 

Wait</title>"

subBarCat "<HTA:APPLICATION "

subBarCat " ID=" & Chr(34) & "StatusBar" & Chr(34) & ""

subBarCat " APPLICATIONNAME=" & Chr(34) & "StatusBar" & Chr(34) & ""

subBarCat " SCROLL=" & Chr(34) & "no" & Chr(34) & ""

subBarCat " SINGLEINSTANCE=" & Chr(34) & "yes" & Chr(34) & ""

subBarCat " caption=" & Chr(34) & "no" & Chr(34) & ""

subBarCat " BORDER=" & Chr(34) & "no" & Chr(34) & ""

subBarCat " BORDERSTYLE=" & Chr(34) & "normal" & Chr(34) & ""

subBarCat " MAXIMIZEBUTTON=" & Chr(34) & "no" & Chr(34) & ""

subBarCat " MINIMIZEBUTTON=" & Chr(34) & "yes" & Chr(34) & ""

subBarCat " SYSMENU=" & Chr(34) & "no" & Chr(34) & ""

subBarCat " CONTEXTMENU=" & Chr(34) & "NO" & Chr(34) & ""

subBarCat " WINDOWSTATE=" & Chr(34) & "normal" & Chr(34) & ""

subBarCat " ShowInTaskBar=" & Chr(34) & "no" & Chr(34) & ""

subBarCat " />"

subBarCat "<script Language=" & Chr(34) & "VBScript" & Chr(34) & ">"

subBarCat "Set objShell = CreateObject(" & Chr(34) & "Wscript.Shell" &

 

Chr(34) & ")"

subBarCat "Set oFSO = CreateObject(" & Chr(34) &

 

"Scripting.FileSystemObject" & Chr(34) & ")"

subBarCat "Dim strTimer, strTimerCnt, sPID, iCID, sStatusMsg,

 

sStatusMsgFile, oStatusMsgFile"

subBarCat "sPID = " & Chr(34) & "" & Chr(34) & ""

subBarCat "iCID = 10"

subBarCat "sStatusMsgFile = " & Chr(34) & sProgressBarMsgFile & Chr(34)

 

& ""

subBarCat " Sub Window_Onload"

subBarCat " window.resizeTo 320,250"

subBarCat " Stats " & Chr(34) & "Init" & Chr(34) & ""

subBarCat " document.title = document.title"

subBarCat " oFSO.CreateTextFile(" & Chr(34) & sProgressBarRunFile &

 

Chr(34) & ")"

subBarCat " oFSO.CreateTextFile(" & Chr(34) & sProgressBarSleepFile &

 

Chr(34) & ")"

subBarCat " Set oVBS = oFSO.OpenTextFile(" & Chr(34) &

 

sProgressBarSleepFile & Chr(34) & ",2)"

subBarCat " oVBS.WriteLine " & Chr(34) & "WScript.Sleep(1000)" & Chr(34)

 

& ""

subBarCat " oVBS.Close"

subBarCat "Dim oWMIService, cItems, oItem"

subBarCat "Set oWMIService = GetObject(" & Chr(34) &

 

"winmgmts:\\.\root\CIMV2" & Chr(34) & ")"

subBarCat "Set cItems = oWMIService.ExecQuery(" & Chr(34) & "SELECT

 

Name, ExecutablePath FROM Win32_Process where Name = 'mshta.exe'" & Chr(34)

 

& ")"

subBarCat "For Each oItem in cItems"

subBarCat " sPID = oItem.Handle"

subBarCat "Next"

subBarCat " Do While oFSO.FileExists(" & Chr(34) & sProgressBarRunFile &

 

Chr(34) & ")"

subBarCat " objShell.Run " & Chr(34) & sProgressBarSleepFile &

 

Chr(34) & ",0,True"

subBarCat " objShell.AppActivate sPID"

subBarCat " Loop "

subBarCat " oFSO.DeleteFile " & Chr(34) & sProgressBarSleepFile &

 

Chr(34) & ", True "

subBarCat " Stats " & Chr(34) & "End" & Chr(34) & ""

subBarCat " window.Close"

subBarCat " End Sub"

subBarCat " Sub Stats(strStatus)"

subBarCat " If strStatus = " & Chr(34) & "Init" & Chr(34) & " Then"

subBarCat " strTimer = window.setInterval(" & Chr(34) & "Stats('Run')"

 

& Chr(34) & ", 175)"

subBarCat " Elseif strStatus = " & Chr(34) & "Run" & Chr(34) & " Then"

subBarCat "Select Case iCID"

subBarCat " Case 10"

subBarCat " strTimerCnt =" & Chr(34) & "ooooo" & Chr(34) & ""

subBarCat " objShell.AppActivate sPID"

subBarCat " iCID = 0"

subBarCat " Case 0"

subBarCat " strTimerCnt = " & Chr(34) & "oooon" & Chr(34) & ""

subBarCat " objShell.AppActivate sPID"

subBarCat " iCID = 1"

subBarCat " Case 1"

subBarCat " strTimerCnt = " & Chr(34) & "ooono" & Chr(34) & ""

subBarCat " objShell.AppActivate sPID"

subBarCat " iCID = 2"

subBarCat " Case 2"

subBarCat " strTimerCnt = " & Chr(34) & "oonoo" & Chr(34) & ""

subBarCat " objShell.AppActivate sPID"

subBarCat " iCID = 3"

subBarCat " Case 3"

subBarCat " strTimerCnt = " & Chr(34) & "onooo" & Chr(34) & ""

subBarCat " objShell.AppActivate sPID"

subBarCat " iCID = 4"

subBarCat " Case 4"

subBarCat " strTimerCnt = " & Chr(34) & "noooo" & Chr(34) & ""

subBarCat " objShell.AppActivate sPID"

subBarCat " iCID = 5"

subBarCat " Case 5"

subBarCat " strTimerCnt = " & Chr(34) & "onooo" & Chr(34) & ""

subBarCat " objShell.AppActivate sPID"

subBarCat " iCID = 6"

subBarCat " Case 6"

subBarCat " strTimerCnt = " & Chr(34) & "oonoo" & Chr(34) & ""

subBarCat " objShell.AppActivate sPID"

subBarCat " iCID = 7"

subBarCat " Case 7"

subBarCat " strTimerCnt = " & Chr(34) & "ooono" & Chr(34) & ""

subBarCat " objShell.AppActivate sPID"

subBarCat " iCID = 8"

subBarCat " Case 8"

subBarCat " strTimerCnt = " & Chr(34) & "oooon" & Chr(34) & ""

subBarCat " objShell.AppActivate sPID"

subBarCat " iCID = 1"

subBarCat " End Select "

subBarCat " document.getElementById(" & Chr(34) & "Stats" & Chr(34) &

 

").innerHTML = strTimerCnt"

subBarCat " If oFSO.FileExists(sStatusMsgFile) and

 

oFSO.GetFile(sStatusMsgFile).Size <> 0 Then"

subBarCat " Set oStatusMsgFile = oFSO.OpenTextFile(sStatusMsgFile,

 

1)"

subBarCat " sStatusMsg = oStatusMsgFile.ReadAll"

subBarCat " oStatusMsgFile.Close"

subBarCat " If Trim(sStatusMsg) <> " & Chr(34) & "" & Chr(34) &

 

" Then "

subBarCat " sStatusMsg = Replace(sStatusMsg, VbCrLf, " &

 

Chr(34) & "<br>" & Chr(34) & ")"

subBarCat " Else"

subBarCat " sStatusMsg = " & Chr(34) & "" & Chr(34) & ""

subBarCat " End If "

subBarCat " Else"

subBarCat " sStatusMsg = " & Chr(34) & "" & Chr(34) & ""

subBarCat " End If "

subBarCat " document.getElementById(" & Chr(34) & "MyMsg" & Chr(34) &

 

").innerHTML = sStatusMsg"

subBarCat " Elseif strStatus = " & Chr(34) & "End" & Chr(34) & " Then"

subBarCat " window.clearInterval(strTimer)"

subBarCat " document.getElementById(" & Chr(34) & "Stats" & Chr(34) &

 

").innerHTML = " & Chr(34) & "" & Chr(34) & ""

subBarCat " oFSO.DeleteFile " & chr(34) & sProgressBarMsgFile &

 

Chr(34) & ", True"

subBarCat " End If"

subBarCat " End Sub"

subBarCat "</SCRIPT>"

subBarCat "<style>"

'Change the settings in the two lines below to alter the colors of the

 

window

subBarCat "body,td,a

 

{font-family:Arial;font-size:12px;text-decoration:none;color:black;}"

subBarCat "body

 

{filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0,

 

StartColorStr='#9999FF', EndColorStr='#FFFFFF')}"

subBarCat ".pix {width: 1px; height 1px;}"

subBarCat "</style>"

subBarCat "</head>"

subBarCat "<body>"

subBarCat "<center>"

subBarCat "<table width=" & Chr(34) & "275" & Chr(34) & ">"

subBarCat " <tr><td>"

subBarCat " <fieldset><legend align=" & Chr(34) & "center" & Chr(34) &

 

"><b> Please Be Patient </b></legend>"

subBarCat " <br><center>"

subBarCat " <span id=Stats style=" & Chr(34) & "font-family:

 

wingdings;font-weight: bold;font-size:20px;" & Chr(34) & "></span>"

subBarCat " </center><br><br>"

subBarCat " </fieldset>"

subBarCat " </td></tr>"

subBarCat "</table>"

subBarCat "<span id=MyMsg style=" & Chr(34) & "font-family:

 

Ariel;font-size:12px;" & Chr(34) & "></span>"

subBarCat "</body>"

subBarCat "</html>"

subWriteFile sProgressBarHTAFile, Join(aHTATextCat,VbCrLf)

subWriteFile sProgressBarMsgFile, sMessageToDisplay

oShell.Run sProgressBarHTAFile, 1, False

End Sub

 

Private Sub subBarCat(sStringToAdd)

ReDim Preserve aHTATextCat(iBarElementCount)

aHTATextCat(iBarElementCount) = sStringToAdd

iBarElementCount = iBarElementCount + 1

End Sub

 

Public Sub CloseBar()

subKillFile sProgressBarRunFile

sProgressBarHTAFileKiller = sTempRoot & "htakiller.vbs"

subWriteFile sProgressBarHTAFileKiller, "On Error Resume Next"

subWriteFile sProgressBarHTAFileKiller, "wscript.sleep(10000)"

subWriteFile sProgressBarHTAFileKiller, "Set oFSO =

 

CreateObject(""Scripting.FileSystemObject"")"

subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) &

 

sProgressBarHTAFile & Chr(34) & ", True"

subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) &

 

sProgressBarHTAFileKiller & Chr(34) & ", True"

oShell.Run sProgressBarHTAFileKiller, 0, False

End Sub

 

Public Sub SetLine(sNewText)

sProgressBarMsgTempFile = sTempRoot & oFSO.GetTempName & ".tmp"

subWriteFile sProgressBarMsgTempFile, sNewText

subKillFile sProgressBarMsgFile

oFSO.MoveFile sProgressBarMsgTempFile, sProgressBarMsgFile

End Sub

 

Private Sub subKillFile(sFileToKill)

If oFSO.FileExists(sFileToKill) Then oFSO.DeleteFile sFileToKill,

 

True

End Sub

Private Sub subWriteFile(sFileToWrite, sTextToWrite)

If not oFSO.FileExists(sFileToWrite) Then oFSO.CreateTextFile

 

sFileToWrite

Set oFileToWrite = oFSO.OpenTextFile(sFileToWrite,8)

oFileToWrite.WriteLine sTextToWrite

oFileToWrite.Close

End Sub

Private Sub Class_Terminate()

End Sub

End Class

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  

×