- This just a Proof of Concept.
- NO, VBA can't be used to create BitCoin.
- NO, not even a very basic (or any type of) production block chain can be run on VBA.
- NO, this example doesn't have peer to peer share code, consensus algorithm, or data serialization/storage code.
|
'Class Block to hold all the individual block details.
'Name : clsBlock
|
|
Option Explicit
Private m_lCounter As Long
Private m_lCreationTime As Double
Private m_sData As String
Private m_sPrevHash As String
Private m_sCurrHash As String
Private m_lNonce As Long
Public Property Get Counter() As Long
Counter = m_lCounter
End Property
Public Property Get CreationTime() As Double
CreationTime = m_lCreationTime
End Property
Public Property Get Data() As String
Data = m_sData
End Property
Public Property Get PrevHash() As String
PrevHash = m_sPrevHash
End Property
Public Property Get CurrHash() As String
CurrHash = GenerateHash
End Property
Public Property Get Nonce() As Long
Nonce = m_lNonce
End Property
Public Property Let Nonce(ByVal lNewValue As Long)
m_lNonce = lNewValue
End Property
Public Property Let CurrHash(ByVal sNewValue As String)
m_sCurrHash = sNewValue
End Property
Public Property Let PrevHash(ByVal sNewValue As String)
m_sPrevHash = sNewValue
End Property
Public Property Let Data(ByVal sNewValue As String)
m_sData = sNewValue
End Property
Public Property Let CreationTime(ByVal lNewValue As Double)
m_lCreationTime = lNewValue
End Property
Public Property Let Counter(ByVal lNewValue As Long)
m_lCounter = lNewValue
End Property
Public Function Init(ctr As Long, crtTime As Double, _
blockData As String, Optional previousHash As String = "")
Me.Counter = ctr
Me.CreationTime = crtTime
Me.Data = blockData
Me.PrevHash = previousHash
Me.CurrHash = GenerateHash
Me.Nonce = 0
End Function
Public Function GenerateHash() As String
Dim oSHA As New clsHash
GenerateHash = oSHA.SHA256(CStr(Me.Counter) & Me.PrevHash & _
CStr(Me.CreationTime) & Me.Data & CStr(Me.Nonce))
End Function
Public Sub ProofOfWork(Difficulty As Long)
While (Mid(Me.CurrHash, 1, Difficulty) <> String(Difficulty, "0"))
Me.Nonce = Me.Nonce + 1
Me.CurrHash = GenerateHash
Wend
End Sub
|
|
'Class Block to hold/create the chain of all the individual blocks
'Name : clsBlockChain
|
|
Option Explicit
Private m_lDifficulty As Long
Private m_oChain As Collection
Public Property Get Difficulty() As Long
Difficulty = m_lDifficulty
End Property
Public Property Let Difficulty(ByVal lNewValue As Long)
m_lDifficulty = lNewValue
End Property
Public Property Get Chain() As Collection
Set Chain = m_oChain
End Property
Public Property Set Chain(ByVal oNewValue As Collection)
Set m_oChain = oNewValue
End Property
Private Sub Class_Initialize()
Dim block As New clsBlock
Me.Difficulty = 3
Set Me.Chain = New Collection
Call block.Init(0, CDbl(Now()), "Genesis Block")
Me.Chain.Add block
End Sub
Private Function GetLastBlock() As clsBlock
Dim block As clsBlock
Dim lCtr As Long
If Me.Chain.Count >= 1 Then
Set block = Me.Chain(Me.Chain.Count)
End If
Set GetLastBlock = block
End Function
Public Sub AddBlock(block As clsBlock)
block.PrevHash = GetLastBlock().CurrHash
block.CurrHash = block.GenerateHash
block.ProofOfWork Me.Difficulty
Me.Chain.Add block
End Sub
Public Function Validate() As Boolean
Dim bRes As Boolean
Dim lCtr As Long
bRes = True
For lCtr = 2 To Me.Chain.Count
If (Me.Chain(lCtr).CurrHash <> Me.Chain(lCtr).GenerateHash) Then
bRes = False
Exit For
End If
If (Me.Chain(lCtr).PrevHash <> Me.Chain(lCtr - 1).CurrHash) Then
bRes = False
Exit For
End If
Next
Validate = bRes
End Function
|
|
'Class Hash to hold SHA256 function for hashing.
'Name : clsHash
|
|
Option Explicit
Public Function SHA256(sIn As String, Optional bB64 As Boolean = 0) As String
'Set a reference to mscorlib 4.0 64-bit
'Test with empty string input:
'64 Hex: e3b0c44298f...etc
'44 Base-64: 47DEQpj8HBSa+/...etc
Dim oT As Object, oSHA256 As Object
Dim TextToHash() As Byte, bytes() As Byte
Set oT = CreateObject("System.Text.UTF8Encoding")
Set oSHA256 = CreateObject("System.Security.Cryptography.SHA256Managed")
TextToHash = oT.GetBytes_4(sIn)
bytes = oSHA256.ComputeHash_2((TextToHash))
If bB64 = True Then
SHA256 = ConvToBase64String(bytes)
Else
SHA256 = ConvToHexString(bytes)
End If
Set oT = Nothing
Set oSHA256 = Nothing
End Function
Private Function ConvToBase64String(vIn As Variant) As Variant
Dim oD As Object
Set oD = CreateObject("MSXML2.DOMDocument")
With oD
.LoadXML "<root />"
.DocumentElement.DataType = "bin.base64"
.DocumentElement.nodeTypedValue = vIn
End With
ConvToBase64String = Replace(oD.DocumentElement.Text, vbLf, "")
Set oD = Nothing
End Function
Private Function ConvToHexString(vIn As Variant) As Variant
Dim oD As Object
Set oD = CreateObject("MSXML2.DOMDocument")
With oD
.LoadXML "<root />"
.DocumentElement.DataType = "bin.Hex"
.DocumentElement.nodeTypedValue = vIn
End With
ConvToHexString = Replace(oD.DocumentElement.Text, vbLf, "")
Set oD = Nothing
End Function
|
|
'Test module to just run a quick test
'Name :mdlTest
|
|
Option Explicit
Public Sub BlockChainTest()
Dim blockchain As clsBlockChain
Dim Block1 As New clsBlock
Dim Block2 As New clsBlock
Set blockchain = New clsBlockChain
'/ Well! VBA lacks cosntructors
Call Block1.Init(1, CDbl(Now()), "First Block")
Call Block2.Init(2, CDbl(Now()), "Second Block")
blockchain.AddBlock Block1
Debug.Print "New Block added. " & Block1.CurrHash
blockchain.AddBlock Block2
Debug.Print "New Block added. " & Block2.CurrHash
'/ Validation Test
Call ValidationTest(blockchain)
'/ tamper data
blockchain.Chain(1).Data = "Tampered"
'/ Validation Test after tampering
Call ValidationTest(blockchain)
End Sub
Private Sub ValidationTest(blockchain As clsBlockChain)
If Not blockchain.Validate Then
Debug.Print "Validation failed."
Else
Debug.Print "Validation passed."
End If
End Sub |
Credits:
[출처]
http://ashuvba.blogspot.com/2018/02/blockchain-extremely-basic-example-of.html
