Content Type
Profiles
Forums
Events
Everything posted by gunsmokingman
-
Test Dim Act :Set Act = CreateObject("Wscript.Shell")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")Fso.CopyFile "New offerte.doc", "H:\",TrueAct.Run(chr(34) & "New offerte.doc"& Chr(34)),Falsecopies without any errorbut needs Double Quotes to open, Chr(34)=" 1:\So the letter are for folders 2:\ You want to copy those files to the User Input Letter Folder Updated Script, it will make the UserInput Letter Folder On Drive H, which you can change to suit your needs, then copies the 2 files. '-> 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.'-> Run Time ObjectsDim Act :Set Act = CreateObject("Wscript.Shell")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> Runtime VariblesDim F, Fld'-> Check To Make Both Files ExistsIf Fso.FileExists("offerte.doc") And Fso.FileExists("factuur.vbs") ThenGetFldLtr()ElseMsgBox "Error Missing the offerte.doc or factuur.vbs."WScript.Quit()End IfFunction GetFldLtr()'-> Loop To Keep Inputbox ActiveDo'-> Get Drive LetterFld = InputBox(_"Type In The Drive Letter You Want To Use" & vbCrLf & vbCrLf &_"To Close And Do Nothing, Type Exit Or Quit","","",6500,5500)'-> Quit Or Exit ScriptIf InStr(1,Fld,"exit",1) And Len(Fld) = 4 Or _InStr(1,Fld,"quit",1) And Len(Fld) = 4 ThenWScript.QuitEnd ifIf Not IsNumeric(Fld) And Len(Fld) = 1 ThenIf Fso.DriveExists("H:\") ThenDim P [img=http://www.msfn.org/board/public/style_emoticons/default/tongue.gif]="H:\"&FldIf Not Fso.FolderExists(P) Then Fso.CreateFolder(P)Set F=Fso.GetFile("offerte.doc")F.Copy P&"\"&F.Name,TrueSet F=Fso.GetFile("factuur.vbs")F.Copy P&"\"&F.Name,TrueExit DoElseMsgBox "Error This Drive H:\ Is Missing . Contact The" & vbCrLf & _"To Get The Correct Drive Letter",4128,"Error No Drive"WScript.QuitEnd IfEnd IfLoop Until Len(Fld) = 1000End Function
-
1:\ Please note I do not have any experience at Networks, I only have one computer 2:\ This script is to replace choice /C:abcdefghijklmnopqrstuvwxyz /N >NUL 3:\ Tested this on my local drives and it copies the 2 files In regards to Number 1 you will have read up on how to use VBS to connect to another computer. '-> 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.'-> Run Time ObjectsDim Act :Set Act = CreateObject("Wscript.Shell")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> Runtime VariblesDim Drv'-> Check To Make Both Files ExistsIf Fso.FileExists("offerte.doc") And Fso.FileExists("factuur.vbs") ThenGetDrvLtr()ElseMsgBox "Error Missing the offerte.doc or factuur.vbs."WScript.Quit()End IfFunction GetDrvLtr()'-> Loop To Keep Inputbox ActiveDo'-> Get Drive LetterDrv = InputBox(_"Type In The Drive Letter You Want To Use" & vbCrLf & vbCrLf &_"To Close And Do Nothing, Type Exit Or Quit","","",6500,5500)'-> Quit Or Exit ScriptIf InStr(1,Drv,"exit",1) And Len(Drv) = 4 Or _InStr(1,Drv,"quit",1) And Len(Drv) = 4 ThenWScript.QuitEnd ifIf Not IsNumeric(Drv) And Len(Drv) = 1 ThenIf Fso.DriveExists(Drv) ThenFso.CopyFile "offerte.doc", Drv & ":\"Fso.CopyFile "factuur.vbs", Drv & ":\"ElseMsgBox Drv & ":\ is missing. Type in another drive letter"GetDrvLtr()End IfExit DoEnd IfLoop Until Len(Drv) = 1000End Function
-
It always good practice when using VBS to include checks to prevents errors. Your script will still run even if the Inputbox is blank, the cancel being pressed, the X being pressed, that would caused it to error out. Another way to get CurrentDirectory=Replace(WScript.ScriptFullName,"\"&WScript.ScriptName,"")
-
If you learned about HTA and the various scripting langauges that can be used you could make something like this to present to the end user. <!--February-05-13 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>Demo User Input</TITLE><HTA:APPLICATION ID="UserIn"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="DmUserIn"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;Text-Align:Center;Vertical-Align:Top;}TD{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}.Tbx{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}BUTTON{Height:15pt;width:60pt;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;Margin-Top:15pt;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 ScreenDim Wth, Hht :Wth = int(475) :Hht = int(255)window.ResizeTo Wth, HhtMoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))'-> Function To Process The Submit ButtonFunction MySubmit()If Len(In1.value) = 0 And Len(In2.value) = 0 And Len(In3.value) = 0 Thenalert("No Textboxes Have Any Information")ElseIf Len(In1.value) >= 1 And Len(In2.value) = 0 And Len(In3.value) = 0 Thenalert("Only TextBox 1 Information : " & In1.value & vbCrlf & _"Please Fill In Textboxes 2 And 3 Then Press Submit")ElseIf Len(In1.value) >= 1 And Len(In2.value) >= 1 And Len(In3.value) = 0 Thenalert("TextBox 1 Information : " & In1.value & vbCrlf & _"TextBox 2 Information : " & In2.value & vbCrlf & _"Please Fill In Textboxes 3 Then Press Submit")ElseIf Len(In1.value) >= 1 And Len(In2.value) >= 1 And Len(In3.value) >= 1 ThenIf Len(In2.value) = 5 Thenalert("Sucess All 3 Textboxes Filled In" & vbCrlf & _"TextBox 1 Information : " & In1.value & vbCrlf & _"TextBox 2 Information : " & In2.value & vbCrlf & _"TextBox 3 Information : " & In3.value)Elsealert("Error Needs The Last Five Digits From Invoice Number : " & In2.value)End IfEnd IfEnd Function</SCRIPT><BODY><!-- Customer Name Area --><TABLE><TD Style='width:101;'>Customer Name</TD><TD><INPUT Type='TextBox' ID='In1' Class='Tbx' Size='40' MAXLENGTH='128'><TD></TABLE><!-- Two Textboxes Start --><TABLE><!-- Invoice Number Area --><TD Style='width:101;'>Invoice Number</TD><TD><INPUT Type='TextBox' ID='In2' Class='Tbx' Size='5' MAXLENGTH='5'Style='Margin-Right:15;' Title="Use Only The Last Five DigitsOf The Invoice Number"></TD><!-- Type Of Job Area --><TD Style='width:101;'>Type Of Job</TD><TD><INPUT Type='TextBox' ID='In3' Class='Tbx' Size='10' MAXLENGTH='15'><TD></TABLE><!-- Buttons Start --><BUTTON ID='Bn1' OnClick='MySubmit()'>Submit</BUTTON><BUTTON ID='Bn2' OnClick='window.close()'>Close</BUTTON><BODY>
-
UserInput in the script is a varible that can be passed to other parts of the script. Example Dim UserInput GetUserInput() Function GetUserInput() Do UserInput = InputBox(_ "Text With Details About User Input Required" & vbCrLf & vbCrLf &_ "To Close And Do Nothing, Type Exit Or Quit","","",6500,5500) If InStr(1,UserInput,"exit",1) And Len(UserInput) = 4 Or _ InStr(1,UserInput,"quit",1) And Len(UserInput) = 4 Then WScript.Quit End if If Not UserInput = "" And Len(UserInput) >= 0 Then '-> User Input Passed To The Function WordDocument WordDocument(UserInput) Exit Do End if Loop Until Len(Input) = 1000 End Function Function WordDocument(Name) Const wdReplaceAll = 2 Set oWord = CreateObject("Word.Application") oWord.Visible = False set oDoc = oWord.Documents.Open(Name & ".doc") With oWord.Selection .Find.Text = "Offerte:" .Find.Replacement.Text = "factuur:" .Find.Forward = True .Find.MatchWholeWord = True .Find.Execute ,,,,,,,,,,wdReplaceAll .Find.Text = "Na eventuele accordatie stellen wij betaling per pin op prijs." .Find.Replacement.Text = "Wij danken u voor uw opdracht, graag betaling via PIN" .Find.Forward = True .Find.MatchWholeWord = True .Find.Execute ,,,,,,,,,,wdReplaceAll End With oDoc.Save oDoc.Close oWord.Quit End Function The above code passes UserInput which becomes the new varibles Name in the function WordDocument
-
You know it would be better to use VBS script to get the user input and then pass that varible. Example Dim UserInput GetUserInput() Function GetUserInput() Do UserInput = InputBox(_ "Text With Details About User Input Required" & vbCrLf & vbCrLf &_ "To Close And Do Nothing, Type Exit Or Quit","","",6500,5500) If InStr(1,UserInput,"exit",1) And Len(UserInput) = 4 Or _ InStr(1,UserInput,"quit",1) And Len(UserInput) = 4 Then WScript.Quit End if If Not UserInput = "" And Len(UserInput) >= 0 Then '-> User Input MsgBox "User Input = " & UserInput ,4128,"Input Return" Exit Do End if Loop Until Len(Input) = 1000 End Function
-
.vbs (cancel within html)
gunsmokingman replied to drfb's topic in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
HTA is just HTML for desktops, I suggest the HTA instead of using CreateObject("InternetExplorer.Application") because the HTA is easier to work with, fewer restriction from the OS. I used VBS to code the countdown and the graph works from vbs code. How make a HTA Goto Full Screen, Change WindowState="Normal" To WindowState="Maximize" There is 3 default, Normal, Minimize, Maximize I suggested this because you can not use WScript with in the CreateObject("InternetExplorer.Application") it a HTML object that does not support that object. Here a simple demo using wscript in an hta <script LANGUAGE='VBScript'> '-> Resize And Place In Approx Center Of Screen Dim Wth, Hht :Wth = int(475) :Hht = int(255) window.ResizeTo Wth, Hht MoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2)) Function Test() wscript.echo "Hello It Works" End Function </SCRIPT> <BODY><BUTTON ID="b01" ONClick="Test()">Test</BUTTON></BODY> Using the Test Button will produce this error at the start Wscript -
.vbs (cancel within html)
gunsmokingman replied to drfb's topic in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
If you take out on error you would find out why it not working or you could try this hta that has a 60 second count down and a graph that works. Count Down Graph Demo.hta <!--January-27-13 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>Count Down Graph Demo</TITLE><HTA:APPLICATION ID="CountDownGraph"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="CntDwnGrph"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:25;Margin-Bottom:5;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;}BUTTON{Height:15pt;width:60pt;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;}.pgbar{filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0,StartColorStr='#44DC88',endColorStr='#005a00')}TD{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}</STYLE><script LANGUAGE='VBScript'>'-> Resize And Place In Approx Center Of ScreenDim Wth, Hht :Wth = int(475) :Hht = int(255)window.ResizeTo Wth, HhtMoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))'-> Runtime VariblesDim Ct, c34, Tm1 :Ct = 60'-> Window OnLoadFunction Window_OnLoad()ProgressBar.style.visibility = ""ProgressBar.style.width = "300"ProgressBar.style.height = "15"Txt1.style.visibility = ""Txt1.style.width = "300"Txt1.style.height = "15"Counter()End Function'-> Count Down FunctionFunction Counter()Dim aIf Len(Ct) = 1 Then Ct = "0" & CtIf Ct = 0 Then'-> Code Here To Do Something When Counter Reaches Zerowindow.clearTimeout(Tm1)window.close()End Ifa = FormatPercent(Ct*15 /300 ,2)a = Replace(a,"%","")a = Replace(a,",","")Txt1.innerHTML= CtProgressBar.style.width = aCt = Ct - 1Tm1=window.setTimeout("Counter()",1000,"VBScript")End Function</SCRIPT><BODY><!-- Uncomment Used To Center The Graph ANd Text<TABLE Width='300' Style='Margin:-2;height:12;' Border='1'><TD Style='Margin:-2;'><DIV ID='' Class='pgbar' Style='width:300'></DIV></TD></TABLE>--><!-- Background Graph --><TABLE Border='1' Style="Filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#ece6e0',endColorStr='#c0bab4');Position:Absolute;Top:9;Left:76;Width:302;Padding:-4pt;"><TD Style='Margin:-2pt;Padding:-4pt;height:13;'></TD></TABLE><!-- Progress Bar --><DIV ID='ProgressBar' Class='pgbar' Style='visibility:hidden;Position:Absolute;Top:10;Left:77;'></DIV><!-- TExt Display On Graph Bar --><DIV ID='Txt1' Style='visibility:hidden;Position:Absolute;Top:11;Left:77;'></DIV><!-- Test Display For User --><TABLE Style='Width;100%;Margin-Top:35pt;'><TD Align='Left'>Some text here with the details of what this does and to alsoinform the user they can cancel and close this HTA.</TD></TABLE><!-- Buttons --><TABLE Style='Width;100%;Margin-Top:5pt;'><TD><BUTTON ID='B01' OnClick='window.clearTimeout(Tm1) :window.close()'>Close</BUTTON></TD></TABLE></BODY> -
Count down in a batch file
gunsmokingman replied to sixpack's topic in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
On Windows 7 they have a exe called Timeout Parameter List: /T timeout Specifies the number of seconds to wait. Valid range is -1 to 99999 seconds. /NOBREAK Ignore key presses and wait specified time. /? Displays this help message. NOTE: A timeout value of -1 means to wait indefinitely for a key press. Examples: TIMEOUT /? TIMEOUT /T 10 TIMEOUT /T 300 /NOBREAK TIMEOUT /T -1 -
Enuff here just place this VBS in the folder where you want to rename them. If you need a script that will loop threw all folders and sub fulder to look for the file post a request. Rename any file with TSP1 as it first 4 digets Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim i For Each i In Fso.GetFolder(".").Files If InStr(1,i.Name,"TSP1",1) And Left(LCase(i.Name),4)="tsp1" Then Fso.MoveFile i.Path, Replace(i.Path,Left(i.Name,4),"TSP") End If Next
-
Ping Test
gunsmokingman replied to Boston2012's topic in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
What IP Address did you use, that a default local adresss for the computer running the script. Here what I done so far Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Os Dim Ip, Return :Ip ="127.0.0.1" '-> Local Address Return Yes GetOsName() Ping(Ip) If Return Then MsgBox Return & ", Ip Reply : " & Ip & vbCrLf & Os,4128, "Test Positive" Else WScript.Echo Return & ", Ip Reply : " & Ip,4128, "Test Negative" End If '-> Get Os Name Function GetOsName() For Each Obj in GetObject("winmgmts:").InstancesOf(_ "Win32_OperatingSystem") Os = Obj.Caption Next End Function '-> Ping Computer Function Ping(P) If Act.Run("Ping -n 1 -w 300 " & P, 0, True) = 0 Then Return = True Else Return = False End If End Function Ip True Ip False -
Ping Test
gunsmokingman replied to Boston2012's topic in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
I ment to try what I posted, the script you posted is a mess, so I want to start from scratch and confirm that you can get either tue or false returns. -
Ping Test
gunsmokingman replied to Boston2012's topic in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
Try this, it should show a true or false message Dim Act :Set Act = CreateObject("Wscript.Shell") Dim Ip, Return :Ip ="127.0.0.1" '-> Local Address Return Yes Ping(Ip) If Return Then WScript.Echo Return & ", Ip Reply : " & Ip Else WScript.Echo Return & ", Ip Reply : " & Ip End If Function Ping(P) If Act.Run("Ping -n 1 -w 300 " & P, 0, True) = 0 Then Return = True Else Return = False End If End Function Rename DemoPing.vbs.txt to DemoPing.vbs to make active DemoPing.vbs.txt -
Merry Christmas
gunsmokingman replied to Yzöwl's topic in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
Merry Chrismas to you cute little exe you wrote. -
This script will list the langauge of the OS like this English - United States I stopped it at 1040, here is a link to the rest of the values, look for the OSLangauge section Set Wmi = GetObject("winmgmts:\\.\root\CIMV2") Dim L1, Obj L1 = "Langauge : " For Each Obj In Wmi.ExecQuery( "SELECT * FROM Win32_OperatingSystem") Select Case Obj.OSLanguage Case 1 L1 = L1 & "Arabic" Case 4 L1 = L1 & "Chinese (Simplified) - China" Case 9 L1 = L1 & "English" Case 1025 L1 = L1 & "Arabic - Saudi Arabia" Case 1026 L1 = L1 & "Bulgarian" Case 1027 L1 = L1 & "Catalan" Case 1028 L1 = L1 & "Chinese (Traditional) - Taiwan" Case 1029 L1 = L1 & "Czech" Case 1030 L1 = L1 & "Danish" Case 1031 L1 = L1 & "German - Germany" Case 1032 L1 = L1 & "Greek" Case 1033 L1 = L1 & "English - United States" Case 1034 L1 = L1 & "Spanish - Traditional Sort" Case 1035 L1 = L1 & "Finnish" Case 1036 L1 = L1 & "French - France" Case 1037 L1 = L1 & "Hebrew" Case 1038 L1 = L1 & "Hungarian" Case 1039 L1 = L1 & "Icelandic" Case 1040 L1 = L1 & "Italian - Italy" End Select Next Wscript.Echo L1
-
Using allen2 example path here is another way using an array and a loop Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim FPath, Obj, SvrPath '->Array For Path To Local And Server Folders SvrPath = Array("C:\inetpub\wwwroot\ErOne", _ "\\server1\C$\inetpub\wwwroot\ErOne", _ "\\server2\C$\inetpub\wwwroot\ErOne") '-> Copy This FPath = "C:\inetpub\wwwroot\Pre-Release\*" '-> Loop Threw The Array For Each Obj In SvrPath '-> Code For Copy Fso.CopyFolder FPath, Obj ,True Fso.CopyFile FPath, Obj, True '-> UnComment For Out Put ' WScript.Echo "Fso.CopyFolder " & FPath & ", " & Obj & ",True" & _ ' vbCrLf & "Fso.CopyFile " & FPath & ", " & Obj & ",True" & vbCrLf Next
-
bat2exe not work win x64?
gunsmokingman replied to MgmTest's topic in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
Because Wrong ( _"%sys Correct ("%sys Underscore is used to split a long line of code and continue on the lower line. -
.CSV File
gunsmokingman replied to Boston2012's topic in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
With so little information yes it possible and depending on scripting langauge it easy to do.