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.
This is the issue I am facing.
Normally the user's machine is set-up with a user graphic signature file recorded under the C:\Users\User name\Signature folder as a safe and secure place for using it in some Excel processes. But not all users’ signature files could be used as the folder path is not always correctly reported by the below code. I have some users with a machine set-up with two differents profiles under the C:\Users\ folder due to profile rebuilt - causing headache when looking at the location for the specific graphic file Excel is using. I attached sample of the code used to search for the correct folder.
So, could you provide me with information on what settings must be set, what changes in the code must be done, to ensure a reliable access to the graphic file however the user's profile is set-up on the machine?
------------------
Main Module
ChDrive "C"
strPictureFilePath = MyDocs()
strPictureFileName = "MySignature.jpg"
ActiveSheet.Shapes.AddPicture Filename:=(strPictureFilePath & strPictureFileName), linktofile:=msoFalse, _
savewithdocument:=msoCTrue, Left:=162, Top:=445, Width:=170, Height:=35
------------------
Sub Module
Option Explicit
' Declare for call to mpr.dll.
Declare Function WNetGetUser Lib "mpr.dll" _
Alias "WNetGetUserA" (ByVal lpName As String, _
ByVal lpUserName As String, lpnLength As Long) As Long
Const NoError = 0 'The Function call was successful
Function GetUserName()
' Buffer size for the return string.
Const lpnLength As Integer = 255
' Get return buffer space.
Dim status As Integer
' For getting user information.
Dim lpName, lpUserName As String
' Assign the buffer size constant to lpUserName.
lpUserName = Space$(lpnLength + 1)
' Get the log-on name of the person using product.
status = WNetGetUser(lpName, lpUserName, lpnLength)
' See whether error occurred.
If status = NoError Then
' This line removes the null character. Strings in C are null-
' terminated. Strings in Visual Basic are not null-terminated.
' The null character must be removed from the C strings to be used
' cleanly in Visual Basic.
lpUserName = Left$(lpUserName, InStr(lpUserName, Chr(0)) - 1)
Else
' An error occurred.
MsgBox "Unable to get the name."
End
End If
GetUserName = lpUserName
End Function
'--------------------------------------------------------------------------
Function MyDocs() As String
Dim strStart As String
Dim strEnd As String
Dim strUser As String
strUser = GetUserName()
strStart = "C:\Users\"
strEnd = "\Signature\"
MyDocs = strStart & strUser & strEnd
End Function
'--------------------------------------------------------------------------
You can get it with Environ()
Function MyDocs() As String
Dim strStart As String
Dim strEnd As String
strStart = Environ("USERPROFILE")
strEnd = "\Signature\"
MyDocs = strStart & strEnd
End Function
I want to hash the passwort 'HelloWorld' to MD5. Following code is an excerpt from Generating the hash value of a file. The problem is that with the presented code, I need to save the password to a file before hashing it. How can I pass it in memory? I am feeling very uncomfortable with vbs, please excuse me. I do not know what kind of type binary is in vbs.
Option Explicit
MsgBox("Md5 Hash for 'HelloWorld': " & GenerateMD5("HelloWorld"))
Public Function GenerateMD5(ByRef hashInput)
'hashInput is the plain text hash algorithm input
Dim oMD5 : Set oMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
oMD5.Initialize()
Dim baHash : baHash = oMD5.ComputeHash_2(GetBinaryFile("D:/HASHINPUT.txt"))
GenerateMD5 = ByteArrayToHexStr(baHash)
End Function
Private Function ByteArrayToHexStr(ByVal fByteArray)
Dim k
ByteArrayToHexStr = ""
For k = 1 To Lenb(fByteArray)
ByteArrayToHexStr = ByteArrayToHexStr & Right("0" & Hex(Ascb(Midb(fByteArray, k, 1))), 2)
Next
End Function
Private Function GetBinaryFile(filename)
Dim oStream: Set oStream = CreateObject("ADODB.Stream")
oStream.Type = 1 'adTypeBinary
oStream.Open
oStream.LoadFromFile filename
GetBinaryFile = oStream.Read
oStream.Close
Set oStream = Nothing
End Function
I suspect you need input of data type Byte() for ComputeHash_2(). VBScript can't create that data type by itself, but you should be able to use the ADODB.Stream object for converting a string to a byte array without writing it to a file first. Something like this:
pwd = "foobar"
Set stream = CreateObject("ADODB.Stream")
stream.Mode = 3 'read/write
stream.Type = 2 'text
stream.Charset = "ascii"
stream.Open
stream.WriteText pwd
stream.Position = 0 'rewind
stream.Type = 1 'binary
bytearray = stream.Read
stream.Close
I know how to do it in VB.Net but not an idea in vb6.
What I what to achieve is to avoid reading the whole file.
Is that possible?
You could open the file using Random access. Work your way backward a byte at a time, counting the number of carriage return line feed character pairs. Store each line in an array, or something similar, and when you've read your 400 lines, stop.
Cometbill has a good answer.
To open file for Random access:
Open filename For Random Access Read As #filenumber Len = reclength
To get the length of the file in Bytes:
FileLen(ByVal PathName As String) As Long
To read from Random access file:
Get [#]filenumber,<[recnumber]>,<varname>
IMPORTANT: the <varname> from the Get function must be a fixed length string Dim varname as String * 1, otherwise it will error out with Bad record length (Error 59) if the variable is declared as a variable length string like this Dim varname as String
EDIT:
Just wanted to point out that in Dim varname as String * 1 you are defining a fixed length string and the length is 1. This is if you wish to use the read-1-byte-backwards approach. If your file has fixed length records, there is no need to go 1 byte at a time, you can read a record at a time (don't forget to add 2 bytes for carriage return and new line feed). In the latter case, you would define Dim varname as String * X where X is the record length + 2. Then a simple loop going backwards 400 times or untill reaching the beginning of the file.
The following is my take on this. This is more efficient than the previous two answers if you have a very large file, since we don't have to store the entire file in memory.
Option Explicit
Private Sub Command_Click()
Dim asLines() As String
asLines() = LoadLastLinesInFile("C:\Program Files (x86)\VMware\VMware Workstation\open_source_licenses.txt", 400)
End Sub
Private Function LoadLastLinesInFile(ByRef the_sFileName As String, ByVal the_nLineCount As Long) As String()
Dim nFileNo As Integer
Dim asLines() As String
Dim asLinesCopy() As String
Dim bBufferWrapped As Boolean
Dim nLineNo As Long
Dim nLastLineNo As Long
Dim nNewLineNo As Long
Dim nErrNumber As Long
Dim sErrSource As String
Dim sErrDescription As String
On Error GoTo ErrorHandler
nFileNo = FreeFile
Open the_sFileName For Input As #nFileNo
On Error GoTo ErrorHandler_FileOpened
' Size our buffer to the number of specified lines.
ReDim asLines(0 To the_nLineCount - 1)
nLineNo = 0
' Read all lines until the end of the file.
Do Until EOF(nFileNo)
Line Input #nFileNo, asLines(nLineNo)
nLineNo = nLineNo + 1
' Check to see whether we have got to the end of the string array.
If nLineNo = the_nLineCount Then
' In which case, flag that we did so, and wrap back to the beginning.
bBufferWrapped = True
nLineNo = 0
End If
Loop
Close nFileNo
On Error GoTo ErrorHandler
' Were there more lines than we had array space?
If bBufferWrapped Then
' Create a new string array, and copy the bottom section of the previous array into it, followed
' by the top of the previous array.
ReDim asLinesCopy(0 To the_nLineCount - 1)
nLastLineNo = nLineNo
nNewLineNo = 0
For nLineNo = nLastLineNo + 1 To the_nLineCount - 1
asLinesCopy(nNewLineNo) = asLines(nLineNo)
nNewLineNo = nNewLineNo + 1
Next nLineNo
For nLineNo = 0 To nLastLineNo
asLinesCopy(nNewLineNo) = asLines(nLineNo)
nNewLineNo = nNewLineNo + 1
Next nLineNo
' Return the new array.
LoadLastLinesInFile = asLinesCopy()
Else
' Simply resize down the array, and return it.
ReDim Preserve asLines(0 To nLineNo)
LoadLastLinesInFile = asLines()
End If
Exit Function
ErrorHandler_FileOpened:
' If an error occurred whilst reading the file, we must ensure that the file is closed
' before reraising the error. We have to backup and restore the error object.
nErrNumber = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
Close #nFileNo
Err.Raise nErrNumber, sErrSource, sErrDescription
ErrorHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Function
I want to store some addresses in a text file and then read specific portions of the file, based on group membership. I've done all of the group membership stuff so I don't need any help for that.
But I'm not sure if I should use a plain text file or an INI file?
The thing is, the post addresses are in two or three lines and I need line break.
I tried using a plain text file, but I couldn't manage to get a line break correctly.
So INI files would be preferable?
The INI file could look like this:
[London]
Address 1
Postbox 3245
58348 London
[Copenhagen]
Address 2
Postbox 2455
5478347 Copenhagen
I'm not quite sure if this is possible in an INI file though, perhaps I need to name each line as well. OR, I could possibly use a plain text file and search for the word [london] and then read each line until there's a line break. Then store all of those lines in a variable that I'll pass along?
How would you guys solve this?
I have written a small VBScript Class that handles "real' ini files written with such format:
[section_name]
key1 = value1
key2 = value2
The code for the class is:
Class IniFileObject
Private m_Data
Private Sub Class_Initialize
Set m_Data = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate
Dim key
If IsObject(m_Data) Then
For Each key In m_Data
m_Data(key).RemoveAll
Set m_Data(key) = Nothing
Next
m_Data.RemoveAll
Set m_Data = Nothing
End If
End Sub
Public Function Init(sFilePath)
Dim arrLines, sLine, x
Dim sCurSection, oSectionDict
Set Init = Me
arrLines = GetFileLines(sFilePath)
If Not(IsArray(arrLines)) Then Exit Function
sCurSection = ""
For x = 0 To UBound(arrLines)
sLine = Trim(arrLines(x))
If Len(sLine)>0 Then
If Left(sLine, 1)="[" Then
If Not(HandleSectionLine(sLine, sCurSection)) Then Exit Function
Else
If Len(sCurSection)=0 Then
Err.Raise 1005, "IniFileObject init", "Found value outside any section (" & Server.HTMLEncode(sLine) & ")"
Exit Function
End If
Set oSectionDict = m_Data(sCurSection)
If Not(ParseOneLine(sLine, oSectionDict)) Then Exit Function
Set m_Data(sCurSection) = oSectionDict
End If
End If
Next
End Function
Public Property Get ReadValue(section, key)
Dim oSectionDict
ReadValue = ""
If m_Data.Exists(section) Then
Set oSectionDict = m_Data(section)
If oSectionDict.Exists(key) Then ReadValue = oSectionDict(key)
End If
End Property
Private Function ParseOneLine(ByVal sLine, ByRef oSectionDict)
Dim arrTemp, sErrorMsg, sKey
sErrorMsg = ""
ParseOneLine = True
If Left(sLine, 2)="//" Or Left(sLine, 1)="'" Or Left(sLine, 1)="{" Then Exit Function
arrTemp = Split(sLine, "=")
If UBound(arrTemp)=1 Then
sKey = Trim(arrTemp(0))
If (Len(sKey)>0) And (Len(arrTemp(1))>0) Then
If Not(oSectionDict.Exists(sKey)) Then
oSectionDict.Add sKey, Trim(arrTemp(1))
Else
sErrorMsg = "Key already exists"
End If
Else
sErrorMsg = "Empty key or value"
End If
Else
sErrorMsg = "Missing or too much '=' characters"
End If
Erase arrTemp
If Len(sErrorMsg)>0 Then
ParseOneLine = False
Err.Raise 1006, "IniFileObject Init", "Failed to parse single line (" & Server.HTMLEncode(sLine) & "): " & sErrorMsg
End If
End Function
Private Function HandleSectionLine(ByVal sLine, ByRef sCurSection)
HandleSectionLine = False
If (Len(sLine)<3) Or (Right(sLine, 1)<>"]") Then
Err.Raise 1002, "IniFileObject init", "Invalid line found: " & Server.HTMLEncode(sLine)
Exit Function
End If
sCurSection = Mid(sLine, 2, Len(sLine) - 2)
If m_Data.Exists(sCurSection) Then
Err.Raise 1003, "IniFileObject init", "Section exists more than once: " & Server.HTMLEncode(sCurSection)
Exit Function
End If
m_Data.Add sCurSection, Server.CreateObject("Scripting.Dictionary")
HandleSectionLine = True
End Function
Private Function GetFileLines(sFilePath)
Dim objFSO, oFile
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If Not(objFSO.FileExists(sFilePath)) Then
Set objFSO = Nothing
Err.Raise 1001, "IniFileObject init", "file path '" & Server.HTMLEncode(sFilePath) & "' does not exist, check permissions"
Exit Function
End If
Set oFile = objFSO.OpenTextFile(sFilePath)
GetFileLines = Split(oFile.ReadAll, VBCrLf)
oFile.Close
Set oFile = Nothing
Set objFSO = Nothing
End Function
End Class
Usage example:
Dim filePath, ini
filePath = Server.MapPath("config.ini")
Set ini = New IniFileObject.Init(filePath)
Response.Write("Value for 'Key001': " & ini.ReadValue("MySection", "Key001") & "<br />")
Set ini = Nothing
The code throw various errors when the file does not exist or contains invalid lines, the errors are pretty much clear. It's possible to "suppress" the errors and not display error page by using such code when consuming:
On Error Resume Next
Set ini = New IniFileObject.Init(filePath)
If Err.Number<>0 Then
Response.Write("Error reading ini file")
End If
On Error Goto 0
If IsObject(ini) Then
Response.Write("Value for 'IP001': " & ini.ReadValue("IPaddress", "IP001") & "<br />")
Set ini = Nothing
End If
I would probably use CSV file instead where each row will represent a country.
Country,Address1,Address2,Address3,Address4
London,Address 1,Postbox 3245,58348 London
Copenhagen,Address 2,Postbox 2455,5478347,Copenhagen
If you can easily identify your data then you could probably have more descriptive column names (i.e. Street1, Street2, Town, Postcode, etc.).
This file format is also easy to read since you only read one line of the input file at a time and split it using something like
aAddress = split(sLine, ",")
To make it even easier to work with you could use dictionary object and use country as a key and array as a value
'sLine should be read from input file'
sLine = "Copenhagen,Address 2,Postbox 2455,5478347,Copenhagen"
'Create dictionary for addresses'
Set dic = CreateObject("Scripting.Dictionary")
'Split line into array'
aAddressParts = Split(sLine, ",")
'Remove the first element of the array'
sValues = Mid(sLine, InStr(sLine, ",")+1)
aValues = Split(sValues, ",")
'Add new entry into dictionary'
dic.Add aAddressParts(0), aValues
'Usage'
MsgBox "Address for Copenhagen: " & vbNewLine & _
Join(dic("Copenhagen"), "," & vbNewLine)
Thanks,
Maciej
You could store the addresses in one line and use a special character, for example an underscore, to indicate a line break. When you read the address, you just need to replace the special character with a line break.
[London]
Address = "Postbox 3245_58348
London"
[Copenhagen]
Address = "Postbox
2455_5478347 Copenhagen"
That allows you to store addresses with more lines or without a postbox line, as well. In my experience, information like "our addresses always have exactly two lines and the first one is always a postbox" is very often incorrect...
I use a small executable that launches native api for that: GetPrivateProfileString and WritePrivateProfileString.
The executable is called like that:
Set sh = CreateObject("WScript.Shell")
Set exec = sh.Exec("ini.exe get %APPDATA%\sth\file.ini ""Section name"" key")
sFirma1 = exec.StdOut.ReadLine
Call sh.Run("ini.exe set %APPDATA%\sth\file.ini ""Section name"" key set_value", 0)
See also Running command line silently with VbScript and getting output?.
This is the code of the executable:
#include <stdio.h>
#include <windows.h>
void usage()
{
puts("ini <get>/<set> <file> <section> <key> <value>");
exit(1);
}
int main(int cArg, char **aszArg)
{
int iFile = 2;
int iSection = 3;
int iKey = 4;
int iValue = 5;
if (cArg < 5) usage();
if (strcmp(aszArg[1], "get") != 0 && strcmp(aszArg[1], "set") != 0) usage();
if (strcmp(aszArg[1], "set") == 0 && cArg < iValue + 1) usage();
if (strcmp(aszArg[1], "set") == 0) {
if (!WritePrivateProfileString(aszArg[iSection], aszArg[iKey],
aszArg[iValue], aszArg[iFile]))
puts("Failure in WriteProfileString.");
} else {
char buf[1000];
buf[0] = 0;
GetPrivateProfileString(
aszArg[iSection], aszArg[iKey], "", buf, 999, aszArg[iFile]);
puts(buf);
}
return 0;
}
You need to compile it using a c compiler for Windows. I did it with gcc, but a free compiler from ms should also work. If this page with a 32-bit executable is still available, you may give it a try, but on your own responsibility. Hackers already visited my site once.