Showing posts with label Cryptography. Show all posts
Showing posts with label Cryptography. Show all posts

Sunday, June 17, 2012

Encode Decode Base64 Menggunakan MSXML

Public Function Base64Enc(ByRef vxbData() As Byte) As String
With CreateObject("MSXML.DOMDocument").CreateElement(" Base64 ")
.DataType = "bin.base64"
.NodeTypedValue = vxbData
Base64Enc = .Text
End With
End Function

Public Function Base64Dec(ByRef vsData As String) As Byte()
With CreateObject("MSXML.DOMDocument").CreateElement("Base64")
.DataType = "bin.base64"
.Text = vsData
Base64Dec = .NodeTypedValue
End With
End Function
READ MORE - Encode Decode Base64 Menggunakan MSXML

MSXML Encode Decode Base64

Private Function EncodeBase64(ByRef arrData() As Byte) As String

Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement

' help from MSXML
Set objXML = New MSXML2.DOMDocument

' byte array to base64
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
objNode.nodeTypedValue = arrData
EncodeBase64 = objNode.Text

' thanks, bye
Set objNode = Nothing
Set objXML = Nothing

End Function

Private Function DecodeBase64(ByVal strData As String) As Byte()

Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement

' help from MSXML
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.dataType = "bin.base64"
objNode.Text = strData
DecodeBase64 = objNode.nodeTypedValue

' thanks, bye
Set objNode = Nothing
Set objXML = Nothing

End Function

Public Sub Main()

Dim strData As String

strData = EncodeBase64(StrConv("Greetings and Salutations", vbFromUnicode))
Debug.Print strData
Debug.Print StrConv(DecodeBase64(strData), vbUnicode)

End Sub
READ MORE - MSXML Encode Decode Base64

Monday, May 28, 2012

Fungsi Encrypt Dan Decrypt Sederhana

Option Explicit 

Public Function
Encrypt(sText As String) As String
Dim i As Integer
Dim
msg As String
For i =
1 To Len(sText)
msg = msg & Chr(Asc(Mid(sText, i, 1)) + 9)
Next
Encrypt = msg
End Function

Public Function
Decrypt(sText As String) As String
Dim i As Integer
Dim
msg As String
For i =
1 To Len(sText)
msg = msg & Chr(Asc(Mid(sText, i, 1)) - 9)
Next
Decrypt = msg
End Function
Contoh penggunaan fungsi encrypt dan decrypt sederhana
Private Sub Command1_Click() 
Text2.Text = Encrypt(Text1.Text)
End Sub

Private Sub
Command2_Click()
Text3.Text = Decrypt(Text2.Text)
End Sub
READ MORE - Fungsi Encrypt Dan Decrypt Sederhana

Sunday, May 27, 2012

Class CRC32 Sebuah File - VB6 Code

Di bawah ini merupakan class untuk mengetahui CRC32 dari sebuah file. Untuk keperluan ini copy dan pastekan kode di bawah ini ke dalam class, kemudian ganti nama kelasnya menjadi clsCRC.
Option Explicit 

Private
crcTable(0 To 255) As Long 'crc32

Private Function
CRC32(ByRef bArrayIn() As Byte, ByVal lLen As Long, Optional ByVal lcrc As Long = 0) As Long

Dim
lCurPos As Long
Dim
lTemp As Long

If
lLen = 0 Then Exit Function 'In case of empty file
lTemp = lcrc Xor &HFFFFFFFF 'lcrc is for current value from partial check on the partial array

For
lCurPos = 0 To lLen
lTemp = (((lTemp And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor (crcTable((lTemp And 255) Xor bArrayIn(lCurPos)))
Next lCurPos

CRC32 = lTemp Xor &HFFFFFFFF

End Function

Private Function
BuildTable() As Boolean

Dim I As Long, x As Long,
crc As Long
Const
Limit = &HEDB88320 'usally its shown backward, cant remember what it was.

For I =
0 To 255
crc = I
For x =
0 To 7
If crc And 1 Then
crc = (((crc And &HFFFFFFFE) \ 2) And &H7FFFFFFF) Xor Limit
Else
crc = ((crc And &HFFFFFFFE) \ 2) And &H7FFFFFFF
End If
Next x
crcTable(I) = crc
Next I

End Function

Private Sub
Class_Initialize()
BuildTable
End Sub

Public Function
CekCRC32(FileName As String) As String

Dim
lngCrc As Long
Dim
sCrc As Long

On Error GoTo
ErrHandler

Open
FileName For Binary Access Read As #1
ReDim tmp(LOF(1)) As Byte
Get
#1, , tmp()
Close #1

lngCrc = UBound(tmp)
lngCrc = CRC32(tmp, lngCrc)
CekCRC32 = Hex(lngCrc)

Exit Function

ErrHandler:

MsgBox Err.Description, vbCritical, "Error"

End
Function
Contoh penggunaan Class CRC32
Option Explicit 

Private Sub
Form_Load()
Dim crc As New clsCRC
MsgBox crc.CekCRC32("C:\boot.ini")
End Sub
READ MORE - Class CRC32 Sebuah File - VB6 Code