• 0

[VBS] Alternative to InputBox

Asked by VWW,

 Share

Question

1 answer to this question

Recommended Posts

  • 0
Community Regular

jake1eye

Posted
Posted
  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.
 Share
Go to question listing

  • Recently Browsing   0 members

    • No registered users viewing this page.

  • Posts

    • Windows 11's growth slowed down in May 2025

      By ZipZapRap · Posted

      This site is just old men ranting at clouds. Neowin knows its audience.
    • Wine 10.9 released bringing EGL support for all graphic drivers and several bug fixes

      By ThaCrip · Posted

      That's nice and all. but I generally just stick with Lutris paired with 'ge-proton' (which gets updated fairly often (June 1st was last update) as the 'ge-proton' entry in Lutris uses stuff here... https://github.com/GloriousEggroll/proton-ge-custom/releases ) and the like to play my games. p.s. if a person wants to stick with a specific version from that link you can download a specific version and extract it to "~/.local/share/lutris/runners/proton/". then select it in Lutris options on game shortcut is the basic idea. because by default the standard 'ge-proton' entry will automatically get updated which can occasionally cause issues even though it's usually fine. but manually setting it on a specific version will prevent the standard updates on 'ge-proton' from messing with it on a particular game you may have issues with if that gets updated etc. one good example of the 'ge-proton' updates messing with a game in particular is the offline version of RDR2 1491.50 as I setup a specific version there and after removing the 'vulkan-1 (native)' entry in 'Wine configuration' on 'RDR2.exe' entry (if you don't remove this the game won't start up) is when the 'ge-proton' updates, it will restore that 'vulkan-1 (native)' entry and prevent the game from working. you can always remove the entry on the RDR2.exe in Wine configuration specifically after updates, but doing that everytime that updates will get old quickly. hence, keeping it on a specific GE Proton version stops me from having to mess with it as then you just adjust it once and you are done with it. also, when using 'bat' files to start a game (like Hitman: WoA for example using Peacock etc) I had some issues with GE Proton after '9-27', so I got the game locked to '9-27' (April 1st) instead of the newer ones (10-1 etc).
    • Sam Altman says AI could soon help with discovering new knowledge

      By Hamid Ganji · Posted

      Sam Altman says AI could soon help with discovering new knowledge by Hamid Ganji OpenAI is currently at the forefront of developing powerful AI models, while its ChatGPT product is rewriting our traditional way of looking for new information. The company's CEO, Sam Altman, now says AI could even help humans discover new knowledge. He also described AI agents as junior employees. Speaking at the Snowflake Summit 2025, Altman boasted that AI agents can act like junior employees, saying, "You hear people that talk about their job now is to assign work to a bunch of agents, look at the quality, figure out how it fits together, give feedback, and it sounds a lot like how they work with a team of still relatively junior employees." OpenAI CEO also added AI agents could help humans discover new knowledge in "limited cases" or "figure out solutions to business problems that are kind of very non-trivial." While the use of AI for scientific discovery is still viewed with skepticism, the technology has proven its capabilities for new discoveries in several cases. For example, the Microsoft Discovery platform, designed for accelerating scientific research and development by AI agents, was recently able to discover a new chemical for cooling data centers in just 200 hours, a process that normally takes years to research and complete by humans. AI firms are also shifting their focus toward developing AI agents capable of performing various tasks. OpenAI recently unveiled Codex, which contains AI agents for helping programmers write and debug code. According to Altman, OpenAI engineers are already using Codex. As AI agents become more intelligent, more employees should be concerned about losing their jobs. Companies have already started replacing some specific roles with AI. For example, Duolingo has replaced its contract workers with AI, while Shopify managers need to provide reasons why AI cannot handle a job before seeking approval for new hires. Via: Business Insider
    • Asus joins Microsoft, AMD, Dell, urges you to "prepare for mandatory Windows 11 upgrade"

      By Werct · Posted

      I personally don't think there will be many survivors past the ESU date, but I can be wrong🙂 >Firefox still supports Windows 7 (until the end of August), which will be just over 16 years since release. Well, yes, but it's an ESR version, which kind of doesn't count as fresh for me. So the last mainline version of Firefox with W7 support was 115, which was released in 2023, exactly around the W7 ESU expiration.
    • WIFI7 Router Recommendation

      By gowtham07 · Posted

      Hey, sounds like it’s definitely time for an upgrade. The R7000 had an excellent run! If you want lots of wired ports and future-proofing, the Asus RT-BE88U is a killer choice. It’s got 2x 10GbE, 4x 2.5GbE, and handles WiFi 7 like a champ. Super fast, stable, and the ASUS firmware is solid with loads of features. The TP-Link BE900 is also great, sleek design, strong performance, and a combo 10G port (RJ45/SFP+), but it has fewer wired ports than the Asus. Netgear RS700S is powerful too, but the firmware isn’t as flexible and only has one 10G port. It might feel familiar from your R7000. If wired ports are a big deal, maybe adding a 2.5G or 10G switch later gives you more options. My vote is RT-BE88U all the way.

  • Recent Achievements

    • First Post
      nothin earned a badge
      First Post
    • Enthusiast
      Epaminombas went up a rank
      Enthusiast
    • Posting Machine
      Fiza Ali earned a badge
      Posting Machine
    • One Year In
      WaynesWorld earned a badge
      One Year In
    • First Post
      chriskinney317 earned a badge
      First Post

  • Popular Contributors

    1. 1
      +primortal
      186
    2. 2
      snowy owl
      130
    3. 3
      ATLien_0
      130
    4. 4
      Xenon
      120
    5. 5
      +FloatingFatMan
      96
    Show More

  • Tell a friend

    Love Neowin? Tell a friend!