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

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

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