• 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.