• 0

[VBS] Alternative to InputBox


Question

1 answer to this question

Recommended Posts

  • 0
  VWW said:
Hi guys,

I code for a system that uses VBScript exclusively. I need to popup a sort of Input Box but with multiple text fields. Also need it to have specially named buttons instead of just the standard "OK". Is there any function in VBScript to allow this sort of thing?

No there no way of doing that with vbs. You could try a hta with your vbs script.

Here is a example that I made up for you to get the an idea of what you

can do with a hta.

Save As Demo.hta

  Quote
  <HEAD><HTML>
  <HTA:APPLICATION ID='Demo Hta'
   SingleInstance='Yes'   
   SysMenu='Yes'
   MaximizeButton='No'	
   MinimizeButton='Yes'
   SCROLLFLAT ='No'	   
   Border='Thin'
   BORDERSTYLE ='complex' 
   INNERBORDER ='Yes'
   Caption='Yes'		  
   WindowState='Normal'
   APPLICATIONNAME='Demo Hta'
   Icon='%Windir%\explorer.exe'>lt;TITLE>Demo Hta</TITLE>
 <STYLE Type='text/css'>
  Body
   {
	Font-Size:9.25pt;
	Font-Weight:Bold;
	Font-Family:segoeui,helvetica,verdana,arial,Poor Richard;
	Color:#000063;
	BackGround-Color:Transparent;
	Filter:progid:DXImageTransform.Microsoft.Gradient
	(StartColorStr='#fdf7f1',endColorStr='#a6a29e');
	Margin-Top:5;
	Margin-Bottom:5;
	Margin-Left:4;
	Margin-Right:4;
	Padding-Top:5;
	Padding-Bottom:5;
	Padding-Left:4;
	Padding-Right:4;
	Text-Align:Center;
	Vertical-Align:Top;
	Border-Top:2px Solid #cbc7c3;
	Border-Bottom:3px Solid #a6a29e;
	Border-Left:2px Solid #bcb8b4;
	Border-Right:3px Solid #b2aeaa;
   }
  Select.Bx1
   {
	Font-Size:8.05pt;
	Font-Weight:Bold;
	Font-Family:segoeui,helvetica,verdana,arial,Poor Richard;
   }
  .B1
   {
	Width:105px;
	Color:#00005a;
	Font-Size:8.05pt;
	Font-Weight:Bold;
	Font-Family:segoeui,helvetica,verdana,arial,Poor Richard;
   }
  .B2
   {
	Width:95px;
	Color:#00005a;
	Font-Size:8.05pt;
	Font-Weight:Bold;
	Font-Family:segoeui,helvetica,verdana,arial,Poor Richard;
	Filter:progid:DXImageTransform.Microsoft.Gradient
	(StartColorStr='#99CCFF',endColorStr='#224466');
	Margin-Top:1;
	Margin-Bottom:1;
	Margin-Left:1;
	Margin-Right:1;
	Padding-Top:0;
	Padding-Bottom:0;
	Padding-Left:0;
	Padding-Right:0;
	Border-Top:0px Transparent;
	Border-Bottom:0px Transparent;
	Border-Left:0px Transparent;
	Border-Right:0px Transparent;
   }
  .ListBox
   {
	Font-Size:8.05pt;
	Font-Weight:Bold;
	Color:131313;
	Font-Family:segoeui,helvetica,verdana,arial;
	Padding-Left:5;
   }
 </STYLE>
 <script Language="VBScript">
  window.resizeTo 443,303
  window.moveTo 125,125
  Dim Fso	:Set Fso = CreateObject("Scripting.FileSystemObject")
  Dim IDate  :Set IDate = CreateObject("WbemScripting.SWbemDateTime")
  Dim Wmi	:Set Wmi =GetObject("winmgmts:\\.\root\CIMV2")
  Dim Arg1, Arg2, Arg3,  CT, StrD
'/--> Listbox Fill Contents
   Function Window_onLoad()
	For Each StrD In Fso.Drives
	 If StrD.IsReady Then
	  Arg3 = Arg3 & vbCrlf & _
	   "Letter" & vbtab & StrD & vbCrlf &_
	   "Name  " & vbtab & StrD.VolumeName & vbCrlf &_
	   "Size  " & vbtab & FormatNumber(StrD.TotalSize/1073741824,2) & vbCrlf &_
	   "Free  " & vbtab & FormatNumber(StrD.FreeSpace/1073741824,2) & vbCrlf  
	  CT = CT + 1
	  Set objOption = Document.createElement("OPTION")
		objOption.Text = StrD
		objOption.Value = StrD
	   If CT Mod 2 Then
		objOption.style.backgroundcolor = "#D9D9D9" 
		objOption.style.color = "#3A3A3A"
	   Else 
		objOption.style.backgroundcolor = "#E9E9E9" 
		objOption.style.color = "#235779" 
	   End If
	  Drives.Add(objOption)
	 End If
	Next 
   Exit Function
   End Function
'/--> Listbox Get Drive Selected
   Function ShowDriveInfo()
	For Each StrD In Fso.Drives
	 If InStr(Drives.value,StrD) Then
	  TextArea1.value = _
	   "Letter " & vbtab & Drives.value & vbCrlf &_
	   "Name   " & vbtab & StrD.VolumeName & vbCrlf &_
	   "Size   " & vbtab & FormatNumber(StrD.TotalSize/1073741824,2) & vbCrlf &_
	   "Free   " & vbtab & FormatNumber(StrD.FreeSpace/1073741824,2)
	  End If
	Next 
	Exit Function
   End Function
'/--> Wmi Function
   Function Win32_OperatingSystem()
	For Each Obj1 in Wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem",,48)
	 IDate.Value = Obj1.InstallDate
	 Arg1 = "Install" & vbtab & IDate.GetVarDate & vbCrlf
	 IDate.Value = Obj1.LastBootUpTime
	 Arg2 = "Uptime " & vbtab & DateDiff("h", IDate.GetVarDate, Now) & " Hours" & vbCrlf
	Next
	Exit Function
   End Function
'/--> System Installed Date
   Function InstalledDate()
	Win32_OperatingSystem()
	TextArea1.value = Arg1
	Exit Function
   End Function
'/--> System Uptime
   Function SystemUptime()
	Win32_OperatingSystem()
	TextArea1.value =Arg2
	Exit Function
   End Function
'/--> Show The All Text Box Contents
   Function Selection()
	 If TextArea1.value = "" Then
	   window.alert( _
	   "There was no Text selected in the Listbox. " & vbCrlf &_
	   "There must be some text in the Listbox.")
	 Else
	  window.alert(vbtab & "Listbox 1 Value" & vbCrlf & TextArea1.value)
	  TextArea1.value = ""
	 End If
	Exit Function
   End Function
'/--> Shows All Buttons, Drive ListBox In The Text Area
   Function ShowAllInfo()
	Win32_OperatingSystem()
	TextArea1.value = Arg3 & vbCrlf & Arg1 & vbCrlf & Arg2 
	Exit Function
   End Function
'/--> Shows Selected Text Only
	Function ShowSelection()
	 Set objSelection = Document.Selection.CreateRange()
	  If objSelection.text = "" Then 
	   window.alert("Nothingcted")
	  Else
	   window.alert(objSelection.text)
	  End If
	Exit Function
   End Function
  </SCRIPT>
 </HEAD><BODY Scroll='No'>
<!-- Text 1-->
 <DIV ID='Txt1' STYLE='Position:Absolute;Top:12;Left:42;'>
  Basic Drive Information</Div>
<!-- List Box -->
 <select size='1.25' name='Drives' Class='Bx1' 
  style='Position:Absolute;Top:12;Left:252;Width:105px;' 
  OnChange='ShowDriveInfo()'>
  <OPTION Value='Select A Drive' Style='BackGround:#E9E9E9;Color:#235779;'>
   Select A Drive</OPTION>
 </select>
<!-- Text 2-->
 <DIV ID='Txt2' STYLE='Position:Absolute;Top:36;Left:42;'>
  System Installed Date</DIV>
<!-- Button 1-->
 <INPUT Type='BUTTON'ID='Btn01' Class='B1'
  Style='Position:Absolute;top:36;Left:252;'
  OnClick='InstalledDate()' Value='Installed Date'>
<!-- Text 3-->
 <DIV ID='Txt3' STYLE='Position:Absolute;Top:60;Left:42;'>
  System Up Time</DIV>
<!-- Button 2-->
 <INPUT Type='BUTTON' ID='Btn02' Class='B1'
  Style='Position:Absolute;top:60;Left:252;'
  OnClick='SystemUptime()'Value='System Uptime'>
<!-- Text 3-->
 <DIV ID='Txt3' STYLE='Position:Absolute;Top:84;Left:42;'>
  Type Some Text In The Listbox</DIV>
<!-- Button 3-->
 <INPUT Type='BUTTON' ID='Btn03' Class='B1'
  Style='Position:Absolute;top:84;Left:252;'
  OnClick='Selection()'Value='Show ListBox'>
<!-- Text Area -->
 <TEXTAREA Name="TextArea1" Class='ListBox'
  Style='Position:Absolute;top:109;Left:23;'
  Rows='7' Cols='72'></TEXTAREA>
<!-- Button 4-->
 <INPUT Type='BUTTON' ID='Btn04' Class='B2'
  Style='Position:Absolute;Bottom:12;Left:20;'
  OnClick='ShowAllInfo()' Value='Show All Info'>
<!-- Button 5-->
 <INPUT Type='BUTTON' ID='Btn05' Class='B2'
  Style='Position:Absolute;Bottom:12;Left:117;'
  OnClick='ShowSelection()' Value='Show Selected'>  
<!-- Button 6-->
 <INPUT Type='BUTTON' ID='Btn06' Class='B2'
  Style='Position:Absolute;Bottom:12;Right:117;'
  OnClick='TextArea1.value =""' Value='Clear'>
<!-- Button 7-->
 <INPUT Type='BUTTON' ID='Btn07' Class='B2' 
  Style='Position:Absolute;Bottom:12;Right:20;'
  OnClick='window.close()' Value='Close'>
 </BODY></HTML>
This topic is now closed to further replies.
  • Recently Browsing   0 members

    • No registered users viewing this page.
  • Posts

    • Hello, I have had good results with Corsair, Crucial, Kioxia (formerly Toshiba), Nextorage, OWC, Patriot, Sabrent, Samsung, SanDisk (formerly Western Digital), Solidigm (formerly Intel) and Team Group SSDs.  Be sure to look at warranty length, and whether the drive uses TLC or QLC memory.  The former tends to be faster and lasts longer, but QLC is maturing and is usually less expensive.   Regards, Aryeh Goretsky  
    • Today's Windows 11 Preview Update (KB5062660) (26100.4770) was a pain in the royal butt. 1. It shut down one of my W11 devices during the update. I had to do a cold boot. The update then finished. 2. It rolled back the network adapter to April on both of my W11 devices. I updated the adapter to the June release, which promptly broke my internet connection. 3. I had to reboot my router and then restart both devices to get my internet connection back. There was one good thing about today's update. My utility software was finally able to update Notepad after several failed attempts before today's update. Anyway, all now appears GTG. Thank goodness.
    • Windows 11 receives a handful of new AI features by Taras Buria Microsoft is supercharging its operating system with a handful of new AI-powered features. Those with compatible computers (mostly Copilot+ PCs) can download a new Windows 11 update that introduces new AI experiences. One of the biggest updates is the Settings app, which now features agentic search to understand complaints about your computer. You can click the search box and tell Windows what is wrong. For example, "my mouse cursor is too small." Windows will then process your request and suggest taking action on your behalf. You can also ask for specific changes like, "change my screen resolution to 1920x1080." The Settings agent is now available for users with Snapdragon-powered Copilot+ PCs. It is coming soon to Intel and AMD-based Copilot+ PCs. Click to Do has received several new actions: Practice in Reading Coach helps improve reading skills by giving feedback and offering suggestions on how to improve. Read with Immersive Reader displays text in a distraction-free environment with the ability to adjust text size, spacing, font and background theme, have text read aloud, break words into syllables and highlight parts of speech. The picture dictionary shows images for unfamiliar words. Draft with Copilot in Word turns a portion of text into a full draft. Actions in Microsoft Teams let you click an email to send a message or schedule a meeting. More AI is available in the Photos app. After a couple of months in testing, the Relight feature is now rolling out, allowing users to adjust lights with AI. You can place three light sources or use built-in presets to edit your photos. Like with the Settings app, this feature is currently available to Snapdragon-powered devices only. Paint now has a sticker generator and a new object select tool that uses AI to isolate the object and edit individual elements, even if they are part of one layer. Snipping Tool has received the "Perfect Screenshot" feature to help you select parts of the screen for a proper cropped screenshot, and a new Color Picker to read colors on the screen in different formats (available on all PCs, not only Copilot+ PCs). Finally, the Copilot app now supports Highlights, a new feature that enables Copilot to show you how to perform specific tasks in the current app on the entire desktop. Today's updates are not just about AI and sticker generation. Microsoft is also improving the performance and security of its system with a redesigned blue screen of death and the new Quick Machine Recovery system. You can read more about those changes here. If you want to get all these updates today, download the latest non-security update for Windows 11 version 24H2, which is now available.
  • Recent Achievements

    • Week One Done
      SmileWorks Dental earned a badge
      Week One Done
    • Community Regular
      vZeroG went up a rank
      Community Regular
    • Collaborator
      Snake Doc earned a badge
      Collaborator
    • Week One Done
      Snake Doc earned a badge
      Week One Done
    • One Month Later
      Johnny Mrkvička earned a badge
      One Month Later
  • Popular Contributors

    1. 1
      +primortal
      585
    2. 2
      Michael Scrip
      199
    3. 3
      ATLien_0
      194
    4. 4
      +FloatingFatMan
      129
    5. 5
      Xenon
      122
  • Tell a friend

    Love Neowin? Tell a friend!