Jump to content

gunsmokingman

Super Moderator
  • Posts

    2,296
  • Joined

  • Last visited

  • Donations

    0.00 USD 
  • Country

    Canada

Everything posted by gunsmokingman

  1. Warning do not double post. Here a start to solve your problem 1;\ Open Cmd Promt, as admin on Vista or Windows 7 2:\ Type in the Cmd Promt Assoc /? If that not enough try this Link
  2. The last time I tried a 32 Bit OS on this computer, I thought I would of had 4 GB on the OS but I only had approx 3.25 GB of 8 GB usable ram. Maybe the Wmi is reading what is left over as the amount of Ram minus the Video Card Usage.
  3. This is what I get on my 64 bit Win 7 So it says I have 8 gigs of ram installed, the exact amount I have on my machine. 4 x 2 GB Ram sticks installed on my machine. So what your saying Example I have a video card that uses 1 GIG of ram and I have 8 gigs you expect this WMI Class to subtract 1 GIG of ram and say you have only 7 gigs. That would give a incorrect amount of installed ram 7 GIGS. The question ask was TOTAL INSTALL RAM not figure out ram after video card usage, usable ram on a 32 bit OS. This WMI Class give what ever amount of working RAM sticks that are plug into the RAM Slots.
  4. You could of just used the WMI ComputerSystem to get the amount of installed ram. Example WMI ComputerSystem Class Const GB = 1073741824 Const MB = 1048576 Dim Obj, Wmi Set Wmi = GetObject("winmgmts:\\.\root\CIMV2") For Each Obj In Wmi.ExecQuery("SELECT * FROM Win32_ComputerSystem") If Obj.TotalPhysicalMemory > Int(GB) Then msgbox _ "Total Physical Memory : " & FormatNumber(Obj.TotalPhysicalMemory / GB,2) & " GB" Else msgbox _ "Total Physical Memory : " & FormatNumber(Obj.TotalPhysicalMemory / MB,2) & " MB" End If Nex
  5. This is a VBS Script that will find EPS files anywhere on the Computer that this script run from. Fill in the App = Chr(34) & "PATH_TO_APPLICATION_HERE" & Chr(34) with the correct path to the app. The Chr(34) = ", so the app path will be in double quotes Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim Wmi :Set Wmi = GetObject("winmgmts:\\.\root\cimv2") Dim App, Col, Obj App = Chr(34) & "PATH_TO_APPLICATION_HERE" & Chr(34) Set Col = Wmi.ExecQuery _ ("Select * from CIM_DataFile Where Extension = 'eps'") '-> If No File Is Found If Col.count = 0 Then Act.Popup "Can Not Find This File Type : eps",5,"No File Found",4128 Else For Each Obj In Col '-> Run Only If App Exists If Fso.FileExists(App) Then Act.Run(App & Obj.Name),1,True Next End If
  6. I do not know if this will help you, but I wrote a VBS script that lists Installed and Not Installed Updates. The script attempts to provide Links to each update, it not 100%. I posted the full scripts in the Win 7 section. Thread VBS Script Rename List_Kb.vbs.txt to List_Kb.vbs to make active Rename List_Kb.vbs.txt Hta that does the same as the VBS Script but gives a UI to use. Kb_List.hta
  7. This is just a simple Demo of a self closing Menu with a 5 second count down You could have your progress bar where the count down is appearing. Save As DemoPopupMenu.hta <!-- 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.--><HTA:APPLICATION ID="DemoMenuTimer"SCROLL="No"SCROLLFLAT ="No"SingleInstance="Yes"ShowInTaskbar="Yes"SysMenu="Yes"MaximizeButton="No"MinimizeButton="No"Border="Thin"BORDERSTYLE ="complex"INNERBORDER ="No"Caption="Yes"WindowState="Normal"APPLICATIONNAME="MainApp"Icon="%SystemRoot%\explorer.exe"><TITLE>Demo Popup Menu Self Close</TITLE><!-- For Menu BackGround Dark To Light#D2B48C = Tan#FAF0E6 = Linen#FFFFF0 = Ivory--><STYLE type="text/css">Body{Font-Size:9.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;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;Text-Align:Center;Vertical-Align:Top;Border-Top:0px Transparent;Border-Bottom:0px Transparent;Border-Left:0px Transparent;Border-Right:0px Transparent;}Div.Menu1{Font-Size:8.05pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;BackGround-Color:Transparent;Filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#FFFFF0',EndColorStr='#D2B48C');Border-Left: 1px Dot;Border-Right: 2px Sunken;Border-Top: 1px Dot;Border-Bottom: 2px Sunken;Text-Align:Center;Margin:1;Padding:2;}TD{Font-Size:8.05pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}BUTTON{Height:18pt;width:61pt;Cursor:Hand;Font:8.05pt;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'>'-> Varibles For Run TimeDim C1,Tm1'-> Count Up UnComment This Comment Out Count Down' C1=0'-> Count Down Default Fot HtaC1=5'-> Resize And Center WindowDim Wth :Wth = int(425)Dim Hht :Hht = int(175)window.ResizeTo Wth, HhtMoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))'-> Button 01 ClickFunction Button01()If Menu01.style.visibility = "hidden" ThenBtn01.disabled=TrueMenu01.style.visibility = ""' Text1.innerHTML="Processing Please Wait"MyTimer1()ElseMenu01.style.visibility = "hidden"End IfEnd Function'-> Timer FunctionFunction MyTimer1()Select Case C1'-> Uncomment Case 5 For Count Up And Commnet Case 0 To Stop Count Down' Case 5Case 0Btn01.disabled=FalseMenu01.style.visibility = "hidden"'-> Count Up UnComment This Comment Out Count Down' C1=0'-> Count Down Default Fot HtaC1=5Case Else'-> Count Up UnComment This Comment Out Count Down' C1=C1+1Text1.innerHTML="Count At : " & C1'-> Count Down Default Fot HtaC1=C1-1Tm1=window.setTimeout("MyTimer1()",1000,"VBScript")End SelectEnd Function</SCRIPT><BODY><!-- Button To Show Menu 01 And Start Timer --><TABLE Style=''><TD><BUTTON ID='Btn01' OnClick='Button01()'> Show Menu </BUTTON></TD></TABLE><!-- Only Seen When Button 01 Click --><DIV ID='Menu01' Class='Menu1'Style='visibility:hidden;position:absolute;Top:40pt;Left:89;Width:225;Height:48;'><TABLE Border=1><TD>Some Text Here For Details</TD></TABLE><FONT ID='Text1' Style='Font-Size:9.05pt;Width:125;Height:16;Matgin-Top:3pt;' > </FONT></DIV></BODY>
  8. Here is a VBS script that will do what you want Save As MK_FiveHundredFolders.vbs '-> Object For Run Time Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") '-> Varibles For Run Time Dim C1,i '-> Loop For 500 Objects For i = 1 To 500 C1 = i + 500 '-> Add Zero To Number If Len(C1) = 3 Then C1 = "00" & C1 If Len(C1) = 4 Then C1 = "0" & C1 If Len(C1) = 5 Then C1 = C1 '-> Uncommecnt For Debugging Only ' WScript.Echo C1 '-> Make The Folder If It Not There If Not Fso.FolderExists(C1) Then Fso.CreateFolder(C1) If Not Fso.FolderExists(C1 & "\Results") Then Fso.CreateFolder(C1 & "\Results") Next
  9. Here is a VBS Script that, you Drag & Drop the folder that you want to list in below format. This will go threw all Folders And Sub Folders, and list all contents. Save As List_File_Directory.vbs '-> 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.'-> Object For Run TimeDim Act :Set Act = CreateObject("Wscript.Shell")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> Varibles For Script Run TimeDim Ar, Dr, Ln, Ts, TxtAr = Chr(160) & Chr(187) & Chr(160)Ln = "--------------------------------------------------------"'-> Makes Sure Only One Object Drag And DropSelect Case WScript.Arguments.CountCase 0call Msg(vbTab & "Error No Folder" & vbCrLf & _"To Use This Script Drag And Drop An" & vbCrLf & _"Single Folder Onto This Script.","Error 1")Case 1'-> Filter Out File From FolderIf Right(InStr(WScript.Arguments.Item(0),"."),6) Thencall Msg(Space(26) & "File Drag Drop" & vbCrLf & _" You Have Drag & Drop A File Onto This Script." & vbCrLf & _"Script Requires Only One Folder To Be, Drag &" & vbCrLf & _"Drop To Make Active","Error 3")ElseDr = WScript.Arguments.Item(0)call Msg("Preparing To List This Folder : " & Dr, "List Contents", 4128)Txt = Act.SpecialFolders("DeskTop") & "\List_Item.txt"Set Ts = Fso.CreateTextFile(Txt)Ts.writeline vbTab & "Scan Time" & Ar & Time()Ts.writeline vbTab & "Scan Date" & Ar & Date()Ts.writeline vbTab & "Scan Path" & Ar & DrRecursive(Fso.GetFolder(Dr))Ts.WriteLine LnTs.CloseAct.Run(Txt),1,Truecall Msg("Did You Want To Keep This File : " & Fso.GetFile(Txt).Name & vbCrLf & _"No To Delete This File, Yes To Keep File If Nothing Is Select" & vbCrLf & _"In 5 Seconds, This Script Will Close And Save The File","Yes To Keep - No To Delete",4132)End IfCase Elsecall Msg(Space(25) & "Error Exceeds Limit" & vbCrLf & _" User Has Drag And Drop " & WScript.Arguments.Count & _" Objects On To This Script." & vbCrLf & "This Script Was Meny To" & _" Process Only One Folder, At" & vbCrLf & " Script Run Time", _"Error 2", 4128)End Select'-> Msgbox Function With 5 Second TimeOutFunction Msg(Tx, Tn, Btn)Select Case BtnCase 4128Act.Popup Tx, 5, Tn, 4128Case 4132If Act.Popup(Tx, 5, Tn, 4132) = 7 Then Fso.DeleteFile(Txt), TrueEnd selectEnd Function'-> Recusive Threw Folder And All Sub FoldersFunction Recursive(Folder)Ts.WriteLine LnTs.WriteLine " Folder Path " & Ar & FolderFor Each Obj In Folder.FilesTs.WriteLine LnTs.WriteLine " File Name " & Ar & Obj.NameTs.WriteLine " Date Created " & Ar & Obj.DateCreatedTs.WriteLine " Last Accessed" & Ar & Obj.DateCreatedTs.WriteLine " Last Modified" & Ar & Obj.DateCreatedNextFor Each Dir In Folder.subFoldersRecursive(Dir)NextEnd Function
  10. I made this HTA that does the same as the VBS script. I Gunsmokingman give all users full permission to do what ever they want with this script. Save As Kb_List.hta <!-- 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.--><TITLE>List Install Updates</TITLE><HTA:APPLICATION ID="KbInfo"SCROLL="No"SCROLLFLAT ="No"SingleInstance="Yes"ShowInTaskbar="Yes"SysMenu="No"MaximizeButton="No"MinimizeButton="No"Border="Thin"BORDERSTYLE ="complex"INNERBORDER ="No"Caption="Yes"WindowState="Normal"APPLICATIONNAME="InfoKb"Icon="%SystemRoot%\explorer.exe"><STYLE Type='text/css'>Body{Font-Size:9.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;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;Text-Align:Left;Vertical-Align:Top;Border-Top:0px Transparent;Border-Bottom:0px Transparent;Border-Left:0px Transparent;Border-Right:0px Transparent;}DIV{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MSColor:Black;#635D57;Text-Align:Left;Filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#ece6e0',EndColorStr='#c0bab4');Padding:3pt;}TD{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MSColor:Black;#635D57;Text-Align:Center;Filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#ece6e0',EndColorStr='#c0bab4');}TD.A1{Cursor:Hand;Color:#224747;Text-Align:Center;Filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='AliceBlue',endColorStr='LightSlateGray');}TD.A2{Cursor:Hand;Color:#113535;Text-Align:Center;Filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='AliceBlue',endColorStr='SeaGreen');}Select{Font-Size:7.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS}</STYLE><script LANGUAGE='JScript'>//-> Resize And Place In Approx centervar W = 725, H = 275;window.resizeTo(W,H)window.moveTo(screen.availWidth/2-(W/2),screen.availHeight/2-(H/2))</SCRIPT><script Language="VBScript">Dim Kb_Info_Var, Kb_Name_Var, Kb_SelectDim Ar :Ar = Chr(160) & Chr(187) & Chr(160)Function FindKb()If Kb_C.options.length = 0 Then QuerryKb(1)If Kb_M.options.length = 0 Then QuerryKb(0)Exit FunctionEnd Function'-> Add To The Select option Update Name And InfoFunction QuerryKb(N)Dim objOptionDim C1 :C1 = 0Set updateSession = CreateObject("Microsoft.Update.Session")Set updateSearcher = updateSession.CreateupdateSearcher()Set SearchResult = UpdateSearcher.Search("IsInstalled=" & N & " and Type='Software'")For I = 0 To searchResult.Updates.Count-1C1 = C1 + 1Set Update = SearchResult.Updates.Item(I)Set objOption = Document.createElement("OPTION")If C1 Mod 2 ThenobjOption.Text = Update.TitleobjOption.Value = Update.DescriptionobjOption.style.color = "Blue"objOption.style.background= "#ECE6E1"ElseobjOption.Text = Update.TitleobjOption.Value = Update.DescriptionobjOption.style.color = "Green"objOption.style.background= "#FBF5F0"End IfIf N = 1 Then Kb_C.Add(objOption)If N = 0 Then Kb_M.Add(objOption)NextIf N = 1 And SearchResult.Updates.Count = 0 ThenSet objOption = Document.createElement("OPTION")objOption.Text = "No Update Found Installed"objOption.Value = "No Update Information. Please Run Windows Update"objOption.style.color = "Blue"objOption.style.background= "#ECE6E1"Kb_C.Add(objOption)End IfIf N = 0 And SearchResult.Updates.Count = 0 ThenSet objOption = Document.createElement("OPTION")objOption.Text = "No Update Are Needed"objOption.Value = "No Update Missing. All Windows Updates Installed"objOption.style.color = "Blue"objOption.style.background= "#ECE6E1"Kb_C.Add(objOption)End IfIf Len(C1) = 2 Then C1 = "0" & C1If Len(C1) = 1 Then C1 = "00" & C1If N = 1 Then Tx1.innerHTML = "Install Updates :" & Ar & C1If N = 0 Then Tx2.innerHTML = "Missing Updates :" & Ar & C1Exit FunctionEnd Function'-> Confirm Update Select OptionFunction SelectConfirm()If Kb_C.options.length => 1 ThenOn Error Resume NextFor i = 0 To Kb_C.options.lengthIf Kb_C.options(i).selected ThenKb_Select = 1Kb_Info_Var = Kb_C.options(i).valueKb_Name_Var = Kb_C.options(i).textKb_Name.style.visibility = ""Kb_Name.innerHTML = Kb_Name_VarKb_Info.style.visibility = ""Kb_Info.innerHTML = Kb_Info_VarEnd IfNextEnd IfExit FunctionEnd Function'-> Missing Update Select OptionFunction SelectMissing()If Kb_M.options.length => 1 ThenOn Error Resume NextFor i = 0 To Kb_M.options.lengthIf Kb_M.options(i).selected ThenKb_Select = 2Kb_Info_Var = Kb_M.options(i).valueKb_Name_Var = Kb_M.options(i).textKb_Name.style.visibility = ""Kb_Name.innerHTML = Kb_Name_VarKb_Info.style.visibility = ""Kb_Info.innerHTML = Kb_Info_VarEnd IfNextEnd IfExit FunctionEnd Function'-> Process Select Item To Open New WindowFunction ProcessSearchQuerry()If Kb_C.options.length = 0 Or Kb_M.options.length = 0 Thenalert("Please Run The Process KB Querry Button First. Then" & vbCrlf & _"Select An Update From The List That You, Want" & vbCrlf & _"To Find Some More Information Or Download." )ElseIf Kb_Name_Var = "" Thenalert("Please Select An Item From The Select Options" )ElseIf Kb_Select = 1 Then S1 = Right(Kb_Name_Var,11)If Kb_Select = 2 Then S1 = Right(Kb_Name_Var,11)If InStr(S1,"(") Then S1 = Replace(S1,"(","")If InStr(S1,")") Then S1 = Replace(S1,")","")If InStr(S1,"-") Then S1 = Replace(S1,"-","")If InStr(S1," ") Then S1 = Replace(S1," ","")If LCase(Left(S1,2)) = "kb" Thenwindow.open( _"http://www.microsoft.com/downloads/results.aspx?pocId=&freetext=" & _S1 &"&DisplayLang=")Elsealert("Can Not Process This Update Link")End IfEnd IfExit FunctionEnd Function</SCRIPT><BODY Style='Align:Center;'><TABLE Align='Center' Border='1'><TD ID='Tx1' Class='A1' style="width:223pt;">Install Updates</TD><TD ID='Tx2' Class='A1' style="width:223pt;">Missing Updates</TD></TABLE><TABLE Align='Center' Border='1'><TD><Select size="1" ID='Kb_C' name='Kb_C' OnChange="SelectConfirm()" style="width:225pt;"></Select></TD><TD><Select size="1" ID='Kb_M' name='Kb_M' OnChange="SelectMissing()" style="width:225pt;"></Select></TD></TABLE><!-- Display KB Name --><DIV ID='Kb_Name' Style='position:absolute;Bottom:85pt;Left:42pt;Width:446pt;Height:16pt;visibility:hidden;'></DIV><!-- Display KB Information --><DIV ID='Kb_Info' Style='position:absolute;Bottom:36pt;Left:42pt;Width:446pt;Height:48pt;visibility:hidden;'></DIV><!-- Button Container --><TABLE Border='1' Style='position:absolute;Bottom:16pt;Left:73pt;'><TD Class='A1' OnMouseOver="this.className='A2'"OnMouseOut="this.className='A1'" OnClick='FindKb()'style="width:123pt;Height:19;">Process KB Querry</TD><TD Class='A1' OnMouseOver="this.className='A2'"OnMouseOut="this.className='A1'" OnClick='ProcessSearchQuerry()'style="width:123pt;Height:19;">Open Application</TD><TD Class='A1' OnMouseOver="this.className='A2'"OnMouseOut="this.className='A1'" OnClick='window.close()'style="width:123pt;Height:19;">Close Application</TD></TABLE></BODY>
  11. This is what I get when I selected a radom link from my computer, with IE as my browser on win7 x64
  12. I have updated the script so it goes to the search results of the KB, this does not wotk 100%. I have edit the script so it will try and get the Kb number then pass that varible to microsoft.com/downloads/results and hope it list the information. I Gunsmokingman give all users full permission to do what ever they want with this script. Save As List_Kb.vbs '-> 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.Option Explicit'-> Makes ShorterDim Vb :Vb = vbCrLf'-> Objects For Script Run TimeDim Act, Fso, CNameSet Act = CreateObject("Wscript.Shell")Set Fso = CreateObject("Scripting.FileSystemObject")CName = Act.ExpandEnvironmentStrings("%ComputerName%")'-> Ask If You Want To Use ScriptDim A1A1 = Act.Popup( _" Would You Like To Run The Report Updates Script?" & Vb & _"The Script Will Take Approx 5 Minutes To Be Done." & Vb & _"If Nothing Is Selected This Will Self Close In 7" & Vb & _"Seconds And Do Nothing", 7, "Search Updates",4132)If A1 = 7 Or A1 = -1 ThenWScript.Quit(1)End If'-> Varibles For Hta OutputDim Hta :Hta = Act.SpecialFolders("Desktop") & "\" & CName & "_KbInfo.hta"Dim Ar :Ar = Chr(160) & Chr(187) & Chr(160)Dim Al :Al = Chr(160) & Chr(171) & Chr(160)Dim Ts'-> Search Objects And VariblesDim SearchResult, Update, UpDateSearcher,UpDateSessionSet UpDateSession = CreateObject("Microsoft.Update.Session")Set UpDateSearcher = UpDateSession.CreateUpDateSearcher()Set SearchResult = UpDateSearcher.Search("Type='Software'")'-> Varibles For Count, Loop, UpdatesDim C1, I, Kb_C, Kb_M, M1, V1, V2 :C1=0 :M1=0'-> Loop To List Install And Missing UpdatesFor I = 0 To SearchResult.Updates.Count-1Set Update = SearchResult.Updates.Item(I)If Update.IsInstalled ThenC1 = C1 + 1 : V1 = C1Kb_C = Kb_C & C1 & "=-=" & Update.Title & "=-=" & Update.Description & VbElseM1 = M1 + 1 : V2 = M1Kb_M = Kb_M & M1 & "=-=" & Update.Title & "=-=" & Update.Description & VbEnd IfNext'-> If There Are No Missing UpdatesIf M1 = 0 ThenV2 = "000"Kb_M = "000=-=No Updates Found=-=There Was No Updates Missing" & VbEnd If'-> If There Are No Installed UpdatesIf C1 = 0 ThenV1 = "000"Kb_C = "000=-=No Updates Found Installed=-=There Was No Updates Found Installed." & VbEnd If'-> Add Zero For 3 DigitIf Len(V1) = 2 Then V1 = "0" & V1If Len(V1) = 1 Then V1 = "00" & V1If Len(V2) = 2 Then V2 = "0" & V2If Len(V2) = 1 Then V2 = "00" & V2'-> Build The Hta ReportSet TS = Fso.CreateTextFile(Hta)TS.WriteLine "<TITLE>" & CName & "</TITLE>" & Vb & _"<STYLE Type=""text/css"">" & Vb & _" Body{Font-Size:9.25pt;Font-Weight:Bold;" & Vb & _" Font-Family:segoeui,helvetica,verdana,arial,Poor Richard;" & Vb & _" Color:#000063;BackGround-Color:Transparent;" & Vb & _" Filter:progid:DXImageTransform.Microsoft.Gradient" & Vb & _" (StartColorStr='#fdf7f1',endColorStr='#d1cbc5');" & Vb & _" Margin-Top:5;Margin-Bottom:5;Margin-Left:4;Margin-Right:4;" & Vb & _" Padding-Top:5;Padding-Bottom:5;Padding-Left:4;Padding-Right:4;" & Vb & _" Text-Align:Left;Vertical-Align:Top;" & Vb & _" Border-Top:2px Solid #cbc7c3;Border-Bottom:3px Solid #a6a29e;" & Vb & _" Border-Left:2px Solid #bcb8b4;Border-Right:3px Solid #b2aeaa;}" & Vb & _" TD.Tx1{Font-Size:8.25pt;Color:#004747;Font-Weight:Bold;Padding-Left:3;Width:70pt;}" & Vb & _" TD.Tx2{Font-Size:8.25pt;Color:#006969;Font-Weight:Bold;Width:105pt;}" & Vb & _" P.D1{Font-Size:8.25pt;Color:#1e1e1e;Width:99%;Padding-Left:1;Margin:1pt;}" & Vb & _" FONT.F1{Font-Size:8.25pt;Color:#004400;Padding-Left:3;Width:17pt;}" & Vb & _" FONT.F2{Font-Size:8.25pt;Font-Weight:Bold;Color:#000063;Padding-Left:3;}" & Vb & _"</STYLE>" & Vb & _"<script LANGUAGE='JScript'>window.resizeTo (725,425), window.moveTo (210,175);</SCRIPT>"Ts.WriteLine "<BODY Link='#003535' vLink='#007575' aLink='#003535'>" & Vb & _"<TABLE ALIGN='CENTER'><TD CLASS='Tx1'>Scan Date Time</TD><TD CLASS='Tx2'>" & _Ar & Now & "</TD></TABLE>" & Vb & _"<TABLE ALIGN='CENTER'><TD CLASS='Tx1'>Computer Name</TD><TD CLASS='Tx2'>" & _Ar & CName & "</TD></TABLE>" & Vb & _"<TABLE ALIGN='CENTER'><TD CLASS='Tx1'>Install KB</TD><TD CLASS='Tx2'>" & _Ar & V1 & "</TD></TABLE>" & Vb & _"<TABLE ALIGN='CENTER'><TD CLASS='Tx1'>Missing KB</TD><TD CLASS='Tx2'>" & _Ar & V2 & "</TD></TABLE><HR Width=97%>"Ts.WriteLine "<TABLE Align='Center'>List Of Missing Updates</TABLE><HR Width=99%>"SortInfo(Kb_M)Ts.WriteLine "<TABLE Align='Center'>List Of Installed Updates</TABLE><HR Width=99%>"SortInfo(Kb_C)Ts.Close'-> Run The HtaAct.Run("mshta.exe " & Chr(34) & Hta & Chr(34)),1,True'/-> Keep Or Delete The Hta ReportIf MsgBox("Did You Want To Keep The HTA Update Report?" & Vb & _"Yes To Keep The Hta, No To Delete The Hta.",4132,"Keep Or Delete") = 7 ThenFso.DeleteFile Hta, TrueEnd If'-> Function Sort The Info For Display In The HtaFunction SortInfo(Arg)Dim Obj, S1, VFor Each Obj In Split(Arg,Vb)If Not Obj = "" ThenV = Split(Obj,"=-=")S1= Right(V(1),11)If Len(V(0)) = 2 Then V(0) = "0" & V(0)If Len(V(0)) = 1 Then V(0) = "00" & V(0)If InStr(S1,"(") Then S1 = Replace(S1,"(","")If InStr(S1,")") Then S1 = Replace(S1,")","")If InStr(S1,"-") Then S1 = Replace(S1,"-","")If InStr(S1," ") Then S1 = Replace(S1," ","")'-> Sort The Info For Links And None linksIf LCase(Left(S1,2)) = "kb" ThenTs.WriteLine "<FONT Class='F1'>" & Al & V(0) & Ar & "</FONT>" & Vb & _"<FONT Class='F2'>" & V(1) & "</FONT>" & Vb &_"<P Class='D1'> " & V(2) & "</DIV>" & Vb & _"<DIV ALIGN='CENTER'>" & Vb & _"<A HREF='http://www.microsoft.com/downloads/results.aspx?pocId=&freetext=" & _S1 &"&DisplayLang='>" & S1 & " Information</A></DIV><HR Width=99%>" & Vb & VbElseTs.WriteLine "<FONT Class='F1'>" & Al & V(0) & Ar & "</FONT>" & Vb &_"<FONT Class='F2'>" & V(1) & "</FONT>" & Vb &_"<P Class='D1'> " & V(2) & "</DIV><HR Width=99%>" & Vb & VbEnd IfEnd IfNextEnd Function
  13. I wrote this VBS script that makes a HTA that list the missing and installed updates. I Gunsmokingman give all users full permission to do what ever they want with this script. Save As KB_Report.vbs '-> 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.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''/-> Varibles And Objects For The ScriptDim Act, CName, CN, Fso, UpdateSession, UpdateSearcherSet Act = CreateObject("Wscript.Shell")Set Fso = CreateObject("Scripting.FileSystemObject")Set updateSession = CreateObject("Microsoft.Update.Session")Set updateSearcher = updateSession.CreateupdateSearcher()CName = Act.ExpandEnvironmentStrings("%ComputerName%")'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''/-> Ask If You Want To Use ScriptDim A1A1 = Act.Popup( _" Would You Like To Run The Report Updates Script?" & vbCrLf &_"The Script Will Take Approx 5 Minutes To Be Done." & vbCrLf &_"If Nothing Is Selected This Will Self Close In 7" & vbCrLf &_"Seconds And Do Nothing", 7, "Search Updates",4132)If A1 = 7 Or A1 = -1 ThenWScript.Quit(1)End If'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''/-> Varibles For The ScriptDim Arg1, Arg2, Arg3, C1, DT, Hta1, Hta2, Hta3, Hta4Dim Rpt, Str1, Str2, Str3, SearchResult, TS, Update, Var1, Var2, Var3'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''/-> Replace Any Spaces In The Computer NameIf InStr(CName," ") ThenCN = Replace(CName," ", "_")ElseCN = CNameEnd If'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''/-> Build The HtaDT = Act.SpecialFolders("Desktop")Rpt = (DT & "\" & CN & "_KbReport.hta")Rpt = Act.ExpandEnvironmentStrings("%UserProfile%\desktop\" & CN & "_KbReport.hta")Var1 = Chr(160) & Chr(171) & Chr(160)Var2 = Chr(160) & Chr(187) & Chr(160)Var3 = Var1 & "---------------------------------------" & Var2Set SearchResult = UpdateSearcher.Search("IsInstalled=0 and Type='Software'")Set TS = Fso.CreateTextFile(Rpt)TS.WriteLine "<TITLE>" & CName & "</TITLE>" & vbCrLf &_"<STYLE Type=""text/css"">" & vbCrLf &_" Body{Font-Size:9.25pt;Font-Weight:Bold;" & vbCrLf &_" Font-Family:segoeui,helvetica,verdana,arial,Poor Richard;" & vbCrLf &_" Color:#000063;BackGround-Color:Transparent;" & vbCrLf &_" Filter:progid:DXImageTransform.Microsoft.Gradient" & vbCrLf &_" (StartColorStr='#fdf7f1',endColorStr='#d1cbc5');" & vbCrLf &_" Margin-Top:5;Margin-Bottom:5;Margin-Left:4;Margin-Right:4;" & vbCrLf &_" Padding-Top:5;Padding-Bottom:5;Padding-Left:4;Padding-Right:4;" & vbCrLf &_" Text-Align:Left;Vertical-Align:Top;" & vbCrLf &_" Border-Top:2px Solid #cbc7c3;Border-Bottom:3px Solid #a6a29e;" & vbCrLf &_" Border-Left:2px Solid #bcb8b4;Border-Right:3px Solid #b2aeaa;}" & vbCrLf &_" Table.Table1{Font-Size:8.25pt;Color:Blue;Font-Weight:Bold;Width:395px;}" & vbCrLf &_" Div.D1{Font-Size:8.25pt;Color:#1e1e1e;Padding-Left:25;Width:97%;}" & vbCrLf &_" Font.F1{Color:#004400;Padding-Left:18;}" & vbCrLf &_" Font.F2{Font-Weight:Bold;Color:#000063;Padding-Left:23;}" & vbCrLf &_"</STYLE>" & vbCrLf &_"<script LANGUAGE='JScript'>window.resizeTo (675,395), window.moveTo (210,175);</SCRIPT>"TS.WriteLine "<BODY><CENTER><TABLE>" & Var1 & Now() & Var2 &_"</TABLE><TABLE>List Of Missing Updates</TABLE><HR Width=95%></CENTER>"For I = 0 To searchResult.Updates.Count-1C1 = C1 + 1If Len(C1) = 3 Then C1 = C1If Len(C1) = 2 Then C1 = "0" & C1If Len(C1) = 1 Then C1 = "00" & C1Set Update = SearchResult.Updates.Item(I)RptUpdate()Arg3 = Arg3 & vbCrLf & Update.TitleNext'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''/-> If There Are No Updates To Install On The MachineIf SearchResult.Updates.Count = 0 ThenTS.WriteLine "<FONT Class='F1;'>" & Var1 & C1 & Var2 & "</FONT>" & vbCrLf &_"<FONT Class='F2'>There Are No Applicable Updates, To Install""</FONT>" & vbCrLf &_"<CENTER><HR Width=95%></CENTER>"End IfDim SResultsC1 = 0TS.WriteLine "<CENTER><TABLE>List Of Installed Updates</TABLE><HR Width=95%></CENTER>"Set SResults = UpdateSearcher.Search("IsInstalled=1 and Type='Software'")For I = 0 To SResults.Updates.Count-1C1 = C1 + 1If Len(C1) = 3 Then C1 = C1If Len(C1) = 2 Then C1 = "0" & C1If Len(C1) = 1 Then C1 = "00" & C1Set Update = SResults.Updates.Item(I)RptUpdate()Next'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''/-> Report The Update InformationFunction RptUpdate()TS.WriteLine "<FONT Class='F1;'>" & Var1 & C1 & Var2 & "</FONT>" & vbCrLf &_"<FONT Class='F2'>" & Update.Title & "</FONT>" & vbCrLf &_"<DIV Class='D1'> " & Update.Description & "</DIV>" & vbCrLf &_"<CENTER><HR Width=95%></CENTER>"End FunctionTS.Close'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''/-> Run The HtaSet Arg1 = Fso.GetFile(Rpt)Act.Run("mshta.exe " & Chr(34) & Arg1.Path & Chr(34)),1,True'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''/-> Keep Or Delete The Hta ReportIf MsgBox("Did You Want To Keep The HTA Update Report?" & vbCrLf & _"Yes To Keep The Hta, No To Delete The Hta.",4132,"Keep Or Delete") = 7 ThenFso.DeleteFile Arg1End If
  14. Here is a script that enumerates the unistall keys in the registry, it produces a text file. Save As ReadRegisteryInstallApps.vbs Const HKLM = &H80000002 Dim StrComputer :StrComputer = "." Dim Act :Set Act = CreateObject("WScript.Shell") Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim Key :Key = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" Dim Reg :Set Reg = GetObject("winmgmts://" & StrComputer & _ "/root/default:StdRegProv") Dim Arr :Arr = Array( _ "DisplayName", "QuietDisplayName", "InstallDate", _ "VersionMajor", "VersionMinor","EstimatedSize") Dim Ts, Txt Txt = Act.SpecialFolders("Desktop") & "\InstallApplications.txt" Set Ts = Fso.CreateTextFile(Txt) Reg.EnumKey HKLM, Key, arrSubkeys Ts.WriteLine vbtab & "List Of Installed Applications" For Each strSubkey In arrSubkeys int1 = Reg.GetStringValue(HKLM, Key & strSubkey, Arr(0), str1) If int1 <> 0 Then Reg.GetStringValue HKLM, Key & strSubkey, Arr(1), str1 If Not IsNull(str1) Then Ts.WriteLine _ "----------------------------------------------------------------" & _ vbCrLf & "Item Name " & vbTab & str1 End If Reg.GetStringValue HKLM, Key & strSubkey, Arr(2), str2 If Not IsNull(str2) Then Ts.WriteLine "Install On " & vbTab & str2 End If Reg.GetDWORDValue HKLM, Key & strSubkey, Arr(3), str3 Reg.GetDWORDValue HKLM, Key & strSubkey, Arr(4), str4 If Not IsNull(str3) Then Ts.WriteLine "Version " & vbTab & str3 & "." & str4 End If Reg.GetDWORDValue HKLM, Key & strSubkey, Arr(5), str5 If Not IsNull(str5) Then Ts.WriteLine "File Size " & vbTab & Round(str5/1024, 3) & " MB" End If Next Ts.Close '-> Open Text Report Act.Run(Txt),1,True '-> Ask To Keep Or delete File If MsgBox("Would you like to keep this file?" & vbCrLf & _ Txt, 4132,"Yes To Keep, No To Delete File?") = 7 Then Fso.DeleteFile Txt,True End If Rename ReadRegisteryInstallApps.vbs.txt to ReadRegisteryInstallApps.vbs to make active. ReadRegisteryInstallApps.vbs.txt
  15. If you provide all the Bat contents perhaps it could be converted to VBS scripting.
  16. You would run it as a VBS script, it does not need cmd promt. Hidden Window And Wont Wait For App To Close CreateObject("Wscript.Shell").Run("hlds.exe -console -game cstrike %IPARG% +sys_ticrate 150 -heapsize 15000 -port %port_add% -noipx +exec server%sv_add%.cfg"), 0,False Show Window And Wait For App To Close CreateObject("Wscript.Shell").Run("hlds.exe -console -game cstrike %IPARG% +sys_ticrate 150 -heapsize 15000 -port %port_add% -noipx +exec server%sv_add%.cfg"), 1,True
  17. If you wanted to run this in VBS with nothing showing in the taskbar aand no 3rd party apps. Save As RunHiddenHids.vbs CreateObject("Wscript.Shell").Run("hlds.exe -console -game cstrike %IPARG% +sys_ticrate 150 -heapsize 15000 -port %port_add% -noipx +exec server%sv_add%.cfg"), 0,False
  18. Are you using 3 separate scripts or just one big script with 3 procedures? You could try changing this line in the print script Change From colItems.Item(i).InvokeVerbEx("Print") Change Too TargetFolder & colItems.Item(i).InvokeVerbEx("Print") This change will pass a full path and File Name now instead of just the File Name
  19. Why not just put the script in the SendTo folder.
  20. Read this How Can I Automatically Run a Script Any Time a File is Added to a Folder?
  21. Truthfully Windows 8 GUI looks like it was design by a someone who took to much acid in the 70`s and never came down.
  22. Now this is just a guess If Not THE_NAME_OF_THE_TEXTBOX.TEXT = "" Then ' Query Code Here ' THE_NAME_OF_THE_TEXTBOX.TEXT End If
  23. Here I made some modification and the script run and produces the vbs files, but it does not place the correct script info into each vbs, you will have to work that out. Change the path for the files, to what you had. textFile = "ScriptingSamples2.txt" saveTo = "Script_" writeTo = "" ' numberPattern = "^([0-9]|[1-9])$" numberPattern = "(\d{1,2})" dim fso,fileFrom,regex set fso = CreateObject("Scripting.FileSystemObject") set fileFrom = fso.OpenTextFile(textFile, 1) set regex = new RegExp regex.Pattern = numberPattern regex.IgnoreCase = False regex.Global = True On Error Resume Next Do while fileFrom.AtEndOfStream <> True line = fileFrom.ReadLine Set matches = regex.Execute(line) If regex.Test(line) = True Then writeTo = saveTo & matches(0).SubMatches(0) & ".vbs" set fileTo = fso.CreateTextFile(writeTo) ElseIf fso.FileExists(writeTo) Then fileTo.WriteLine(line) End If Loop Regex_Demo.vbs.txt
  24. Well then you are going to have to figure out how to do what you want, by yourself.
×
×
  • Create New...