This question already has answers here:
How to mask input with VBScript?
(2 answers)
Closed 2 years ago.
I am making a simple username and password storage program in vbs. After entering the username, I need to have a password input. I can't however, find a way to not show the input in plaintext and convert it to ******
This is what i have already:
x=MsgBox("VBScript username and password storage")
username = InputBox("Please enter your username", "Credentials storage", "Your username goes here")
passwd = InputBox("Please enter your password", "Credentials storage", "Your password goes here")
Set obj = CreateObject("Scripting.FileSystemObject")
Const ForWriting = 2
Set obj1 = obj.OpenTextFile("test.txt", ForWriting)
obj1.WriteLine(username & " " & passwd)
obj1.Close
Set obj=Nothing
I also tried doing this which I found as an answer on another question
Set oInput = CreateObject("ScriptPW.Password")
WScript.StdOut.Write "Enter password: "
pw = oInput.GetPassword
But when i ran it it said "ActiveX component can't create object "ScriptPW.Password"
Is there a way to hide the text in line 3 or fix my problem?
Toyed around with this, never had a need for it. My poor man's solution so far is this. I could not figure yet out if it is possible to create a powershell object that you can use in VBScript directly, I think there's an inherent barrier there, since PS is .Net. In this case I stil return the password returned by Get-Credential as plain text, so consider this a hack. It only masks the inputbox. There are undoubtedly better solutions for this. On the plus side: this code is quite small and -importantly- does not rely on IE.
Option Explicit
Const WshRunning = 0
Const WshFinished = 1
Const WshFailed = 2
Dim objShell, oExec, strOutput, strPS1Cmd
'create Powershell command
'Note that we manipulate the credentials object into a plain string
strPS1Cmd = "& { $cred = Get-Credential; Write-Output ($cred.Username + '|and-now-comes-the-password-in-plaintext|' + $cred.GetNetworkCredential().Password) } "
' Create a shell and execute powershell, pass the script
Set objShell = WScript.CreateObject("wscript.shell")
Set oExec = objShell.Exec("powershell -windowstyle hidden -command """ & strPS1Cmd & """ ")
Do While oExec.Status = WshRunning
WScript.Sleep 100
Loop
Select Case oExec.Status
Case WshFinished
strOutput = oExec.StdOut.ReadAll()
Case WshFailed
strOutput = oExec.StdErr.ReadAll()
End Select
WScript.Echo(strOutput)
You can give a try for this function PasswordBox
PasswordBox.vbs
Option Explicit
Dim bPasswordBoxWait,bPasswordBoxOkay,Password
Password = PasswordBox("Veuillez taper votre mot de passe",False)
wscript.echo Password
'----------------------------------------------------------------------------'
Function PasswordBox(sTitle,FullScreen)
Dim oIE
set oIE = CreateObject("InternetExplorer.Application")
With oIE
If FullScreen = True Then
.FullScreen = True
Else
.FullScreen = False
End if
.ToolBar = False : .RegisterAsDropTarget = False
.StatusBar = False : .Navigate("about:blank")
.Resizable = False
While .Busy : WScript.Sleep 100 : Wend
With .document
.Title = "Veuillez taper votre mot de passe * * * * * * * * * * * * *"
With .ParentWindow
.resizeto 350,100
.moveto .screen.width/2-200, .screen.height/2-50
End With
.WriteLn("<html><title>Veuillez taper votre mot de passe * * * * * * *</title><body text=white bgColor=DarkOrange><center>")
.WriteLn(sTitle)
.WriteLn("<input type=password id=pass>" & _
"<input type=Submit id=but0 value=Envoyer>")
.WriteLn("</center></body></html>")
With .ParentWindow.document.body
.scroll="no"
.style.borderStyle = "outset"
.style.borderWidth = "1px"
End With
.all.but0.onclick = getref("PasswordBox_Submit")
.all.pass.focus
oIE.Visible = True
bPasswordBoxOkay = False : bPasswordBoxWait = True
On Error Resume Next
While bPasswordBoxWait
WScript.Sleep 100
if oIE.Visible Then bPasswordBoxWait = bPasswordBoxWait
if Err Then bPasswordBoxWait = False
Wend
PasswordBox = .all.pass.value
End With
.Visible = False
.Quit
End With
End Function
'----------------------------------------------------------------------------'
Sub PasswordBox_Submit()
bPasswordBoxWait = False
End Sub
'----------------------------------------------------------------------------'
Related
I have done this code, but it seems that it dosen't work. I don't why. I have searched on google, but no luck. :(
Set objREG = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
Const HKEY_LOCAL_MACHINE = &H80000002
Dim lstrKeyPath, lstrValueName, lstrValue
lstrKeyPath = "SOFTWARE\Canon\GARO1\"
lstrValueName = "LocaleInfo"
objReg.GetStringValue HKEY_LOCAL_MACHINE,lstrKeyPath,lstrValueName,lstrValue
msgbox lstrValue <--- This works.
if IsNull(lstrValue) then
lstrKeyPath = lstrKeyPath & lstrValueName
else
lstrValueName = "LocaleTest"
lstrKeyPath = "Software\Test\"
Return = objReg.CreateKey(HKEY_LOCAL_MACHINE,lstrKeyPath)
if Return = 0 Then
msgbox "Yes"
else
msgbox "No"
end if
end if
Set OBJREG = Nothing
I can't see my "Test" key in the registry
I have used the following to check for and insert registry keys if they don't exist:
Dim WshShell, Test, blExists, DQ
Set WshShell = CreateObject("WScript.Shell")
DQ = chr(34)
RegKeyPath = "HKEY_CLASSES_ROOT\LFS\"
RegValueName = "URL:LFS Protocol"
Test = RegKeyExists(RegKeyPath,RegValueName)
If Test = False Then
WshShell.RegWrite RegKeyPath, "URL:LFS Protocol" ,"REG_SZ"
End If
'Function Returns False if the regkey isnt found otherwise it returns
'The registry key value specified
Function RegKeyExists(sRegKey,sRegValueName)
On Error Resume Next
Dim WSHShellRegTest, Test, blExists
Set WSHShellRegTest = CreateObject("WScript.Shell")
blTrueFalse = True
Test = WSHShellRegTest.RegRead (sregkey + sRegValueName)
If Err Then
RegKeyExists = False
Err.clear
Exit Function
End if
Set WSHShellRegTest = Nothing
RegKeyExists = Test
End Function
I'm trying to write a script to show every server ipaddress that I put into a text file. I've been looking online and came across the script below. What I need is instead of it showing 'online' I need it show show the actual IP address of each server in the text file. I've been looking for an answer to this for a while now, I've pretty new to vbs so I'm sorry if the script below is wrong or simple. This does open an excel doc which I'm pretty happy with.
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Server Name"
objExcel.Cells(1, 2).Value = "IP Address"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set InputFile = fso.OpenTextFile("MachineList.Txt")
Do While Not (InputFile.atEndOfStream)
HostName = InputFile.ReadLine
Set WshShell = WScript.CreateObject("WScript.Shell")
Ping = WshShell.Run("ping -n 1 " & HostName, 0, True)
objExcel.Cells(intRow, 1).Value = HostName
Select Case Ping
Case 0 objExcel.Cells(intRow, 2).Value = "On Line"
Case 1 objExcel.Cells(intRow, 2).Value = "Off Line"
End Select
intRow = intRow + 1
Loop
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
Edited because my original statement wasn't accurate. You can get the StdOut of a process launched with exec like this:
Option Explicit
Const HOST_FILE = "MachineList.txt"
Dim shl, exe, exl, fso, file
Dim iRow, out, host
Set shl = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FilesystemObject")
Set exl = CreateObject("Excel.Application")
exl.Workbooks.Add
iRow = 2
exl.Cells(1,1).Value = "Server Name"
exl.Cells(1,2).Value = "IP Address"
Set file = fso.OpenTextFile(HOST_FILE)
While not file.AtEndOfStream
host = Trim(file.ReadLine)
exl.Cells(iRow,1).Value = host
Set exe = shl.Exec("%COMSPEC% /c ping -n 1 """ & host & """ | Find ""statistics for""")
If Not exe.StdOut.AtEndOfStream Then
out = exe.StdOut.ReadAll
exl.Cells(iRow,2).Value = getIP(out)
Else
exl.Cells(iRow,2).Value = "Ping Failed"
End If
iRow = iRow + 1
Wend
exl.Visible = True
Set exl = Nothing
Set shl = Nothing
Set fso = Nothing
Set exe = Nothing
WScript.Quit
Function getIP(text)
Dim s
s = Mid(text, Len("Ping statistics for ") + 1)
getIP = Trim(Replace(s,":",""))
End Function
However, the exec function has no WindowStyle option, so you'll see the command processor flash up for every time it runs ping.
You can use the RUN method of the script shell instead and have the ping statement output to a text file. Then read the text file once the ping statement completes and get the info that way.
Set objWSH = CreateObject("WScript.Shell")
objWSH.Run "%COMSPEC% /c ping -n 1 """ & host & """ | Find ""statistics for"" > temp.txt", 0, True
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("temp.txt", 1)
out = Trim(objFile.ReadAll)
If out <> "" Then
' Read ping data
Else
' Ping failed to run
End If
Or something along those line. That should get you on the right track.
I have my script to search by displayname and return the userid, which works fine.
but when I encounter a displayname that has 2 entries in AD i.e.
pavle stojanovic - he is from company 1
pavle stojanovic - he is from company 2
the userid doesnt get displayed because the script doesnt know what to do ?
how do i over come this ? if I get a return of 2 or more I'd like to say in the output hey i found the same name twice etc.. here are the userids and companies for both.
If you want to see the script its below...
strFile = objFSO.GetParentFolderName(Wscript.ScriptFullName) & "\users.xls"
Set objWorkbook = objExcel.Workbooks.Open(strFile)
objWorkbook.Activate
objExcel.Visible = False
intRow = 2 ' starts reading file at line 2
' this part runs a loop through the excel file reading each userid and getting data requested.
' ---------------------------------------------------------------------------------------------
Do Until objExcel.Cells(intRow,1).Value = ""
ExcelRow = objExcel.Cells(intRow, 1)
Call GetOU ' calling sub to search
intRow = intRow + 1
Loop
' This section just formats the excel file to widen the columns
' --------------------------------------------------------------
Set objRange = objExcel.Range("A1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
Set objRange = objExcel.Range("C1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
Set objRange = objExcel.Range("D1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
objExcel.ActiveWorkbook.Save
objExcel.Quit
' Sub to get Details for user
' ----------------------------
Sub GetOU
On Error Resume Next
Set objRootDSE = GetObject("LDAP://RootDSE")
strDomain = objRootDSE.Get("DefaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Size Limit") = 100000
objCommand.Properties("Searchscope") = 2
objCommand.CommandText = "SELECT distinguishedName FROM 'LDAP://" & _
strDomain & _
"' WHERE objectCategory='User' AND DisplayName = '" & _
ExcelRow & "'"
Set objRecordSet = objCommand.Execute
If Not objRecordSet.EOF Then
strDN = objRecordSet.Fields("distinguishedName").Value
' ###########################################################
' ###########################################################
' This is where the script does 'its thing' ...
' gets what you want.
' ------------------------------------------------
Set MyUser = GetObject ("LDAP://" & strDN)
objExcel.Cells(intRow, 3).Value = UCASE(MyUser.SamAccountName)
' ###########################################################
' ###########################################################
Else
Wscript.Echo "User Not Found: " & ExcelRow
End If
Err.Clear
End Sub
If multiple accounts are found, the Record Set will have multiple records and you'll need to loop through it. Your code currently only gets the first item in the Record Set.
Change If Not objRecordSet.EOF Then to Do While Not objRecordSet.EOF
Then
strDN = objRecordSet.Fields("distinguishedName").Value
' ###########################################################
' ###########################################################
Set MyUser = GetObject ("LDAP://" & strDN)
When inserting the users into the spreadsheet, you'll want to control the placement of the cell dynamically so the same cell isn't written over at each loop.
objExcel.Cells(intRow, 3).Value = UCASE(MyUser.SamAccountName)
At the end of processing this user, you'll use this to move to the next object (user) in the Record Set
objRecordSet.MoveNext
Then instead of End If, you'll use Loop
EDIT:
Also, instead of connecting to the object using Set MyUser = GetObject(etc), could you just use "SELECT sAMAccountName FROM... in your query then strsAMAccountName = objRecordSet.Fields("sAMAccountName") to save some memory/time?
Edit2:
I am doing this in my script.
If objRecordSet.RecordCount = 0 Then
'Things to do if not found
Exit Sub 'Then exit before entering loop
End If
Also, if the user isn't found then objRecordSet.EOF will equal True.
Looking how to create a vbscript to pull the maximum number of days a PSO policy has set. It comes back as a value of ... and I do not know how to get the real value that was set.
This is what I have so far:
Option Explicit
Const ADS_UF_PASSWD_CANT_CHANGE = &H40
Const ADS_UF_DONT_EXPIRE_PASSWD = &H10000
Dim strFilePath, objFSO, objFile, adoConnection, adoCommand, objCDOConf
Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset, objMaxPwdAge
Dim strDN, objShell, lngBiasKey, lngBias, blnPwdExpire, strDept, strAdd
Dim objDate, dtmPwdLastSet, lngFlag, k, address, objAdd, objMessage
' Check for required arguments.
If (Wscript.Arguments.Count < 1) Then
Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
& "cscript PwdLastChanged.vbs c:\MyFolder\UserList.txt"
Wscript.Quit(0)
End If
strFilePath = Wscript.Arguments(0)
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Open the file for write access.
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "File " & strFilePath & " cannot be opened"
Wscript.Quit(1)
End If
On Error GoTo 0
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
' Use ADO to search the domain for all users.
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection
' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
' Filter to retrieve all user objects.
strFilter = "(&(objectClass=msDS-PasswordSettings))"
' Filter to retrieve all computer objects.
strQuery = "<LDAP://CN=PSO-Information Systems,CN=Password Settings Container,CN=System,DC=yrmc,DC=org>;" _
& ";cn,msDS-LockoutDuration,msDS-MaximumPasswordAge,msDS-
PasswordSettingsPrecedence;subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
objFile.WriteLine adoRecordset.Fields("cn").Value
adoRecordset.MoveNext
Loop
adoRecordset.Close
I can get a value for cn and even msDS-PasswordSettingsPrecedence but not for msDS-MaximumPasswordAge. Any help would be appreciated.
This is at best a partial answer but I did some searching and I believe you will need one or more of the following:
DSGet/DSQuery
LDIFDE to manage PSO's.
Quest's "Free PowerShell Commands for Active Directory"
Using Quest's free tools, you might find this link handy
Put square brackets around our Active Directory attribute name:
See the blog post "How can I retrieve the value of an active directory attribute that has a hyphen in its name" for more.
you have to find UsersPSO location in your AD like that
domainLookupString = ""CN=UsersPSO,CN=Password Settings Container,CN=System,DC=COMPAY,DC=ORG";
then run the ldap query
ldapFilterString = "(&(objectClass=msDS-PasswordSettings))";
at the end, get the ldap attribute with the Maximum Password Age of the current PSO policy
"msDS-MaximumPasswordAge"
I'm trying to write a vb script that prompts a user for a schema attribute which I'll call bID and checks that the person with that bID is in active directory. I really have no idea how to get started, there are plenty of examples on how to query active directory users but I havent found a good one regarding checking against specific attributes. Any help/suggestions are greatly appreciated!
UPDATE:
ok heres my code so far, doesnt error out and returns 0, but I dont get a wscript.echo of the distinguished name for some reason. I included a few debugging wscript.echo's and it seems to never get into the while loop. Any ideas?
Option Explicit
GetUsers "CN=users,DC=example,DC=example,DC=example,DC=com","123456"
Function GetUsers(domainNc, ID)
Dim cnxn
Set cnxn = WScript.CreateObject("ADODB.Connection")
cnxn.Provider = "ADsDSOObject"
cnxn.Open "Active Directory Provider"
Dim cmd
Set cmd = WScript.CreateObject("ADODB.Command")
cmd.ActiveConnection = cnxn
cmd.CommandText = "<LDAP://" & domainNc & ">;(&(objectCategory=user)(objectClass=user) (employeeNumber=" & ID & "));distinguishedName;subtree"
WScript.Echo cmd.CommandText
cmd.Properties("Page Size") = 100
cmd.Properties("Timeout") = 30
cmd.Properties("Cache Results") = False
WScript.Echo "setting cmd.properties"
Dim rs
Set rs = cmd.Execute
WScript.Echo "rs object set"
While Not rs.eof
On Error Resume Next
WScript.Echo "while loop start"
Wscript.Echo rs.fields("distinguishedName".Value)
rs.MoveNext
If (Err.Number <> 0) Then
WScript.Echo vbCrLf& "Error # "& CStr(Err.Number)& " "& Err.Description
Else
On Error GoTo 0
End If
Wend
WScript.Echo "while loop end"
rs.close
WScript.Echo "rs object closed"
cnxn.Close
Set rs = Nothing
Set cmd = Nothing
Set cnxn = Nothing
End Function
Here's some vbscript that will find all users with bID=FooVal and write their DN out
Function GetUsers(domainNc, bIdVal)
Dim cnxn
Set cnxn = WScript.CreateObject("ADODB.Connection")
cnxn.Provider = "ADsDSOObject"
cnxn.Open "Active Directory Provider"
Dim cmd
Set cmd = WScript.CreateObject("ADODB.Command")
cmd.ActiveConnection = cnxn
cmd.CommandText = "<LDAP://" & domainNc & ">;(&(objectCass=user)(objectCategory=person)(bid=" & bidVal & "));distinguishedName;subtree"
cmd.Properties("Page Size") = 100
cmd.Properties("Timeout") = 30
cmd.Properties("Cache Results") = False
Dim rs
Set rs = cmd.Execute
While Not rs.eof
Wscript.Echo rs.fields("distinguishedName").Value
rs.MoveNext
Wend
rs.close
cnxn.Close
Set rs = Nothing
Set cmd = Nothing
Set cnxn = Nothing
End Function