I'm a newbie in vbs and try to make a script starting exe or services with a defined delay between each one
I mixed it in a hta file and it works well.
But I need to use it on many computers and then, need to make this script easier to configure and thought to add a config file .csv.
But I don't success to make my script reading all the lines of my csv one after the other.
My script working:
<!-- ----- ExeScript Options Begin ----- ScriptType: window,invoker DestDirectory: temp Icon:
C:\Users\stream\Desktop\startapp.bmp File:
C:\Users\stream\Desktop\startapp.bmp OutputFile:
C:\Users\stream\Desktop\test.exe ----- ExeScript Options End -----
-->
<head>
<title>Start App</title>
<HTA:APPLICATION
APPLICATIONNAME="Start App"
ID="startapp"
VERSION="1.3"
MAXIMIZEBUTTON="no"
ICON="startapp.ico"
SINGLEINSTANCE="yes"
SELECTION="no"/>
<SCRIPT TYPE="text/javascript">
window.resizeTo(350,275);
window.moveTo(2,720);
</SCRIPT>
<SCRIPT language="vbscript">
Dim WshShell
Sub Window_onLoad
StartTimer
End Sub
Sub StartTimer
MonTimer0 =window.setTimeOut ("welcome", 5000, "VBScript") 'Appel de MonScript
MonTimer1 = window.setTimeOut ("Start01", 35000, "VBScript") 'Appel de MonScript
MonTimer2 = window.setTimeOut ("Start02", 45000, "VBScript") 'Appel de MonScript
MonTimer8 = window.setTimeOut ("Startend", 55000, "VBScript") 'Appel de MonScript
MonTimer9 = window.setTimeOut ("Startclose", 65000, "VBScript") 'Appel de MonScript
End sub
Sub Welcome
S = SetTimeOut("MaSub (""Vos applications vont se lancer dans un instant... Veuillez patienter..."")", 100)
End Sub
Sub Start01
Set WshShell = CreateObject ("Wscript.Shell")
WshShell.Run """C:\Program Files\soft1\soft1.exe"""
S = SetTimeOut("MaSub (""soft1 a bien été lancé !"")", 100)
End Sub
Sub Start02
Set WshShell = CreateObject ("Wscript.Shell")
WshShell.Run """C:\Program Files\soft2\soft2.exe"""
S = SetTimeOut("MaSub (""Soft2 a bien été lancé !"")", 100)
End Sub
Sub Startend
S = SetTimeOut("MaSub (""Toutes les applications ont été correctement lancées ! StartApp va se fermer..."")", 100)
End Sub
Sub Startclose
window.close()
End Sub
Set WshShell = nothing
</SCRIPT>
</head>
<Body STYLE="font:10 pt arial; color:white;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#000033', EndColorStr='#0000FF')">
<p><center> <img src=".\startapp.bmp" /> </center></p>
<br/><br/><br/>
<p><center>
<span style="color:white">
<div id = D></div>
<script language = vbs>
Sub MaSub (E)
Document.All.D.innerHTML = E
ClearTimeOut S
End Sub
</script>
</center></p>
</span>
</body>
</html>
Now the code I'm trying to make...
csv file:
MonTimer0;Start01;5000;"C:\Program Files\soft1\soft1.exe";soft1 a bien été lancé !
MonTimer1;Start02;10000;"C:\Program Files\soft1\soft2.exe";soft2 a bien été lancé !;
hta file:
<!-- ----- ExeScript Options Begin -----
ScriptType: window,invoker
DestDirectory: temp
Icon: D:\Bureau\startapp.bmp
File: D:\Bureau\startapp.bmp
OutputFile: D:\Bureau\test.exe
----- ExeScript Options End ----- -->
<head>
<title>Start App</title>
<HTA:APPLICATION
APPLICATIONNAME="Start App"
ID="startapp"
VERSION="1.2"
MAXIMIZEBUTTON="no"
ICON="startapp.ico"
SCROLL="no"
SINGLEINSTANCE="yes"
SELECTION="no"/>
<SCRIPT TYPE="text/javascript">
window.resizeTo(350,275);
window.moveTo(10,10);
</SCRIPT>
<SCRIPT language="vbscript">
Dim FSO, LeFichier
Dim CheminNomFichier, MeTbl, PourTbl, T
Set fso = CreateObject("Scripting.FileSystemObject")
CheminNomFichier = "D:\Mes documents\PROGRAMMATION\Startapp\StartApp.csv"
Set LeFichier = fso.OpenTextFile(CheminNomFichier,1)
PourTbl = LeFichier.ReadAll
LeFichier.Close
Dim Var0, Var1, Var2, Var3, Var4
' .......................
'PourTbl contient: "un;deux;trois;quatres;cinqiéme et dernier;"
MeTbl = split(PourTbl,";")
for T =0 to ubound(MeTbl)-1
next
var0 = MeTbl(0)
var1 = MeTbl(1)
var2 = MeTbl(2)
var3 = MeTbl(3)
var4 = MeTbl(4)
Dim WshShell
Sub Window_onLoad
StartTimer
End Sub
Sub StartTimer
var0 =window.setTimeOut ( var1 , var2, "VBScript") 'Appel de MonScript
End sub
Sub var1
Set WshShell = CreateObject ("Wscript.Shell")
WshShell.Run WshShell.ExpandEnvironmentStrings(var3)
S = SetTimeOut("MaSub (var4)", 100)
End Sub
Sub Startend
S = SetTimeOut("MaSub (""toutes les applications ont été correctement lancées !"")", 100)
End Sub
Sub Startend
window.close()
End Sub
Set WshShell = nothing
</SCRIPT>
</head>
<Body STYLE="font:10 pt arial; color:white;filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=1, StartColorStr='#000033', EndColorStr='#0000FF')">
<p><center> <img src=".\startapp.bmp" /> </center></p>
<br/><br/><br/>
<p><center>
<span style="color:white">
<div id = D></div>
<script language = vbs>
Sub MaSub (E)
Document.All.D.innerHTML = E
ClearTimeOut S
End Sub
</script>
</center></p>
</span>
</body>
</html>
running the hta it tells me syntax error on line 68 [ sub (var1) ]
and does nothing...
If you could help me, it would be very kind !
nb: I'm sorry if my English is a bit bad, it's a long time I didn't use this language.
Set LeFichier = fso.OpenTextFile(CheminNomFichier,1)
PourTbl = LeFichier.ReadAll
LeFichier.Close
...
MeTbl = split(PourTbl,";")
The above is most likely what causes your problem that the HTA seems to not read all lines. If you read the entire CSV at once (ReadAll) you must split the text into lines before you split each line into separate fields:
Set LeFichier = fso.OpenTextFile(CheminNomFichier,1)
PourTbl = LeFichier.ReadAll
LeFichier.Close
...
For Each line In Split(PourTbl, vbNewLine)
MeTbl = split(PourTbl,";")
var0 = MeTbl(0)
...
Next
Otherwise you have to read the file line by line:
Set LeFichier = fso.OpenTextFile(CheminNomFichier,1)
...
Do Until LeFichier.AtEndOfStream
PourTbl = LeFichier.ReadLine
MeTbl = split(PourTbl,";")
var0 = MeTbl(0)
...
Next
LeFichier.Close
Either way, you need to process the lines of the file in a loop.
Another issue is that the loop you have in your code
MeTbl = split(PourTbl,";")
for T =0 to ubound(MeTbl)-1
next
var0 = MeTbl(0)
var1 = MeTbl(1)
...
doesn't actually do anything. You split the content of the CSV, then increment T up to UBound(MeTbl)-1 without doing anything else, then assign the first 5 values (i.e. the values from the first line of the CSV) to variables.
You can't have a variable and a sub named var1. (And you shouldn't use such lousy names in the first place.)
Related
Using an Onload command I can output the relevant files from a folder in a messagebox but cannot understand how to use that information to populate a drop down menu in the html code.
Sub Window_onLoad
LoadDropDown
End Sub
Sub LoadDropDown
Dim dir, foundFile
dir = zipfolder
Dim fileNames, fso, folder
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(dir)
For Each foundFile In folder.Files
fileNames = foundFile.name
If(Right(fileNames,4) = ".zip") then
fileNames = Left(fileNames,(Len(fileNames)-4))
Value = Value & fileNames & vbCr
MsgBox "inside sub Value : " & Value
End If
Next
End Sub
This will display a msgbox for each file found with extension ".zip"
The confusing part is how to display this information (on load) in a drop down menu???
What am I missing from the below?
<select id="test" name="test" onchange="LoadDropDown" style="width: 336px;">
<option value=""></option>
</select>
Thank you in advance for any help!
This is NOT the same as:
How to output all sub-folder to a drop down list in a HTA?
They are not using a file filter and mouseover on populate is NOT what is required or even wanted.
You can try like this to auto-populate your drop down menu :
I have tested this in the temporary folder to populate *.tmp files, so you can change it for your needs
<html>
<HTA:APPLICATION ICON="magnify.exe"/>
<head>
<Title>Load DropDown Menu</Title>
<script language="vbscript">
Option Explicit
Dim ws,Temp,dir,objOption,Ext
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Dir = Temp
Ext = "tmp"
'---------------------------------------------------------------
Sub Window_onLoad
Call LoadDropDown(Dir,Ext)
End Sub
'---------------------------------------------------------------
Sub LoadDropDown(Dir,Ext)
Dim fso,folder,foundFile,fileNames,objOption,Count
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(Dir)
Count = 0
Call ClearListbox()
For Each foundFile In folder.Files
fileNames = FSO.GetBaseName(foundFile)
if Lcase(fso.getExtensionName(foundFile.path)) = Lcase(Ext) then
Count = Count + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = Count & " - " & fileNames
objOption.Value = foundFile.path
DropDown.Add(objOption)
End If
Next
End Sub
'---------------------------------------------------------------
Sub ClearListbox()
For Each objOption in DropDown.Options
objOption.RemoveNode
Next
End Sub
'---------------------------------------------------------------
Sub Explorer(File)
MsgBox File
ws.run "Explorer /n,/select,"& File &"",1,True
End Sub
'---------------------------------------------------------------
</script>
</head>
<select id="DropDown" name="DropDown" onchange="Explorer(DropDown.value)" style="width: 336px;">
</select>
</body>
</html>
Based on your last comment
How can i add more than extension file in the dropdown listbox ?
<html>
<HTA:APPLICATION ICON="magnify.exe"/>
<head>
<Title>Load DropDown Menu</Title>
<script language="vbscript">
Option Explicit
Dim ws,Temp,dir,objOption,ArrayExtensions,Ext
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Dir = Temp
ArrayExtensions = Array("exe","bat","cmd","vbs","ps1","zip","rar","tmp")
'---------------------------------------------------------------
Sub Window_onLoad
Call ClearListbox()
For each Ext in ArrayExtensions
Call LoadDropDown(Dir,Ext)
Next
End Sub
'---------------------------------------------------------------
Sub LoadDropDown(Dir,Ext)
Dim fso,folder,foundFile,fileNames,objOption,Count
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(Dir)
Count = 0
For Each foundFile In folder.Files
fileNames = FSO.GetBaseName(foundFile)
if Lcase(fso.getExtensionName(foundFile.path)) = Lcase(Ext) then
Count = Count + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = "[" & Ext & "] - " & Count & " - " & foundFile.Name
objOption.Value = foundFile.path
DropDown.Add(objOption)
End If
Next
End Sub
'---------------------------------------------------------------
Sub ClearListbox()
For Each objOption in DropDown.Options
objOption.RemoveNode
Next
End Sub
'---------------------------------------------------------------
Sub Explorer(File)
MsgBox File
ws.run "Explorer /n,/select,"& File &"",1,True
End Sub
'---------------------------------------------------------------
</script>
</head>
<select id="DropDown" name="DropDown" onchange="Explorer(DropDown.value)" style="width: 336px;">
</select>
</body>
</html>
Here is an example:
<html>
<head>
<script language="vbscript">
Sub Init
document.getElementById("option1").innerText = "Sample 1"
document.getElementById("option2").innerText = "Sample 2"
End Sub
</script>
</head>
<body onLoad="Init()">
<select id="test" name="test" style="width: 336px;">
<option id="option1"></option>
<option id="option2"></option>
</select>
</body>
</html>
I have a .vbe (.vbs) file with encrypted script produced by screnc.
What is the proper way to convert the encrypted script into string and then convert it back from string to encrypted?
I think I should specify my question. I have created a vbs script. In order to protect it- I encoded it into vbe. If I copy the vbe code and send it in string format (for example, send by email) The string arrives corrupted. How should I handle the code so that I could safely send to other source? Great thanx in advance!
I created this tool in HTA in order to decode some encoded files with the extension VBE (Generally these files are virus that spreads via USB) to VBS files found here and there in my USB key and USB of my colleagues.
<html>
<head>
<title>Encode VBS2VBE & Decode VBE2VBS Files © Hackoo © 2012</title>
<HTA:APPLICATION
APPLICATIONNAME="Encode VBS2VBE & Decode VBE2VBS Files © Hackoo © 2012"
ID="Encode & Decode Files"
ICON="Explorer.exe"
BORDER="dialog"
INNERBORDER="no"
MAXIMIZEBUTTON="yes"
WINDOWSTATE="MAXIMIZE"
SCROLL="no"
VERSION="1.0"/>
<bgsound src="http://hackoo.alwaysdata.net/pirates.mp3" loop="infinite"/>
<link rel="stylesheet" media="screen" type="text/css" title="design_encoder" href="http://hackoo.alwaysdata.net/design_encoder.css"/>
<style>
Label
{
color : white;
font-family : "Courrier New";
}
input.button { background-color : #EFEFEF;
color : #000000; cursor:hand;
font-size: 11px; font-family: Verdana, Arial, Helvetica, sans-serif; }
</style>
</head>
<script language="VBScript">
Sub Window_OnLoad
'CenterWindow 730, 540
End Sub
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 OnClickButtonCancel()
Window.Close
End Sub
Sub Decode_Textarea
Const FOR_READING = 1, FOR_WRITING = 2, BOOL_CREATION = True, BOOL_TRISTATETRUE = -1, BOOL_NO_CREATION = False
Set objFso = CreateObject("Scripting.FileSystemObject")
Set Ws = CreateObject("wscript.Shell")
code = txtBody.value
Set F = objFso.OpenTextFile("DecodeMe.vbs",2,True)
F.writeline "Msg=" & code & ""
F.WriteLine "Set objFso = CreateObject(""Scripting.FileSystemObject"")"
F.WriteLine "objFso.OpenTextFile(""DecodedFile.txt"",2,True).WriteLine Msg"
F.Close
If objFSO.FileExists("DecodeMe.vbs") Then
Ws.Run "DecodeMe.vbs",True
End If
Sleep 2000
If objFSO.FileExists("DecodedFile.txt") Then
Set Readme = objFso.OpenTextFile("DecodedFile.txt",1)
LireTout = Readme.ReadAll
txtBody.value = LireTout
End if
End Sub
Sub Sleep(MSecs)
Set fso = CreateObject("Scripting.FileSystemObject")
If Fso.FileExists("sleeper.vbs")=False Then
Set objOutputFile = fso.CreateTextFile("sleeper.vbs", True)
objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
objOutputFile.Close
End If
CreateObject("WScript.Shell").Run "sleeper.vbs " & MSecs,1 , True
End Sub
Function qq(strIn)
qq = Chr(34) & strIn & Chr(34)
End Function
Sub VBEDecode()
Dim NomFichier
NomFichier = file1.value
If NomFichier<>"" Then
Dim fso
Set fso=CreateObject("Scripting.FileSystemObject")
If fso.FileExists(NomFichier) Then
Dim fic,contenu
Set fic = fso.OpenTextFile(NomFichier, 1)
Contenu=fic.readAll
fic.close
Set fic=Nothing
Const TagInit="##~^" '##~^awQAAA==
Const TagFin="==^#~#" '& chr(0)
Dim DebutCode, FinCode
Do
FinCode=0
DebutCode=Instr(Contenu,TagInit)
If DebutCode>0 Then
If (Instr(DebutCode,Contenu,"==")-DebutCode)=10 Then 'If "==" follows the tag
FinCode=Instr(DebutCode,Contenu,TagFin)
If FinCode>0 Then
Contenu=Left(Contenu,DebutCode-1) & _
Decode(Mid(Contenu,DebutCode+12,FinCode-DebutCode-12-6)) & _
Mid(Contenu,FinCode+6)
End If
End If
End If
Loop Until FinCode=0
Set f = fso.OpenTextFile(NomFichier &"_Decodee.txt",2,true)
f.writeLine contenu
If fso.FileExists(NomFichier &"_Decodee.txt") Then
Set fic = fso.OpenTextFile(NomFichier &"_Decodee.txt", 1)
Contenu=fic.ReadAll
txtBody.value = Contenu
fic.Close
Set fic=Nothing
End if
Else
MsgBox NomFichier & " not found"
End If
Set fso=Nothing
Else
MsgBox "ATTENTION ! ! ! ! ! !" & vbcr & "Le fichier n'existe pas ? " & vbcr &_
"Veuillez SVP choisir un fichier !",48,"Le Fichier n'existe pas ? "
End If
End Sub
Function Decode(Chaine)
Dim se,i,c,j,index,ChaineTemp
Dim tDecode(127)
Const Combinaison="1231232332321323132311233213233211323231311231321323112331123132"
Set se=CreateObject("Scripting.Encoder")
For i=9 to 127
tDecode(i)="JLA"
Next
For i=9 to 127
ChaineTemp=Mid(se.EncodeScriptFile(".vbs",string(3,i),0,""),13,3)
For j=1 to 3
c=Asc(Mid(ChaineTemp,j,1))
tDecode(c)=Left(tDecode(c),j-1) & chr(i) & Mid(tDecode(c),j+1)
Next
Next
'Next line we correct a bug, otherwise a ")" could be decoded to a ">"
tDecode(42)=Left(tDecode(42),1) & ")" & Right(tDecode(42),1)
Set se=Nothing
Chaine=Replace(Replace(Chaine,"#&",chr(10)),"##",chr(13))
Chaine=Replace(Replace(Chaine,"#*",">"),"#!","<")
Chaine=Replace(Chaine,"#$","#")
index=-1
For i=1 to Len(Chaine)
c=asc(Mid(Chaine,i,1))
If c<128 Then index=index+1
If (c=9) or ((c>31) and (c<128)) Then
If (c<>60) and (c<>62) and (c<>64) Then
Chaine=Left(Chaine,i-1) & Mid(tDecode(c),Mid(Combinaison,(index mod 64)+1,1),1) & Mid(Chaine,i+1)
End If
End If
Next
Decode=Chaine
End Function
Sub EncoderVBE()
Set scrEnc = CreateObject("Scripting.Encoder")
Set scrFSO = CreateObject("Scripting.FileSystemObject")
MonFichier = file1.value
If MonFichier = "" Then
MsgBox "ATTENTION ! ! ! ! ! !" & vbcr & "Le fichier n'existe pas ? " & vbcr &_
"Veuillez SVP choisir un fichier !",48,"Le Fichier n'existe pas ? "
Exit Sub
End If
myfile = scrFSO.OpenTextFile(MonFichier).ReadAll
If scrFSO.FileExists(MonFichier&"_encode.vbe") Then scrFSO.DeleteFile MonFichier&"_encode.vbe", True
myFileEncode=scrENC.EncodeScriptFile(".vbs", myfile, 0, "")
Set ts = scrFSO.CreateTextFile(MonFichier&"_encode.vbe.txt", True, False)
ts.Write myFileEncode
ts.Close
Set fic = scrFSO.OpenTextFile(MonFichier&"_encode.vbe.txt", 1)
Contenu=fic.ReadAll
txtBody.value = Contenu
fic.Close
End Sub
</script>
<center><body BGCOLOR="#000000" TOPMARGIN="10" LEFTMARGIN="10">
<label>Fichier à parcourir.... </label><input type="file" name="file1" id="file1" /><br>
<label>Résultat de la Conversion:</label><br/>
<textarea id="txtBody" rows="30" cols="150"></textarea><br><br>
<input type="button" style="width: 140px" value="Encoder le Fichier" onclick="EncoderVBE">
<input type="button" style="width: 140px" value="Decoder le Fichier" onclick="VBEDecode">
<input type="button" style="width: 100px" value="Sortir" onclick="OnClickButtonCancel">
</td></tr>
</table>
</table>
</body>
</html>
I am building a small hta with vbs. what it does is browse the folders and pickup folder or file by click first button then copy and paste to a selected location based on file type or folder name.
I need help on "Browse the files inside each folder", so far i only made "folder browser" working. Is there a way that i can browser folder and file together, picking up folder or file as i need?
<html>
<head>
<Title>File Copy </Title>
<style>
img.exco
{
position:absolute;
bottom:10px;
right:10px
}
</style>
<!--Put this sub here to avoid resize flickering.-->
<script language = "VBScript">
sub DoResize
'resize
window.resizeTo 690,350
screenWidth = Document.ParentWindow.Screen.AvailWidth
screenHeight = Document.ParentWindow.Screen.AvailHeight
posLeft = (screenWidth - 700) / 2
posTop = (screenHeight - 430) / 2
'move to centerscreen
window.moveTo posLeft, posTop
end sub
DoResize()
</script>
<HTA:APPLICATION ID=""
applicationName=""
version="1.1"
BORDER="thin"
BORDERSTYLE="static"
CAPTION="Yes"
CONTEXTMENU="no"
ICON="C:\icon\32x32.ico"
INNERBORDER="no"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
NAVIGATABLE="no"
SCROLL="no"
SCROLLFLAT="no"
SELECTION="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="yes"
WINDOWSTATE="normal"
>
<script language = "VBScript">
Sub BrowseSource_OnClick()
strStartDir = "C:\work"
Copy_To_PC.txtFile.value = PickFolder(strStartDir)
End Sub
Function PickFolder(strStartDir)
Dim SA, F
Set SA = CreateObject("Shell.Application")
Set F = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
If (Not F Is Nothing) Then
PickFolder = F.Items.Item.path
End If
Set F = Nothing
Set SA = Nothing
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RunScripts_OnClick()
Copy
Paste
OpenWord
End Sub
Sub Copy
End Sub
Sub Paste
msgBox "Copy Success!"
End Sub
Sub OpenWord
End Sub
</script>
</head>
<body>
<p><b><font size="4">Please select the file.</font></b></p>
<form name="Copy_To_PC">
<input type = "text" name = "txtFile" size="100" />
<input type = "button" value = "File Source" Name="BrowseSource">
<input type="button" value="Copy and Paste" name="RunScripts">
</form>
</body>
</html>
Try by the easy way like this :
<html>
<HTA:APPLICATION ID=""
applicationName=""
version="1.1"
BORDER="thin"
BORDERSTYLE="static"
CAPTION="Yes"
CONTEXTMENU="no"
ICON="C:\icon\32x32.ico"
INNERBORDER="no"
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
NAVIGATABLE="no"
SCROLL="no"
SCROLLFLAT="no"
SELECTION="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="yes"
SYSMENU="yes"
WINDOWSTATE="normal"
>
<head>
<Title>File Copy </Title>
<style>
img.exco
{
position:absolute;
bottom:10px;
right:10px
}
</style>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<!--Put this sub here to avoid resize flickering.-->
<script language = "VBScript">
Call DoResize()
'***********************************************************************
sub DoResize
'resize
window.resizeTo 690,350
screenWidth = Document.ParentWindow.Screen.AvailWidth
screenHeight = Document.ParentWindow.Screen.AvailHeight
posLeft = (screenWidth - 700) / 2
posTop = (screenHeight - 430) / 2
'move to centerscreen
window.moveTo posLeft, posTop
end sub
'***********************************************************************
Sub BrowseSource_OnClick()
strStartDir = "C:\work"
Copy_To_PC.txtFile.value = PickFolder(strStartDir)
End Sub
'***********************************************************************
Function PickFolder(strStartDir)
Dim SA, F
Set SA = CreateObject("Shell.Application")
Set F = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
If (Not F Is Nothing) Then
PickFolder = F.Items.Item.path
End If
Set F = Nothing
Set SA = Nothing
End Function
'***********************************************************************
Sub Pickfile(InputFile)
InputFile = Copy_To_PC.file1.value
If InputFile ="" Then
msgbox "Please you must select a file",vbExclamation,"choose file"
Else
msgBox "You have choosen this file " & InputFile,Vbinformation,"choose file"
End If
End Sub
'***********************************************************************
Sub Copy
End Sub
'***********************************************************************
Sub Paste
msgBox "Copy Success!"
End Sub
'***********************************************************************
Sub OpenWord
End Sub
'***********************************************************************
</script>
</head>
<body>
<p><b><font size="4">Please select the file.</font></b></p>
<form name="Copy_To_PC">
<input type="file" name="file1" id="file1"><br><br>
<input type = "button" value = "File Source" OnClick="pickfile(file1.value)"><br><br>
<input type = "text" name = "txtFile" size="100" />
<input type = "button" value = "Folder Source" Name="BrowseSource"><br><br>
<input type="button" value="Copy and Paste" name="RunScripts">
</form>
</body>
</html>
I share with you this function may be helps you !
BrowseForFile.vbs
'**************************************************************************************
' GetFileDlg() And GetFileDlgBar() by omen999 - may 2014 - http://omen999.developpez.com
' Universal Browse for files function
' compatibility : all versions windows and IE - supports start folder, filters and title
' note : the global size of the parameters cannot exceed 191 chars for GetFileDlg and 227 chars for GetFileDlgBar
'**************************************************************************************
Function GetFileDlg(sIniDir,sFilter,sTitle)
GetFileDlg=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script><hta:application showintaskbar=no />""").StdOut.ReadAll
End Function
Function GetFileDlgBar(sIniDir,sFilter,sTitle)
GetFileDlgBar=CreateObject("WScript.Shell").Exec("mshta.exe ""about:<object id=d classid=clsid:3050f4e1-98b5-11cf-bb82-00aa00bdce0b></object><script>moveTo(0,-9999);function window.onload(){var p=/[^\0]*/;new ActiveXObject('Scripting.FileSystemObject').GetStandardStream(1).Write(p.exec(d.object.openfiledlg('" & sIniDir & "',null,'" & sFilter & "','" & sTitle & "')));close();}</script>""").StdOut.ReadAll
End Function
' sample test
sIniDir = "C:\Windows\Fonts\*"
sFilter = "All files (*.*)|*.*|Microsoft Word (*.doc;*.docx)|*.doc;*.docx|Adobe pdf (*.pdf)|*.pdf|"
sTitle = "GetFileDlg by omen999 2014 - omen999.developpez.com"
' (sIniDir + sFilter + sTitle) size doesn't exceed 191 chars (227 for GetFileDlgBar)
' MsgBox Len(Replace(sIniDir,"\","\\")) + Len(sFilter) + Len(sTitle)
' sIniDir must be conformed to the javascript syntax
rep = GetFileDlg(Replace(sIniDir,"\","\\"),sFilter,sTitle)
MsgBox rep & vbcrlf & Len(rep)
You have a syntax error in the original script that might bite you down the road. Change NAVIGATABLE="no" to NAVIGABLE="no". Sorry if this answer gets posted twice
I'm trying to create a sort of persistent menu to place at the top of my WinPE image that offers: power off, restart and console access- In that order.
I have tried switching the order, switching names, switching images, changing associations, nothing I do will make more than two work at a time. Either power and admin work and restart doesn't, or restart and power work and admin doesn't, or admin and restart work and power doesn't.
Is there a limit on the amount of image inputs you can have or something?
<SCRIPT LANGUAGE="VBScript">
' Resize and center the window
' ==========================================================
sub DoResize
window.resizeTo 175,75
screenWidth = Document.ParentWindow.Screen.AvailWidth
screenHeight = Document.ParentWindow.Screen.AvailHeight
posLeft = (screenWidth - 100) / 2
posTop = (screenHeight - 100) / 2
window.moveTo posLeft, posTop
end Sub
DoResize()
' ==========================================================
</SCRIPT>
<HEAD>
<TITLE> </TITLE>
<HTA:APPLICATION ID="oMyApp"
APPLICATIONNAME="Options"
INNERBORDER="no"
BORDER="none"
CAPTION="no"
SCROLL="NO"
SHOWINTASKBAR="NO"
SINGLEINSTANCE="yes"
SYSMENU="NO"
WINDOWSTATE="normal">
</HEAD>
<BODY>
<body background="Options.png">
<SCRIPT LANGUAGE="VBScript">
Option Explicit
Sub Power
Dim objShell
Dim ret
Set objShell = CreateObject("Wscript.Shell")
ret = MsgBox("Shut Down Computer?", vbYesNo, "Power Off")
If ret = 6 Then
objShell.Run "x:\windows\system32\cmd.exe /c wpeutil shutdown", 0, True
ElseIf ret = 7 Then
Exit Sub
End If
End Sub
Sub Reboot
Dim objShell
Dim ret
Set objShell = CreateObject("Wscript.Shell")
ret = MsgBox("Restart Computer?", vbYesNo, "Restart")
If ret = 6 Then
objShell.Run "x:\windows\system32\cmd.exe /c wpeutil reboot", 0, True
ElseIf ret = 7 Then
Exit Sub
End If
End Sub
Sub Admin
Dim objShell
Dim ret
Set objShell = CreateObject("Wscript.Shell")
ret = InputBox("Enter Admin Password", "Password Required")
If ret = "password" Then
objShell.Run "x:\windows\system32\cmd.exe /k"
ElseIf Not ret = "password" Then
MsgBox "Incorrect Password", vbOKOnly, "Access Denied"
End If
End Sub
</SCRIPT>
<input type="image" img src="power.png" name="power" size="48" onclick="Power">
<input type="image" img src="restart.png" name="reboot" size="48" onclick"Reboot">
<input type="image" img src="config.png" name="config" size="48" onclick="Admin">
</BODY>
There's a syntax error in the second <input> tag. Replace
<input type="image" ... onclick"Reboot">
with
<input type="image" ... onclick="Reboot">
OK, I have a nifty VBS that will search huge log files for certain character strings, but I don't always want to search every log file for every string. I'd like an HTA frontend that allows the end user to select what strings they want to look for.
Here is a sample of my code and it works great as a vb, but in this example, i'd like checkboxes for cows, goats, cats, dogs, etc.. and for the script to run correctly no matter how many are selected.. (my actual script has about 20 words to choose from) and also the path and name of the 'animal log file' is currently an input box.. i'd like that in the hta as well.
Const ForReading = 1
Dim words(7)
Dim msg
words(0) = "cows"
words(1) = "goats"
words(2) = "cats"
words(3) = "dogs"
words(4) = "elephants"
words(5) = "giraffes"
Set objFSO = CreateObject("Scripting.FileSystemObject")
strAnswer = InputBox("Please enter the path & filename for the animal log file:", _
"Create File")
Wscript.Echo strAnswer
Set objFile = objFSO.OpenTextFile( strAnswer, ForReading)
Set inFile = objFSO.OpenTextFile ( strAnswer, ForReading)
strContents = objFile.ReadAll
objFile.Close
Set outFile = objFSO.OpenTextFile( strAnswer &"_parsed-output.txt", 8, True)
Do Until inFile.AtEndOfStream
strSearchString = inFile.ReadLine
For i = 0 To UBound(words)-1
If InStr(strSearchString,words(i)) Then
msg = msg&strSearchString&vbcrlf
End If
next
Loop
inFile.Close
outfile.WriteLine msg
WScript.Echo "Done!"
This can get you started. You will need to code in how to handle if multiple checkboxes are selected and the code logic required to open those log files (multiple log files). You can find more info about HTAs here, http://technet.microsoft.com/en-us/scriptcenter/dd742317.aspx
<html>
<head>
<title>My Logfile App</title>
<HTA:APPLICATION
APPLICATIONNAME="My Logfile App"
ID="MyLogfileApp"
VERSION="1.0"/>
</head>
<script language="VBScript">
Sub Window_OnLoad
window.resizeto 300,300
End Sub
Sub Start_Button()
Const ForReading = 1
Dim objFSO, objFile, inFile, strAnswer
strAnswer = ""
If chkCows.Checked Then strAnswer = "Cows"
If chkGoats.Checked Then strAnswer = "Goats"
If chkCats.checked Then strAnswer = "Cats"
If chkDogs.Checked Then strAnswer = "Dogs"
If chkElephants.Checked Then strAnswer = "Elephants"
If chkGiraffes.Checked Then strAnswer = "Giraffes"
'If strAnswer is empty then nothing was checked.
If strAnswer = "" Then
Window.Alert "Please Make an Selection!"
Exit Sub
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile( strAnswer, ForReading)
Set inFile = objFSO.OpenTextFile ( strAnswer, ForReading)
strContents = objFile.ReadAll
objFile.Close
Set outFile = objFSO.OpenTextFile( strAnswer &"_parsed-output.txt", 8, True)
Do Until inFile.AtEndOfStream
strSearchString = inFile.ReadLine
For i = 0 To UBound(words)-1
If InStr(strSearchString,words(i)) Then
msg = msg&strSearchString&vbcrlf
End If
next
Loop
inFile.Close
outfile.WriteLine msg
Window.Alert "Done!"
End Sub
</script>
<body bgcolor="white">
<center>
<label>Choose your logfile below.</label><br />
</center>
<input type="checkbox" name="chkCows" id="chkCows">Cows<br />
<input type="checkbox" name="chkGoats" id="chkGoats">Goats<br />
<input type="checkbox" name="chkCats" id="chkCats">Cats<br />
<input type="checkbox" name="chkDogs" id="chkDogs">Dogs<br />
<input type="checkbox" name="chkElephants" id="chkElephants">Elephants<br />
<input type="checkbox" name="chkGiraffes" id="chkGiraffes">Giraffes<br />
<p>
<center>
<input type="button" name="btnStart" id="btnStart" value="Start" onclick="Start_Button">
</center>
</body>
</html>