Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

Need urget help with this HTA :)

Posted on 2014-04-04
8
Medium Priority
?
615 Views
Last Modified: 2014-04-05
Hi,
Im a newbe to scripting so am getting frustrated with this script,
it works , pretty much, but the animated gif does not start with the script, it only appears only at the end.
Also, i need to find a way to display the script running so users can actually see what its doing ,I want them to be able to see the actual code, line by line at the bottom of the HTA window.
Thanks!

Code below:
<html>
<HEAD>
<title>Processing</title>
<HTA:APPLICATION
	BORDER = none
	APPLICATION = yes
	WINDOWSTATE = normal
	INNERBORDER = no
	SHOWINTASKBAR = no
	SCROLL = no
	APPLICATIONNAME = "Processing"
	NAVIGABLE = yes>
</HEAD>
</BODY>
<body background = "pics\processing.gif">
<script LANGUAGE="VBScript">
'--------------------------------------------------------------
'Globals
'--------------------------------------------------------------
Set objWMIService = GetObject ("winmgmts:\\.\root\cimv2")
'--------------------------------------------------------------
'Window_onLoad (Resize and center window)
'--------------------------------------------------------------
Sub Window_onLoad
	strComputer = "."
	Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
	For Each objItem in colItems
		intHorizontal = objItem.ScreenWidth
		intVertical = objItem.ScreenHeight
	Next
	intLeft = (intHorizontal - 800) / 2
	intTop = (intVertical - 400) / 2
	window.resizeTo 800,400
	window.moveTo intLeft, intTop
End Sub
Dim FSO, oShell, oNetwork, objSysInfo, sUserDN, objUser
Dim sDepartment, sUserName, sComputerName, sDomain, sDisplayName, sGroups, sDN
Dim sStatus, intSeconds, sDesktop, sScriptDir, iTimerID

'Configure for your domain. See "MainScript" Sub for drive mappings.
sDN = "kalura.com"

Sub Window_onLoad
	On Error Resume Next
	
	Set FSO = CreateObject("Scripting.FileSystemObject")
	Set oShell = CreateObject("WScript.Shell")
	Set oNetwork = CreateObject("WScript.Network")
     
    'Get User's information.
    UserInfo
	
    'User's Desktop for deploying shortcuts.
    sDesktop = oShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\"
    
    'Populate Window with user info.
	document.title = sDomain & " Logon Script - " & sDepartment 'Changes title bar to reflect domain and department the current user is logging onto.
	DisplayName.InnerHTML = sDisplayName
	UserName.InnerHTML = sUserName
	ComputerName.InnerHTML = sComputerName
	
	
	'Move to top left of screen.
	Me.MoveTo 10,10
	
	'Run Main Logon Script
	MainScript
	
	'Countdown timer before closing. Set time in seconds.
	intSeconds = 5
	iTimerID = window.setInterval("Count", 1000)
End Sub

Sub Default_Buttons
    If Window.Event.KeyCode = 13 Then
    End If
End Sub

Sub UserInfo
	On Error Resume Next
	
	Dim arrDept
	
	Set objSysInfo = CreateObject("ADSystemInfo")
	
	sUserDN = objSysInfo.UserName
	Set objUser = GetObject("LDAP://" & sDN & "/" & sUserDN)
	
	'Find User and Computer info.
	sUserName = oNetwork.UserName
	sComputerName = UCase((oNetwork.ComputerName))
	sDomain = UCase((oNetwork.UserDomain))
	sDisplayName = Trim(objUser.DisplayName)
	
	'Find Group Memberships
	sGroups = GetGroups(sUserDN)
	
	'Get department name from DN. (Assuming users OU in AD is setup as Domain->Department->Users->UserObject)
	arrDept = Split(sUserDN, ",")
	sDepartment = Mid(arrDept(2), 4) 'Set number in array where department OU name is found. 
									'ie: CN=UserName,OU=Users,OU=Department,DC=your,DC=domain,DC=com; arrDept(2) = OU=Department
	
	'If Full Name isn't found, set as username.
	If sDisplayName = "" Then
		sDisplayName = sUserName
	End If
	
	Err.Clear
	
	Set objSysInfo = Nothing
	Set objUser = Nothing
End Sub

Sub MainScript

	On Error Resume Next
	
	' *********************************
	' ***	   Common Mappings  	***
	' *********************************
	
	If InStr(UCase(sGroups),"DOMAIN USERS") <> 0 Then 'Domain Users get H and P mappings.
		If FSO.DriveExists("H:") Then
			ShowStat("H: Already Exists")
		Else
			If Not MapDrive("H:", "\\server\share\" & sDepartment) Then 'This is an example of mapping to a Department common share.
		 		If Not MapDrive("H:", "\\0.0.0.0\share\" & sDepartment) Then 'Try mapping by ip if name cannot be resolved.
		    		ShowStat("H: for Common - Failed")
		    	Else
		    		ShowStat("H: for Common - Mapped")
		   		End If
		   	Else
		   		ShowStat("H: for Common - Mapped")
		  	End If
		End If
		
		If FSO.DriveExists("P:") Then
			ShowStat("P: Already Exists")
		Else
			If Not MapDrive("P:", "\\server\Public") Then
				If Not MapDrive("P:", "\\0.0.0.0\Public") Then
		   			ShowStat("P: for Public - Failed")
		   		Else
		   			ShowStat("P: for Public - Mapped")
		   		End If
		   	Else
		   		ShowStat("P: for Public - Mapped")
		  	End If
		End If
	End If
	
	' *********************************
	' ***	 Department Mappings	***
	' *********************************
	
	' ************* Sales *************
	
	If InStr(UCase(sGroups),"SALES") <> 0 Then
		If FSO.DriveExists("S:") Then
			ShowStat("S: Already Exists")
		Else 
			If Not MapDrive("S:", "\\server\sales") Then
	   			If Not MapDrive("S:", "\\0.0.0.0\sales") Then
		   			ShowStat("S: for Sales - Failed")
		   		Else
		   			ShowStat("S: for Sales - Mapped")
		   		End If
		   	Else
		   		ShowStat("S: for Sales - Mapped")
		  	End If
	 	End If
	End If
	
	' *********************************
	' ***	End of Drive Mappings	***
	' *********************************
	
	'Copy shortcut to Desktop.
	FSO.CopyFile "\\server\share\Shortcut.lnk", sDesktop, False
End Sub

'-------------------- Functions --------------------------

Sub CloseSelf
	window.close
End Sub

Sub Hold
	document.all.lock.checked = True
	window.clearInterval(iTimerID)
	countdown.Style.Display = "none"
	btn_close.Style.Display = "inline"
End Sub

Sub Count
	'Bring script to front.
	window.focus()
	
	If intSeconds <> 0 Then
		countdown.InnerHTML = intSeconds
		intSeconds = intSeconds - 1
	Else
		If Not document.all.lock.checked Then
			CloseSelf
		End If
	End If
End Sub

Function GetGroups(sUDN)
	On Error Resume Next
	
	'Function to return user's Group Memberships
	Set objUser2 = GetObject("LDAP://" & sDN & "/" & sUDN)
	
	If objUser2.primaryGroupID = 513 Then
		sList = sList & "Domain Users" & VbCrLf
	Else 
		If objUser2.primaryGroupID = 512 Then
			sList = sList & "Domain Admins" & VbCrLf
		End If
	End If

	oMemberOf = objUser2.GetEx("memberOf")

	For Each oGroup In oMemberOf
		oGroup = Mid(oGroup, 4, 330)
		arrGroup = Split(oGroup, ",")
		sList = sList & arrGroup(0) & VbCrLf
	Next 
	
	Set objUser2 = Nothing
	
	GetGroups = sList
End Function

Function MapDrive(strDrive, strShare)
  On Error Resume Next
  Err.Clear
  If FSO.DriveExists(strDrive) Then
    Set objDrive = FSO.GetDrive(strDrive)
    If Err.Number <> 0 Then
      Err.Clear
      MapDrive = False
      Exit Function
    End If
    If CBool(objDrive.DriveType = 3) Then
      oNetwork.RemoveNetworkDrive strDrive, True, True
    Else
      MapDrive = False
      Exit Function
    End If
    Set objDrive = Nothing
  End If
  oNetwork.MapNetworkDrive strDrive, strShare
  If Err.Number = 0 Then
    MapDrive = True
  Else
    Err.Clear
    MapDrive = False
  End If
  On Error GoTo 0
End Function

Function ShowStat(sMessage)
	sStatus = sMessage & VbCrLf & sStatus
	document.all.status.InnerText = sStatus
End Function
</SCRIPT>
</HTML>

Open in new window

0
Comment
Question by:PleaseAnswer
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
  • 2
  • +2
8 Comments
 
LVL 46

Expert Comment

by:aikimark
ID: 39980044
I think the problem lies with your body tag.  You have an ending tag and no beginning tag:
</HEAD>
</BODY>

Open in new window

0
 

Author Comment

by:PleaseAnswer
ID: 39980063
added them at the end but the script sill loads first , and a few seconds later loads te GIF.
And how wold i be able to show the 'runtime' of the script on the  foreground of the HTA, while it is running?
0
 
LVL 46

Expert Comment

by:aikimark
ID: 39980073
added them at the end
added what at the end?

I don't understand your requirement to
show the 'runtime' of the script on the  foreground of the HTA
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 29

Expert Comment

by:sammySeltzer
ID: 39980099
when you say runtime, what do you mean?
0
 

Author Comment

by:PleaseAnswer
ID: 39980216
i mean that the users will be able to see the script tun down line by line 'matrix screensaver stile' so they will see the code rune line by line.
0
 
LVL 75

Expert Comment

by:Michel Plungjan
ID: 39980236
I do not do VB, but try

<body>


and have

Sub Window_onLoad
      strComputer = "."
        document.body.style.backgroundImage = "url(pics/processing.gif)"
0
 
LVL 53

Expert Comment

by:COBOLdinosaur
ID: 39980237
The browser needs to load the complete script before it can execute it.  to display it line by line, you would need to put a write to the screen between each line of the script.  Even if you could manage to stream the script text, you would never get the timing correct.

I very much doubt you are going to attain your goal.  the script has to run inside of the browser application so to do what you want seamlessly you would need to write a dedicated custom browser that allows real time display of console messages, echoing the the running script.

With IE closed source, and other browsers not supporting HTA or vbscript, I think you are not going to find a solution without substantial investment.

Cd&
0
 
LVL 29

Accepted Solution

by:
sammySeltzer earned 2000 total points
ID: 39980304
If you meant displaying a Loading... type message, then I will try this:

//css

<style type="text/css">

    #load{
       visibility: hidden;
       width: 300px;
       text-align: center;
       color: white;
       background-color: red;
    }

</style>

On your click button, do this:

Sub GoButton_onclick()        
    load.style.visibility="visible"
    window.setTimeout "searchdata(txtsrch.Value)", 100, "VBScript"  
End Sub

Open in new window


In the vbscript sub example above, user enters search term and clicks the GoButton button.

Modify for your needs.

Finally, on your markup, you get:

<center><div id="load">Search in Progress...Please Wait</div></center>

Open in new window


Please tell me if this is not what you meant.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
With User Account Control (UAC) enabled in Windows 7, one needs to open an elevated Command Prompt in order to run scripts under administrative privileges. Although the elevated Command Prompt accomplishes the task, the question How to run as script…
The viewer will learn how to create a basic form using some HTML5 and PHP for later processing. Set up your basic HTML file. Open your form tag and set the method and action attributes.: (CODE) Set up your first few inputs one for the name and …
Learn how to create flexible layouts using relative units in CSS.  New relative units added in CSS3 include vw(viewports width), vh(viewports height), vmin(minimum of viewports height and width), and vmax (maximum of viewports height and width).
Suggested Courses

618 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question