I have a lengthy string of hex values to convert to base64.
I'm looking for a simple format cell function such as =Hex2b64(Hexstring) that will accept any length of hex characters.
I have been using http://home.paulschou.net/tools/xlate/ to do my conversion manually. The conversion works and the data is received by all relevant databases and parsed appropriately.
The data I am receiving is hex represented binary, which has been converted in multiple blocks and concatenated into long hex strings in accordance with project documentation that I am not privy to.
A typical Input String would be:
Hex= 00014088F6650101393939393939392D30304646463238313030000343332353430342D35353FA10000002805900100002805
and the corresponding output would be:
B64 = AAFAiPZlAQE5OTk5OTk5LTAwRkZGMjgxMDAAA0MzI1NDA0LTU1P6EAAAAoBZABAAAoAF
Function Hex2Base64(ByVal sHex)
Static oNode As Object
Dim a() As Byte
If Len(sHex) Mod 2 <> 0 Then
sHex = Left(sHex, Len(sHex) - 1) & "0" & Right(sHex, 1)
End If
If oNode Is Nothing Then
Set oNode = CreateObject("MSXML2.DOMDocument").createElement("Node")
End If
With oNode
.text = ""
.dataType = "bin.hex"
.text = sHex
a = .nodeTypedValue
.dataType = "bin.base64"
.nodeTypedValue = a
Hex2Base64 = .text
End With
End Function
Related
when searching for a particular event. e.g. "oscars 2018 date", Google shows a widget with the date of the event, before any search results. I need to get this date in Excel but it seems difficult in terms of actual coding. I have been tinkering with these functions but not getting any results. The div I am interested in is:
<div class="Z0LcW">5 March 2018, 1:00 am GMT</div>
Here is the full code I am trying to use:
Option Explicit
Public Sub Example()
Call GoogleSearchDescription("oscars 2018 date")
End Sub
Public Function GoogleSearchDescription(ByVal SearchTerm As String) As String
Dim Query As String: Query = "https://www.google.com/search?q=" & URLEncode(SearchTerm)
Dim HTML As String: HTML = GetHTML(Query)
Dim Description() As String: Description = RegExer(HTML, "(<div class=""Z0LcW"">[\w\s.<>/]+<\/div>)")
Description(0) = FilterHTML(Description(0))
Debug.Print Description(0)
Debug.Print "ok"
End Function
Public Function GetHTML(ByVal URL As String) As String
On Error Resume Next
Dim HTML As Object
With CreateObject("InternetExplorer.Application")
.navigate URL
Do Until .ReadyState = 4: DoEvents: Loop
Do While .Busy: DoEvents: Loop
Set HTML = .Document.Body
GetHTML = HTML.innerHTML
.Quit
End With
Set HTML = Nothing
End Function
Private Function URLEncode(ByVal UnformattedString As String) As String
'CAUTION: This function URLEncodes strings to match Google Maps API URL specifications, see note below for details
'Note: We convert spaces to + signs, and skip converting plus signs to anything because they replace spaces
'We also skip ampersands [&] as they should not be parsed out of a valid query
Dim Index As Long, ReservedChars As String: ReservedChars = "!#$'()*/:;=?#[]""-.<>\^_`{|}~"
'Convert all % symbols to encoding, as the unformatted string should not already contain URL Encoded characters
UnformattedString = Replace(UnformattedString, "%", "%" & Asc("%"))
'Convert spaces to plus signs to match Google URI query specifications
UnformattedString = Replace(UnformattedString, " ", "+")
'Iterate through the reserved characters for encoding
For Index = 1 To (Len(ReservedChars) - 1)
UnformattedString = Replace(UnformattedString, Mid(ReservedChars, Index, 1), "%" & Asc(Mid(ReservedChars, Index, 1)))
Next Index
'Return URL encoded string
URLEncode = UnformattedString
End Function
Private Function FilterHTML(ByVal RawHTML As String) As String
If Len(RawHTML) = 0 Then Exit Function
Dim HTMLEntities As Variant, HTMLReplacements As Variant, Counter As Long
Const REG_HTMLTAGS = "(<[\w\s""':.=-]*>|<\/[\w\s""':.=-]*>)" 'Used to remove HTML formating from each step in the queried directions
HTMLEntities = Array(" ", "<", ">", "&", """, "'")
HTMLReplacements = Array(" ", "<", ">", "&", """", "'")
'Parse HTML Entities into plaintext
For Counter = 0 To UBound(HTMLEntities)
RawHTML = Replace(RawHTML, HTMLEntities(Counter), HTMLReplacements(Counter))
Next Counter
'Remove any stray HTML tags
Dim TargetTags() As String: TargetTags = RegExer(RawHTML, REG_HTMLTAGS)
'Preemptively remove new line characters with actual new lines to separate any conjoined lines.
RawHTML = Replace(RawHTML, "<b>", " ")
For Counter = 0 To UBound(TargetTags)
RawHTML = Replace(RawHTML, TargetTags(Counter), "")
Next Counter
FilterHTML = RawHTML
End Function
Public Function RegExer(ByVal RawData As String, ByVal RegExPattern As String) As String()
'Outputs an array of strings for each matching expression
Dim RegEx As Object: Set RegEx = CreateObject("VBScript.RegExp")
Dim Matches As Object
Dim Match As Variant
Dim Output() As String
Dim OutputUBound As Integer
Dim Counter As Long
With RegEx
.Global = True
.MultiLine = True
.IgnoreCase = True
.Pattern = RegExPattern
End With
If RegEx.test(RawData) Then
Set Matches = RegEx.Execute(RawData)
For Each Match In Matches
OutputUBound = OutputUBound + 1
Next Match
ReDim Output(OutputUBound - 1) As String
For Each Match In Matches
Output(Counter) = Matches(Counter)
Counter = Counter + 1
Next Match
RegExer = Output
Else
ReDim Output(0) As String
RegExer = Output
End If
End Function
You can use data from web, with this query
https://www.google.com/search?q=oscars+2018+date&oq=oscars+2018
then check the whole page and import. it for me it was in row 27.
I feel dirty asking this because it's such a hacky workaround, but I have a project where the deliverable must be a single .xlsm file. However, we have no restrictions on what files that deliverable may write or execute. VBA and Excel's macro editor have limitations that don't work with the project.
So I'm trying to save the binary values of a Python interpreter in a worksheet and then write that .exe to the client's computer when the macro is run. (It's pretty much a virus and a bad idea, I know, but the requirements are strict and unchangeable.)
I have a macro to read python.exe into a worksheet:
Function ReadFromFile(path)
Dim bytes() As Byte
Dim fileInt As Integer: fileInt = FreeFile
Open path For Binary Access Read As #fileInt
ReDim bytes(0 To LOF(fileInt) - 1)
Get #fileInt, , bytes
Close #fileInt
Set ReadFromFile = bytes
End Function
Sub ReadCompiler_Click()
Dim path As String: path = ActiveWorkbook.path & "\python.exe.original"
Dim bytes() As Byte
bytes = ReadFromFile(path)
Dim cell As Range
Set cell = Worksheets("PythonEXE").Range("A1")
For Each chunk In bytes
cell.Value = chunk
Set cell = cell.Offset(1, 0)
Next chunk
End Sub
I have verified that this copies the binary file byte-for-byte into column A of my PythonEXE worksheet.
My problem is when writing the bytes back to a file, the written file is significantly different than the original. I'm using the following functions to write from the worksheet to the output file:
Function WriteToFile(path, data)
Dim fileNo As Integer
fileNo = FreeFile
Open path For Binary Access Write As #fileNo
Put #fileNo, 1, data
Close #fileNo
End Function
Sub WriteCompiler_Click()
Dim TotalRows As Long
Dim bytes() As Byte
TotalRows = Worksheets("PythonEXE").Rows(Worksheets("PythonEXE").Rows.Count).End(xlUp).Row
ReDim bytes(TotalRows)
For i = 1 To TotalRows
bytes(i) = CByte(Worksheets("PythonEXE").Cells(i, 1).Value)
Next i
Dim path As String: path = ActiveWorkbook.path & "\python.exe.written"
WriteToFile path, bytes
End Sub
Why is my output binary different than the input binary? It's not human readable, but their checksums are different and when I open them both in an IDE the output file looks like it has a bunch of rectangle glyphs at the beginning where the input file does not.
I changed a couple of things (guided by this answer to get around the problem:
When VBA writes a Variant, it puts some header info in the output. So I changed WriteToFile to copy data to a Byte array before writing it:
Dim buffer() As Byte
ReDim buffer(UBound(data))
buffer = data
For i = 0 To UBound(data)
Put #fileNo, i + 1, CByte(buffer(i))
Next i
I had an off-by-one error by going to UBound(data) instead of UBound(data) - 1. This is a little hairy because Put takes the write position as one-based instead of zero-based, but array indexers are zero-based:
Dim buffer() As Byte
ReDim buffer(UBound(data))
buffer = data
For i = 0 To (UBound(data) - 1)
Put #fileNo, i + 1, CByte(buffer(i))
Next i
Here's the full solution:
Function WriteToFile(path, data)
Dim fileNo As Integer
fileNo = FreeFile
Open path For Binary Access Write As #fileNo
Dim buffer() As Byte
ReDim buffer(UBound(data))
buffer = data
For i = 0 To (UBound(data) - 1)
Put #fileNo, i + 1, CByte(buffer(i))
Next i
Close #fileNo
' Shell ("explorer.exe " & path)
End Function
Function ReadFromFile(path)
Application.StatusBar = "Reading " & path
Dim bytes() As Byte
Dim fileInt As Integer: fileInt = FreeFile
Open path For Binary Access Read As #fileInt
ReDim bytes(0 To LOF(fileInt) - 1)
Get #fileInt, , bytes
Close #fileInt
ReadFromFile = bytes
End Function
Sub UpdatePython_Click()
Application.Calculation = xlCalculationManual
Dim path As String: path = ActiveWorkbook.path & "\python.exe.original"
Dim bytes() As Byte
bytes = ReadFromFile(path)
Worksheets("PythonEXE").Columns(1).EntireColumn.Clear
Dim cell As range
Set cell = Worksheets("PythonEXE").range("A1")
For Each chunk In bytes
cell.Value = chunk
Set cell = cell.Offset(1, 0)
Next chunk
Application.ActiveWorkbook.Save
Application.Calculation = xlCalculationAutomatic
End Sub
Sub WriteCompiler_Click()
Dim TotalRows As Long
Dim bytes() As Byte
TotalRows = Worksheets("PythonEXE").Rows(Worksheets("PythonEXE").Rows.Count).End(xlUp).Row
ReDim bytes(TotalRows)
For i = 0 To TotalRows
bytes(i) = CByte(Worksheets("PythonEXE").Cells(i + 1, 1).Value)
Next i
Dim path As String: path = ActiveWorkbook.path & "\python.exe.written"
If Dir(path) <> "" Then
Kill path
End If
WriteToFile path, bytes
Shell ActiveWorkbook.path & "\checksum.bat", vbNormalFocus
End Sub
I have 16 bytes string which im shifting left, after i shift it left, im trying to display result in RichTextbox:
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
Dim positiveString As String = "00082B002C421A21B630B934B7B71C9A99"
Dim posBigInt As BigInteger = 0
posBigInt = BigInteger.Parse(positiveString, System.Globalization.NumberStyles.AllowHexSpecifier)
posBigInt = (posBigInt << 1)
RichTextBox1.Text = Hex(posBigInt.ToString)
End Sub
Public Function StrToHex(ByRef Data As String) As String
Dim sVal As String
Dim sHex As String = ""
While Data.Length > 0
sVal = Conversion.Hex(Strings.Asc(Data.Substring(0, 1).ToString()))
Data = Data.Substring(1, Data.Length - 1)
sHex = sHex & sVal
End While
Return sHex
End Function
StrToHex function gives me wrong output, and if i try Hex(posBigInt.ToString) gives me correct output, if value fits up to uint64, therefore Hex() cant fit biginterger
Seems like this ("X") do the thing:
RichTextBox1.Text = posBigInt.ToString("X")
Found it on c# thread about biginterger: BigInteger to Hex/Decimal/Octal/Binary strings?
My Classic ASP application retrieves an UTF-8 string from it's database, but I need to convert it to ISO-8859-1. I can't change the HTML page encoding;
I really need to convert just the fetched string. How can I do it?
I found the answer here:
Const adTypeBinary = 1
Const adTypeText = 2
' accept a string and convert it to Bytes array in the selected Charset
Function StringToBytes(Str,Charset)
Dim Stream : Set Stream = Server.CreateObject("ADODB.Stream")
Stream.Type = adTypeText
Stream.Charset = Charset
Stream.Open
Stream.WriteText Str
Stream.Flush
Stream.Position = 0
' rewind stream and read Bytes
Stream.Type = adTypeBinary
StringToBytes= Stream.Read
Stream.Close
Set Stream = Nothing
End Function
' accept Bytes array and convert it to a string using the selected charset
Function BytesToString(Bytes, Charset)
Dim Stream : Set Stream = Server.CreateObject("ADODB.Stream")
Stream.Charset = Charset
Stream.Type = adTypeBinary
Stream.Open
Stream.Write Bytes
Stream.Flush
Stream.Position = 0
' rewind stream and read text
Stream.Type = adTypeText
BytesToString= Stream.ReadText
Stream.Close
Set Stream = Nothing
End Function
' This will alter charset of a string from 1-byte charset(as windows-1252)
' to another 1-byte charset(as windows-1251)
Function AlterCharset(Str, FromCharset, ToCharset)
Dim Bytes
Bytes = StringToBytes(Str, FromCharset)
AlterCharset = BytesToString(Bytes, ToCharset)
End Function
So I just did this:
AlterCharset(str, "ISO-8859-1", "UTF-8")
And it worked nicely.
To expand on the OP's own self-answer, when converting from single-byte character sets (such as ISO-8859-1, Windows-1251, Windows-1252, etc...) to UTF-8, there is some needless redundancy in converting to and back from ADODB's byte array. The overhead of multiple function calls and conversions can be eliminated as such:
Const adTypeText = 2
Private Function AsciiStringToUTF8(AsciiString)
Dim objStream: Set objStream = CreateObject("ADODB.Stream")
Call objStream.Open()
objStream.Type = adTypeText
'Any single-byte charset should work in theory
objStream.Charset = "Windows-1252"
Call objStream.WriteText(AsciiString)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
objStream.Position = 0
objStream.Charset = "UTF-8"
AsciiStringToUTF8 = objStream.ReadText()
Call objStream.Close(): Set objStream = Nothing
End Function
I am interested if it's possible to do string encryption/decryption using Excel Visual Basic and some cryptographic service provider.
I have found a walk-through Encrypting and Decrypting Strings in Visual Basic, but it seems it's valid for standalone Visual Basic only.
So would you suggest me another encryption method or show how the walk-through could be adopted for Excel Visual Basic?
The link you provide shows how to perform string encryption and decryption using VB.NET, and thus, using the .NET Framework.
Currently, Microsoft Office products cannot yet use the Visual Studio Tools for Applications component which will enable Office products to access the .NET framework's BCL (base class libraries) which, in turn, access the underlying Windows CSP (cryptographic server provider) and provide a nice wrapper around those encryption/decryption functions.
For the time being, Office products are stuck with the old VBA (Visual Basic for Applications) which is based on the old VB6 (and earlier) versions of visual Basic which are based upon COM, rather than the .NET Framework.
Because of all of this, you will either need to call out to the Win32 API to access the CSP functions, or you will have to "roll-your-own" encryption method in pure VB6/VBA code, although this is likely to be less secure. It all depends upon how "secure" you'd like your encryption to be.
If you want to "roll-your-own" basic string encryption/decryption routine, take a look at these link to get you started:
Encrypt a String Easily
Better XOR Encryption with a readable string
vb6 - encryption function
Visual Basic 6 / VBA String Encryption/Decryption Function
If you want to access the Win32 API and use the underlying Windows CSP (a much more secure option), see these links for detailed information on how to achieve this:
How to encrypt a string in Visual Basic 6.0
Access to CryptEncrypt (CryptoAPI/WinAPI) functions in VBA
That last link is likely the one you'll want and includes a complete VBA Class module to "wrap" the Windows CSP functions.
This code works well for me (3DES Encryption/Decryption):
I store INITIALIZATION_VECTOR and TRIPLE_DES_KEY as environment variables (obviously different values than those posted here) and get them using VBA Environ() function, so all sensitive data (passwords) in VBA code is encrypted.
Option Explicit
Public Const INITIALIZATION_VECTOR = "zlrs$5kd" 'Always 8 characters
Public Const TRIPLE_DES_KEY = ">tlF8adk=35K{dsa" 'Always 16 characters
Sub TestEncrypt()
MsgBox "This is an encrypted string: -> " & EncryptStringTripleDES("This is an encrypted string:")
Debug.Print EncryptStringTripleDES("This is an encrypted string:")
End Sub
Sub TestDecrypt()
MsgBox "u99CVItCGiMQEVYHf8+S22QbJ5CPQGDXuS5n1jvEIgU= -> " & DecryptStringTripleDES("u99CVItCGiMQEVYHf8+S22QbJ5CPQGDXuS5n1jvEIgU=")
End Sub
Function EncryptStringTripleDES(plain_string As String) As Variant
Dim encryption_object As Object
Dim plain_byte_data() As Byte
Dim encrypted_byte_data() As Byte
Dim encrypted_base64_string As String
EncryptStringTripleDES = Null
On Error GoTo FunctionError
plain_byte_data = CreateObject("System.Text.UTF8Encoding").GetBytes_4(plain_string)
Set encryption_object = CreateObject("System.Security.Cryptography.TripleDESCryptoServiceProvider")
encryption_object.Padding = 3
encryption_object.key = CreateObject("System.Text.UTF8Encoding").GetBytes_4(TRIPLE_DES_KEY)
encryption_object.IV = CreateObject("System.Text.UTF8Encoding").GetBytes_4(INITIALIZATION_VECTOR)
encrypted_byte_data = _
encryption_object.CreateEncryptor().TransformFinalBlock(plain_byte_data, 0, UBound(plain_byte_data) + 1)
encrypted_base64_string = BytesToBase64(encrypted_byte_data)
EncryptStringTripleDES = encrypted_base64_string
Exit Function
FunctionError:
MsgBox "TripleDES encryption failed"
End Function
Function DecryptStringTripleDES(encrypted_string As String) As Variant
Dim encryption_object As Object
Dim encrypted_byte_data() As Byte
Dim plain_byte_data() As Byte
Dim plain_string As String
DecryptStringTripleDES = Null
On Error GoTo FunctionError
encrypted_byte_data = Base64toBytes(encrypted_string)
Set encryption_object = CreateObject("System.Security.Cryptography.TripleDESCryptoServiceProvider")
encryption_object.Padding = 3
encryption_object.key = CreateObject("System.Text.UTF8Encoding").GetBytes_4(TRIPLE_DES_KEY)
encryption_object.IV = CreateObject("System.Text.UTF8Encoding").GetBytes_4(INITIALIZATION_VECTOR)
plain_byte_data = encryption_object.CreateDecryptor().TransformFinalBlock(encrypted_byte_data, 0, UBound(encrypted_byte_data) + 1)
plain_string = CreateObject("System.Text.UTF8Encoding").GetString(plain_byte_data)
DecryptStringTripleDES = plain_string
Exit Function
FunctionError:
MsgBox "TripleDES decryption failed"
End Function
Function BytesToBase64(varBytes() As Byte) As String
With CreateObject("MSXML2.DomDocument").createElement("b64")
.DataType = "bin.base64"
.nodeTypedValue = varBytes
BytesToBase64 = Replace(.Text, vbLf, "")
End With
End Function
Function Base64toBytes(varStr As String) As Byte()
With CreateObject("MSXML2.DOMDocument").createElement("b64")
.DataType = "bin.base64"
.Text = varStr
Base64toBytes = .nodeTypedValue
End With
End Function
Source code taken from here: https://gist.github.com/motoraku/97ad730891e59159d86c
Note the difference between the original code and my code, that is additional option encryption_object.Padding = 3 which forces VBA to not perform padding. With padding option set to 3 I get result exactly as in C++ implementation of DES_ede3_cbc_encrypt algorithm and which is in agreement with what is produced by this online tool.
This code works fine in VBA and can easily be moved to VB.NET
Avoids dealing with not "normal" characters. You decide in AllowedChars what characters to allow.
Public Function CleanEncryptSTR(MyString As String, MyPassword As String, Encrypt As Boolean) As String
'Encrypts strings chars contained in Allowedchars
'MyString = String to decrypt
'MyPassword = Password
'Encrypt True: Encrypy False: Decrypt
Dim i As Integer
Dim ASCToAdd As Integer
Dim ThisChar As String
Dim ThisASC As Integer
Dim NewASC As Integer
Dim MyStringEncrypted As String
Dim AllowedChars As String
AllowedChars = "&0123456789;ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
If Len(MyPassword) > 0 Then
For i = 1 To Len(MyString)
' ThisASC = Asc(Mid(MyString, i, 1))
' ThisASC = IntFromArray(Asc(Mid(MyString, i, 1)), MyVector())
ThisChar = Mid(MyString, i, 1)
ThisASC = InStr(AllowedChars, ThisChar)
If ThisASC > 0 Then
ASCToAdd = Asc(Mid(MyPassword, i Mod Len(MyPassword) + 1, 1))
If Encrypt Then
NewASC = ThisASC + ASCToAdd
Else
NewASC = ThisASC - ASCToAdd
End If
NewASC = NewASC Mod Len(AllowedChars)
If NewASC <= 0 Then
NewASC = NewASC + Len(AllowedChars)
End If
MyStringEncrypted = MyStringEncrypted & Mid(AllowedChars, NewASC, 1)
Else
MyStringEncrypted = MyStringEncrypted & ThisChar
End If
Next i
Else
MyStringEncrypted = MyString
End If
CleanEncryptSTR = MyStringEncrypted
End Function
Create a Class Module called clsCifrado:
Option Explicit
Option Compare Binary
Private clsClave As String
Property Get Clave() As String
Clave = clsClave
End Property
Property Let Clave(value As String)
clsClave = value
End Property
Function Cifrar(Frase As String) As String
Dim Cachos() As Byte
Dim LaClave() As Byte
Dim i As Integer
Dim Largo As Integer
If Frase <> "" Then
Cachos() = StrConv(Frase, vbFromUnicode)
LaClave() = StrConv(clsClave, vbFromUnicode)
Largo = Len(clsClave)
For i = LBound(Cachos) To UBound(Cachos)
Cachos(i) = (Cachos(i) Xor LaClave(i Mod Largo)) + 34
Next i
Cifrar = StrConv(Cachos(), vbUnicode)
Else
Cifrar = ""
End If
End Function
Function Descifrar(Frase As String) As String
Dim Cachos() As Byte
Dim LaClave() As Byte
Dim i As Integer
Dim Largo As Integer
If Frase <> "" Then
Cachos() = StrConv(Frase, vbFromUnicode)
LaClave() = StrConv(clsClave, vbFromUnicode)
Largo = Len(clsClave)
For i = LBound(Cachos) To UBound(Cachos)
Cachos(i) = Cachos(i) - 34
Cachos(i) = (Cachos(i) Xor LaClave(i Mod Largo))
Next i
Descifrar = StrConv(Cachos(), vbUnicode)
Else
Descifrar = ""
End If
End Function
Now you can use it in your code:
to cipher
Private Sub btnCifrar_Click()
Dim Texto As String
Dim cCifrado As clsCifrado
Set cCifrado = New clsCifrado
'---poner la contraseña
If tbxClave.Text = "" Then
MsgBox "The Password is missing"
End Sub
Else
cCifrado.Clave = tbxClave.Text
End If
'---Sacar los datos
Texto = tbxFrase.Text
'---cifrar el texto
Texto = cCifrado.Cifrar(Texto)
tbxFrase.Text = Texto
End Sub
To descipher
Private Sub btnDescifrar_Click()
Dim Texto As String
Dim cCifrado As clsCifrado
Set cCifrado = New clsCifrado
'---poner la contraseña
If tbxClave.Text = "" Then
MsgBox "The Password is missing"
End Sub
Else
cCifrado.Clave = tbxClave.Text
End If
'---Sacar los datos
Texto = tbxFrase.Text
'---cifrar el texto
Texto = cCifrado.Descifrar(Texto)
tbxFrase.Text = Texto
End Sub
You can call pipe excel cell data through any shell script.
Install the GPL Bert (http://bert-toolkit.com/) R language interface for Excel.
Use the R script below in Excel to pipe cell data to Bash / perl / gpg / openssl.
c:\> cat c:\R322\callable_from_excel.R
CRYPTIT <- function( PLAINTEXT, MASTER_PASS ) {
system(
sprintf("bash -c 'echo '%s' |
gpg --symmetric --cipher-algo blowfish --force-mdc --passphrase '%s' -q |
base64 -w 0'",
PLAINTEXT, MASTER_PASS),
intern=TRUE)
}
DECRYPTIT <- function( CRYPTTEXT, MASTER_PASS ) {
system(
sprintf("bash -c 'echo '%s'|
base64 -d |
gpg --passphrase '%s' -q |
putclip | getclip' ",CRYPTTEXT,MASTER_PASS),
intern=TRUE)
}
In Excel, you can try: C1=CRYPTIT(A1,A2) and C2=DECRYPTIT(C1,A2)
Optional: putclip saves decrypted text in clipboard.
Both functions types are: String -> String.
Usual caveats about escaping single-quotes in single-quoted strings.
Here is a basic symmetric encryption/decryption example:
Sub testit()
Dim inputStr As String
inputStr = "Hello world!"
Dim encrypted As String, decrypted As String
encrypted = scramble(inputStr)
decrypted = scramble(encrypted)
Debug.Print encrypted
Debug.Print decrypted
End Sub
Function stringToByteArray(str As String) As Variant
Dim bytes() As Byte
bytes = str
stringToByteArray = bytes
End Function
Function byteArrayToString(bytes() As Byte) As String
Dim str As String
str = bytes
byteArrayToString = str
End Function
Function scramble(str As String) As String
Const SECRET_PASSWORD As String = "K*4HD%f#nwS%sdf032#gfl!HLKN*pq7"
Dim stringBytes() As Byte, passwordBytes() As Byte
stringBytes = stringToByteArray(str)
passwordBytes = stringToByteArray(SECRET_PASSWORD)
Dim upperLim As Long
upperLim = UBound(stringBytes)
ReDim scrambledBytes(0 To upperLim) As Byte
Dim idx As Long
For idx = LBound(stringBytes) To upperLim
scrambledBytes(idx) = stringBytes(idx) Xor passwordBytes(idx)
Next idx
scramble = byteArrayToString(scrambledBytes)
End Function
Be aware that this will crash if your given input string is longer than the SECRET_PASSWORD. This is just an example to get started with.