Jump to content

gunsmokingman

Super Moderator
  • Posts

    2,296
  • Joined

  • Last visited

  • Donations

    0.00 USD 
  • Country

    Canada

Everything posted by gunsmokingman

  1. Here is a VBS script that will search all the local drives for the FILE_NAME Change FILE_NAME to the name of the file you want to search Dim Obj Dim Wmi :Set Wmi = GetObject( _ "winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") Dim Col :Set Col = Wmi.ExecQuery( _ "Select * from CIM_DataFile Where FileName='FILE_NAME'") If Col.count = 0 Then WScript.Echo "Missing : FILE_NAME" WScript.Quit Else For Each Obj in Col Wscript.Echo Obj.Drive & Obj.Path & Obj.FileName & "." & Obj.Extension Next End if
  2. I thought the update to the newer version went well, the UI is not as ugly as Window 8.
  3. Here is the way of getting active drive letter with VBS scripting Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim Drv For Each Drv In Fso.Drives If Drv.IsReady Then WScript.Echo Drv.DriveLetter End If Next
  4. Here is a VBS script that does 1:\ Make sure it's run by Cscript 2:\ Ping a range of computer Ip 192.168.1.100 to 192.168.1.115 3:\ Has a Timed 5 minute message box that has Yes No Default time out action 4:\ Will run until user select no '-> Script By Gunsmokingman AKA Jake1Eye'-> This Script And Or Any Code Is The Property Of Gunsmokingman Or'-> Jake1Eye, Except Where Acknowledgement Comments Exists for Code'-> Written By Other Coders.'-> If Any Part Of This Code Is Used In Other Coding Project, There'-> Must Be An Acknowledgement Comments To The Original Coder Must Be '-> Included In Any Other Coding Project. '-> Runtime Objects Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Wmi :Set Wmi = GetObject("winmgmts:\\.\root\cimv2")'-> Runtime Varibles Dim C1, Col, Obj, R'-> Make Sure Cscript.exe Is Used If InStr(1,WScript.FullName,"cscript",1) Then PingComputer() Else MsgBox _ "Wrong scripting engine selected. This script was ment to be " & _ "run using Cscript.exe. Right click this script and select " & _ "either Cmd Prompt or Cscript.exe.",4128,"Error Wrong Script Engine" End If'-> Function For Pinging Computer, Looping Until No Is Selected'-> Code Bassed On This MSDN Code'-> URL http://msdn.microsoft.com/en-us/library/aa394595(v=vs.85).aspx Function PingComputer() For C1 = 100 To 115 Set Ping = Wmi.ExecQuery( _ "Select * From Win32_PingStatus where Address = '92.168.1."& C1 &"'") For Each Obj in Ping If IsNull(Obj.StatusCode) Or Obj.StatusCode<>0 Then'-> Code Here For Offline Action WScript.Echo "Computer Off Line : " & Obj.Address Else'-> Code Here For Online Action Wscript.Echo "Computer On Line : " & Obj.Address End If Next Next '-> Timed Messagebox, With Yes No And Timeout R = Act.Popup( _ "Would you like to continue pinging the computers?" & vbCrLf & _ "If nothing is selected in 5 minutes, than the script willl" & vbCrLf & _ "restart pinging the computers",300, "Stop Or Continue",4132)'-> Timeout, Yes, No R Return Action Select Case R Case -1'-> Timed Messagebox Timeout Wscript.Echo vbCrLf &"This Script Has Time Out" & vbCrLf & _ "Restarting pinging computers" & vbCrLf PingComputer() Case 6'-> Yes Action Wscript.Echo vbCrLf & "User selected yes" & vbCrLf &_ "Restarting pinging computers" & vbCrLf PingComputer() Case 7'-> User cancel Script Wscript.Echo vbCrLf & "Ending Script, rerun it later" WScript.Sleep(3000) WScript.Quit(0) End Select End Function Rename PingMultiRange.vbs.txt to PingMultiRange.vbs to make active PingMultiRange.vbs.txt
  5. One of the problems I had was how the New OS Key was processed by Win 7 and Vista, if you removed the dash between the 5 characters it would cause an error. If you leave the dashes in then it ran without errors, that why in the V7 function there is no On Error Resume Next. It was not that it was hard to figure out how to merge the 2 scripts, when you break it down to separate functions. Thank you and I was glad to help getting the script to work. Here is a VBS script that meant to have One File Drag Drop or Use in Cmd Line with One File, to be run with Admin Access. RunAsDragDrop.vbs '-> Script By Gunsmokingman AKA Jake1Eye'-> This Script And Or Any Code Is The Property Of Gunsmokingman Or'-> Jake1Eye, Except Where Acknowledgement Comments Exists for Code'-> Written By Other Coders.'-> If Any Part Of This Code Is Used In Other Coding Project, There'-> Must Be An Acknowledgement Comments To The Original Coder Must Be '-> Included In Any Other Coding Project.'-> Objects For Runtime Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim Reg :Set Reg = GetObject("winmgmts://./root/default:StdRegProv")'-> Varibles For Various Run Time Dim A, c34, Ts, Txt c34 = Chr(34) Txt = Act.ExpandEnvironmentStrings("%Temp%\DragDropItem.txt")'-> Makes Sure One Item Has Been Drag And Drop Or Cmd Lines Arguments A = WScript.Arguments.Count If A = 0 Then call Msg("You Must Drag And Drop One File" & vbCrLf & _ "Type On To This Script.", "Error No File Drop") WScript.Quit(0) ElseIf A >= 2 Then call Msg("This Script Only Allow For One File To" & vbCrLf & _ "Be Drag And Drop. Total Files Drag And Drop : " & A,"Errpr To Many Files") WScript.Quit(1) End If '-> Original Link To Script At StackOverFlow'-> http://stackoverflow.com/questions/18504036/is-is-possible-to-have-run-as-prompt-for-vbscript'-> Script Modified By Gunsmokingman Aka Jake1eye If Reg.GetStringValue(&h80000003, "S-1-5-19\Environment", "TEMP", val) = 5 Then If WScript.Arguments.Count = 1 Then MkT(WScript.Arguments.Item(0)) CreateObject("Shell.Application").ShellExecute "wscript.exe" _ , Chr(34) & WScript.ScriptFullName & Chr(34) & " relaunch", "", "runas", 1 WScript.Quit(2) Else call Msg("Can Not Acquire Admin Privileges", "Error No Admin Access") WScript.Quit(3) End If Else'-> Code Here With Admin Access Set Ts = Fso.OpenTextFile(Txt) A=Ts.ReadAll Ts.Close() Act.Run(A),1,True Fso.DeleteFile(Txt),True End If'-> Makes Text File With WScript.Arguments.Item(0) Passed On'-> As Varible To Run With Admin Access Function MkT(T) Set Ts = Fso.CreateTextFile(Txt) Ts.WriteLine c34 & T & c34 Ts.Close() End Function'-> Makes All The Msgbox For The Script Function Msg(T, L) MsgBox T, 4128, L End FunctionRename RunAsDragDrop.vbs.txt to RunAsDragDrop.vbs to make activeRunAsDragDrop.vbs.txt
  6. 1:\ Thanks to Jaclaz for pointing the correct WMI object 2:\ Tested this on Windows 7 as admin and as User, works I had to supply the admin stuff threw UAC GUI, with no errors. 3:\ Tested this same way on Windows Vista no errors. RunAsKeyChanger.vbs '-> Script By Gunsmokingman AKA Jake1Eye'-> This Script And Or Any Code Is The Property Of Gunsmokingman Or'-> Jake1Eye, Except Where Acknowledgement Comments Exists for Code'-> Written By Other Coders.'-> If Any Part Of This Code Is Used In Other Coding Project, There'-> Must Be An Acknowledgement Comments To The Original Coder Must Be '-> Included In Any Other Coding Project.'-> Objects For Runtime Dim Wmi :Set Wmi = GetObject("winmgmts:\\.\root\cimv2")'-> Varible For RunTime Dim A, Obj, R'-> Original Link To Script At StackOverFlow'-> http://stackoverflow.com/questions/18504036/is-is-possible-to-have-run-as-prompt-for-vbscript'-> Script Modified By Gunsmokingman Aka Jake1eye Set reg = GetObject("winmgmts://./root/default:StdRegProv") rc = reg.GetStringValue(&h80000003, "S-1-5-19\Environment", "TEMP", val) If rc = 5 Then'-> return code 5 == access denied, re-launch script only when it was run without arguments, '-> so we don't goin circles when admin privileges can't be acquired If WScript.Arguments.Count = 0 Then'-> re-launch as administrator; the additional argument is a guard to make'-> sure the script is re-launched only once CreateObject("Shell.Application").ShellExecute "wscript.exe" _ , Chr(34) & WScript.ScriptFullName & Chr(34) & " relaunch", "", "runas", 1 WScript.Quit 0 Else Msgbox "Cannot acquire admin privileges.",4128,"Admin Access denied" WScript.Quit 1 End If Else'-> Code Here To Run Elevated Input() ConfirmChange(A) End If'-> Function To Get The New Replace Key Function Input() Input=InputBox( _ "Type In The New Key In This Format 12345-54321-12345-ABCDE-1A2B3.") If Len(Input) = 29 Then A = Input If Not Len(Input) = 29 Then If MsgBox( _ "Does Not Appear To Have 29 Characters : " & Len(Input) & vbCrLf & _ "Would You Like To Redo Your Input, Yes To Redo," & vbCrLf & _ "No To Exit And Do Nothing?",4132,"Redo Or Quit") = 6 Then Input() Else WScript.Quit End If End If End Function '-> Confirm The Changes Function ConfirmChange(K) Dim Os If MsgBox( _ "Did you want to continue with changing the OS Product Key?" & vbCrLf & _ "Yes to continue and change the OS Product Key, No to exit" & vbCrLf & _ "and make no changes to the OS Product Key",4132,"Continue Or Stop") = 6 Then For Each Obj In Wmi.ExecQuery("SELECT * FROM win32_OperatingSystem") Os = Obj.Caption Next If InStr(1,Os,"XP",1) Then OsX(Replace(K,"-","")) If InStr(1,Os,"7",1) Or InStr(1,Os,"Vista",1)Then V7(K) Else WScript.Quit End If End Function '-> Original Link To Script At PasteBin'-> http://pastebin.com/Wp5cCsHk'-> Script Modified By Gunsmokingman Aka Jake1eye'-> For XP Function OsX(K) On Error Resume Next For Each Obj In Wmi.ExecQuery("SELECT * FROM win32_WindowsProductActivation") R = Obj.SetProductKey(K) If Err = 0 Then MsgBox "Key Has Been Change",4128,"Success" If Err <> 0 Then MsgBox "An Error entering the new OS Product Key" & vbCrLf & _ "Key Enter : " & K & vbCrLf & "Verify that this is the correct or valid" & vbCrLf & _ "OS Product Key",4128,"Key Error" Next End Function'-> Tested On Win 7 And Vista Function V7(K) For Each Obj In Wmi.ExecQuery("SELECT * FROM SoftwareLicensingService") R = Obj.InstallProductKey(K) If Err = 0 Then MsgBox "Key Has Been Change",4128,"Success" If Err <> 0 Then MsgBox "An Error entering the new OS Product Key" & vbCrLf & _ "Key Enter : " & K & vbCrLf & "Verify that this is the correct or valid" & vbCrLf & _ "OS Product Key",4128,"Key Error" Next End Function Rename RunAsKeyChanger.vbs.txt to RunAsKeyChanger.vbs to make activeRunAsKeyChanger.vbs.txt
  7. 1:\ The user was asking for help on how to make the script work correct. 2:\ My understanding is that the user want to change some product keys on some OS that seems to have UAC enable. 3:\ Jaclaz your wrong List Windows Product Activation Status
  8. Since I dont want to write the whole things for you, not my job I will point you in a direction that might help you. I added a function to the script from Stackoverflow that I called Input. Dim A Set reg = GetObject("winmgmts://./root/default:StdRegProv")rc = reg.GetStringValue(&h80000003, "S-1-5-19\Environment", "TEMP", val)If rc = 5 Then 'return code 5 == access denied 're-launch script only when it was run without arguments, so we don't go 'in circles when admin privileges can't be acquired If WScript.Arguments.Count = 0 Then 're-launch as administrator; the additional argument is a guard to make 'sure the script is re-launched only once CreateObject("Shell.Application").ShellExecute "wscript.exe" _ , Chr(34) & WScript.ScriptFullName & Chr(34) & " relaunch", "", "runas", 1 WScript.Quit 0 Else WScript.Echo "Cannot acquire admin privileges." WScript.Quit 1 End IfElse 'your code here ' CreateObject("Wscript.Shell").Run("C:\Users\Gunsmokingman\Desktop\RegistrationChanger.hta"),1,True ' CreateObject("Wscript.Shell").Run("powerCfg -H Off") Input() WScript.Echo AEnd If Function Input() Input=InputBox( _ "Type In The New Key In This Format 12345-54321-12345-ABCDE-1A2B3.") If Len(Input) = 29 Then A = Input If Not Len(Input) = 29 Then If MsgBox( _ "Does Not Appear To Have 29 Characters : " & Len(Input) & vbCrLf & _ "Would You Like To Redo Your Input, Yes To Redo," & vbCrLf & _ "No To Exit And Do Nothing?",4132,"Redo Or Quit") = 6 Then Input() Else WScript.Quit End If End If End Function
  9. I tried my test on Win 7 UAC enable on account that had only user rights. The hta in my script needed an admin account to make the changes to the registry keys, I was able to make the changes on that regular user account.
  10. Here is what I can confirm 1:\ Windows 7 UAC enable 2:\ Created A User level account called Jake 3:\ Ran the from script Stackoverflow Set reg = GetObject("winmgmts://./root/default:StdRegProv")rc = reg.GetStringValue(&h80000003, "S-1-5-19\Environment", "TEMP", val)If rc = 5 Then 'return code 5 == access denied 're-launch script only when it was run without arguments, so we don't go 'in circles when admin privileges can't be acquired If WScript.Arguments.Count = 0 Then 're-launch as administrator; the additional argument is a guard to make 'sure the script is re-launched only once CreateObject("Shell.Application").ShellExecute "wscript.exe" _ , Chr(34) & WScript.ScriptFullName & Chr(34) & " relaunch", "", "runas", 1 WScript.Quit 0 Else WScript.Echo "Cannot acquire admin privileges." WScript.Quit 1 End IfElse 'your code here CreateObject("Wscript.Shell").Run("C:\Users\Jake\Desktop\RegistrationChanger.hta"),1,True 'WScript.Echo "Code Here With Admin Rights"End If4:\ I was able to make reg changes that required admin rights, I had to supplythe admin right threw the standard UAC GUI. Before Changes After Changes
  11. The only way you can do what you want is to use a HTA like this <!-- Hta And Script By Gunsmokingman AKA Jake1Eye This HTA And Or Any Code Is The Property Of Gunsmokingman Or Jake1Eye, Except Where Acknowledgement Comments Exists for Code Written By Other Coders. If Any Part Of This Code Is Used In Other Coding Project, There Must Be An Acknowledgement Comments To The Original Coder Must Be Included In Any Other Coding Project. --><TITLE>Registration Changer</TITLE> <HTA:APPLICATION ID="Registration Changer" APPLICATIONNAME="RegChngr" SCROLL="No" SCROLLFLAT ="No" SingleInstance="Yes" ShowInTaskbar="Yes" SysMenu="Yes" MaximizeButton="No" MinimizeButton="No" Border="Thin" BORDERSTYLE ="complex" INNERBORDER ="Yes" Caption="Yes" WindowState="Normal" Icon="%SystemRoot%\explorer.exe"><STYLE Type='text/css'> Body{ Text-Align:Center;Vertical-Align:Top; Font-Size:9.25pt;Font-Weight:Bold;Color:Black; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; BackGround-Color:#EFE9E3; Margin-Top:21;Margin-Bottom:1; Margin-Left:4;Margin-Right:4; Padding-Top:1;Padding-Bottom:1; Padding-Left:4;Padding-Right:4; Border-Top:0px Transparent;Border-Bottom:0px Transparent; Border-Left:0px Transparent;Border-Right:0px Transparent; } TD{ Text-Align:Left; Font-Size:8.25pt;Font-Weight:Bold;Color:Black; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; Padding-Top:1;Padding-Bottom:1; Padding-Left:3;Padding-Right:3; } Button{ Cursor:Hand; Height:17pt;Width:49pt; Text-Align:Center;Vertical-Align:Middle; Font-Size:8.75pt;Font-Weight:Bold;Color:DarkSlateGray; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; BackGround-Color:#DED8D2; filter:progid:DXImageTransform.Microsoft.Gradient (StartColorStr='#E5E5E5',EndColorStr='#7D7D7D'); Margin-Top:-1;Margin-Bottom:1; Margin-Left:-1;Margin-Right:1; }</STYLE><SCRIPT LANGUAGE='JScript'>//-> Resize And Place In Approx center var W = 355, H = 221; window.resizeTo(W,H) window.moveTo(screen.availWidth/2-(W/2),screen.availHeight/2-(H/2))</SCRIPT><SCRIPT Language="VBScript"> Dim Act :Set Act = Createobject("Wscript.Shell") Dim Reg :Reg ="HKLM\Software\Microsoft\Windows NT\CurrentVersion\" Function Window_onLoad() Dim V1, V2, V3 :V3= "No Information Found" V1 = Act.RegRead(Reg & "RegisteredOwner") V2 = Act.RegRead(Reg & "RegisteredOrganization") If V1 = "" Then V1 = V3 If V2 = "" Then V2 = V3 Owner.innerHTML= v1 Organ.innerHTML= V2 End Function Function TheSubmit() Dim V1 :V1="Please make sure both fields are filled in" If NewOwner.value <> "" And NewOrgan.value <> "" Then Act.RegWrite Reg & "RegisteredOwner", NewOwner.value Act.RegWrite Reg & "RegisteredOrganization", NewOrgan.value ElseIf NewOwner.value <> "" And NewOrgan.value = "" Then alert(V1) ElseIf NewOwner.value = "" And NewOrgan.value <> "" Then alert(V1) ElseIf NewOwner.value = "" And NewOrgan.value = "" Then alert(V1) End If End Function</SCRIPT><BODY><TABLE> <TD Style='Width:83;'>Owner</TD><TD Style='Width:179;'><DIV ID='Owner'> </DIV></TD></TABLE><TABLE> <TD Style='Width:83;'>Organization</TD><TD Style='Width:179;'><DIV ID='Organ'> </DIV></TD></TABLE> <TABLE Style='Margin-Top:5pt;'> <TABLE> <TD Style='Width:83;'>Owner</TD> <TD><Input Type='Text' ID='NewOwner' Size='26'></TD></TABLE> <TABLE> <TD Style='Width:83;'>Organization</TD> <TD><Input Type='Text' ID='NewOrgan' Size='26'></TD></TABLE> </TABLE><TABLE Style='Margin-Top:5pt;'> <BUTTON ID='Bn1' OnClick='TheSubmit()'>Submit</BUTTON> <BUTTON ID='Bn2' OnClick='window.close()'>Close</BUTTON></TABLE></BODY>
  12. You should of been able to figure this out, it was simple Change to this function //-> Hack To Pause The Script function pause(t){var Vbs =Act.ExpandEnvironmentStrings("%Temp%\\VbsTimeout.vbs") var Ts=fso.CreateTextFile(Vbs) Ts.Write("Wscript.Sleep("+t+")") Ts.Close() Act.Run(Vbs,1,true) fso.DeleteFile(Vbs) }And than make the changes like so //-> Process Only Checked Checkboxes function submit(){ for (var i = 0; i < cbo.length; i++) { if (cbo[i].value==null==false && cbo[i].checked){try{ display.innerHTML=(cbo[i].indicator); Act.Run(cbo[i].value.split("%CurDir%").join(basepath),1,true); display.innerHTML="<blink><B>Processing Please Wait</B></blink>".fontcolor("#005335") pause(3000);} catch(e){alert("COULD NOT EXECUTE:\n"+cbo[i].value.split("%CurDir%").join(basepath));} }} display.innerHTML="<blink><b>Finished</b></blink>".fontcolor("#005335"); pause(7000);window.close(); }
  13. Here is a hacked HTA that will do what you want This works by creating a VBS script in the Temp folder Contents Of VBS Ts.Write("Wscript.Sleep(10000)")It than runs the file wait for it to finish than it deletes it self. fso.DeleteFile(Vbs)Than it repeats the process over until all is done. <!-- Hta And Script By Gunsmokingman AKA Jake1Eye This HTA And Or Any Code Is The Property Of Gunsmokingman Or Jake1Eye, Except Where Acknowledgement Comments Exists for Code Written By Other Coders. If Any Part Of This Code Is Used In Other Coding Project, There Must Be An Acknowledgement Comments To The Original Coder Must Be Included In Any Other Coding Project. --><TITLE> TESTSCRIPT </TITLE><HTA:APPLICATION ID="TESTSCRIPT" SCROLL="no" SCROLLFLAT="no" SINGLEINSTANCE="yes" SHOWINTASKBAR="yes" SYAMENU="yes" MAXIMIZEBUTTON="no" MINIMIZEBUTTON="yes" CONTEXTMENU="no" NAVIGABLE="no" BORDER="thin" BORDERSTYLE="normal" INNERBORDER="no" CAPTION="yes" WINDOWSTATE="normal" APPLICATIONNAME="TESTSCRIPT" ICON="%SystemRoot%\explorer.exe"><script language="JavaScript">//-> Resize And Place In Approx Centerwindow.resizeTo(260,200)window.moveTo(screen.availWidth/2-(260/2),screen.availHeight/2-(200/2))//-> Objects For Runtime var Act = new ActiveXObject("Wscript.Shell"); var fso = new ActiveXObject("Scripting.FileSystemObject"); var Wmi = GetObject("winmgmts:{impersonationLevel=impersonate}!\\\\.\\root\\cimv2");//-> Runtime Varible var c34 = String.fromCharCode(34); var HtaPath = TESTSCRIPT.commandLine.replace(c34,""); var basepath = new Array;//-> Body OnLoad Function window.onload=function(){basepath = HtaPath.split('\\'); basepath.pop(); basepath = basepath.join('\\'); Act.CurrentDirectory = basepath; setInterval("blinkit()",800); }//-> Blinking Text for <blink></blink> tag function blinkit(){if(!document.all) return; else{ for(i=0;i<document.all.tags('blink').length;i++) { s=document.all.tags('blink')[i]; s.style.visibility=(s.style.visibility=="visible") ?"hidden":"visible"; }}}//-> Hack To Pause The Script function pause(){var Vbs =Act.ExpandEnvironmentStrings("%Temp%\\VbsTimeout.vbs") var Ts=fso.CreateTextFile(Vbs) Ts.Write("Wscript.Sleep(10000)") Ts.Close() Act.Run(Vbs,1,true) fso.DeleteFile(Vbs) }//-> Process Only Checked Checkboxes function submit(){ for (var i = 0; i < cbo.length; i++) { if (cbo[i].value==null==false && cbo[i].checked){try{ display.innerHTML=(cbo[i].indicator); Act.Run(cbo[i].value.split("%CurDir%").join(basepath),1,true); display.innerHTML="<blink><B>Processing Please Wait</B></blink>".fontcolor("#005335") pause();} catch(e){alert("COULD NOT EXECUTE:\n"+cbo[i].value.split("%CurDir%").join(basepath));} }} display.innerHTML="<blink><b>Finished</b></blink>".fontcolor("#005335"); pause();window.close(); }</script><body> <table width="100%" align="center" border="1"> <td valign="top"><table><tr><td class="c1">Start Calculator</td> <td><input type="checkbox" id="cbo" name="checkbox1" indicator=" <b>Starting Calculator</b> <blink>Please wait...</blink>" value='"%WinDir%\system32\calc.exe"' checked></input> </td></tr> <tr><td class="c1">Start Notepad</td> <td><input type="checkbox" id="cbo" name="checkbox2" indicator=" <b>Starting Notepad</b> <blink>Please wait...</blink>" value='"%windir%\system32\notepad.exe"' checked></input> </td></tr> <tr><td class="c1">Start Paint</td> <td><input type="checkbox" id="cbo" name="checkbox3" indicator=" <b>Starting Paint</b> <blink>Please wait...</blink>" value='"%SystemRoot%\system32\mspaint.exe"' checked></input> </td></tr> </table></td> <tr> <td colspan="3" align="center" id="display" class="display"></td></tr> </table> <table width="60%" align="center" style="margin:8px 0px 0px 0px;"> <tr> <td align="center"><button type="button" id="btc" Style="width:100px;" onmouseover='this.className="button_hover"' onmouseout='this.className=""' onclick="submit()">Submit</button></td> <td align="center"><button type="button" id="btc" Style="width:100px;" onmouseover='this.className="button_hover"' onmouseout='this.className=""' onclick="window.close();">Quit</button></td> </tr></table> </body>If you did not write the blink function could you add a comment to the original coder or a link address to where you found it.
  14. Here is how to use the timer object using Jscript <TITLE>Time Out Demo</TITLE> <HTA:APPLICATION ID="TmOut" APPLICATIONNAME="TmOutDemo" Border="Thin" BORDERSTYLE ="Complex" Caption="Yes" Icon="%SystemRoot%\explorer.exe"" INNERBORDER ="No" MaximizeButton="No" MinimizeButton="Yes" Scroll="No" SCROLLFLAT ="No" SingleInstance="Yes" SysMenu="Yes" WindowState="Normal"/> <STYLE> Body { Text-Align:Center;Vertical-Align:Top; Font-Size:9.25pt;Font-Weight:Bold;Color:Black; Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS; BackGround-Color:#EFE9E3; Margin-Top:11;Margin-Bottom:1; Margin-Left:4;Margin-Right:4; Padding-Top:1;Padding-Bottom:1; Padding-Left:4;Padding-Right:4; Border-Top:0px Transparent;Border-Bottom:0px Transparent; Border-Left:0px Transparent;Border-Right:0px Transparent; }</STYLE><SCRIPT LANGUAGE='JScript'>//-> Resize And Place In Approx center window.resizeTo(301,151) window.moveTo(screen.availWidth/2-(301/2),screen.availHeight/2-(151/2))//-> Run Time Varible var Tm1="";//-> Start The Timer function Button1Click(){ Tm1=window.setInterval("TheTimeOut()",10000); }//-> End Timer function TheTimeOut(){ window.clearInterval(Tm1); alert("Ten Seconds Time Out Completed") }</SCRIPT><BODY><Button ID='Bn1' OnCliCk='Button1Click()'>10 Seconds</Button></BODY>That will not work if he using a HTA with Jscript
  15. It would help if you posted any code you have written because I really do not understand what you want now. Here a way to query Google and get some results Dim Act :Set Act = CreateObject("Wscript.Shell")Dim Query Do Query = InputBox("Type In The Search Word To Use On Google.com?" &vbCrLf&_ "To Do Nothing Type Exit Or Quit") If InStr(1,Query,"exit",1) Or InStr(1,Query,"quit",1) Then WScript.Quit(1) ElseIf Len(Query) >= 2 Then Act.Run("http://www.google.com/search?q="&Query),1,False WScript.Quit(2) Else Query = "" End If Loop Until Len(Query) = 1000
  16. Here I modified it so when you type exit or quit it will kill the cmd prompt window, and not report back that the user cancel. CmdVbsReturn2.cmd @Echo OffCLSMODE 75, 12COLOR 9FSet Vbs=VbsReturn.vbs > %Vbs% Echo Dim Return, Cmd, Fso, Ts>> %Vbs% Echo Do >> %Vbs% Echo Return = Inputbox("Type In Some Web Addresss, This Must Be" ^&^_>> %Vbs% Echo "Longer Than 10 Character EG: WWW.123.CA" ^&vBcrlf^&_>> %Vbs% Echo "Type Exit Or Quit To Do Nothing")>> %Vbs% Echo If Instr(1,Return,"exit",1) Or Instr(1,Return,"quit",1) Then>> %Vbs% Echo CreateObject("Wscript.Shell").Run("Taskkill /F /IM cmd.exe /T"),0,true >> %Vbs% Echo Wscript.Quit(1)>> %Vbs% Echo End If>> %Vbs% Echo If Len(Return) ^>= 10 Then>> %Vbs% Echo MkCmd(Return)>> %Vbs% Echo Exit Do>> %Vbs% Echo Else>> %Vbs% Echo Return = "">> %Vbs% Echo End If>> %Vbs% Echo Loop Until Len(Return) ^>= 10 >> %Vbs% Echo Function MkCmd(T) >> %Vbs% Echo Set Fso = CreateObject("Scripting.FileSystemObject")>> %Vbs% Echo Cmd = "%CD%\ReturnCmd.cmd" >> %Vbs% Echo Set Ts = Fso.CreateTextFile(Cmd)>> %Vbs% Echo Ts.WriteLine "Set Return=" ^&T>> %Vbs% Echo Ts.Close>> %Vbs% Echo End Functionstart /wait "" %Vbs%call "%CD%\ReturnCmd.cmd"del %Vbs%del "%CD%\ReturnCmd.cmd"CLSMODE 82,5COLOR 5FEcho.Echo User URL %Return%Echo.pauseExitRename CmdVbsReturn2.cmd.txt to CmdVbsReturn2.cmd to make active.CmdVbsReturn2.cmd.txt
  17. Here is a CMD file that builds the VBS script than creates another cmd that passes the VBS input back to the cmd window. @Echo OffCLSMODE 75, 12COLOR 9FSet Vbs=VbsReturn.vbs > %Vbs% Echo Dim Return, Cmd, Fso, Ts>> %Vbs% Echo Do >> %Vbs% Echo Return = Inputbox("Type In Some Web Addresss, This Must Be" ^&^_>> %Vbs% Echo "Longer Than 10 Character EG: WWW.123.CA" ^&vBcrlf^&_>> %Vbs% Echo "Type Exit Or Quit To Do Nothing")>> %Vbs% Echo If Instr(1,Return,"exit",1) Or Instr(1,Return,"quit",1) Then>> %Vbs% Echo MkCmd(Return)>> %Vbs% Echo Exit Do>> %Vbs% Echo End If>> %Vbs% Echo If Len(Return) ^>= 10 Then>> %Vbs% Echo MkCmd(Return)>> %Vbs% Echo Exit Do>> %Vbs% Echo Else>> %Vbs% Echo Return = "">> %Vbs% Echo End If>> %Vbs% Echo Loop Until Len(Return) ^>= 10 >> %Vbs% Echo Function MkCmd(T) >> %Vbs% Echo Set Fso = CreateObject("Scripting.FileSystemObject")>> %Vbs% Echo Cmd = "%CD%\ReturnCmd.cmd" >> %Vbs% Echo Set Ts = Fso.CreateTextFile(Cmd)>> %Vbs% Echo Ts.WriteLine "Set Return=" ^&T>> %Vbs% Echo Ts.Close>> %Vbs% Echo End Functionstart /wait "" %Vbs%call "%CD%\ReturnCmd.cmd"del %Vbs%del "%CD%\ReturnCmd.cmd"IF /I '%Return%'=='exit' GOTO UserCancelIF /I '%Return%'=='quit' GOTO UserCancelCLSMODE 92,5COLOR 5FEcho.Echo User URL %Return%Echo.pauseExit:UserCancelCLSCOLOR F9Mode 62,5Echo.Echo The User Has Decided To %Return%Echo So No Changes Where MadeEcho.ping -n 4 127.0.0.1>nulexitRename CmdVbsReturn.cmd.txt to CmdVbsReturn.cmd to make activeCmdVbsReturn.cmd.txt
  18. Perhaps this might work ChkNetFrameWork2.vbs.txt '-> Runtime Objects Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Wmi :Set Wmi = GetObject("winmgmts:\\.\root\CIMV2") '-> Runtime Varibles Dim Net, Obj, Var Net = False'-> Loop Threw Installed Products For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_Product")'-> Found A Version Of .Net Framework If Instr(1,Obj.Caption,".net",1) Then Net = True Var = Var & Obj.Caption & " - " & Obj.Version & vbCrLf End if Next'-> Confirm .Net Framework Installed If Net = True Then Act.Popup "A version of .Net Framework was Found" & vbCrLf & _ Var,10,".Net Framework Installed",4128 Else'-> Code Here If .Net Framework Is Not Installed'-> Example Below On How To Use The VBS Object Act To Run A Install'-> Act.Run("Path:\To\The\File.exe /Switches"),1,True If InStr(1,Os,"Windows 7",1) Then '-> Code Here ElseIf InStr(1,Os,"Windows Vista",1) Then '-> Code Here ElseIf InStr(1,Os,"Windows XP",1) Then '-> Code Here ElseIf InStr(1,Os,"Windows 8",1) Then'-> Code Here ElseIf InStr(1,Os,"Windows 8.1",1) Then'-> Code Here End If End If '-> Function To Get Os Function Os() For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem") Os=Obj.Caption Next End FunctionRename ChkNetFrameWork2.vbs.txt to ChkNetFrameWork2.vbs make activeChkNetFrameWork2.vbs.txt Tested this code on my Vista and Win 7 and it return the correct Os, it was the only way I could test the new code for runtime errors. Dim Wmi :Set Wmi = GetObject("winmgmts:\\.\root\CIMV2") If InStr(1,Os,"Windows 7",1) Then '-> Code Here MsgBox Os ElseIf InStr(1,Os,"Windows Vista",1) Then '-> Code Here MsgBox Os ElseIf InStr(1,Os,"Windows XP",1) Then '-> Code Here MsgBox Os ElseIf InStr(1,Os,"Windows 8",1) Then'-> Code Here MsgBox Os ElseIf InStr(1,Os,"Windows 8.1",1) Then'-> Code Here MsgBox Os End If '-> Function To Get Os Function Os() For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem") Os=Obj.Caption Next End Function
  19. Here is another way of checking for .Net Framework is on a computer using VBS scriptingand using WMI query. Tested this on Windows 7 and it returns the if True message Example ChkNetFrameWork.vbs '-> Runtime Objects Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Wmi :Set Wmi = GetObject("winmgmts:\\.\root\CIMV2") '-> Runtime Varibles Dim Net, Obj, Var Net = False'-> Loop Threw Installed Products For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_Product")'-> Found A Version Of .Net Framework If Instr(1,Obj.Caption,".net",1) Then Net = True Var = Var & Obj.Caption & " - " & Obj.Version & vbCrLf End if Next'-> Confirm .Net Framework Installed If Net = True Then Act.Popup "A version of .Net Framework was Found" & vbCrLf & _ Var,10,".Net Framework Installed",4128 Else'-> Code Here If .Net Framework Is Not Installed'-> Example Below On How To Use The VBS Object Act To Run A Install'-> Act.Run("Path:\To\The\File.exe /Switches"),1,True End If Rename ChkNetFrameWork.vbs.txt to ChkNetFrameWork.vbs to make activeChkNetFrameWork.vbs.txt
  20. @Outbreaker Perhaps you could figure out the correct Cmd that you need using this example <!-- Hta And Script By Gunsmokingman Aka Jake1Eye Hta And Script By Gunsmokingman Aka Jake1Eye This code is property of Gunsmokingman and Or Jake1Eye and you must have his permission to use. This is only posted as example code and meant only to used as such.--><SCRIPT LANGUAGE='JScript'> var w=375; h=175 window.resizeTo(w,h) window.moveTo(screen.availWidth/2-(w/2),screen.availHeight/2-(h/2)) var Act = new ActiveXObject("WScript.Shell"); window.onload=function(){document.title='Demo CMD Script HTA'}</SCRIPT><BODY Scroll='No'><Input Type="CheckBox" Name='TestMe' OnClick="if(TestMe.checked==true){Act.Run('%Comspec% /c @Echo Off && MODE 75,7 &&'+ 'CLS && COLOR 9f && TITLE Demo Cmd Jscript HTA && Set CD=CD && Echo. && Echo %CD% && '+ 'ping -n 4 127.0.0.1>nul',1,true) }" Value="Test">Demo Checkbox</BODY>
  21. Here is another example of getting location, I also demo how to change the CurrentDirectory to another location '-> This code is property of Gunsmokingman and Or Jake1Eye and you must have his permission to use.'-> This is only posted as example code and meant only to used as such.Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim Old_CD, vB, vT :vB = vbCrLf :vT = vbTab'-> Change The Current Directory To Another Location Old_CD = Act.CurrentDirectory Act.CurrentDirectory = "E:\" MsgBox "Current Folder " & vT & _ Replace(Fso.GetFile(WScript.ScriptFullName), _ Fso.GetFile(WScript.ScriptFullName).Name,"") & vB & _ "Parent Folder " & vT & _ Fso.GetParentFolderName(WScript.ScriptFullName) & vB & _ "Path Name " & vT & _ Fso.GetAbsolutePathName(WScript.ScriptFullName) & vB & vB & _ "Old Current Directory " & vT & Old_CD & vB & _ "New Current Directory " & vT & Act.CurrentDirectory & vB & _ "Vbs File Name" & Space(15) & vT & _ Fso.GetFile(WScript.ScriptFullName).Name If you need to use Cmd with Vbs here is a VBS script that out put %CD% varible with the correct path. Dim Act :Set Act = CreateObject("Wscript.Shell") Act.Run( _ "%Comspec% /c @Echo Off && COLOR 9F && CLS && MODE 62,9 && CLS && Echo. &&" & _ "Set CD=CD && Echo. && Echo Current Directory = %CD% && ping -n 5 127.0.0.1>nul"),1,True
  22. I do not think it possible to do what you want because the way VBS intrepid %CD% as this %CD% with no reference to location Here is a Example Using Jscript Using The Same Object As VBS <!-- Hta And Script By Gunsmokingman Aka Jake1Eye Hta And Script By Gunsmokingman Aka Jake1Eye This code is property of Gunsmokingman and Or Jake1Eye and you must have his permission to use. This is only posted as example code and meant only to used as such.--><SCRIPT LANGUAGE='JScript'> var w=375; h=175 window.resizeTo(w,h) window.moveTo(screen.availWidth/2-(w/2),screen.availHeight/2-(h/2)) var Act = new ActiveXObject("WScript.Shell"); window.onload=function(){document.title='Demo Script HTA'}</SCRIPT><BODY Scroll='No'> <Input Type="CheckBox" Name='TestMe' OnClick="if(TestMe.checked==true){alert( 'Current Directory\t'+Act.CurrentDirectory+'\n\r'+ 'App Data Path \t'+Act.ExpandEnvironmentStrings('%AppData%')) }" Value="Test">Demo Checkbox</BODY>
  23. Here is a VBS script that will move only files that do not exists on the other computer and reports the results in a self closing messagebox. There is no user input and you can not cancel Note This make the folder where the script resides for the object Fso.GetFolder(".").Files To use another folder just put a path in between the quotes example Fso.GetFolder("Drive:\Folder\SomeName").Files This is to make sure the VBS script does not get moved to the other folder If Not LCase(Obj.Path) = LCase(WScript.ScriptFullName) Then This make sure that files does not get moved to the other folder if it exists If Fso.FileExists("\\HOMEBETAVISTA\VistaHomeBeta\" & Obj.Name) Then '-> This code is property of Gunsmokingman and Or Jake1Eye and you must have his permission to use.'-> This is only posted as example code and meant only to used as such.Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")Dim Obj, Var For Each Obj In Fso.GetFolder(".").Files If Not LCase(Obj.Path) = LCase(WScript.ScriptFullName) Then If Fso.FileExists("\\HOMEBETAVISTA\VistaHomeBeta\" & Obj.Name) Then Var = Var & "File Exists : \\HOMEBETAVISTA\VistaHomeBeta\" & Obj.Name & vbCrLf Else Var = Var & "Move File : \\HOMEBETAVISTA\VistaHomeBeta\" & Obj.Name & vbCrLf Fso.MoveFile Obj.Path, "\\HOMEBETAVISTA\VistaHomeBeta\" & Obj.Name End If End If Next CreateObject("Wscript.Shell").Popup "Script Completed" & vbCrLf & Var ,30,"Move Completed",4128
  24. Here is a VBS solution to what you wanted, a way to get user input and apply that to your command. I also added a section to where you can cancel all the action, before applying the command. I only took a guess at how the command should be in VBS NOTES Chr(34) = " This Chr(34) & "icacls" & Chr(34) = ""icacls"" so it quoted around the areas that need them Save As UserNameToAdmin.vbs Dim Act :Set Act = CreateObject("Wscript.Shell")Dim Input'-> Loop That Will Run Until a Selection Is Inputted Do'-> Get User Input Input = InputBox( _ "Type In Some User Name To Process","","",5500,5500)'-> To Quit And Do Nothing If Len(Input) >= 4 And LCase(Input) = "quit" Then MsgBox "User Cancal", 4128, "User Cancel" WScript.Quit(1) End If '-> Process User Input If Length Is 4 Character Or More If Len(Input) >= 4 Then '-> Confirm Before Processing User Input If MsgBox("Is This The Correct Name You Want To Process : " & Input & vbCrLf & _ "Yes to Continue, No To Exit And Do Nothing",4132,"Confirm Action") = 6 Then'-> UnComment The 3 Lines To Make Active' Act.Run("psexec -s " & Chr(34) & "icacls" & Chr(34) & _' Chr(34) & " d:\profiles\"& Input &".DOMAIN.V2" & Chr(34) & _' " /grant administrators:F /t") WScript.Quit(2) Else'-> User Cancel Action, MessageBox Self Closes In 3 Seconds Act.Popup "User Cancel Action",3,"User Cancel",4128 WScript.Quit(3) End If End If Loop Until Len(Input) = 1000
×
×
  • Create New...