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
Related
I have been using the base64 encoding function from this answer (code is below)
https://stackoverflow.com/a/506992/510296
I noticed that it is wrapping lines of output after the 72nd character (which causes problems when I try to pass that encoded string to the eBay API).
I can remove the line breaks easily enough with replace(base64string, vblf, "") but wanted to ask if there is a proper way to prevent line breaks in the output.
Function Base64Encode(sText)
Dim oXML, oNode
Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
Set oNode = oXML.CreateElement("base64")
oNode.dataType = "bin.base64"
oNode.nodeTypedValue =Stream_StringToBinary(sText)
Base64Encode = oNode.text
Set oNode = Nothing
Set oXML = Nothing
End Function
Function Stream_StringToBinary(Text)
Const adTypeText = 2
Const adTypeBinary = 1
'Create Stream object
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save text/string data.
BinaryStream.Type = adTypeText
'Specify charset For the source text (unicode) data.
BinaryStream.CharSet = "us-ascii"
'Open the stream And write text/string data To the object
BinaryStream.Open
BinaryStream.WriteText Text
'Change stream type To binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary
'Ignore first two bytes - sign of
BinaryStream.Position = 0
'Open the stream And get binary data from the object
Stream_StringToBinary = BinaryStream.Read
Set BinaryStream = Nothing
End Function
I have a requirement of converting a zip file from my local machine to base64.
Get/Read the path name from the excel sheet row
convert the file in the path (zip file) to base 64 string
Copy the base 64 value to next column in the excel sheet.
Tried a few but did not work.
Current Code:
Dim inByteArray, base64Encoded
inByteArray = readBytes("F:path/file.zip")
base64Encoded = encodeBase64(inByteArray)
Private Function readBytes(file)
Dim inStream
' ADODB stream object used
Set inStream = CreateObject("ADODB.Stream")
' open with no arguments makes the stream an empty container
inStream.Open
inStream.Type = TypeBinary
inStream.LoadFromFile(file)
readBytes = inStream.Read()
End Function
Private Function encodeBase64(bytes)
Dim DM, EL
Set DM = CreateObject("Microsoft.XMLDOM")
' Create temporary node with Base64 data type
Set EL = DM.CreateElement("tmp")
EL.DataType = "bin.base64"
' Set bytes, get encoded String
EL.NodeTypedValue = bytes
encodeBase64 = EL.Text
End Function
Error 1 in the line inStream.type = TypeBinary:
Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.
Error 2 in the line readBytes = inStream.Read():
Operation is not allowed in this context.
Error 3 in the line EL.NodeTypedValue = bytes:
Type mismatch
Looks like you got the code from here, but didn't include
Const TypeBinary = 1
Adding this will avoid the "Arguments are of the wrong type ..." error.
Perhaps careful copy will solve your other problems too.
Thanks for that :)
Further for excel sheet read and write I used the below code which helped in achieving my target. Thank you
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("F:\path")
Set ws = objWorkbook.Sheets("Sheet1")
Set ws2 = objWorkbook.Sheets("Sheet2")
rowcount = ws.usedrange.rows.count
for j = 1 to rowcount
fieldvalue = ws.cells(j,1)
inByteArray = readBytes(fieldvalue)
base64Encoded = encodeBase64(inByteArray)
ws2.cells(j,1) = base64Encoded
next
The setup is: an Excel table with some usernames and filenames (as files are photos in some directory). The aim is to create a Word document based on data from selected row by changing variables in template to real username and adding photo to it. The trouble is in positioning and setting properties of that photo. I used Selection.InlineShapes.AddPicture method due to Selection.Shapes.AddPicture method returned error (Run-time error '438': Object doesn't support this property or method) to me. So, the following is my actual code, and I hope someone could help me. Thanks in advance!
Option Explicit
Sub CreateDocs()
Const wdReplaceAll = 2
Dim user_name As String, user_surname As String, user_patronymic As String
Dim user_type As String, user_type_num As Integer, user_country As String
Dim user_pic As String, pic As Object
Dim wrd As Object, doc As Object
Dim length As Integer
Dim ind As Integer
Dim pict As Object
ind = ActiveCell.Row
With Sheets("SHEET_NAME")
user_name = .Cells(ind, 4)
user_surname = .Cells(ind, 3)
user_type = .Cells(ind, 22)
user_pic = .Cells(ind, 25)
End With
Set wrd = CreateObject("Word.Application")
wrd.Visible = True
Set doc = wrd.Documents.Add(ThisWorkbook.Path & "\SUBPATH\TMPL.dotx")
Set pic = wrd.Selection.InlineShapes.AddPicture( _
Filename:=ThisWorkbook.Path & "\SUBPATH\" & user_pic, _
LinkToFile:=False, _
SaveWithDocument:=True _
)
pic.ConvertToShape
' THE NEXT 4 CODE LINES DOESN'T WORK AT ALL
' I have the same error here:
' Run-time error '438': Object doesn't support this property or method
pic.LockAspectRatio = msoTrue
pic.Left = 197
pic.Top = 191
pic.Width = 179
With wrd.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "%user_name%"
.Replacement.Text = user_name
.Execute Replace:=wdReplaceAll
.Text = "%user_surname%"
.Replacement.Text = user_surname
.Execute Replace:=wdReplaceAll
.Text = "%user_type%"
.Replacement.Text = user_type
.Execute Replace:=wdReplaceAll
End With
doc.SaveAs ThisWorkbook.Path & "\SUBPATH\" & user_name & ".docx"
doc.Close False
Set doc = Nothing
wrd.Quit False
Set wrd = Nothing
End Sub
Try creating another variable (let's call it picShape) and setting it to the result of ConverttoShape. So,
Dim picShape As Object
.....
Set picShape = pic.ConvertToShape
picShape.LockAspectRatio = msoTrue
picShape.Left = 197
picShape.Top = 191
picShape.Width = 179
I wish I could provide a fuller explanation for this, but I rarely work with late-binding. From the looks of the Local window, it doesn't seem like pic.ConvertToShape actually changes the underlying type of pic (although it does change the actual picture from an inlineshape to a shape). So, either you can't change the type at that point, or this method does not affect the variable to which it is applied in the way you might expect.
I used earlier ADODB.Stream to read and to write binary file here is the link for that
How to concatenate binary file using ADODB.stream in VBscript
it works fine the only problem is ADODB.stream is disabled on windows 2003 server,
Is there another way i can read 3 files in binary mode and concatenate them or store them in one file in VBscript
thank you
Jp
Based on Luc125 and Alberto answers here are the 2 reworked and simplified functions:
The Read function
Function readBinary(strPath)
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
Dim oFile: Set oFile = oFSO.GetFile(strPath)
If IsNull(oFile) Then MsgBox("File not found: " & strPath) : Exit Function
With oFile.OpenAsTextStream()
readBinary = .Read(oFile.Size)
.Close
End With
End Function
The Write function
Function writeBinary(strBinary, strPath)
Dim oFSO: Set oFSO = CreateObject("Scripting.FileSystemObject")
' below lines pupose: checks that write access is possible!
Dim oTxtStream
On Error Resume Next
Set oTxtStream = oFSO.createTextFile(strPath)
If Err.number <> 0 Then MsgBox(Err.message) : Exit Function
On Error GoTo 0
Set oTxtStream = Nothing
' end check of write access
With oFSO.createTextFile(strPath)
.Write(strBinary)
.Close
End With
End Function
I had a similar problem a year ago. We know that the TextStream objects are intended for ANSI or Unicode text data, not binary data; their .readAll() method produces a corrupted output if the stream is binary. But there is workaround. Reading the characters one by one into an array works fine. This should allow you to read binary data into VB strings, and write it back to disk. When further manipulating such binary strings do not forget that certain operations may result into broken strings because they are intended for text only. I for one always convert binary strings into integer arrays before working with them.Function readBinary(path)
Dim a
Dim fso
Dim file
Dim i
Dim ts
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.getFile(path)
If isNull(file) Then
MsgBox("File not found: " & path)
Exit Function
End If
Set ts = file.OpenAsTextStream()
a = makeArray(file.size)
i = 0
' Do not replace the following block by readBinary = by ts.readAll(), it would result in broken output, because that method is not intended for binary data
While Not ts.atEndOfStream
a(i) = ts.read(1)
i = i + 1
Wend
ts.close
readBinary = Join(a,"")
End Function
Sub writeBinary(bstr, path)
Dim fso
Dim ts
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set ts = fso.createTextFile(path)
If Err.number <> 0 Then
MsgBox(Err.message)
Exit Sub
End If
On Error GoTo 0
ts.Write(bstr)
ts.Close
End Sub
Function makeArray(n) ' Small utility function
Dim s
s = Space(n)
makeArray = Split(s," ")
End Function
The ADODB stream object is VBScript's only native method of reading binary streams. If ADODB is disabled, you will need to install some other third-party component to provide the same functionality.
It is possible to read all bytes together:
Set FS = CreateObject("Scripting.FileSystemObject")
Set fil = FS.GetFile(filename)
fpga = fil.OpenAsTextStream().Read(file.Size)
ADODB stream object is VBScript's only native method of reading binary streams
Const TypeBinary = 1
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Function readBytes(file)
Dim inStream: Set inStream = WScript.CreateObject("ADODB.Stream") ' ADODB stream object used
inStream.Open ' open with no arguments makes the stream an empty container
inStream.type= TypeBinary
inStream.LoadFromFile(file)
readBytes = inStream.Read()
End Function
Sub writeBytes(file, bytes)
Dim binaryStream: Set binaryStream = CreateObject("ADODB.Stream")
binaryStream.Type = TypeBinary
binaryStream.Open 'Open the stream and write binary data
binaryStream.Write bytes
binaryStream.SaveToFile file, ForWriting 'Save binary data to disk
End Sub
Read 3 files & join to one file (without ADODB):
Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists("out.bin") Then oFSO.DeleteFile("out.bin")
Dim outFile : Set outFile = oFSO.OpenTextFile("out.bin", 8, true)
' 3 input files to concatenate
Dim oFS1 : Set oFS1 = oFSO.GetFile("in1.bin")
Dim oFS2 : Set oFS2 = oFSO.GetFile("in2.bin")
Dim oFS3 : Set oFS3 = oFSO.GetFile("in3.bin")
Dim read1 : Set read1 = oFS1.OpenAsTextStream()
Dim read2 : Set read2 = oFS2.OpenAsTextStream()
Dim read3 : Set read3 = oFS3.OpenAsTextStream()
Dim write1 : write1 = read1.Read(oFS1.Size)
read1.Close
outFile.write(write1)
Dim write2 : write2 = read2.Read(oFS2.Size)
read2.Close
outFile.write(write2)
Dim write3 : write3 = read3.Read(oFS3.Size)
read3.Close
outFile.write(write3)
outFile.Close
Tested on audio, video, image, zip archives & pdf (binaries) on Win 10 for binary file copy, edit, split, join, patching & (byte level) encryption, encoding & compression.
See example (answer) here for binary file patching.
i have a vbscript which connects to db2 and recset gets long varchar 18000 (contains xml message).
The problem is that variable in vbscript has length only 250.
Ok, i have divided recset to array(50) 250 chars each string.
Then when i trying to pass first string from array to file it throws error.
Because in array(0) string there are a lot of quotes. How can i save result to file?
sql = "select message_data from messages where MESSAGE_ID = '5461654648464'"
Set objConnection = CreateObject("ADODB.Connection")
objConnection.ConnectionString = "Provider=ibmdadb2; DSN=TEST; UID=user; PWD=password"
objConnection.Open
Set recset = CreateObject("ADODB.Recordset")
recset.Open sql,objConnection
if recset.EOF then WScript.Echo "No found" else splt recset("message_data") end if
recset.Close
objConnection.Close
function splt (strg)
dim arr(50)
Set fso = CreateObject("Scripting.FileSystemObject")
sFolder = "C:\jdk1.3\temp\arch"
Set NewFile = fso.CreateTextFile(sFolder&"\file.txt", True)
if len(strg) > 250 then ll = round(len(strg)/250, 0) + 1
for i = 0 to ll
arr(i) = left(right(strg, abs(Cint(len(strg))-250*i)), 250)
txt = arr(i)
NewFile.Write txt
next
NewFile.Close
End function
#Ruslan: Make sure the file exists first (it can be just a blank text file) and I'd suggest you also update your function with
Dim arr(50), fso, sFolder, NewFile, ll, txt, i
and add Option Explicit right at the top of the file as well.