gunsmokingman

Super Moderator
  • Content count

    2,265
  • Joined

  • Last visited

  • Days Won

    4

gunsmokingman last won the day on April 11 2015

gunsmokingman had the most liked content!

Community Reputation

20 Excellent

About gunsmokingman

  • Birthday 09/26/1962

Profile Information

  • OS
    none specified
  • Country

Recent Profile Visitors

1,508 profile views
  1. I have updated the original script 1:\ Added a message box to appear with instructions on how to use 2:\ Added a new user input to search for the file type New Code Dim Col,Str, Res :Str = "." Dim Wmi :Set Wmi = GetObject("winmgmts:\\" & Str & "\root\cimv2") '-> Check To Nake Sure Cscript Is Used If InStr(1,WScript.FullName,"cscript",1) Then UserImput() '-> Main Search Object Using The User Input Set Col = Wmi.ExecQuery("Select * from CIM_DataFile Where Extension = '" & Res &"'") WScript.StdOut.WriteLine "Begin Querry For " & Res Main() Else '-> Wrong Script Engine MsgBox Space(10) & "Error Wrong Scripting Engine" & vbCrLf & _ "You must right click this script and select the Cmd Prompt or" & vbCrLf & _ "Csript option to run this script",4128,"Error Wrong Script Engine" End If '-> Main Function To Collect All The Files Function Main() If Col.count = 0 Then WScript.StdOut.WriteLine "Can Not Find This File Type" WScript.Sleep 3500 WScript.Quit Else WScript.StdOut.WriteLine "Processing Please Wait..." For Each Obj in Col '-> Display File Type WScript.StdOut.WriteLine Obj.Name WScript.Sleep 300 Next End If Res = "" CloseCmd() End Function '-> Get User Input For File Type Function UserImput() Do While Res = "" WScript.StdOut.WriteBlankLines 1 WScript.StdOut.WriteLine _ "Type the file type you are searching for in this" & vbCrLf &_ "format txt or vbs or cmd no dot is needed." & vbCrLf & _ "Type exit or quit to stop the script." WScript.StdOut.WriteBlankLines 1 Res = Wscript.StdIn.ReadLine Select Case LCase(Res) Case "exit" WScript.Quit Case "quit" WScript.Quit End Select Loop End Function '-> Close The CMD Window Function CloseCmd() Do While Res = "" WScript.StdOut.WriteBlankLines 2 WScript.StdOut.WriteLine "Total File Count : " & Col.count WScript.StdOut.WriteLine "Type quit Or exit to close CMD window" Res = Wscript.StdIn.ReadLine Select Case LCase(Res) Case "exit" WScript.Quit Case "quit" WScript.Quit End Select Loop End Function Rename WmiUserInExtSearch.vbs.txt to WmiUserInExtSearch.vbs to make active WmiUserInExtSearch.vbs.txt
  2. Here is a VBS script that output results to CMD prompt window. You will have to add the file type that you want to search for. '-> Main Search Object Change 'vbs' to 'FileTypeHere' Dim Col :Set Col = Wmi.ExecQuery("Select * from CIM_DataFile Where Extension = 'vbs'") Dim Str :Str = "." Dim Wmi :Set Wmi = GetObject("winmgmts:\\" & Str & "\root\cimv2") '-> Main Search Object Change 'vbs' to 'FileTypeHere' Dim Col :Set Col = Wmi.ExecQuery("Select * from CIM_DataFile Where Extension = 'vbs'") Dim Res '-> Check To Nake Sure Cscript Is Used If InStr(1,WScript.FullName,"cscript",1) Then Main() End If '-> Main Function To Collect All The Files Function Main() If Col.count = 0 Then WScript.StdOut.WriteLine "Can Not Find This File Type" WScript.Sleep 3500 WScript.Quit Else WScript.StdOut.WriteLine "Processing..." For Each Obj in Col '-> Display File Type WScript.StdOut.WriteLine Obj.Name WScript.Sleep 500 Next End If CloseCmd() End Function '-> Close The CMD Window Function CloseCmd() Do While Res = "" WScript.StdOut.WriteLine "Total File Count : " & Col.count WScript.StdOut.WriteLine " Type quit Or exit to close CMD window" Res = Wscript.StdIn.ReadLine Select Case LCase(Res) Case "exit" WScript.Quit Case "quit" End Select Loop End Function I have tested this script on my computer with no run-time error. I will help you edit this script so it will do what you want.
  3. Here is a rewrite of your code that you posted, I removed all the redundant code and added a function to process the text file. <script language="VBScript"> Option Explicit '-> Objects For Run Time Dim fso :Set fso = CreateObject("Scripting.FileSystemObject") Dim WshShell :Set WshShell = CreateObject("WScript.Shell") Dim Temp :Temp = Temp = WshShell.ExpandEnvironmentStrings("%Temp%") '-> Varibles For Run Time Dim Command, PSFile, return, file,text '-> Button 01 Click Function Run_PS_Script1() ExampleOutput.value = "" btnClick1.disabled = True document.body.style.cursor = "wait" btnClick1.style.cursor = "wait" Command = "cmd /c echo Get-NetAdapter ^| select Name,MacAddress ^| Where-Object {$_.Name -like 'Ethernet' -or $_.Name -like 'Wi-Fi'} ^| Out-File %temp%\output.txt -Encoding ascii > %temp%\process.ps1" PSFile = WshShell.Run(Command,0,True) return = WshShell.Run("powershell.exe -ExecutionPolicy Unrestricted -File %temp%\process.ps1", 0, true) '-> Replace It With A Function, So It Can Be Access More than Once ReadTheFile() document.body.style.cursor = "default" btnClick1.style.cursor = "default" btnClick1.disabled = False End Function '-> Button 02 Click Function Run_PS_Script2() ExampleOutput.value = "" btnClick2.disabled = True document.body.style.cursor = "wait" btnClick2.style.cursor = "wait" Command = "cmd /c echo Get-NetAdapter ^| select Name,MacAddress ^| Where-Object {$_.Name -like 'Ethernet'} ^| Out-File %temp%\output.txt -Encoding ascii > %temp%\process.ps1" PSFile = WshShell.Run(Command,0,True) return = WshShell.Run("powershell.exe -ExecutionPolicy Unrestricted -File %temp%\process.ps1", 0, true) Set fso = CreateObject("Scripting.FileSystemObject") '-> Replace It With A Function, So It Can Be Access More than Once ReadTheFile() document.body.style.cursor = "default" btnClick2.style.cursor = "default" btnClick2.disabled = False End Function '-> Read The Text File Dislay The Results, From Button 01 And Button 02 Function ReadTheFile() Set file = fso.OpenTextFile(Temp &"\output.txt", 1) text = file.ReadAll ExampleOutput.Value=text file.Close End Function </script>
  4. VBS Drag And Drop Function '-> Checks To Make Sure Only 1 Files Is Process If WScript.Arguments.Count = 0 Then MsgBox "You Must Drag And Drop One File Onto This Script.",4128, _ "Error No Drag And Drop performed" ElseIf WScript.Arguments.Count = 1 Then MsgBox WScript.Arguments.Item(0),4128, "Drag Drop Demo" ElseIf WScript.Arguments.Count > 1 Then MsgBox "Drag And Drop To Many Files, This Script Is Only For One File To Be Drag And Drop Onto " & _ "This Script",4128,"Error To Many Files" End If
  5. Here is a Demo VBS script that pings in this order, your computer, made up IP, your computer, made up IP. It uses a counter that resets it self every 5 times. When it stops if you do nothing or select No than the script continues after 30 seconds, if Yes is selected script quits. It displays the ping results in a 3 second self closing message box, it also display the cycles left before being ask to continue or quit. DemoPing '-> Run Time Object Dim Act :Set Act = CreateObject("Wscript.Shell") '-> Run Time Varibles Dim C1, i, Ip, Rtn, T1, T2 Ip = Array("127.0.0.1", "81.123.55.99","127.0.0.2","82.234.100.56") '-> Loop To Keep Repeating The Second Loop Do C1 = C1 + 1 '-> Stops The Script If C1 = 5 Then '-> No Or Time Out Continues The Script, Yes Script Quit, If Act.Popup("Would You Like To Quit The Script?",30, _ "Continue Or Quit", 4132) = 6 Then WScript.Quit(1) End If '-> Reset The Counter C1 = 0 End If '-> Threw The Ip Array For Each i In Ip Ping(i) T1 = Rtn & ", Ip Reply : "& i :T2 = "Cycles Left : " & 5-C1 If Rtn Then Act.Popup T1 & vbCrLf & T2,3,"Yes Reply",4128 Else Act.Popup T1 & vbCrLf & T2,3,"No Reply",4128 End If Next Loop Until C1 = 10000 '-> Ping Computer Function Ping(P) If Act.Run("Ping -n 1 -w 1000 " & P, 0, True) = 0 Then Rtn = True Else Rtn = False End If End Function Rename PingDemo.vbs.txt to PingDemo.vbs to make it active PingDemo.vbs.txt
  6. You would need to use a loop within a loop to do what you need Example only not working code Do For Each Object In Your List Of Computors Some Code Here To Ping next Until Something That last 6 Hours
  7. Here is a VBS script that meant to be run from your Desktop to a Folder and list it Contents. It then rename the file to a 4 digit number, it also produces a text file with the changes made. 1:\ Change This For Each i In Fso.GetFolder("D:\UsbMp3").Files, to the path of the folder 2:\ This script only is meant to be used with file that have only 3 characters and a period any less or more will cause an error Code '-> Object For Runtime Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") '-> Run Time Varibles Dim C1, i, j, t, Ts '->Loop Threw The File In The Folder Listed Below For Each i In Fso.GetFolder("D:\UsbMp3").Files '-> Count The Files C1 = C1 + 1 '-> Get The Period And File Charaters EG .com, .txt, .vbs j = Right(i.Name,4) '-> For The Text Report List The New File Name With The Old File Name t = t & Az(C1) & j & " = " & i.Name & vbCrLf '-> Copy Old Name To the New Name = Az(C1) & j Fso.CopyFile i.Path,Replace(i.path,i.name,Az(C1) & j),True '-> Delete The Old File Fso.DeleteFile(i.Path),True Next '-> Build And Show The Report Set Ts = Fso.CreateTextFile("TestList.txt") Ts.WriteLine Now() Ts.WriteLine "Files Process : " & Az(C1) Ts.WriteLine t Ts.Close() Act.Run("TestList.txt"),1,True '-> Ask To Keep It Or Delete It If MsgBox("Yes To Keep TestList.txt Or No To Delete TestList.txt", _ 4132,"Keep Or Delete") = 7 Then Fso.DeleteFile("TestList.txt"),True End If '-> Funtion To Add Zero To The Number Function Az(n) Dim z If Len(n)= 1 Then n = "000" & n If Len(n)= 2 Then n = "00" & n If Len(n)= 3 Then n = "0" & n Az=n End Function Rename TestListFiles.vbs.txt to TestListFiles.vbs to make active TestListFiles.vbs.txt Resuts TestList.txt
  8. Perhaps a more simple solution would be to use a VBS script to install. I say this because VBS has a built in Timer Function, below is an example using 3 common MS apps in an Array. It will then process the time it takes you to close each app and report it with a 10 second self closing Popup messagebox. '-> Runtime Object Dim Act :Set Act = CreateObject("Wscript.Shell") '-> Array To Hold Apps Dim App :App = Array("Notepad.exe","mspaint.exe", "cmd.exe") '-> Runtime Varibles Dim Tm1, Tm2, Tm3, Tm4, i '-> Threw Each App In Tha Array For Each i In App '-> Start Time Tm1 = Timer Act.Run(i),1,True '-> End Time Tm2 = Timer '-> Results Tm3 = Tm2 - Tm1 '-> For The Popup Report Tm4 = Tm4 & Round(Tm3,2) & " seconds " & i & vbCrLf Next '-> Show The Results Act.Popup Tm4,10,"Results",4128 Rename DemoTimer.vbs.txt to DemoTimer.vbs to make active DemoTimer.vbs.txt
  9. Here is a HTA that uses VBS script to create Demo Timer Here is the code for the HTA <!-- Script By Gunsmokingman Aka Jake1eye --> <TITLE>Demo Timer</TITLE> <HTA:APPLICATION ID="Demo Timer" SCROLL="No" SCROLLFLAT ="No" SingleInstance="Yes" ShowInTaskbar="No" SysMenu="No" MaximizeButton="No" MinimizeButton="No" Border="Thin" BORDERSTYLE ="complex" INNERBORDER ="No" Caption="Yes" WindowState="Normal" APPLICATIONNAME="DTimer" Icon="%SystemRoot%\explorer.exe"> <STYLE type="text/css"> Body { Padding-Top:1pt;Padding-Bottom:1pt;Margin:1pt; Font-Size:10.25pt;Font-Weight:Bold; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; Color:Black;BackGround-Color:#EFE9E3; Text-Align:Center;Vertical-Align:Top; } DIV { Font-Size:10.25pt;Font-Weight:Bold;Color:#00A1A1; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; } TD { Font-Size:10.25pt;Font-Weight:Bold;Color:#515151; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; } BUTTON { Height:15pt;width:51pt;Cursor:Hand; Font:8.25pt;Font-weight:bold; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; Color:#404040;Text-Align:Center;Vertical-Align:Middle; filter:progid:DXImageTransform.Microsoft.Gradient (StartColorStr='#E5E5E5',EndColorStr='#7D7D7D'); Margin:1;Padding:2; Border-Left: 1px Transparent;Border-Right: 2px Transparent; Border-Top: 1px Transparent;Border-Bottom: 2px Transparent; } </STYLE> <SCRIPT LANGUAGE='VBScript'> '-> Resize And Place In Approx Center Of Screen Dim Wth, Hht :Wth = int(327) :Hht = int(150) window.ResizeTo Wth, Hht MoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2)) Dim C1, H1, M1, T1, Tm1, txt Function Window_OnLoad() C1=0 :H1=0 :M1=0 Counter() End Function '-> To Keeps The Script In An Infinte Loop Until User Interaction Function Counter() '-> Reset The Seconds And Minutes Every 60 Cycles If C1 = 60 Then :M1 = M1 + 1 :C1 = 0 If M1 = 60 Then :H1 = H1 + 1 :M1 = 0 '-> To Display 02 Digits Ex 1 = 01 If Len(C1) = 1 Then C1 = "0" & C1 If Len(M1) = 1 Then M1 = "0" & M1 If Len(H1) = 1 Then H1 = "0" & H1 T1 = Split(Time(),":") If Len(T1(0)) = 1 Then T1(0) = "0" & T1(0) If Len(T1(1)) = 1 Then T1(1) = "0" & T1(1) Tx1.style.color="#9A0000" :Tx1.innerHTML=H1 Tx2.style.color="#009a00" :Tx2.innerHTML=M1 Tx3.style.color="#00009a" :Tx3.innerHTML=C1 Dim S :S = Split(T1(2), " ") If Len(S(0)) = 1 Then S(0) = "0" & S(0) Tx4.style.color="#009595" Tx4.innerHTML=T1(0) & ":" & T1(1) & ":" & S(0) & " " & S(1) C1 = C1 + 1 Tm1=window.setTimeout("Counter()",1000,"VBScript") End Function </SCRIPT> <BODY Scroll='No'><TABLE>Demo Timer</TABLE> <TABLE> <TD><TD>Hours&#160;&#187;</TD><TD><DIV ID='Tx1'>00 </DIV></TD></TD> <TD><TD>Minutes&#160;&#187;</TD><TD><DIV ID='Tx2'>00</DIV></TD></TD> <TD><TD>Seconds&#160;&#187;</TD><TD><DIV ID='Tx3'>00</DIV></TD></TD> </TABLE> <TABLE> <BUTTON ID='Bn1' OnClick="window.clearTimeout(Tm1)">Stop</BUTTON> <BUTTON ID='Bn2' OnClick="Counter()">Re-Start</BUTTON> <BUTTON ID='Bn3' OnClick="window.clearTimeout(Tm1): Window_OnLoad()">Re-Set</BUTTON> <BUTTON ID='Bn4' OnClick="window.clearTimeout(Tm1): window.close()">Close</BUTTON> </TABLE> <TABLE> <TD><DIV ID='Tx4'>00:00 PM</DIV></TD> </TABLE> </BODY> Demo_TimerCount.zip
  10. Here are some links for you to try and work out what you need done 1:\ Reading From and Writing to the Local Registry 2:\Changing Registry Data 3:\How Can I Create a New Registry Key
  11. You can use a VBS script to not show any windows Example '-> Constants For The Various Window States Const Hide = 0, Norm = 1, Min = 2, Max =3 '-> Object For Runtime Dim Act :Set Act = CreateObject("Wscript.Shell") '-> Hidden Window And No Wait For The Script Act.Run("%comspec% /C @Echo Off && CLS && Echo. && Echo Test && ping -n 3 127.0.0.1>nul"),0,False '-> Show The Normal Window And Wait For The Script To Finish ' Act.Run("%comspec% /C @Echo Off && CLS && Echo. && Echo Test && ping -n 3 127.0.0.1>nul"),1,True
  12. Here is the results with 2 usb drives plug in to my computer, remove the .txt to make active. UsbDrive.vbs.txt
  13. Here is a simple VBS script that list Removable drives if they are connected. It will display the Drive Size, Free Space, Used Spaced. '-> Constant For GB Size Const GB = 1073741824 '-> Object For Runtime Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") '-> Varibles For Run Time Dim Drv, Dsk, Usb, vB :vB = vbTab '-> Loop Threw All Drives For Each Dsk In Fso.Drives If Dsk.IsReady Then '-> Drive Type Removable Or USB If Dsk.DriveType = 1 Then Usb = Usb &_ Dsk.DriveLetter & ":\ USB" & vB & "Size = " & Num(Dsk.TotalSize) & ", Free = " &_ Num(Dsk.FreeSpace) & ", Used = " & Num(Dsk.TotalSize - Dsk.FreeSpace) & vbCrLf End If End If Next '-> Function To Convert Numbers To GB Function Num(N) Num = Round(N/GB,2) If Num <= 10 Then Num = "0" & Num If Num > 0 And Num < 1 Then Num = "0" & Num End Function '-> Show The Results If Chk = True Then MsgBox vbTab & "Usb Drive Results" & vbCrLf & Usb, 4128,"Usb Querry" Else MsgBox "No Removable Drives Were Found",4128,"Usb Querry" End If
  14. Here is the VBS way of doing it with checks '-> Runtime Varibles Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") '-> Runtime Object Dim C1, C2, Tx1, Tx2,Ts '-> Check For Text File One If Fso.FileExists("Test1.txt") Then C1 = True Set Ts = Fso.OpenTextFile("Test1.txt") Tx1 = Ts.ReadAll Ts.Close End If '-> Check For Text File Two If Fso.FileExists("Test2.txt") Then C2 = True Set Ts = Fso.OpenTextFile("Test2.txt") Tx2 = Ts.ReadAll Ts.Close End If '-> If C1 And C2 Are true Than Make The Third Text File If C1 = True And C2 = True Then Set Ts = Fso.CreateTextFile("Test3.txt") Ts.WriteLine Tx1 & vbCrLf & Tx2 Ts.Close CreateObject("Wscript.Shell").run("Test3.txt") End If
  15. Perhaps a VBS script would be better suited to your needs, here is an example of looping threw all the non empty drives. '-> Object For RuntimeDim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> Varibles For Run TimeDim Drv, Dsk'-> Loop Threw All Drives For Each Dsk In Fso.Drives If Dsk.IsReady Then'-> Drive Type Select Case Dsk.DriveType Case 0: Drv = "Unknown" Case 1: Drv = "Removable" Case 2: Drv = "Fixed" Case 3: Drv = "Network" Case 4: Drv = "CD-ROM" Case 5: Drv = "RAM Disk" End select WScript.Echo Dsk.DriveLetter & ":\ " & Drv End If Next