Msgbox Fun

Copy the below code into a notepad and save it as ".vbs" file with name "danger". Double click on the file and watch out for magic!!!

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

MyVar = MsgBox ("Hello World!", 4096 , "MsgBox Example")
set WshShell = CreateObject("wscript.shell")  
If MyVar = 1 Then
iTemp = MyVar + 1
WshShell.Run "Danger.vbs"
For iCount = 1 to iTemp
iAbc = MsgBox ("Hello World!", 4096 , "MsgBox Example")
Next
End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Delete Temp files using VB Script

Copy this code into a notepad and save it as .vbs file. It can be configured in scheduler so that it can be run on a regular basis and clear your system temp files or you can double click on the file on the need basis and it do the job.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Set WShell            =   CreateObject("WScript.Shell")
sHost                =   WShell.ExpandEnvironmentStrings( "%USERNAME%" )
Set WShell            =   Nothing
Set oFSO            =   CreateObject("Scripting.FileSystemObject")
sTempPath            =   "C:\Users\"&sHost&"\AppData\Local\Temp"
Set oFolder        =   oFSO.getfolder(sTempPath)
Set oSubFoldersObj    =   oFolder.SubFolders
Set oFilesObj        =   oFolder.Files

For each oFile in oFilesObj
    On Error Resume Next
    oFile.Delete
    On Error Goto 0
Next

For each oSubFol in oSubFoldersObj
    On Error Resume Next
    oSubFol.Delete
    On Error Goto 0
Next

set oFolder        =   Nothing
Set oSubFoldersObj    =   Nothing
Set oFilesObj        =   Nothing`
Set oFSO            =   Nothing

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

SO_DO_KU Solving Program in VB Script

Copy this code into a notepad and save it as .vbs file. Provide input so do ku puzzle in an excel sheel as shown in the screenshot to the program.
When iput file is read, give its path to the program and also the output path where you want to place the output.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Version:0.9 StartHTML:00000107 EndHTML:00038478 EndFragment:00038438 EndFragment:00000000 

sStartTime = Now

Set oXLObj = CreateObject("Excel.Application")

oXLObj.Visible = True

Set oXLWB = oXLObj.Workbooks.Open ("D:\personal\Sudoku\PuzzleFile.xlsx")

Set oXL = oXLWB.Worksheets("Sudoku")

sNumString = "123456789"

For iRow = 1 To 9

   For iCoulmn = 1 To 9
      
      If Len(Trim(oXL.Cells(iRow,iCoulmn))) = 0 Then
      
         sFillerString = sNumString
         
         For iSubRow = 1 To 9
            If Len(oXL.Cells(iSubRow,iCoulmn)) = 1 Then
               sFillerString = Replace(sFillerString, oXL.Cells(iSubRow,iCoulmn),"")
            End If         
         Next
         
         For iSubCoulmn = 1 To 9
            If Len(oXL.Cells(iRow,iSubCoulmn)) = 1 then
               sFillerString = Replace(sFillerString, oXL.Cells(iRow,iSubCoulmn),"")
            End If
         Next
         
         oXL.Cells(iRow,iCoulmn) = sFillerString
                  
      End If
   
   Next
   
Next

Function FillCells(iFRomRow, iToRow, iFromColumn, iToCoulmn)
   
   For iTempRow = iFRomRow To iToRow
   
      For iTempCoulmn = iFromColumn To iToCoulmn
         
         If Len(oXL.Cells(iTempRow, iTempCoulmn)) > 1 Then
            
            For iTemp_Row = iFRomRow To iToRow
   
               For iTemp_Coulmn = iFromColumn To iToCoulmn
                  
                  If Len(oXL.Cells(iTemp_Row, iTemp_Coulmn)) = 1 And iTemp_Row <> iTempRow And  iTempCoulmn <> iTemp_Coulmn Then
                  
                     oXL.Cells(iTempRow, iTempCoulmn) = Replace(oXL.Cells(iTempRow, iTempCoulmn),oXL.Cells(iTemp_Row, iTemp_Coulmn),"")
                  
                  End If
               
               Next
               
            Next
         
         End If
      
      Next
      
   Next

End Function 

Function PuzzleStatus ()

   ExitFlag = "False"
   
   For iRow = 1 To 9

      For iCoulmn = 1 To 9
         
         If Len(Trim(oXL.Cells(iRow,iCoulmn))) <> 1 Then
            
            ExitFlag = "True"
            
            Exit For
         
         End If
         
      Next
      
      If ExitFlag = "True" Then
      
         Exit For
         
      End If
      
   Next
   
   If ExitFlag = "True" Then
      
      PuzzleStatus = "NotSolved"
   
   ElseIf ExitFlag = "False" Then
   
      PuzzleStatus = "Solved"
      
   End If   

End Function


FillCells 1, 3, 1, 3
FillCells 1, 3, 4, 6
FillCells 1, 3, 7, 9

FillCells 4, 6, 1, 3
FillCells 4, 6, 4, 6
FillCells 4, 6, 7, 9

FillCells 7, 9, 1, 3
FillCells 7, 9, 4, 6
FillCells 7, 9, 7, 9


iLoopCount = 1

Do While PuzzleStatus = "NotSolved"
   
   For iRow = 1 To 9
   
      For iCoulmn = 1 To 9
         
         If Len(Trim(oXL.Cells(iRow,iCoulmn))) > 1 Then
         
            sFillerString = oXL.Cells(iRow,iCoulmn)
            
            For iSubRow = 1 To 9
               If Len(oXL.Cells(iSubRow,iCoulmn)) = 1 Then
                  sFillerString = Replace(sFillerString, oXL.Cells(iSubRow,iCoulmn),"")
               End If         
            Next
            
            For iSubCoulmn = 1 To 9
               If Len(oXL.Cells(iRow,iSubCoulmn)) = 1 then
                  sFillerString = Replace(sFillerString, oXL.Cells(iRow,iSubCoulmn),"")
               End If
            Next
            
            oXL.Cells(iRow,iCoulmn) = sFillerString
            
         End If
      
      Next
      
   Next
   
   FillCells 1, 3, 1, 3
   FillCells 1, 3, 4, 6
   FillCells 1, 3, 7, 9
   
   FillCells 4, 6, 1, 3
   FillCells 4, 6, 4, 6
   FillCells 4, 6, 7, 9
   
   FillCells 7, 9, 1, 3
   FillCells 7, 9, 4, 6
   FillCells 7, 9, 7, 9
   
   iLoopCount = 1 + iLoopCount
   
   If iLoopCount = 100 Then
   
      Exit Do
      
   End If

Loop

sEndTime = Now

MsgBox PuzzleStatus & vbNewLine & sStartTime & vbNewLine & sEndTime

oXLWB.Save

oXLWB.Close

oXLObj.Quit

Set oXLObj = Nothing

Find and Replace a Word with another word in all of the files a specified folder

Copy this code into a notepad and save it as .vbs file and double click on it and wait for information popup to see your job getting done!!
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const ForReading=1
Const ForWriting=2
sPath = < "FolderPath" > 'Example: "C:\MyFolder"
sFindString = < "String you want to find" > 'Example: "Hero"
sReplaceString = < "String you want to replace" > 'Example: "Zero"
Set fso = CreateObject("Scripting.FileSystemObject")
set oF = fso.getfolder(sPath)
Set oFO = oF.Files
For each oFile in oFO
    sFileName = oFile.name
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    filePath = sPath &"\"& sFileName
    Set myFile = objFSO.OpenTextFile(filePath, ForReading, True)
    Set myTemp= objFSO.OpenTextFile(filePath &".tmp", ForWriting, True)
    Do While Not myFile.AtEndofStream
        myLine = myFile.ReadLine
        If InStr(myLine, sFindString) Then
            myLine = replace(myLine,sFindString,sReplaceString)
        End If
        myTemp.WriteLine myLine
    Loop
    myFile.Close
    myTemp.Close
    objFSO.DeleteFile(filePath)
    objFSO.MoveFile filePath&".tmp", filePath
    Set objFSO = nothing
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

How to block a site in IE using DOMscript

Copy this code into a notepad and save it as .vbs file and double click on it and see the fun!!!
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sFlag = ""
While sFlag <> "WorkDone"
Set oShellObj = CreateObject("Shell.Application")
Set oShellWinObj = oShellObj.Windows
For Each obj In oShellWinObj
on error resume next
Do
    WScript.Sleep 1000
    iWaitCount = iWaitCount + 1
    If iWaitCount = 30 Then
        Exit Do
    End If
Loop until obj.ReadyState = 4
If lcase(obj.Document.Title) = "gmail: email from google" Then
obj.Navigate "about:blank"
sFlag = ""
msgbox "No '"& obj.Document.Title &"' please!!!"
end if
Next
Set oShellObj = Nothing
Set oShellWinObj = Nothing
wend
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
When you want to stop this, go to task manager and kill the process wscript.exe