vbscript+function calling function - return value - vbscript

I have a vbscript that calls a second vbscript and runs a function. This second function returns a value. But I can't figure out how to get this value, as the result of the first function returns the status code.
original call: fileCASTRING(12345678)
vbscript 1
function fileCASTRING(varRAW)
lresult = CreateObject("WScript.Shell").Run ("c:\windows\syswow64\cscript.exe C:\ERMXData\Config\query-castring.vbs " & varRAW,0,true)
fileCASTRING=1
end function
query-castring.vbs
doctype=WScript.Arguments.Item(0)
Dim strCon
strCon = "DSN=*****; " & _
"uid=*****;pwd=*****;"
Dim oCon: Set oCon = WScript.CreateObject("ADODB.Connection")
Dim oRs: Set oRs = WScript.CreateObject("ADODB.Recordset")
oCon.Open strCon
Set oRs = oCon.Execute("select ESBLINK_ADMR_CODE from ESBLINK where ESBLINK_DTYP_CODE like '%" + doctype + "%'"")
queryB=oRs.Fields(0).Value
oCon.Close
Set oRs = Nothing
Set oCon = Nothing
I have to do it like this because the program that runs vbscript 1 runs in 64 bit mode and the code in query-castring.vbs needs to run in 32bit mode in order for it to work. How can I get the queryB value back to the original caller? I am trying to not have to write the value to a file.

The only easy way to communicate between two command line processes is via StdOut.
(Be aware the code is not tested but should get you into the right direction.)
VBScript 1
Option Explicit
' ...
Function fileCASTRING(varRAW)
Dim program, script, cmdline, output
program = "c:\windows\syswow64\cscript.exe /nologo"
script = "C:\ERMXData\Config\query-castring.vbs"
cmdLine = program & " " script & " """ & varRAW & """"
output = ""
With CreateObject("WScript.Shell").Exec(cmdLine)
While Not .StdOut.AtEndOfStream
output = output & .StdOut.ReadAll
Wend
End With
fileCASTRING = output
End Function
see the documentation of the WshScriptExec object
query-castring.vbs
Option Explicit
Dim doctype: doctype = WScript.Arguments.Item(0)
Dim strCon: strCon = "DSN=*****;uid=*****;pwd=*****;"
Dim strSql: "select ESBLINK_ADMR_CODE from ESBLINK where ESBLINK_DTYP_CODE like '%' + ? + '%'"
Dim oCon: Set oCon = WScript.CreateObject("ADODB.Connection")
Dim oCmd: Set oCmd = WScript.CreateObject("ADODB.Command")
oCon.Open strCon
With WScript.CreateObject("ADODB.Command")
Set .ActiveConnection = oCon
.CommandText = strSql
.Parameters.Add(.CreateParameter)
.Parameters(0).Value = doctype
With .Execute
If Not .EOF Then
WScript.Echo .Fields("ESBLINK_ADMR_CODE").Value
End If
End With
End With
oCon.Close
See the documentation of the ADODB Command and Parameter objects. Don't build SQL from strings.
Also, look into "integrated security" connection strings - do not store plain text passwords in in code files. ADODB can easily use the security context of the account that runs the script, if you tell it to.

VBScript 1
Function getADMRCODE(varRAW)
Dim program, script, cmdline, output
program = "c:\windows\syswow64\cscript.exe /nologo"
script = "C:\ERMXData\Config\common_app\queries\admrcode.vbs"
cmdLine = program & " " & script & " """ & varRAW & """"
output = ""
With CreateObject("WScript.Shell").Exec(cmdLine)
While Not .StdOut.AtEndOfStream
output = output & .StdOut.ReadAll
Wend
End With
getADMRCODE = output
End Function
query-castring.vbs
Dim doctype: doctype = WScript.Arguments.Item(0)
Dim strCon
strCon = "DSN=*****; " & _
"uid=*****;pwd=*****;"
Dim oCon: Set oCon = WScript.CreateObject("ADODB.Connection")
Dim oRs: Set oRs = WScript.CreateObject("ADODB.Recordset")
oCon.Open strCon
Set oRs = oCon.Execute("select ESBLINK_ADMR_CODE from ESBLINK where ESBLINK_DTYP_CODE LIKE '%" + doctype + "%'")
WScript.Echo oRs.Fields(0).Value
oCon.Close
Set oRs = Nothing
Set oCon = Nothing

Related

How to create text files with dynamic file name

So far the code below is what I am using. It is running on a Siemens HMI (IPC477d) but when I test the script out, the error I get is
An Unhandled exception ('Bad File name or number') occurred in HmiRTm.exe[5984].
I want to know where is the mistake in my code.
The line of Code SmartTags(...) is part of the Software within HMI for handling PLC tags coming through. So it's just a variable in the PLC Code. The variable itself will always be a string value. I dont know if this was important but I thought I would throw that out there for anyone wondering what is happening with that line of code.
Sub CreateTXTReport()
'Tip:
' 1. Use the <CTRL+SPACE> or <CTRL+I> shortcut to open a list of all objects and functions
' 2. Write the code using the HMI Runtime object.
' Example: HmiRuntime.Screens("Screen_1").
' 3. Use the <CTRL+J> shortcut to create an object reference.
'Write the code as of this position:
Dim TT,DT
'If(SmartTags("
TT = FormatDateTime(Time,3)
DT = FormatDateTime(Date,0)
Dim fso, MYfile, strFileName, strFullName, strPath
strPath = "D:\txtFiles"
strFileName = "BatchFile_" & DT & "_" & TT & ".txt"
SmartTags("BatchFileName") = strFileName
Const forWriting=1,forReading=2, forAppending=8
Set fso = CreateObject("Scripting.FileSystemObject")
strFullName = fso.BuildPath(strPath,strFileName)
'If (fso.FileExists("D:\txtFiles\" & strFileName)) = True Then
'Set MYfile = fso.OpenTextFile("D:\txtFiles\" & strFileName, forAppending, True)
'Else
'Set MYfile = fso.CreateTextFile("D:\txtFiles\" & strFileName, forWriting, True)
'MYfile.WriteLine DT & "," & TT & "," & "BatchFile"
'End If
If (fso.FileExists(strFullName)) = True Then
Set MYfile = fso.OpenTextFile(strFullName, forAppending, True)
Else
Set MYfile = fso.CreateTextFile(strFullName, forWriting, True)
MYfile.WriteLine DT & "," & TT & "," & "BatchFile"
End If
MYfile.WriteLine(SmartTags("ReportVariable"))
MYfile.Close
PrintReport("BatchFile_" & DT & "_" & TT & ".txt" )
End Sub

VBS Run cmd.exe output to a variable; not text file

This is what I have so far. It works; outputing the folder path to temp to a text file.
What I really want, is to output the data to a variable. Every example I see online, show how to do this using something like:
set objScriptExec = wshShell.Exec (strCommand)
followed by
strresult = LCase(objScriptExec.StdOut.ReadAll. // code
I want this to run with Run, not Exec, because I want the command prompt windows to be hidden as I will performing many commands with the code below. How can I capture that output to a variable?
Set wsShell = CreateObject("WScript.Shell")
strCommand = "cmd /c echo %temp% > %temp%\test.txt"
wsShell.Run strcommand,0,True
This may be done with the Windows Script Host Exec command. StdOut, StdIn, and StdErr may all be accessed, and ERRORLEVEL is available when the command completes.
Dim strMessage, strScript, strStdErr, strStdOut
Dim oExec, oWshShell, intErrorLevel
Dim ComSpec
Set oWshShell = CreateObject("WScript.Shell")
ComSpec = oWshShell.ExpandEnvironmentStrings("%comspec%")
intErrorLevel = 0
strScript = ComSpec & " /C echo %temp%"
On Error Resume Next
Set oExec = oWshShell.Exec (strScript)
If (Err.Number <> 0) Then
strMessage = "Error: " & Err.Message
intErrorLevel = 1
Else
Do While oExec.Status = 0
Do While Not oExec.StdOut.AtEndOfStream
strStdOut = strStdOut & oExec.StdOut.ReadLine & vbCrLf
Loop
Do While Not oExec.StdErr.AtEndOfStream
strStdErr = strStdErr & oExec.StdErr.ReadLine & vbCrLf
Loop
WScript.Sleep 0
Loop
intErrorLevel = oExec.ExitCode
strMessage = strStdOut & strStdErr & CStr(intErrorLevel)
End If
WScript.Echo (strMessage)
NOTE: Replacing "ReadLine" above with "Read(1)" accomplishes the same thing, but adds an ability to process characters rather than whole lines.
Of course Wscript.Shell would be a lot easier, but, since you want more fine grain control of your session, consider using Win32_Process. Usually, one uses this to control the placement of a new window, but, in your case, you want it hidden, so I set startupInfo.ShowWindow = 0 which means SW_HIDE. The following declares a VBScript function called RunCmd and which will run a command in an invisible window saving the output to a text file and then return the contents of the text file to the caller. As an example, I invoke RunCmd with the HOSTNAME command:
Function RunCmd(strCmd)
Dim wmiService
Set wmiService = GetObject("winmgmts:\\.\root\cimv2")
Dim startupInfo
Set startupInfo = wmiService.Get("Win32_ProcessStartup")
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim cwd
cwd = fso.GetAbsolutePathname(".")
startupInfo.SpawnInstance_
startupInfo.ShowWindow = 0
' startupInfo.X = 50
' startupInfo.y = 50
' startupInfo.XSize = 150
' startupInfo.YSize = 50
' startupInfo.Title = "Hello"
' startupInfo.XCountChars = 36
' startupInfo.YCountChars = 1
Dim objNewProcess
Set objNewProcess = wmiService.Get("Win32_Process")
Dim intPID
Dim errRtn
errRtn = objNewProcess.Create("cmd.exe /c """ & strCmd & """ > out.txt", cwd, startupInfo, intPID)
Dim f
Set f = fso.OpenTextFile("out.txt", 1)
RunCmd = f.ReadAll
f.Close
End Function
MsgBox RunCmd("HOSTNAME")
References:
Create method of the Win32_Process class
Win32_ProcessStartup class

vbscript function variable not resolving

I have a vbs file that calls a function which in turn runs a command. (I know this is convoluted, but it has to be done this way.) The issue I'm having is that I am passing a value into the function, which is supposed to pass that value as an argument to the command line. The msgbox in file1.vbs returns "10698441", as it should but the msgbox in file2.vbs is returning varRAW. I need this to show the true value of the variable. How can I get this variable to resolve to the correct value? I will also need the value created by file2.vbs saved into a variable. Is that possible?
file1.vbs:
fileAPPNUM("10698441")
function fileAPPNUM(varRAW)
msgbox varRAW
lresult = CreateObject("WScript.Shell").Run ("c:\windows\syswow64\cscript.exe file2.vbs varRAW",0,true)
end function
file2.vbs:
Set objFSO=CreateObject("Scripting.FileSystemObject")
outFile="C:\temp\AppNum.txt"
Set objFile = objFSO.CreateTextFile(outFile,True)
Dim strCon
CAID=WScript.Arguments.Item(0)
msgbox CAID
strCon = "DSN=*****; " & _
"uid=********;pwd=*********;"
Dim oCon: Set oCon = WScript.CreateObject("ADODB.Connection")
Dim oRs: Set oRs = WScript.CreateObject("ADODB.Recordset")
oCon.Open strCon
Set oRs = oCon.Execute("select SPRCMNT_TEXT from SPRCMNT where SPRCMNT_TEXT like 'CA_%" + CAID + "%'")
objFile.write oRs.Fields(0).Value & vbCrLf
objFile.close
oCon.Close
Set oRs = Nothing
Set oCon = Nothing
Pass the value of varRAW like in .Run("... file2.vbs " & varRAW,0,true).

Passing objects as arguments in VBScript

I'm working on a project to capture various disk performance metrics using VBScript and would like to use a sub procedure with an object as an argument. In the following code samples the object I'm referring to is objitem.AvgDiskQueueLength which will provide a value for the disk queue length. I haven't found a way to make it work since it is recognized as a string and then doesn't capture the value. My goal is to make it easy for anyone to change the counters that are to be captured by only having to make a change in one location(the procedure call argument). The way I'm going about this may not be the best but I'm open to suggestions. The sub procedure call is below.
PerfCounter "Average Disk Queue Length", "disk_queueLength", "objItem.AvgDiskQueueLength"
The following code is the sub procedure.
Sub PerfCounter(CounterDescription, CounterLabel, CounterObject)
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PerfFormattedData_PerfDisk_PhysicalDisk",,48)
args_index = args_index + 1
arrCriteria = split(command_line_args(args_index),",")
strDriveLetter = UCase(arrCriteria(0))
intCriticalThreshold = arrCriteria(1)
intWarningThreshold = arrCriteria(2)
For Each objItem in colItems
With objItem
WScript.Echo "objitem.name = " & objitem.name
If InStr(objItem.Name, strDriveLetter & ":") > 0 Then
intChrLocation = InStr(objItem.Name, strDriveletter)
strInstanceName = Mid(objItem.Name, intChrLocation, 1)
End If
If strDriveLetter = strInstanceName AND InStr(objItem.Name, strDriveLetter & ":") > 0 Then
If intActiveNode = 1 OR Len(intActiveNode) < 1 Then
WScript.Echo "CounterDescription = " & CounterDescription
WScript.Echo "CounterLabel = " & CounterLabel
WScript.Echo "CounterObject = " & CounterObject
If CInt(CounterOjbect) => CInt(intCriticalThreshold) Then
arrStatus(i) = "CRITICAL: " & strDriveLetter & ": " & CounterDescription
arrTrendData(i) = CounterLabel & "=" & CounterObject
intExitCode = 2
arrExitCode(i) = intExitCode
ElseIf CInt(CounterOjbect) => CInt(intWarningThreshold) AND CInt(CounterObject) < CInt(intCriticalThreshold) Then
arrStatus(i) = "WARNING: " & strDriveLetter & ": " & CounterDescription
arrTrendData(i) = CounterLabel & "=" & CounterObject
intExitCode = 1
arrExitCode(i) = intExitCode
Else
arrStatus(i) = "OK: " & strDriveLetter & ": " & CounterDescription
arrTrendData(i) = CounterLabel & "=" & CounterObject
intExitCode = 0
arrExitCode(i) = intExitCode
End If
Else
PassiveNode CounterDescription, CounterLabel
End If
End If
End With
Next
i = i + 1
ReDim Preserve arrStatus(i)
ReDim Preserve arrTrendData(i)
ReDim Preserve arrExitCode(i)
End Sub
Why cant you do this...
PerfCounter "Average Disk Queue Length", "disk_queueLength", objItem.AvgDiskQueueLength
To pass an object you have to pass an object, not a string. To make this method work as expected you would have to have the object prior to the procedure call, but in your code example it looks like you are trying to pass an object that you don't have. A working example:
Set objFSO = CreateObject("Scripting.FileSystemObject")
UseFileSystemObject objFSO
Sub UseFileSystemObject( objfso)
'Now I can use the FileSystemObject in this procedure.
End Sub
But calling the UseFileSystemObject procedure like this will not work,
UseFileSystemObject "objFSO"
because you are passing in a string not an object.
The only way I can think of to accomplish what you want is to use a select statement to write the appropriate attribute of the object, something like this.
Call PerfCounter "Average Disk Queue Length", "disk_queueLength", "AvgDiskQueueLength"
Sub PerfCounter(CounterDescription, CounterLabel, CounterObjectAttribute)
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_PerfFormattedData_PerfDisk_PhysicalDisk",,48)
For Each objItem in colItems
Select Case CounterObjectAttribute
Case "ObjectAttribute1"
Case "ObjectAttribute2"
Case "AvgDiskQueueLength"
Wscript.Echo objItem.AvgDiskQueueLength
End Select
Next
End Sub
So in the select you would have to add a case for each attribute that can be used, but it would allow you to pass a string into the procedure. I might be way off on this, but I don't know how you can pass an object if you don't have the object first.

VBScript: way to check why the script stopped?

I have this VBScript which runs however, while it is processing, it will randomly stop and require a user to hit the spacebar for it to display the rest of its ongoing output.
How do I figure out why this is happening?
Here is a copy of the script:
'On Error Resume Next
Dim arrFolders()
intSize = 0
Function StampNow()
Dim Hr, Mn, Yr, Mon, Dy, Date1
Date1=Now()
Hr=DatePart("h",Date1)
Mn=DatePart("n",Date1)
Yr = DatePart("yyyy",Date1)
Mon = DatePart("m",Date1)
Dy = DatePart("d",Date1)
StampNow = Yr & "-" & Mon & "-" & Dy
end function
'Output log info.
Function OutputToLog (strToAdd)
Dim strDirectory,strFile,strText, objFile,objFolder,objTextFile,objFSO
strDirectory = "c:\log"
strFile = "\dpadmin_copy2run-"& StampNow & ".bat"
'strText = "dpadmin_copy2"
strText = strToAdd
' Create the File System Object.
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Check that the strDirectory folder exists.
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFolder = objFSO.CreateFolder(strDirectory)
'WScript.Echo "Just created " & strDirectory
End If
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Else
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
'Wscript.Echo "Just created " & strDirectory & strFile
End If
set objFile = nothing
set objFolder = nothing
' OpenTextFile Method needs a Const value
' ForAppending = 8 ForReading = 1, ForWriting = 2
Const ForAppending = 8
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
' Writes strText every time you run this VBScript.
objTextFile.WriteLine(strText)
objTextFile.Close
End Function
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
strFolderName = "D:\1\production\Openjobs"
Set colSubfolders = objWMIService.ExecQuery _
("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
& "Where AssocClass = Win32_Subdirectory " _
& "ResultRole = PartComponent")
dim diffindates
'Init vars for regex.
Dim retVal, retVal2
Dim Lastprop
Dim objRegExpr 'regex variable
Set objRegExpr = New regexp
Set objRegExprX31 = New regexp
objRegExpr.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9][A-Z][A-Z][A-Z]"
objRegExprX31.Pattern = "[0-9][0-9][0-9][0-9][0-9][0-9]X31"
objRegExpr.Global = True
objRegExprX31.Global = True
objRegExpr.IgnoreCase = True
objRegExprX31.IgnoreCase = True
'Variables for getting last accessed property.
Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject")
'Current time vars.
Dim currenttime
currenttime = Now()
ParentFolder = "D:\1\Production\Openjobs\ClosedJobs"
For Each objFolder in colSubfolders
intSize = intSize + 1
retVal = objRegExpr.Test(objFolder.Name)
retVal2 = objRegExprX31.Test(objFolder.Name)
if (retVal OR retVal2 ) then
'set filename to array
strFolderName = objFolder.Name
'Get last modified date.
Set f = fs.GetFolder(objFolder.Name)
Lastprop = f.DateLastModified
'MsgBox(Lastprop)
if ( DateDiff("m", f.DateLastModified, Now()) > 4) then
diffindates = DateDiff("m", f.DateLastModified, Now())
Set objShell = CreateObject("Shell.Application")
Set objCopyFolder = objShell.NameSpace(ParentFolder)
OutputToLog("rem " & f.DateLastModified & ":" & objFolder.Name )
outputtolog("move /Y """ & objFolder.Name & """ " & ParentFolder)
wscript.echo(diffindates & ":" & objFolder.Name & vbCr)
end if
end if
Next
Update
It stops at the line:
Set objTextFile = objFSO.OpenTextFile _
(strDirectory & strFile, ForAppending, True)
with the error Microsoft VBScript runtime error: Permission denied
I'm a little confusd by this. The logfile was only 356kb
I was able to run your script several times without it pausing for input. Run your script with the //X flag to start it in the debugger:
>cscript //nologo //X dpadmin_copy2.vbs"
You should be able to then step through the code.
You can also start putting in wscript.echo trace statements everywhere and see if you can narrow down what it's waiting on.
One thing that's gotten me in the past; If your command console is in QuickEdit mode and you accidentally click anywhere in the console window, the console will hang while it waits for you to press a key.
Well the first step is to remove any global On Error Resume Next statements. Better feedback would come if we could see the script.
You usually get an Permission denied when trying to write to a text file when the text file already has an open handle from some other process or because you have previously opened a handle earlier in you code which you have not closed. I haven't tried this but I don't know why this wouldn't work, you can look at using Handle from Sysinternals (Microsoft) to tell you what process has the open handle for the file. Please see here for a further reference of how to use Handle: http://www.orcsweb.com/blog/post/Closing-open-file-handles.aspx You could also write a second script which runs in a loop to monitor the main script. The second script can verify the first script by doing a WMI Process query which returns only processes that match a defined command line. The second script could then restart the main it stops, alert you, log a file, launch a handle search, etc.

Resources