exe with accepting runtime parameter - vb6

how o write vb code which can except parameter at runtime
ex. My exe is "readfile.exe" and if i want to give file name rom command line the command to be executed will be
readfile.exe filename
it should take the file name parameter and perform the action

Look at the Command function, that should give you all the parameters that were passed in.
I can't find the VB6 docs for it online, but MSDN have the docs for the VBA version, and that's usually the same so I'd suggest looking here for more info. And it even has a full sample here.

You can do something like this:
Sub Main()
Dim a_strArgs() As String
Dim blnDebug As Boolean
Dim strFilename As String
Dim i As Integer
a_strArgs = Split(Command$, " ")
For i = LBound(a_strArgs) To UBound(a_strArgs)
Select Case LCase(a_strArgs(i))
Case "-d", "/d"
' debug mode
blnDebug = True
Case "-f", "/f"
' filename specified
If i = UBound(a_strArgs) Then
MsgBox "Filename not specified."
Else
i = i + 1
End If
If Left(a_strArgs(i), 1) = "-" Or Left(a_strArgs(i), 1) = "/" Then
MsgBox "Invalid filename."
Else
strFilename = a_strArgs(i)
End If
Case Else
MsgBox "Invalid argument: " & a_strArgs(i)
End Select
Next i
MsgBox "Debug mode: " & blnDebug
MsgBox "Filename: " & strFilename
End Sub

Related

VBScript error 5 trying to compute sha512 with 'System.Security.Cryptography.SHA512Managed'

I am trying to write a piece of code in VBScript to compute the
SHA512 value for a given file. According to MSFT documentation
the ComputeHash method of the SHA512Managed object requires a
Byte array as input. So I used ADODB to read the input file which
SHA512 value is to be computed (Because, AFAIK, there is no way
to build a Byte array in VBScript). However I get a runtime error 5,
'Invalid procedure call or argument' when calling the method. The
variable bar in the code below is of type Byte() - VBScript says.
Could anyone tell me what is going wrong ?
Code :
Option Explicit
'
'
'
Dim scs, ado
Dim bar, hsh
Set scs = CreateObject("System.Security.Cryptography.SHA512Managed")
Set ado = CreateObject("ADODB.Stream")
ado.type = 1 ' TypeBinary
ado.open
ado.LoadFromFile WScript.ScriptFullName
bar = ado.Read
ado.Close
MsgBox TypeName(bar) & "/" & LenB(bar) & "/" & Len(bar),,"Box 1"
' Displays : "Byte()/876/438"
On Error Resume Next
' Attempt 1
Set hsh = scs.ComputeHash(bar)
MsgBox Hex(Err.Number) & "/" & Err.Description,,"Set hsh = "
' Displays : "5/Invalid procedure call or argument"
' Attempt 2
hsh = scs.ComputeHash(bar)
MsgBox Hex(Err.Number) & "/" & Err.Description,,"hsh = "
' Displays : "5/Invalid procedure call or argument"
MsgBox TypeName(scs),,"scs" ' Displays : "SHA512Managed"
Set ado = Nothing
Set scs = Nothing
WScript.Quit
Use
hsh = scs.ComputeHash_2((bar))
(no set, _2 suffix not to pick the other ComputeHash method, pass by value ())
see here.

VBS using LIKE to compare strings "Sub or Function not defined"

I'm trying to make a script to connect a network printer to a user computer.
The script uses the computer name who needs the printer as a parameter.
Printers names are similar their printserver name, eg. server_USA has printers like printer_USA01, printer_USA02.
But it's throwing the error "Sub or Function not defined" when arrives at the first like... why ?
Set shl = WScript.CreateObject("WScript.Shell")
strName = Wscript.Arguments.Item(0)
'input Printer name
strPrinter = InputBox("Please enter share name of printer to install:", _
"Add network printer")
if strPrinter = "" then
msgbox "Can't be empty."
WScript.quit
elseif strPrinter Like "printer_USA*" then
strServer = server_USA
elseif strPrinter Like "printer_SPAIN*" then
strServer = server_SPAIN
else
'Printer name NOT registered, input printserver manually:
strServer = inputbox("Please enter the name of the printserver","printserver")
if strServer = "" then
msgbox "Can't be empty."
WScript.quit
End if
End if
'ADD
shl.run "RUNDLL32 PRINTUI.DLL,PrintUIEntry /ga /c\\" & strName & " /n\\" & strServer & "\" & strPrinter
there is no Like operator in VBScript. You could use Instr.
if strPrinter = "" then
msgbox "Can't be empty."
WScript.quit
elseif Instr( 1, strPrinter, "printer_USA", vbTextCompare ) > 0 then
strServer = server_USA
The vbTextCompare constant ( value=1) is used to Perform a textual comparison
you can use StrComp to have same result in this way
If StrComp(strPrinter,"printer_USA",vbTextCompare)=0 then
strServer = server_USA
End IF
equal 0 mean zero different between strPrinter and printer_USA with ignore the letter case because we use vbTextCompare .
You can replace vbTextCompare with 1 and you will have same result.
If letter case is important you can use vbBinaryCompare or 0.
A way to do that with select case. This version of instr() is case sensitive, but other versions aren't. instr() returns the position of the found substring, which here is always one.
select case 1
case instr(strPrinter, "") + 1
wscript.echo "empty"
case instr(strPrinter, "printer_USA")
wscript.echo "server_USA"
case instr(strPrinter, "printer_SPAIN")
wscript.echo "server_SPAIN"
case instr(strPrinter, "printer_ITALY"), instr(strPrinter, "printer_RUSSIA")
wscript.echo "other known ones"
case else
wscript.echo "not registered"
end select
I used the following alternative (VBScript Regular Expressions)…
Uses slightly different syntax from LIKE but easiest solution to make a match successfully similar to LIKE operator.
dim regExp
set regExp=CreateObject("VBScript.RegExp")
regExp.IgnoreCase = true
regExp.Global = true
regxp.Pattern = ".*Test Pattern.*" ' example only, basic pattern
if regExp.Test(MyString) then
' match successful
end if

Excel VB Open File OSX and Windows

I've got a spreadsheet that uses some basic code to get the user to select a file (txt file). It works flawlessly on Windows but fails on OSX obviously due to the difference in FileDialog calls. I've done some research though and can't seem to find much information about opening a File Dialog on both OSX and Windows for Excel/VB.
The current code is,
FileToOpen = Application.GetOpenFilename _
(Title:="Please choose a file to import", _
FileFilter:="Excel Files *.xls (*.xls),")
''
If FileToOpen = False Then
MsgBox "No file specified.", vbExclamation, "Duh!!!"
Exit Sub
Else
Workbooks.Open Filename:=FileToOpen
End If
Answer can be found here - http://msdn.microsoft.com/en-us/library/office/hh710200%28v=office.14%29.aspx
Code is as follows,
OSX
Sub Select_File_Or_Files_Mac()
Dim MyPath As String
Dim MyScript As String
Dim MyFiles As String
Dim MySplit As Variant
Dim N As Long
Dim Fname As String
Dim mybook As Workbook
On Error Resume Next
MyPath = MacScript("return (path to documents folder) as String")
'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:"
' In the following statement, change true to false in the line "multiple
' selections allowed true" if you do not want to be able to select more
' than one file. Additionally, if you want to filter for multiple files, change
' {""com.microsoft.Excel.xls""} to
' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""}
' if you want to filter on xls and csv files, for example.
MyScript = _
"set applescript's text item delimiters to "","" " & vbNewLine & _
"set theFiles to (choose file of type " & _
" {""com.microsoft.Excel.xls""} " & _
"with prompt ""Please select a file or files"" default location alias """ & _
MyPath & """ multiple selections allowed true) as string" & vbNewLine & _
"set applescript's text item delimiters to """" " & vbNewLine & _
"return theFiles"
MyFiles = MacScript(MyScript)
On Error GoTo 0
If MyFiles <> "" Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
MySplit = Split(MyFiles, ",")
For N = LBound(MySplit) To UBound(MySplit)
' Get the file name only and test to see if it is open.
Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), Application.PathSeparator, , 1))
If bIsBookOpen(Fname) = False Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MySplit(N))
On Error GoTo 0
If Not mybook Is Nothing Then
MsgBox "You open this file : " & MySplit(N) & vbNewLine & _
"And after you press OK it will be closed" & vbNewLine & _
"without saving, replace this line with your own code."
mybook.Close SaveChanges:=False
End If
Else
MsgBox "We skipped this file : " & MySplit(N) & " because it Is already open."
End If
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Contributed by Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Windows
Sub Select_File_Or_Files_Windows()
Dim SaveDriveDir As String
Dim MyPath As String
Dim Fname As Variant
Dim N As Long
Dim FnameInLoop As String
Dim mybook As Workbook
' Save the current directory.
SaveDriveDir = CurDir
' Set the path to the folder that you want to open.
MyPath = Application.DefaultFilePath
' You can also use a fixed path.
'MyPath = "C:\Users\Ron de Bruin\Test"
' Change drive/directory to MyPath.
ChDrive MyPath
ChDir MyPath
' Open GetOpenFilename with the file filters.
Fname = Application.GetOpenFilename( _
FileFilter:="Excel 97-2003 Files (*.xls), *.xls", _
Title:="Select a file or files", _
MultiSelect:=True)
' Perform some action with the files you selected.
If IsArray(Fname) Then
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For N = LBound(Fname) To UBound(Fname)
' Get only the file name and test to see if it is open.
FnameInLoop = Right(Fname(N), Len(Fname(N)) - InStrRev(Fname(N), Application.PathSeparator, , 1))
If bIsBookOpen(FnameInLoop) = False Then
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(Fname(N))
On Error GoTo 0
If Not mybook Is Nothing Then
MsgBox "You opened this file : " & Fname(N) & vbNewLine & _
"And after you press OK, it will be closed" & vbNewLine & _
"without saving. You can replace this line with your own code."
mybook.Close SaveChanges:=False
End If
Else
MsgBox "We skipped this file : " & Fname(N) & " because it is already open."
End If
Next N
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
' Change drive/directory back to SaveDriveDir.
ChDrive SaveDriveDir
ChDir SaveDriveDir
End Sub
Function bIsBookOpen(ByRef szBookName As String) As Boolean
' Contributed by Rob Bovey
On Error Resume Next
bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing)
End Function
Picker Function
Sub WINorMAC()
' Test for the operating system.
If Not Application.OperatingSystem Like "*Mac*" Then
' Is Windows.
Call Select_File_Or_Files_Windows
Else
' Is a Mac and will test if running Excel 2011 or higher.
If Val(Application.Version) > 14 Then
Call Select_File_Or_Files_Mac
End If
End If
End Sub
Sub WINorMAC_2()
' Test the conditional compiler constants.
#If Win32 Or Win64 Then
' Is Windows.
Call Select_File_Or_Files_Windows
#Else
' Is a Mac and will test if running Excel 2011 or higher.
If Val(Application.Version) > 14 Then
Call Select_File_Or_Files_Mac
End If
#End If
End Sub

VB script run time error input past end of file

I'm taking a scripting class and im having some issues with my script. According to the lab assignment all my syntax is correct. However i keep getting a input past end of file error on line 60,1. I've starred at the program forever and checked all lines letter for letter for quite some time with no luck. Any help would be greatly appreciated. Here is the script.
dim ipAddress(5,3)
ipAddress(0,0)="192.168.10.11"
ipAddress(0,1)="192.168.10.12"
ipAddress(0,2)="192.168.10.13"
ipAddress(0,3)="192.168.10.14"
ipAddress(1,0)="192.168.10.19"
ipAddress(1,1)="192.168.10.20"
ipAddress(1,2)="192.168.10.21"
ipAddress(1,3)="192.168.10.22"
ipAddress(2,0)="192.168.10.27"
ipAddress(2,1)="192.168.10.28"
ipAddress(2,2)="192.168.10.29"
ipAddress(2,3)="192.168.10.30"
ipAddress(3,0)="192.168.10.35"
ipAddress(3,1)="192.168.10.36"
ipAddress(3,2)="192.168.10.37"
ipAddress(3,3)="192.168.10.38"
ipAddress(4,0)="192.168.10.43"
ipAddress(4,1)="192.168.10.44"
ipAddress(4,2)="192.168.10.45"
ipAddress(4,3)="192.168.10.46"
ipAddress(5,0)="192.168.10.51"
ipAddress(5,1)="192.168.10.52"
ipAddress(5,2)="192.168.10.53"
ipAddress(5,3)="192.168.10.54"
const READ = 1
const WRITE = 2
const APPEND = 8
const ASCII = 0
dim fileName
fileName = "IP_Addresses.csv"
dim ipAddrStr
ipAddrStr = ""
dim fso
Set fso = Wscript.CreateObject("Scripting.FileSystemObject")
Set ipFileObj = fso.CreateTextFile(fileName,True,ASCII)
For room = 0 to 5
For computer = 0 to 3
ipAddrSr = CStr(room+100) & "," & CStr(computer+1) & "," ipAddress(room,computer)
& vbCrlf
ipFileObj.write(ipAddrStr)
Next
Next
ipFileObj.close
Set ipFileObj = fso.OpenTextFile(fileName,READ,ASCII)
WScript.Echo ipFileObj.ReadAll **' this is line 60**
ipFileObj.Close
As you don't use "Option Explicit", you get what you deserve: You (try to) concatenate the lines into ipAddrSr but write ipAddrStr to the file. So nothing gets written to the file.
Fix the syntax error and the bad name to:
ipAddrStr = CStr(room+100) & "," & CStr(computer+1) & "," & ipAddress(room,computer) & vbCrlf
Assuming that the file isn't empty, perhaps you need to specify the directory the file is in? I think this can be done either in your script:
fileName = "c:\your_directory\IP_Addresses.csv"
Or if you run it in the command line via cscript...
cscript.exe your.vbs "c:\your_directory\IP_Addresses.csv"
You can check the file size before executing your Echo if you like...
if fileName.size > 0 then
Set ipFileObj = fso.OpenTextFile(fileName,READ,ASCII)
WScript.Echo ipFileObj.ReadAll **' this is line 60**
ipFileObj.Close
else
WScript.Echo = "File was empty"
end if
See details of passing an argument to your script here.

VB6 categorize search function

If I have a text file that contains the below information, what is the best way to search for the version, for example on system1 only? (in vb6 code, can I use InStr?)
[system1]
version=xx
date=xx
[system2]
version=xx
date=xx
The sample file looks like a standard INI file. You can read these using the GetPrivateProfileString() and related functions. You can also enumerate the sections and values using GetPrivateProfileSectionNames() and GetPrivateProfileSection().
Supposing there is a space after the version and before date (str would be your text):
Dim version As String
version = Mid(str, InStr(str, "version") + 8)
version = Mid(version, 1, InStr(version, " "))
But there are a bunch of functions to parse .ini files out there.
I created a text file "C:\MYFILE.TXT" and this is the content of the file:
[system1]
version=aa
date=bb
[system2]
version=yy
date=zz
[system3]
date=4
[system4]
[system5]
As you can see, I made all possible situation, ie. a system with version info, a system with no version info, etc. Then I wrote this code:
Here is one way to look for a value under a categorized list:
Dim mySystem As String
Dim myVersion As String
mySystem = "[system2]" 'Replace this with the system you are looking for
Dim strTmp As String
Dim SystemFound As Boolean
Dim VersionFound As Boolean
Open "c:\myfilename.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, strTmp
If InStr(UCase(strTmp), UCase(mySystem)) > 0 Then
SystemFound = True
strTmp = ""
Do While Not EOF(1) And InStr(strTmp, "[") = 0
Line Input #1, strTmp
If InStr(UCase(strTmp), "VERSION") > 0 Then
VersionFound = True
myVersion = Mid(strTmp, InStr(strTmp, "=") + 1, Len(strTmp))
End If
Loop
Exit Do
End If
Loop
Close #1
If SystemFound And VersionFound Then
MsgBox "The Version of " & mySystem & " is " & myVersion
ElseIf SystemFound And Not VersionFound Then
MsgBox "The system " & mySystem & " has no version definition"
ElseIf SystemFound = False Then
MsgBox "The system " & mySystem & " is not found in file"
End If

Resources