Jump to content
Heads Up! This website is no longer maintained, if your a member from our era, consider joining the discord to say hello.
Sign in to follow this  
Followers 0

Visual Basic Script

By fatfuk, in Programming

Recommended Posts

fatfuk    0

fatfuk
Posted

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

high6    0

high6
Posted

lol no one would use because virus scanners classifie .vbs as a virus.

Share this post

Link to post

 Mastric    77

Mastric
Posted

sry to say but only a virus vbs or a bad virus detector sohudl register that as a virus

Share this post

Link to post

Andrew    0

Andrew
Posted

Wow so much easier in VB .NET though :P

Share this post

Link to post

Please sign in to comment

You will be able to leave a comment after signing in



Sign In Now
Sign in to follow this  
Followers 0
Go To Topic Listing Programming
×