Solved

Need urget help with this HTA :)

Posted on 2014-04-04
8
604 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
  • 2
  • 2
  • 2
  • +2
8 Comments
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
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
Comment Utility
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 45

Expert Comment

by:aikimark
Comment Utility
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
 
LVL 28

Expert Comment

by:sammySeltzer
Comment Utility
when you say runtime, what do you mean?
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 

Author Comment

by:PleaseAnswer
Comment Utility
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
Comment Utility
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
Comment Utility
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 28

Accepted Solution

by:
sammySeltzer earned 500 total points
Comment Utility
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

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

This article will show, step by step, how to integrate R code into a R Sweave document
This article discusses how to create an extensible mechanism for linked drop downs.
In this tutorial viewers will learn how to style a corner ribbon overlay for an image using CSS Create a new class by typing ".Ribbon":  Define the class' "display:" as "inline-block": Define its "position:" as "relative": Define its "overflow:" as …
This tutorial will teach you the core code needed to finalize the addition of a watermark to your image. The viewer will use a small PHP class to learn and create a watermark.

763 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

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now