Display Timed Image

eGeeked · Dec 30, 2011

My goal is to display an image for X seconds before application runs. Basically like a splash screen that simply shows the logo and some brief info about the program before the input box comes up.

I have included the code below so you can see how it acts. Any help on this is greatly appreciated.

<code>
on error resume next

strComputer=inputbox("Enter Device Name: ", "Login Script Generator V1.1")
strUser=inputbox("Enter Username: ", "Login Script Generator V1.1")

Const HKEY_USERS = &H80000003

strMsg = ""

Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objWbem = GetObject("winmgmts:")
Set objRegistry = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")

if err.number = "-2147217375" then
else

Select Case err.number
Case 462
strWarn=MsgBox("Unable to connect to " & strComputer & ".", 48, "Login Script Generator V1.1 - System Information Checker")
Case -2147217394
strWarn=MsgBox(strComputer & " is not a valid name.", 48, "Login Script Generator V1.1 - System Information Checker")
Case 70
strWarn=MsgBox(strComputer & " has denied access.", 48, "Login Script Generator V1.1 - System Information Checker")
Case Else

Set colProc = objWmiService.ExecQuery("Select Name from Win32_Process" & " Where Name='explorer.exe'")

strMsg = strMsg & "'***** User: " & strUser & VbCrLf
strMsg = strMsg & "'***** Device: " & strComputer & VbCrLf & VbCrLf

lngRtn = objRegistry.EnumKey(HKEY_USERS, "", arrRegKeys)

For Each strKey In arrRegKeys
If UCase(strKey) = ".DEFAULT" Or UCase(Right(strKey, 8)) = "_CLASSES" Then
Else
Set objSID = objWbem.Get("Win32_SID.SID='" & strKey & "'")
If objSID.accountname = strUser Then
regpath2enumerate = strkey & "\Network"
objRegistry.enumkey hkey_users, regpath2enumerate, arrkeynames

If Not (IsEmpty(arrkeynames)) Then
For Each subkey In arrkeynames
regpath = strkey & "\Network\" & subkey
regentry = "RemotePath"
objRegistry.getstringvalue hkey_users, regpath, regentry, dapath
strMsg = strMsg & "net use " & subkey & ": """ & dapath & """ /yes" & VbCrLf
Next
End If
End If
End If
Next
strDirectory=inputbox("(OPTIONAL) Enter Save File Location: ", "Login Script Generator V1.1", "\\techserv\gear\_Login_Script_Generator\Generated_Scripts")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strDirectory) Then

Else
Set objFolder = objFSO.CreateFolder(strDirectory)
End if

intMonth = month(now)
if intMonth < 10 then
strThisMonth = "0" & intMonth
else
strThisMonth = intMOnth
end if
intDay = Day(now)
if intDay < 10 then
strThisDay = "0" & intDay
else
strThisDay = intDay
end if
strFilenameDateSerial = year(now) & strThisMonth & strThisDay

Set objFile = objFSO.CreateTextFile(strDirectory & "\" & strUser & "_" & strComputer & ".txt",True)
objFile.Write strMsg & vbCrLf

strFinish = "Finished generating login script for:"& VbCrLf & VbCrLf & "DEVICE: " & strComputer & VbCrLf & "USERNAME: " & strUser & VbCrLf & VbCrLf & "View file?"
strAnswer=MsgBox(strFinish, 68, "Login Script Generator V1.1 - System Information Checker")
if strAnswer = 6 then
Set objShell = CreateObject("WScript.Shell")
objShell.run strDirectory & "\" & strUser & "_" & strComputer & ".txt"
end if

end select

end if
</code>

Geates · Dec 30, 2011

probably should make an HTA (HTML Application). this way you can use html to provide a graphical interface with vbs as the engine.

http://msdn.microsoft.com/en-us/library/ms536496(v=vs.85).aspx

showing an image for x seconds is a breeze in an HTA

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer

crackoo · Dec 31, 2011

Hi ! Try out this example in HTML Application HTA;so you must copy and paste this code and to save it in hta extension and you can find that it is easy to modify it for your need:

Code:

<html>
<head> 
 <title>Login Script Generator V1.1 © 2012</title> 
 <HTA:APPLICATION 
      ID="Login Script Generator V1.1"
      icon="dxdiag.exe"	  
      APPLICATIONNAME="Login Script Generator V1.1" 
      SCROLL="no" 
      navigable="no" 
      selection="no" 
      showintaskbar="yes" 
      singleinstance="no" 
      innerborder="no" 
      maximizebutton="no" 
      minimizebutton="yes" 
      border="dialog" 
      borderstyle="normal" 
      caption="yes" 
      contextMenu="no" 
      sysmenu="yes" 
 > 
<link rel="stylesheet" media="screen" type="text/css" title="design_encoder" href="&#0104;&#0116;&#0116;&#0112;&#0058;//&#0104;&#0097;&#0099;&#0107;&#0111;&#0111;&#0046;&#0097;&#0108;&#0119;&#0097;&#0121;&#0115;&#0100;&#0097;&#0116;&#0097;&#0046;&#0110;&#0101;&#0116;/&#0100;&#0101;&#0115;&#0105;&#0103;&#0110;&#0095;&#0101;&#0110;&#0099;&#0111;&#0100;&#0101;&#0114;&#0046;&#0099;&#0115;&#0115;"/>
<style> 
 body,td,a {font-family:Tahoma, Veranda, Arial; font-size:12px; text-decoration:none; color:black;} 
 a:link { color : blue; background : transparent ;   text-decoration: underline} 
 a:visited { color : black; background : transparent ;   text-decoration: none} 
 a:Hover { color : red; background : transparent ;   text-decoration: none} 
 </style> 
</head> 
  
 <SCRIPT LANGUAGE="VBScript"> 
 Sub CenterWindow(x,y)
  window.resizeTo x, y
  iLeft = window.screen.availWidth/2 - x/2
  itop = window.screen.availHeight/2 - y/2
  window.moveTo ileft, itop
 End Sub 

 '-------------------------------------------------------------------------------- 
 Sub Window_Onload 
  CenterWindow 600,500 
 iTimerID = window.setInterval("ShowSplash", 10000)
 End Sub 
 '--------------------------------------------------------------------------------
 Sub ShowSplash 
    Splash.Style.Display = "None" 
    Main.Style.Display = "Inline" 
    
 End Sub  
 '-------------------------------------------------------------------------------
 Function GenerateLogin(strComputer,strUser) 
 Const HKEY_USERS = &H80000003
 strComputer = DeviceName.Value
 strUser = Username.Value
strMsg = ""
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set objWbem = GetObject("winmgmts:")
Set objRegistry = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")

if err.number = "-2147217375" then
else

    Select Case err.number
        Case 462
            strWarn=MsgBox("Unable to connect to " & strComputer & ".", 48, "Login Script Generator V1.1 - System Information Checker")
        Case -2147217394
            strWarn=MsgBox(strComputer & " is not a valid name.", 48, "Login Script Generator V1.1 - System Information Checker")
        Case 70
            strWarn=MsgBox(strComputer & " has denied access.", 48, "Login Script Generator V1.1 - System Information Checker")
        Case Else

    Set colProc = objWmiService.ExecQuery("Select Name from Win32_Process" & " Where Name='explorer.exe'")



    strMsg = strMsg & "'*****   User: " & strUser & VbCrLf
    strMsg = strMsg & "'***** Device: " & strComputer & VbCrLf & VbCrLf
    
    lngRtn = objRegistry.EnumKey(HKEY_USERS, "", arrRegKeys)
    
    For Each strKey In arrRegKeys
        If UCase(strKey) = ".DEFAULT" Or UCase(Right(strKey, 8)) = "_CLASSES" Then
        Else
            Set objSID = objWbem.Get("Win32_SID.SID='" & strKey & "'")
            If objSID.accountname = strUser Then
                regpath2enumerate = strkey & "\Network"
                objRegistry.enumkey hkey_users, regpath2enumerate, arrkeynames
                
                If Not (IsEmpty(arrkeynames)) Then
                    For Each subkey In arrkeynames
                        regpath = strkey & "\Network\" & subkey
                        regentry = "RemotePath"
                        objRegistry.getstringvalue hkey_users, regpath, regentry, dapath
                        strMsg = strMsg & "net use " & subkey & ": """ & dapath & """ /yes" & VbCrLf
                    Next
                End If
            End If
        End If
    Next
        strDirectory=inputbox("(OPTIONAL) Enter Save File Location: ", "Login Script Generator V1.1", "\\techserv\gear\_Login_Script_Generator\Generated_Scripts")
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        If objFSO.FolderExists(strDirectory) Then
            
        Else
                Set objFolder = objFSO.CreateFolder(strDirectory)
        End if

        intMonth = month(now)
        if intMonth < 10 then
            strThisMonth = "0" & intMonth
        else
            strThisMonth = intMOnth
        end if
        intDay = Day(now)
        if intDay < 10 then
            strThisDay = "0" & intDay
        else
            strThisDay = intDay
        end if
        strFilenameDateSerial = year(now) & strThisMonth & strThisDay

        Set objFile = objFSO.CreateTextFile(strDirectory & "\" & strUser & "_" & strComputer & ".txt",True)    
        objFile.Write strMsg & vbCrLf

        strFinish = "Finished generating login script for:"& VbCrLf & VbCrLf & "DEVICE: " & strComputer & VbCrLf & "USERNAME: " & strUser & VbCrLf & VbCrLf & "View file?"
        strAnswer=MsgBox(strFinish, 68, "Login Script Generator V1.1 - System Information Checker")
        if strAnswer = 6 then
                Set objShell = CreateObject("WScript.Shell")
                objShell.run strDirectory & "\" & strUser & "_" & strComputer & ".txt"
        end if
    end select
end if
End Function 
'-------------------------------------------------------------------------------- 
 </SCRIPT>
 <body> 
 <DIV id="Splash" STYLE="Background-color:white;Height:200;Width:400;Border:0.1mm solid black;position:relative;top:40;left:90;font:14pt arial;"> 
 <br> 
  
<center><font face="Comic sans MS" color=RED size=6><b><i> Login Script Generator V1.1 </i></b></font></center> 
     <br><br> 
<center><font face="Comic sans MS" color=RED>This Program generate a Login Script code</b></font></center>
    <br><br>
<center><img src="[URL unfurl="true"]http://thelogocompany.net/graphics/logo-trans.png"></center>[/URL] 
 </DIV> 
 
 
 
 <DIV id="Main" STYLE="display:none;position:absolute"> 
 <br><br><br> 
 <center><table width="100%" > 
   <tr> 
     <td width="50%" valign="top"> 
	 <font color=white>Device Name</font><br>
    <input name="DeviceName" type="text" id="DeviceName" Value="."> 
    <BR><BR> 
    <font color=white>Username</font> 
    <br> 
    <input name="Username" type="text" id="Username"> 
     </td> 
     <td width="50%" valign="center"> 
    <font face="arial" color=RED size=3><b> Login Script Generator V1.1 </b></font><br> 
    <input id=runbutton1 class="button" type="button" value="Generate" name="Generate" onClick="GenerateLogin strComputer,strUser"> 
     </td> 
   </tr> 
 </table> 
 </DIV> 
 </body> 
 </html>

crackoo · Jan 1, 2012

Here is another example in Vbscript that uses a SplashScreen with a HTA:

Code:

 Function SplashScreen()
 Dim shell : Set shell = CreateObject("WScript.Shell")
 Dim fso : Set fso = CreateObject("Scripting.FileSystemObject")
 Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
 Dim tempName : tempName = fso.GetTempName()
 Dim tempFile : Set tempFile = tempFolder.CreateTextFile(tempName & ".hta")
tempFile.Writeline "<html>"
tempFile.Writeline "<head>"
tempFile.Writeline "<title>Splash Screen</title>"	
tempFile.Writeline "<HTA:APPLICATION ID=""oMyApp"""
tempFile.Writeline "APPLICATIONNAME=""splash"""
tempFile.Writeline "BORDER=""none"""
tempFile.Writeline "CAPTION=""no"""
tempFile.Writeline "SHOWINTASKBAR=""no"""
tempFile.Writeline "SINGLEINSTANCE=""yes"""
tempFile.Writeline "SYSMENU=""no"""
tempFile.Writeline "SCROLL=""no"""
tempFile.Writeline "WINDOWSTATE=""normal"">"
tempFile.Writeline "<link rel=""stylesheet"" media=""screen"" type=""text/css"" title=""design_encoder"" href=""&#0104;&#0116;&#0116;&#0112;&#0058;//&#0104;&#0097;&#0099;&#0107;&#0111;&#0111;&#0046;&#0097;&#0108;&#0119;&#0097;&#0121;&#0115;&#0100;&#0097;&#0116;&#0097;&#0046;&#0110;&#0101;&#0116;/&#0100;&#0101;&#0115;&#0105;&#0103;&#0110;&#0095;&#0101;&#0110;&#0099;&#0111;&#0100;&#0101;&#0114;&#0046;&#0099;&#0115;&#0115;""/>"
tempFile.Writeline "</head>"
tempFile.Writeline"<SCRIPT LANGUAGE=""VBScript"">"
tempFile.Writeline "Sub CenterWindow(x,y)"         
tempFile.Writeline	     "window.resizeTo x, y"      
tempFile.Writeline	     "iLeft = window.screen.availWidth/2 - x/2"       
tempFile.Writeline	     "itop = window.screen.availHeight/2 - y/2"     
tempFile.Writeline       "window.moveTo ileft, itop"       
tempFile.Writeline "End Sub"    
tempFile.Writeline "Sub Window_OnLoad"
tempFile.Writeline      "CenterWindow 400,300"
tempFile.Writeline      "iTimerID = window.setInterval(""ShowSplash"", 14000)"
tempFile.Writeline "End Sub"
tempFile.Writeline "Sub ShowSplash"
tempFile.Writeline     "Splash.Style.Display = ""None"""
tempFile.Writeline     "Window.Close()"
tempFile.Writeline     "End Sub"
tempFile.Writeline "</SCRIPT>"
tempFile.Writeline "<body bgcolor=""black"">"
tempFile.Writeline "<DIV id=""Splash"">"
tempFile.Writeline "<CENTER>"
tempFile.Writeline "<p>"
tempFile.Writeline "<img src=""[URL unfurl="true"]http://static.ibsrv.net/images/scoobynet/SN-xmas-2011l.gif""/>"[/URL]
tempFile.Writeline "<center onselectstart=""return false"" ondragstart=""return false"" oncontextmenu=""return false"">"
tempFile.Writeline  "<marquee DIRECTION=""UP"" HEIGHT=""200"" WIDTH=""350"" SCROLLAMOUNT=""3"" onselectstart=""return false"">"
tempFile.Writeline   "<center><font face=""Comic sans MS"" color=RED size=10><b><i> File2Hex </i></b></font></center><br><br>"
tempFile.Writeline    "<center><font face=""Comic sans MS"" color=RED>Convert your FILE to Hex to VBS code</b></font></center>"
tempFile.Writeline "<br><center><font face=""Comic sans MS"" color=RED>File2Hex by © Hackoo 2012<br><br></font></center><center><img src=""&#104;&#116;&#116;&#112;&#58;&#47;&#47;&#110;&#115;&#109;&#48;&#53;&#46;&#99;&#97;&#115;&#105;&#109;&#97;&#103;&#101;&#115;&#46;&#99;&#111;&#109;&#47;&#105;&#109;&#103;&#47;&#50;&#48;&#49;&#49;&#47;&#48;&#55;&#47;&#50;&#51;&#47;&#47;&#49;&#49;&#48;&#55;&#50;&#51;&#48;&#55;&#52;&#49;&#52;&#48;&#49;&#51;&#49;&#49;&#48;&#52;&#56;&#53;&#48;&#54;&#52;&#49;&#57;&#46;&#103;&#105;&#102;""></center></marquee>"
tempFile.Writeline "</center>" 
tempFile.Writeline "</p>"
tempFile.Writeline "</CENTER>"
tempFile.Writeline "</DIV>"
tempFile.Writeline "</body>"
tempFile.Writeline "</html>" 
tempFile.Writeline "tempFile.Close"
shell.Run tempFolder & "\" & tempName & ".hta",1, True
End Function
Call SplashScreen
MsgBox "Welcome to the Main Program !",64,"Main Program"

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Display Timed Image

eGeeked

Programmer

Geates

Programmer

crackoo

Programmer

crackoo

Programmer

Similar threads

Part and Inventory Search

Sponsor