Option Explicit Dim arrstrDict, strPassWord, intPassTime, boolLoopAgain Const INT_PASS_PLACE = 6 arrstrDict = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "a", _ "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", _ "q", "r", "s", "t", "u", "v", "w", "x", "y", "z") Do boolLoopAgain = False ShowPassWord Loop While boolLoopAgain '**************************************************************************** Sub ShowPassWord Dim bCount, sCount, intX, intY For bCount = 1 To 3 Select Case bCount Case 1 intX = 9 : intY = 0 Case 2 intX = 25: intY = 10 Case 3 intX = 35: intY = 0 End Select For sCount = 1 To INT_PASS_PLACE strPassWord = strPassWord & arrstrDict(GetIndex(intX, intY)) Next CheckPassWord If boolLoopAgain = True Then Exit Sub End If Next End Sub Sub CheckPassWord Dim strCode, btnCode strCode = InputBox("Plase enter the password: " & strPassWord) If strCode = strPassWord Then intPassTime = intPassTime + 1 Else intPassTime = 0 btnCode = _ MsgBox("The password was wrong! Do you want to entry again?", _ vbYesNo, "Windows Script Host") End If strPassWord = Empty If intPassTime = 3 Then MsgBox "Success. The script was ended." WScript.Quit End If Select Case btnCode Case 6 boolLoopAgain = True Case 7 WScript.Quit End Select End Sub '**************************************************************************** Function GetIndex(lngUBound, AddNumber) Randomize GetIndex = Round(lngUBound * Rnd) + AddNumber End Function