Jump to content

Welcome to MSFN Forum
Register now to gain access to all of our features. Once registered and logged in, you will be able to create topics, post replies to existing threads, give reputation to your fellow members, get your own private messenger, post status updates, manage your profile and so much more. This message will be removed once you have signed in.
Login to Account Create an Account



Photo

Hta List And Read All Text Files

- - - - -

  • Please log in to reply
7 replies to this topic

#1
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,447 posts
  • Joined 02-August 03
  • OS:none specified
  • Country: Country Flag
I was reading this page at the Hey Scripting Guy, How Can I Create an HTA For Displaying Log Files. I like the script so i modified it to list all the text files on the local computer.

Code updated to this link
Updated Rar

Edited by gunsmokingman, 14 February 2015 - 11:46 AM.



GunSmokingMan




How to remove advertisement from MSFN

#2
Yzöwl

Yzöwl

    Wise Owl

  • Super Moderator
  • 4,598 posts
  • Joined 13-October 04
  • OS:Windows 7 x64
  • Country: Country Flag

Donator

Yes, I like it too!

All you need to do is change the txt to cmd and possibly give the option limiting the check to a particular drive or directory.

It took five and a half minutes to run on my PC for Text Files and believe me I've got more NT Command Scripts.

#3
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,447 posts
  • Joined 02-August 03
  • OS:none specified
  • Country: Country Flag
Code updated to this link
Updated Rar

Edited by gunsmokingman, 14 February 2015 - 11:46 AM.
code tags changed to improve page formatting



GunSmokingMan



#4
Yzöwl

Yzöwl

    Wise Owl

  • Super Moderator
  • 4,598 posts
  • Joined 13-October 04
  • OS:Windows 7 x64
  • Country: Country Flag

Donator

Made a couple of changes to the text due to the change in file types and also a spelling error
 
<TITLE>Text File and NT Command Script Lister</TITLE>
<HTA:APPLICATION ID='ListTxtCmd'
Scroll='No'
SCROLLFLAT ='No'
SingleInstance='Yes'
SysMenu='Yes'
ShowInTaskBar='No'
MaximizeButton='No'
MinimizeButton='Yes'
Border='Thin'
BORDERSTYLE ='complex'
INNERBORDER ='Yes'
Caption='Yes'
WindowState='Normal'
APPLICATIONNAME='List_Txt_Cmd_Files'
Icon='%SystemRoot%\explorer.exe'>
<STYLE Type="text/css">
Body
{
Font-Size:8.05pt;
Font-Weight:Bold;
Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
Color:#001254;
BackGround-Color:Transparent;
Filter:progid:DXImageTransform.Microsoft.Gradient
(StartColorStr='#fdf7f1',endColorStr='#d1cbc5');
Margin-Top:1;
Margin-Bottom:1;
Margin-Left:4;
Margin-Right:4;
Padding-Top:1;
Padding-Bottom:1;
Padding-Left:4;
Padding-Right:4;
Text-Align:Center;
Vertical-Align:Top;
Border-Top:2px Solid #a6a29e;
Border-Bottom:3px Solid #cbc7c3;
Border-Left:2px Solid #b2aeaa;
Border-Right:3px Solid #bcb8b4;
}
BUTTON
{
Width:121pt;
Height:15;
Cursor:Hand;
Font-Size:8.05pt;
Font-Weight:Bold;
Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
Color:#001142;
Filter:progid:DXImageTransform.Microsoft.Gradient
(StartColorSTR='#bbddff',endColorSTR='#224488');
Padding-Top:1;
Padding-Bottom:2;
Margin-Left:1pt;
Margin-Right:1pt;
Border-Top:1px TransParent;
Border-Bottom:2px TransParent;
Border-Left:1px TransParent;
Border-Right:2px TransParent;
}
TD
{
Font-Size:7.95pt;
Font-Weight:Bold;
Color:#5E5E5E;
Text-Align:Center;
Margin-Top:1;
Margin-Bottom:1;
}
</STYLE>
<script language="VBScript">
window.resizeTo 800,625
Const WINDOW_HANDLE = 0 ,OPTIONS = 0,MY_COMPUTER = &H11&
Dim Computer :Computer = "."
Dim Shell :Set Shell = CreateObject("Shell.Application")
Dim Act :Set Act = CreateObject("Wscript.Shell")
Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
Dim Wmi :Set Wmi = GetObject("winmgmts:\\" & Computer & "\root\cimv2")
Dim strFolderName
'-> Single Directory
Function DirectoryList
Dim Folder, FolderItem, ObjPath
Set Folder = Shell.BrowseForFolder(0, "Select a folder:", 0, MY_COMPUTER)
If Folder Is Nothing Then
Exit Function
Else
Set FolderItem = Folder.Self
ObjPath = FolderItem.Path
UpdateList()
Set colFiles = Wmi.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & ObjPath & "'} Where " _
& "ResultClass = CIM_DataFile")
For Each objFile In colFiles
If Right(Instr(objFile.Name,".txt"),4) Or Right(Instr(objFile.Name,".cmd"),4) Then
C1 = C1 + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.FileName
objOption.Value = objFile.Name
If C1 Mod 2 Then
objOption.style.backgroundcolor = "#C9C9C9"
objOption.style.color = "#3A3A3A"
Else
objOption.style.backgroundcolor = "#E9E9E9"
objOption.style.color = "#235779"
End If
TxtFile.Add(objOption)
End If
Next
End If
C1=0
Exit Function
End Function
'-> Folder And Sub Folders
Function FolderSubFolderListAll()
Dim colSubfolders, Folder, FolderItem, ObjPath
Set Folder = Shell.BrowseForFolder(0, "Select a folder:", 0, MY_COMPUTER)
If Folder Is Nothing Then
Exit Function
Else
Set FolderItem = Folder.Self
strFolderName = FolderItem.Path
UpdateList()
Set colSubfolders = Wmi.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
Set colFiles = Wmi.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & strFolderName & "'} Where " _
& "ResultClass = CIM_DataFile")
For Each objFile in colFiles
If Right(Instr(objFile.Name,".txt"),4) Or Right(Instr(objFile.Name,".cmd"),4) Then
C1 = C1 + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.FileName
objOption.Value = objFile.Name
If C1 Mod 2 Then
objOption.style.backgroundcolor = "#C9C9C9"
objOption.style.color = "#3A3A3A"
Else
objOption.style.backgroundcolor = "#E9E9E9"
objOption.style.color = "#235779"
End If
TxtFile.Add(objOption)
End If
Next
C1=0
For Each objFolder in colSubfolders
GetSubFolders strFolderName
Next
End If
Exit Function
End Function
'-> Sub Folders
Sub GetSubFolders(strFolderName)
On Error Resume Next
Set colSubfolders2 = Wmi.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
For Each objFolder2 in colSubfolders2
strFolderName = objFolder2.Name
Set colFiles = Wmi.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & strFolderName & "'} Where " _
& "ResultClass = CIM_DataFile")
For Each objFile in colFiles
If Right(Instr(objFile.Name,".txt"),4) Or Right(Instr(objFile.Name,".cmd"),4) Then
C1 = C1 + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.FileName
objOption.Value = objFile.Name
If C1 Mod 2 Then
objOption.style.backgroundcolor = "#C9C9C9"
objOption.style.color = "#3A3A3A"
Else
objOption.style.backgroundcolor = "#E9E9E9"
objOption.style.color = "#235779"
End If
TxtFile.Add(objOption)
End If
Next
GetSubFolders strFolderName
Next
End Sub
'-> All Cmd And Text From Local Computer
Function ListAll()
UpdateList()
Set ColFiles = Wmi.ExecQuery("Select * from CIM_DataFile Where Extension = 'txt' Or Extension = 'cmd'")
For Each objFile In colFiles
C1 = C1 + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.FileName
objOption.Value = objFile.Name
If C1 Mod 2 Then
objOption.style.backgroundcolor = "#C9C9C9"
objOption.style.color = "#3A3A3A"
Else
objOption.style.backgroundcolor = "#E9E9E9"
objOption.style.color = "#235779"
End If
TxtFile.Add(objOption)
Next
Exit Function
End Function
'-> Select From List
Function ReadFile()
On Error Resume Next
Set objFile = Fso.OpenTextFile(TxtFile.Value)
strContents = objFile.ReadAll
objFile.Close
Contents.Value = strContents
Path.innerHTML=TxtFile.Value
Exit Function
End Function
Function UpdateList()
For Each ObjList In TxtFile.Options :ObjList.RemoveNode :Next
Exit Function
End Function
</SCRIPT>
<BODY>Gunsmokingman List And Show Txt and Cmd Files
<TABLE Border='1' Align='Center'>
<!-- -->
<TD>
<BUTTON OnClick='DirectoryList()'>Single Directory</BUTTON>
</TD>
<!-- -->
<TD>
<BUTTON OnClick='FolderSubFolderListAll()'>Folder And Sub Folder</BUTTON>
</TD>
<!-- -->
<TD>
<BUTTON OnClick='ListAll()'>Local Computer</BUTTON>
</TD>
</TABLE>
<TABLE width="100%" Border='1'>
<TR>
<TD width="25%" valign="top">
<select size="35" name="TxtFile" onChange="ReadFile()"
style="Width:100%;Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;Font-Size:7.95pt;Font-Weight:Bold;">
</select>
</TD>
<TD width="75%" valign="top">
<textarea name="Contents" rows="35" cols="100"
Style='Width:100%;Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;Font-Size:7.95pt;'
ReadOnly>
</textarea>
</TD>
</TR>
</TABLE>
<SPAN ID='Path'> </SPAN>
<DIV Style='Color:#Ad1111;Margin-Top:5;'>
This may appear to not be responding, while the query is active!
</DIV>
</BODY>
I gotta say, I really do like this idea; thanks again GSM!

#5
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,447 posts
  • Joined 02-August 03
  • OS:none specified
  • Country: Country Flag
Yzöwl Thanks :thumbup
Code updated to this link
Updated RarUpdated Rar[/b][/color][/url]
I made a App in VB 2008 that does more or less what the hta does. This requires net framework to be
installed, for the app to work.

Attached Files


Edited by gunsmokingman, 14 February 2015 - 11:47 AM.



GunSmokingMan



#6
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,447 posts
  • Joined 02-August 03
  • OS:none specified
  • Country: Country Flag
I have made a couple of changes to the HTA
1:\ More file types to list
2:\ Single file search only.
3:\ Removed the local computer button
4:\ Add a clear button
5:\ Layout changed

<TITLE>Gunsmokingman Multi Editor</TITLE>
<HTA:APPLICATION ID='Gsm_ME'
Scroll='No'
SCROLLFLAT ='No'
SingleInstance='Yes'
SysMenu='Yes'
ShowInTaskBar='No'
MaximizeButton='No'
MinimizeButton='Yes'
Border='Thin'
BORDERSTYLE ='complex'
INNERBORDER ='Yes'
Caption='Yes'
WindowState='Normal'
APPLICATIONNAME='Gsm_ME'
Icon='%SystemRoot%\explorer.exe'>
<STYLE Type="text/css">
Body
{
Font-Size:8.05pt;
Font-Weight:Bold;
Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
Color:#001254;
BackGround-Color:Transparent;
Filter:progid:DXImageTransform.Microsoft.Gradient
(StartColorStr='#fdf7f1',endColorStr='#d1cbc5');
Margin-Top:1;
Margin-Bottom:1;
Margin-Left:4;
Margin-Right:4;
Padding-Top:1;
Padding-Bottom:1;
Padding-Left:4;
Padding-Right:4;
Text-Align:Center;
Vertical-Align:Top;
Border-Top:2px Solid #a6a29e;
Border-Bottom:3px Solid #cbc7c3;
Border-Left:2px Solid #b2aeaa;
Border-Right:3px Solid #bcb8b4;
}
BUTTON
{
Width:101pt;
Height:13pt;
Cursor:Hand;
Font-Size:8.05pt;
Font-Weight:Bold;
Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
Color:#001142;
Filter:progid:DXImageTransform.Microsoft.Gradient
(StartColorSTR='#bbddff',endColorSTR='#224488');
Padding-Top:1;
Padding-Bottom:2;
Margin-Left:1pt;
Margin-Right:1pt;
Border-Top:1px TransParent;
Border-Bottom:2px TransParent;
Border-Left:1px TransParent;
Border-Right:2px TransParent;
}
TD
{
Font-Size:7.95pt;
Font-Weight:Bold;
Color:#5E5E5E;
Text-Align:Center;
Margin-Top:1;
Margin-Bottom:1;
}
TD.T1
{
Width:39;
Font-Size:7.95pt;
Font-Weight:Bold;
Color:#5E5E5E;
Text-Align:Left;
Margin-Top:1;
Margin-Bottom:1;
}
</STYLE>
<script LANGUAGE="VBScript">
'-> Resize And Move Window
Dim Wth :Wth = int(800)
Dim Hht :Hht = int(625)
window.ResizeTo Wth, Hht
MoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))

Const WINDOW_HANDLE = 0 ,OPTIONS = 0,MY_COMPUTER = &H11&
Dim Computer :Computer = "."
Dim Shell :Set Shell = CreateObject("Shell.Application")
Dim Act :Set Act = CreateObject("Wscript.Shell")
Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
Dim Wmi :Set Wmi = GetObject("winmgmts:\\" & Computer & "\root\cimv2")
Dim Cmd1, colSubfolders, Folder, FolderItem, ObjPath, strFolderName, Time1
Dim Msg1 :Msg1="Select The File Type That You Want To List."
Dim Msg2 :Msg2="<FONT Style='Color:#Ad1111;Margin-Top:3;'>" & _
"This may appear to not be responding, while the query is active!</FONT>"
Function Window_onLoad()
self.Focus()
Txt1.innerHTML=Msg1
End Function
'-> File Type Selection
Dim F_Type
Function CheckFileType()
If FType(0).checked Then
F_Type = ".cmd"
ElseIf FType(1).checked Then
F_Type = ".hta"
ElseIf FType(2).checked Then
F_Type = ".inf"
ElseIf FType(3).checked Then
F_Type = ".ini"
ElseIf FType(4).checked Then
F_Type = ".reg"
ElseIf FType(5).checked Then
F_Type = ".vbs"
ElseIf FType(6).checked Then
F_Type = ".txt"
Else
F_Type = "Nothing Selected"
End If
Exit Function
End Function
'-> No File Selected Error Message
Function NoFileSelected()
alert(" There Was Not A File Type Selected" & vbcrlf & _
"Select A File Type To Search For.")
Exit Function
End Function
'-> Clear Left Side Text List
Function UpdateList()
For Each ObjList In TxtFile.Options :ObjList.RemoveNode :Next
Path.innerHTML = ""
Exit Function
End Function
'-> Save Any Changes
Function SaveMyChanges()
Dim TS
If Contents.Value = "" Then
Else
Set Ts = Fso.CreateTextFile(TxtFile.Value)
TS.WriteLine Contents.Value
Ts.Close
End If
Exit Function
End Function
'-> Select From List And Fill Main Text Area
Function ReadFile()
On Error Resume Next
Set objFile = Fso.OpenTextFile(TxtFile.Value)
strContents = objFile.ReadAll
objFile.Close
Contents.Value = strContents
Path.innerHTML=TxtFile.Value
Exit Function
End Function
</SCRIPT>
<BODY>Gunsmokingman Multi Editor
<DIV ID='Txt1' Style='Color:;Margin-Top:3;'> </DIV>
<TABLE width="50%">
<TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Cmd</TD>
<TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Hta</TD>
<TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Inf</TD>
<TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Ini</TD>
<TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Reg</TD>
<TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Vbs</TD>
<TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Txt</TD>
</TABLE>
<TABLE width="100%" Style='Margin-Top:3px;Margin-Bottom:3px;' Border='1'>
<TR>
<TD width="25%" valign="top">
<select size="32" name="TxtFile" onChange="ReadFile()"
style="Width:100%;Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;Font-Size:7.95pt;Font-Weight:Bold;">
</select>
</TD>
<TD width="75%" valign="top">
<textarea name="Contents" rows="32" cols="100"
Style='Width:100%;Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;Font-Size:7.95pt;Font-Weight:Bold;'
OnChange='SaveMyChanges()'></textarea>
</TD>
</TR>
</TABLE>
<SPAN ID='Path' > </SPAN>
<!-- Button Table Start -->
<TABLE Style='Margin-Top:3px;Margin-Bottom:3px;' Border='1' Align='Center'>
<!-- Single Folder Querry Start -->
<script LANGUAGE="VBScript">
Function DirectoryList()
CheckFileType()
If instr(F_Type,"Nothing Selected") Then
NoFileSelected()
Else
Set Folder = Shell.BrowseForFolder(0, "Select a folder:", 0, MY_COMPUTER)
If Folder Is Nothing Then
Exit Function
Else
Contents.Value=""
Txt1.innerHTML=Msg2
Time1 = window.setTimeout("Querry1", 2000, "VBScript")
End If
End If
Exit Function
End Function
Function Querry1()
Set FolderItem = Folder.Self
ObjPath = FolderItem.Path
UpdateList()
Set colFiles = Wmi.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & ObjPath & "'} " _
& "Where ResultClass = CIM_DataFile ")
For Each objFile In colFiles
If Right(Instr(objFile.Name,F_Type),4) Then
C1 = C1 + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.FileName
objOption.Value = objFile.Name
If C1 Mod 2 Then
objOption.style.backgroundcolor = "#C9C9C9"
objOption.style.color = "#3A3A3A"
Else
objOption.style.backgroundcolor = "#E9E9E9"
objOption.style.color = "#235779"
End If
TxtFile.Add(objOption)
End If
Next
C1=0
Txt1.innerHTML=Msg1
Time1 = window.clearTimeout()
Exit Function
End Function
</SCRIPT>
<TD><BUTTON OnClick='DirectoryList()'>Folder</BUTTON></TD>
<!-- Single Folder Querry End -->
<!-- Directory Folder Querry Start -->
<script LANGUAGE="VBScript">
'-> Folder And Sub Folders
Function FolderSubFolderListAll()
CheckFileType()
If instr(F_Type,"Nothing Selected") Then
NoFileSelected()
Else
Set Folder = Shell.BrowseForFolder(0, "Select a folder:", 0, MY_COMPUTER)
If Folder Is Nothing Then
Exit Function
Else
Contents.Value=""
Txt1.innerHTML=Msg2
Time1 = window.setTimeout("Querry2", 2000, "VBScript")
End If
End If
Exit Function
End Function
Function Querry2()
Set FolderItem = Folder.Self
strFolderName = FolderItem.Path
UpdateList()
Set colSubfolders = Wmi.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory ResultRole = PartComponent")
Set colFiles = Wmi.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & strFolderName & "'} Where " _
& "ResultClass = CIM_DataFile")
For Each objFile in colFiles
If Right(Instr(objFile.Name,F_Type),4) Then
C1 = C1 + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.FileName
objOption.Value = objFile.Name
If C1 Mod 2 Then
objOption.style.backgroundcolor = "#C9C9C9"
objOption.style.color = "#3A3A3A"
Else
objOption.style.backgroundcolor = "#E9E9E9"
objOption.style.color = "#235779"
End If
TxtFile.Add(objOption)
End If
Next
For Each objFolder In colSubfolders :GetSubFolders strFolderName :Next
C1=0
Txt1.innerHTML=Msg1
Time1 = window.clearTimeout()
Exit Function
End Function
'-> Sub Folders
Sub GetSubFolders(strFolderName)
On Error Resume Next
Set colSubfolders2 = Wmi.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
For Each objFolder2 in colSubfolders2
strFolderName = objFolder2.Name
Set colFiles = Wmi.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name='" & strFolderName & "'} Where " _
& "ResultClass = CIM_DataFile")
For Each objFile in colFiles
If Right(Instr(objFile.Name,F_Type),4) Then
C1 = C1 + 1
Set objOption = Document.createElement("OPTION")
objOption.Text = objFile.FileName
objOption.Value = objFile.Name
If C1 Mod 2 Then
objOption.style.backgroundcolor = "#C9C9C9"
objOption.style.color = "#3A3A3A"
Else
objOption.style.backgroundcolor = "#E9E9E9"
objOption.style.color = "#235779"
End If
TxtFile.Add(objOption)
End If
Next
GetSubFolders strFolderName
Next
End Sub
</SCRIPT>
<TD><BUTTON OnClick='FolderSubFolderListAll()'>Directory</BUTTON></TD>
<!-- Directory Folder Querry End -->
<!-- Clear Select And Path Start -->
<script LANGUAGE="VBScript">
Function ClearReset()
UpdateList()
Contents.Value = ""
Path.innerHTML = ""
Exit Function
End Function
</SCRIPT>
<TD><BUTTON OnClick='ClearReset()'>Clear</BUTTON></TD>
<!-- Clear Select And Path End -->
<!-- Run Selected Item Start -->
<script LANGUAGE="VBScript">
Function RunCmdPromt()
If TxtFile.Value = "" Then
alert("There was nothing to run")
Else
If FType(0).checked Then Cmd1 = "cmd.exe /c " & Chr(34) & TxtFile.Value & Chr(34)
If FType(1).checked Then Cmd1 = "mshta.exe " & Chr(34) & TxtFile.Value & Chr(34)
If FType(5).checked Then Cmd1 = "cscript.exe " & Chr(34) & TxtFile.Value & Chr(34)
If FType(2).checked Or FType(3).checked Or FType(4).checked Or FType(6).checked Then
Cmd1 = "notepad.exe " & Chr(34) & TxtFile.Value & Chr(34)
End If
Act.Run(Cmd1),1,True
End If
Exit Function
End Function
</SCRIPT>
<TD><BUTTON OnClick='RunCmdPromt()'>Process</BUTTON></TD>
<!-- Run Selected Item End -->
</TABLE>
<!-- Button Table End -->
</BODY>


Code updated to this link
Updated Rar

Attached Files


Edited by gunsmokingman, 14 February 2015 - 11:48 AM.



GunSmokingMan



#7
delei

delei
  • Member
  • 1 posts
  • Joined 28-June 08
Hi friends, I didn't write very well in english but I want know if you can help me to solve a problem. I found your script and think it very intrusting.
I need a simplified version of this script with the following modifications:

* Open only ".txt" files - it don't need to have the radio buttons. Only "txt" as default.

* List automatically the files in a default folder, so it have no need to exist the buttons "folder", "directory" or "process".

* The Delete button must remove from list and delete the files from folder.

If you could help me, I will be gratefull.

Follow attached a simple preview to show waht I need.
Posted Image

Thank your for the attention.

Attached Files



#8
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,447 posts
  • Joined 02-August 03
  • OS:none specified
  • Country: Country Flag
I have now updated the HTA
1:\ Clean up the code
2:\ Added a choice to run VBS with either Cscript or Wscript engine
3:\ Replaced the directory search with a search of all local drives

Attached File  HtaMe.png   63.06KB   0 downloads
<!--
 Coded By Gunsmokingman Aka Jake1eye
 Updated  February-13-15
 -->
<TITLE>HTA Multi Editor</TITLE>
<HTA:APPLICATION ID='HTA_ME'
  Scroll='Yes'             
  SCROLLFLAT ='Yes'        
  SingleInstance='Yes'
  SysMenu='Yes'
  ShowInTaskBar='Yes'
  MaximizeButton='No'
  MinimizeButton='Yes'     
  Border='Thick'
  BORDERSTYLE ='complex'  
  INNERBORDER ='Yes'
  Caption='Yes'  
  WindowState='Normal'
  APPLICATIONNAME='Gsm_ME' 
  Icon='%SystemRoot%\explorer.exe'>
<STYLE Type="text/css">
  Body{
   BackGround-Color:#fdf7f1;Text-Align:Center;Vertical-Align:Top;
   Font-Size:8.05pt;Font-Weight:Bold;Color:#001254;
   Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
   Margin-Top:1;Margin-Bottom:1;Margin-Left:4;Margin-Right:4;
   Padding-Top:1;Padding-Bottom:1;Padding-Left:4;Padding-Right:4;
   Border-Top:2px Solid #a6a29e;Border-Bottom:3px Solid #cbc7c3;
   Border-Left:2px Solid #b2aeaa;Border-Right:3px Solid #bcb8b4;
  }
  BUTTON{
   Width:101pt;Height:13pt;Cursor:Hand;
   Font-Size:8.05pt;Font-Weight:Bold;Color:#112253;    
   Font-Family:Arial,Tahoma,Comic Sans MS,Segoe Ui;
   Filter:progid:DXImageTransform.Microsoft.Gradient
   (StartColorSTR='#bcdeff',endColorSTR='#335599');
   Padding-Top:1;Padding-Bottom:2;Margin-Left:1pt;Margin-Right:1pt;
   Border-Top:1px TransParent;Border-Bottom:2px TransParent;
   Border-Left:1px TransParent;Border-Right:2px TransParent;
  }
  TD{
   Text-Align:Center;Font-Size:7.95pt;Font-Weight:Bold;Color:#5E5E5E;
   Margin-Top:1;Margin-Bottom:1;
  }
  TD.T1{
   Text-Align:Left;Width:39;Font-Size:7.95pt;Font-Weight:Bold;Color:#5E5E5E;
   Margin-Top:1;Margin-Bottom:1;
  }
</STYLE>
<SCRIPT LANGUAGE="VBScript">
  Const WINDOW_HANDLE = 0 ,OPTIONS = 0,MY_COMPUTER = &H11&  
'-> Resize And Move Window
   Dim Wth :Wth = int(925)
   Dim Hht :Hht = int(575)
   window.ResizeTo Wth, Hht
   MoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))
'-> Object For Runtime
  Dim Shl :Set Shl = CreateObject("Shell.Application")
  Dim Act :Set Act = CreateObject("Wscript.Shell")
  Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
  Dim Wmi :Set Wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
  Dim C1, c34, Cmd1, Ext, Folder, FItem, i, Obj, Time1 :c34 = Chr(34)
  Dim Msg1 :Msg1="Select The File Type That You Want To List."
  Dim Msg2 :Msg2="<FONT Style='Color:#Ad1111;Margin-Top:3;'>" & _
   "This may appear to not be responding, while the query is active! " & _
   "This is the normal and expected occurance.</FONT>"
'-> Window OnLoad
   Function Window_onLoad()
    self.Focus() :Txt1.innerHTML=Msg1 :Path.innerHTML = chr(160)
   End Function
'-> File Type Selection 
   Function CheckFileType()
    Dim j :j = 1 
    If FType(0).checked Then Ext = "cmd" :j=2
    If FType(1).checked Then Ext = "hta" :j=2
    If FType(2).checked Then Ext = "inf" :j=2
    If FType(3).checked Then Ext = "ini" :j=2
    If FType(4).checked Then Ext = "reg" :j=2
    If FType(5).checked Then Ext = "vbs" :j=2
    If FType(6).checked Then Ext = "txt" :j=2
    if j = 1 Then  Ext = "Nothing Selected"
   End Function
'-> No File Selected Error Message
   Function NoFileSelected()
    alert(" There Was Not A File Type Selected" & vbcrlf & _
     "You must select A File Type To Search For.")
   End Function
'-> Clear Left Side Text List
   Function UpdateList()
    For Each Obj In TxtFile.Options :Obj.RemoveNode :Next
    Path.innerHTML = chr(160)
   End Function
'-> Save Any Changes
   Function SaveMyChanges()
    Dim TS
    If Contents.Value = "" Then
    Else
     Set Ts = Fso.CreateTextFile(TxtFile.Value)
      TS.WriteLine Contents.Value
      Ts.Close
     End If
   Exit Function
   End Function
'-> Select From List And Fill Main Text Area
   Function ReadFile()
    On Error Resume Next
     Set objFile = Fso.OpenTextFile(TxtFile.Value)
     strContents = objFile.ReadAll
     objFile.Close
     Contents.Value = strContents
     Path.innerHTML=TxtFile.Value
   Exit Function
   End Function
'-> Brows For Dailog To Folder To search
   Function BrowsFor()
   CheckFileType()
    If instr(Ext,"Nothing Selected") Then
     NoFileSelected()
    Else
     Set Folder = Shl.BrowseForFolder(0, "Select a folder:", 0, MY_COMPUTER) 
     If Folder Is Nothing Then
      Exit Function
     Else 
      Contents.Value=""
      Txt1.innerHTML=Msg2
      Time1 = window.setTimeout("Querry1", 2000, "VBScript")
     End If 
    End If     
   End Function
'-> Main Query For Single Folder
   Function Querry1()
    Set FItem = Folder.Self 
    UpdateList()
     For Each Obj In Fso.GetFolder(FItem.Path).Files
      If Right(Instr(Obj.Path,Ext),3) Then
       Call AddToList(Obj.Name,Obj.Path)
      End If
     Next
     C1=0
     Txt1.innerHTML=Msg1
    TimerOut()
   End Function
'-> Start Auto Search Function
   Function AllDrives()
    CheckFileType()
    Contents.Value=""
    Txt1.innerHTML=Msg2
    Time1 = window.setTimeout("Querry2", 2000, "VBScript")
   End Function
'-> Main Query For All Local Drives
   Function Querry2()
    UpdateList()
    Dim Col :Set Col = Wmi.ExecQuery("Select * from CIM_DataFile Where Extension = '"&Ext&"'")      
     If Col.count = 0 Then
      MsgBox "Query Results Is Zero Type Found For This Type : " & A1 , 4128, "No File Type Found"
     Else 
      For Each Obj in Col   
       If InStr(Obj.Path,"windows") Or InStr(Obj.Path,"program") Then    
       Else    
        Call AddToList(Obj.FileName,Obj.Drive & Obj.Path & Obj.FileName & "." & Obj.Extension)
       End If 
      Next
     End If
    C1=0
    Txt1.innerHTML=Msg1
    TimerOut()     
   End Function
'-> Add To List Box
   Function AddToList(N,P)
    C1 = C1 + 1
     Set i = Document.createElement("OPTION")
      i.Text = N
      i.Value = P
       If C1 Mod 2 Then
        i.style.backgroundcolor = "#C9C9C9" 
        i.style.color = "#3A3A3A"
       Else 
        i.style.backgroundcolor = "#E9E9E9" 
        i.style.color = "#235779"
       End If
     TxtFile.Add(i)
   End Function
'-> Clear Select And Path Start
   Function ClearReset()
    UpdateList()
    Contents.Value = ""
    Path.innerHTML = Chr(160)
   End Function
'-> Run Select Item
   Function RunCmdPromt()
   If TxtFile.Value = "" Then
    alert("There was nothing to run")
   Else
    If FType(0).checked Then Cmd1 = "cmd.exe /c " & c34 & TxtFile.Value & c34  
    If FType(1).checked Then Cmd1 = "mshta.exe " & c34 & TxtFile.Value & c34
    If FType(5).checked Then     
     If confirm("Press Ok to run the VBS script using Cscript.exe, " &_
     "or press Cancel to run the VBS script using Wscript.exe") = True Then
      Cmd1 = "cscript.exe " & c34 & TxtFile.Value & c34
     Else
      Cmd1 = "wscript.exe " & c34 & TxtFile.Value & c34
     End If
    End If
    If FType(2).checked Or FType(3).checked Or FType(4).checked Or FType(6).checked Then
     Cmd1 = "notepad.exe " & c34 & TxtFile.Value & c34    
    End If  
    Act.Run(Cmd1),1,True
    End If
   End Function 
'-> Clear The Timer
   Function TimerOut()
    Time1 = window.clearTimeout()
   End Function    
  </SCRIPT>
<BODY>HTA Multi Editor
<DIV ID='Txt1' Style='Color:;Margin-Top:3;'>&#160;</DIV>
<!-- Select File Type -->
<TABLE width="50%">
  <TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Cmd</TD>
  <TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Hta</TD>
  <TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Inf</TD>
  <TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Ini</TD>
  <TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Reg</TD>
  <TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Vbs</TD>
  <TD STYLE='Width:14;'><INPUT Type='Radio' Name='FType'></TD><TD Class='T1'>Txt</TD>
</TABLE>
<TABLE width="100%" Style='Margin-Top:3px;Margin-Bottom:3px;' Border='1'><TR>
<!-- Display Item Name -->
<TD width="25%" valign="top">
 <select style="Width:100%;Font-Family:Lucida Console;Font-Size:7.95pt;Font-Weight:Bold;"
  size="35" Name="TxtFile"  OnChange="ReadFile()"></select></TD>
<!--Display File And Edit -->
<TD width="75%" valign="top">
 <textarea Style='Width:100%;Font-Family:Lucida Console;Font-Size:7.95pt;Font-Weight:Bold;'
 Name="Contents" rows="35" cols="100"  OnChange='SaveMyChanges()'></textarea></TD>
</TR></TABLE>
<!-- Display Item Path -->
<SPAN ID='Path' >&#160;</SPAN>
<!-- Button Table Start -->
<TABLE Style='Margin-Top:3px;Margin-Bottom:3px;' Border='1' Align='Center'>
<!-- Single Folder Button -->
<TD><BUTTON OnClick='BrowsFor()'>Single Folder</BUTTON></TD>
<!-- Auto Search Button -->
<TD><BUTTON Title='Searches All The Local Drives For Selected File Type' 
  OnClick='AllDrives()'>Auto Search</BUTTON></TD>
<!-- >Clear Query Button --> 
<TD><BUTTON OnClick='ClearReset()'>Clear Query Box</BUTTON></TD>
<!-- Run Selected Button -->  
<TD><BUTTON OnClick='RunCmdPromt()'>Process Item</BUTTON></TD>
</TABLE>
</BODY>
Code Fixes Or Updates
1:\ Fixed a couple of errors I missed in the Single Folder Button
2:\ Updated Query1 and Query2 to use a single function to populate the left side list.
Old Query 1 and 2 Function
'-> Main Query For Single Folder
   Function Querry1()
    Set FItem = Folder.Self 
    UpdateList()
     For Each Obj In Fso.GetFolder(FItem.Path).Files
      If Right(Instr(Obj.Path,Ext),3) Then
       C1 = C1 + 1
       Set i = Document.createElement("OPTION")
        i.Text = Obj.Name
        i.Value = Obj.Path
        If C1 Mod 2 Then
         i.style.backgroundcolor = "#C9C9C9" 
         i.style.color = "#3A3A3A"
        Else 
         i.style.backgroundcolor = "#E9E9E9" 
         i.style.color = "#235779"
        End If
       TxtFile.Add(i)      
      End If
     Next
     C1=0
     Txt1.innerHTML=Msg1
    TimerOut()
   End Function

'-> Main Query For All Local Drives
   Function Querry2()
    UpdateList()
    Dim Col :Set Col = Wmi.ExecQuery("Select * from CIM_DataFile Where Extension = '"&Ext&"'")      
     If Col.count = 0 Then
      MsgBox "Query Results Is Zero Type Found For This Type : " & A1 , 4128, "No File Type Found"
     Else 
      For Each Obj in Col   
       If InStr(Obj.Path,"windows") Or InStr(Obj.Path,"program") Then    
       Else    
        'WScript.Echo Obj.Drive & Obj.Path & Obj.FileName & "." & Obj.Extension
          C1 = C1 + 1
         Set i = Document.createElement("OPTION")
          i.Text = Obj.FileName
          i.Value = Obj.Drive & Obj.Path & Obj.FileName & "." & Obj.Extension
         If C1 Mod 2 Then
          i.style.backgroundcolor = "#C9C9C9" 
          i.style.color = "#3A3A3A"
         Else 
          i.style.backgroundcolor = "#E9E9E9" 
          i.style.color = "#235779"
         End If
        TxtFile.Add(i)       
       End If 
      Next
     End If
    C1=0
    Txt1.innerHTML=Msg1
    TimerOut()     
   End Function

New Query 1 and 2 Function
'-> Main Query For Single Folder
   Function Querry1()
    Set FItem = Folder.Self 
    UpdateList()
     For Each Obj In Fso.GetFolder(FItem.Path).Files
      If Right(Instr(Obj.Path,Ext),3) Then
       Call AddToList(Obj.Name,Obj.Path)
      End If
     Next
     C1=0
     Txt1.innerHTML=Msg1
    TimerOut()
   End Function
'-> Main Query For All Local Drives
   Function Querry2()
    UpdateList()
    Dim Col :Set Col = Wmi.ExecQuery("Select * from CIM_DataFile Where Extension = '"&Ext&"'")      
     If Col.count = 0 Then
      MsgBox "Query Results Is Zero Type Found For This Type : " & A1 , 4128, "No File Type Found"
     Else 
      For Each Obj in Col   
       If InStr(Obj.Path,"windows") Or InStr(Obj.Path,"program") Then    
       Else    
        Call AddToList(Obj.FileName,Obj.Drive & Obj.Path & Obj.FileName & "." & Obj.Extension)
       End If 
      Next
     End If
    C1=0
    Txt1.innerHTML=Msg1
    TimerOut()     
   End Function

'-> Add To List Box
   Function AddToList(N,P)
    C1 = C1 + 1
     Set i = Document.createElement("OPTION")
      i.Text = N
      i.Value = P
       If C1 Mod 2 Then
        i.style.backgroundcolor = "#C9C9C9" 
        i.style.color = "#3A3A3A"
       Else 
        i.style.backgroundcolor = "#E9E9E9" 
        i.style.color = "#235779"
       End If
     TxtFile.Add(i)
   End Function
Updated Code Zip
Attached File  HtaEditor.zip   3.26KB   5 downloads


GunSmokingMan






0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users