####### Form1.frm
VERSION 5.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   5025
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8085
   LinkTopic       =   "Form1"
   ScaleHeight     =   5025
   ScaleWidth      =   8085
   StartUpPosition =   3  '窗口缺省
   Begin Command2
      Caption         =   "base64解密"
      Height          =   975
      Left            =   1560
      TabIndex        =   1
      Top             =   2880
      Width           =   5535
   End
   Begin Command1
      Caption         =   "base64加密"
      Height          =   855
      Left            =   1560
      TabIndex        =   0
      Top             =   840
      Width           =   5535
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim zzz As String

       zzz = B64Encode("源码免费helloworld")
        Stop
End Sub
'*********************************************
'    源码免费学习下载www.
'        欢迎分享源码给Love代码
'      源码投稿分享邮箱12328484@
'分享的源码中可留下您的联系方式,广告宣传等信息
'*********************************************
Private Sub Command2_Click()
        MsgBox B64Decode("1LTC68Pit9FoZWxsb3dvcmxk")
End Sub


以下是模块！modBase64.bas



Attribute VB_Name = "modBase64"

'名称: Base64编码/解码模块
'*********************************************
'    源码免费学习下载www.
'        欢迎分享源码给Love代码
'      源码投稿分享邮箱12328484@
'分享的源码中可留下您的联系方式,广告宣传等信息
'*********************************************
Option Explicit

Public Type tpBase64_Dollop2438 '24Bit(8Bit*3Byte)数据块
btBytes(0 To 2) As Byte
End Type
Public Type tpBase64_Dollop2446 '24Bit(6Bit*4Byte)数据块
btBytes(0 To 3) As Byte
End Type
'数据表
'priBitMoveTable - 移位缓冲表
Private priBitMoveTable() As Byte '移位缓冲表
Private priBitMoveTable_CellReady() As Boolean '移位缓冲表标志表
Private priBitMoveTable_Create As Boolean '移位缓冲表创建标志
'priEncodeTable - 编码表
Private priEncodeTable() As Byte '编码表（素码转Base64）
Private priEncodeTable_Create As Boolean
'priDecodeTable - 解码表
Private priDecodeTable() As Byte '解码表（Base64转素码）
Private priDecodeTable_Create As Boolean
'常量
'conBase64_CodeTableStrng 'Base64默认编码表(字符串)
Public Const conBase64_CodeTableStrng As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
'conBase64_PatchCode 'Base64默认追加码(Ascii)
Public Const conBase64_PatchCode As Byte = 61
Private Declare Sub Base64_CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef pDestination As Any, ByRef pSource As Any, ByVal pLength As Long)

Public Function Base64Decode(ByRef pBytes() As Byte, Optional ByVal pPatchCode As Byte = conBase64_PatchCode) As Byte()
Dim tOutBytes() As Byte
Dim tOutBytes_Length As Long
Dim tBytes_Length As Long
Dim tBytes2446() As Byte
Dim tSurBytes_Length As Long
Dim tDesBytes_Length As Long
Err.Clear
On Error Resume Next
tBytes_Length = UBound(pBytes())
If CBool(Err.Number) Or tSurBytes_Length < 0& Then Exit Function
tBytes2446() = BytesPrimeDecode(pBytes())
tOutBytes() = Bytes2438GetBy2446(tBytes2446())
Dim tPatchNumber As Long
Dim tIndex As Long
Dim tBytesIndex As Long
For tIndex = 0& To 10&
tBytesIndex = tBytes_Length - tIndex
tPatchNumber = tPatchNumber + ((pBytes(tBytesIndex) = pPatchCode) And 1&)
Next
tSurBytes_Length = tBytes_Length - tPatchNumber
tDesBytes_Length = (tSurBytes_Length * 3&) \ 4&
ReDim Preserve tOutBytes(tDesBytes_Length)
Base64Decode = tOutBytes()
End Function

Public Function Base64Encode(ByRef pBytes() As Byte, Optional ByVal pPatchCode As Byte = conBase64_PatchCode) As Byte()
Dim tOutBytes() As Byte
Dim tOutBytes_Length As Long
Dim tBytes2446() As Byte
Dim tSurBytes_Length As Long
Dim tDesBytes_Length As Long
Err.Clear
On Error Resume Next
tSurBytes_Length = UBound(pBytes())
If CBool(Err.Number) Or tSurBytes_Length < 0& Then Exit Function
tBytes2446() = Bytes2438PutTo2446(pBytes())
tOutBytes() = BytesPrimeEncode(tBytes2446())
tOutBytes_Length = UBound(tOutBytes())
Dim tPatchNumber As Long
tDesBytes_Length = (tSurBytes_Length * 4& + 3&) \ 3&
tPatchNumber = tOutBytes_Length - tDesBytes_Length
Dim tIndex As Long
Dim tBytesIndex As Long
For tIndex = 1 To tPatchNumber
tBytesIndex = tOutBytes_Length - tIndex + 1&
tOutBytes(tBytesIndex) = pPatchCode
Next

Base64Encode = tOutBytes()
End Function

Private Function BytesPrimeDecode(ByRef pBytes() As Byte) As Byte()
'功能：将Base64数组解码为素码数组

Dim tOutBytes() As Byte
Dim tBytes_Length As Long
Err.Clear
On Error Resume Next
tBytes_Length = UBound(pBytes())
If CBool(Err.Number) Then Exit Function
ReDim tOutBytes(tBytes_Length)
If Not priDecodeTable_Create Then Base64CodeTableCreate
Dim tIndex As Long
For tIndex = 0& To tBytes_Length
tOutBytes(tIndex) = priDecodeTable(pBytes(tIndex))
Next
BytesPrimeDecode = tOutBytes()
End Function

Private Function BytesPrimeEncode(ByRef pBytes() As Byte) As Byte()
'功能：将素码数组编码为Base64数组
Dim tOutBytes() As Byte
Dim tBytes_Length As Long
Err.Clear
On Error Resume Next
tBytes_Length = UBound(pBytes())
If CBool(Err.Number) Then Exit Function
ReDim tOutBytes(tBytes_Length)
If Not priEncodeTable_Create Then Base64CodeTableCreate
Dim tIndex As Long
For tIndex = 0 To tBytes_Length
tOutBytes(tIndex) = priEncodeTable(pBytes(tIndex))
Next
BytesPrimeEncode = tOutBytes()
End Function

Private Sub Base64CodeTableCreate(Optional ByVal pString As String = conBase64_CodeTableStrng)
'功能：根据字符串提供的代码初始化Base64解码/编码码表。
Dim tBytes() As Byte
Dim tBytes_Length As Long
tBytes() = pString
tBytes_Length = UBound(tBytes())
If Not tBytes_Length = 127& Then
MsgBox "编码/解码表初始化失败", , "错误"
Exit Sub
End If
Dim tIndex As Byte
ReDim priEncodeTable(0& To 255&)
ReDim priDecodeTable(0& To 255&)
Dim tTableIndex As Byte
Dim tByteValue As Byte
For tIndex = 0& To tBytes_Length Step 2&
tTableIndex = tIndex \ 2&
tByteValue = tBytes(tIndex)
priEncodeTable(tTableIndex) = tByteValue
priDecodeTable(tByteValue) = tTableIndex
Next
priEncodeTable_Create = True
priDecodeTable_Create = True
End Sub

Private Function Bytes2438GetBy2446(ByRef pBytes() As Byte) As Byte()
'功能：将素码转换为字节。
Dim tOutBytes() As Byte
Dim tDollops2438() As tpBase64_Dollop2438
Dim tDollops2446() As tpBase64_Dollop2446
tDollops2446() = BytesPutTo2446(pBytes())
tDollops2438() = Dollops2438GetBy2446(tDollops2446())
tOutBytes() = BytesGetBy2438(tDollops2438())
Bytes2438GetBy2446 = tOutBytes()
End Function

Private Function Bytes2438PutTo2446(ByRef pBytes() As Byte) As Byte()
'功能：将字节转换为素码。
Dim tOutBytes() As Byte
Dim tDollops2438() As tpBase64_Dollop2438
Dim tDollops2446() As tpBase64_Dollop2446
tDollops2438() = BytesPutTo2438(pBytes())
tDollops2446() = Dollops2438PutTo2446(tDollops2438())
tOutBytes() = BytesGetBy2446(tDollops2446())
Bytes2438PutTo2446 = tOutBytes()
End Function

Private Function BytesGetBy2446(ByRef p2446() As tpBase64_Dollop2446) As Byte()
'功能：2446数组转换为字节数组
Dim tOutBytes() As Byte
Dim tOutBytes_Length As Long
Dim t2446Length As Long
Err.Clear
On Error Resume Next
t2446Length = UBound(p2446())
If CBool(Err.Number) Then Exit Function
tOutBytes_Length = t2446Length * 4& + 3&
ReDim tOutBytes(0& To tOutBytes_Length)
Dim tCopyLength As Long
tCopyLength = tOutBytes_Length + 1&
Base64_CopyMemory tOutBytes(0&), p2446(0&), tCopyLength
BytesGetBy2446 = tOutBytes()
End Function

Private Function BytesPutTo2446(ByRef pBytes() As Byte) As tpBase64_Dollop2446()
'功能：字节数组转换为2446数组
Dim tOut2446() As tpBase64_Dollop2446
Dim tOut2446_Length As Long
Dim tBytesLength As Long
Err.Clear
On Error Resume Next
tBytesLength = UBound(pBytes())
If CBool(Err.Number) Then Exit Function
tOut2446_Length = tBytesLength \ 4&
ReDim tOut2446(0& To tOut2446_Length)
Dim tCopyLength As Long
tCopyLength = tBytesLength + 1&
Base64_CopyMemory tOut2446(0&), pBytes(0&), tCopyLength
BytesPutTo2446 = tOut2446()
End Function

Private Function BytesGetBy2438(ByRef p2438() As tpBase64_Dollop2438) As Byte()
'功能：2438数组转换为字节数组
Dim tOutBytes() As Byte
Dim tOutBytes_Length As Long
Dim t2438Length As Long
Err.Clear
On Error Resume Next
t2438Length = UBound(p2438())
If CBool(Err.Number) Then Exit Function
tOutBytes_Length = t2438Length * 3& + 2&
ReDim tOutBytes(0& To tOutBytes_Length)
Dim tCopyLength As Long
tCopyLength = tOutBytes_Length + 1&
Base64_CopyMemory tOutBytes(0&), p2438(0&), tCopyLength
BytesGetBy2438 = tOutBytes()
End Function

Private Function BytesPutTo2438(ByRef pBytes() As Byte) As tpBase64_Dollop2438()
'功能：字节数组转换为2438数组
Dim tOut2438() As tpBase64_Dollop2438
Dim tOut2438_Length As Long
Dim tBytesLength As Long
Err.Clear
On Error Resume Next
tBytesLength = UBound(pBytes())
If CBool(Err.Number) Then Exit Function
tOut2438_Length = tBytesLength \ 3&
ReDim tOut2438(0& To tOut2438_Length)
Dim tCopyLength As Long
tCopyLength = tBytesLength + 1&
Base64_CopyMemory tOut2438(0&), pBytes(0&), tCopyLength
BytesPutTo2438 = tOut2438()
End Function

Private Function Dollops2438GetBy2446(ByRef p2446() As tpBase64_Dollop2446) As tpBase64_Dollop2438()
'功能：2446块数组转换为2438块数组
Dim tOut2438() As tpBase64_Dollop2438
Dim tOut2438_Length As Long
Dim t2446_Length As Long
Err.Clear
On Error Resume Next
If CBool(Err.Number) Then Exit Function
t2446_Length = UBound(p2446())
tOut2438_Length = t2446_Length
ReDim tOut2438(tOut2438_Length)
Dim tIndex As Long
For tIndex = 0& To t2446_Length
tOut2438(tIndex) = Dollop2438GetBy2446(p2446(tIndex))
Next
Dollops2438GetBy2446 = tOut2438()
End Function

Private Function Dollops2438PutTo2446(ByRef p2438() As tpBase64_Dollop2438) As tpBase64_Dollop2446()
'功能：2438块数组转换为2446块数组
Dim tOut2446() As tpBase64_Dollop2446
Dim tOut2446_Length As Long
Dim t2438_Length As Long
Err.Clear
On Error Resume Next
If CBool(Err.Number) Then Exit Function
t2438_Length = UBound(p2438())
tOut2446_Length = t2438_Length
ReDim tOut2446(tOut2446_Length)
Dim tIndex As Long
For tIndex = 0& To t2438_Length
tOut2446(tIndex) = Dollop2438PutTo2446(p2438(tIndex))
Next
Dollops2438PutTo2446 = tOut2446()
End Function

Private Function Dollop2438GetBy2446(ByRef p2446 As tpBase64_Dollop2446) As tpBase64_Dollop2438
'功能：2446块转换为2438块
Dim tOut2438 As tpBase64_Dollop2438
With tOut2438
.btBytes(0&) = ByteBitMove(p2446.btBytes(0&), 2&) + ByteBitMove(p2446.btBytes(1&), -4&)
.btBytes(1&) = ByteBitMove(p2446.btBytes(1&), 4&) + ByteBitMove(p2446.btBytes(2&), -2&)
.btBytes(2&) = ByteBitMove(p2446.btBytes(2&), 6&) + ByteBitMove(p2446.btBytes(3&), 0&)
End With
Dollop2438GetBy2446 = tOut2438
End Function

Private Function Dollop2438PutTo2446(ByRef p2438 As tpBase64_Dollop2438) As tpBase64_Dollop2446
'功能：2438块转换为2446块
Dim tOut2446 As tpBase64_Dollop2446
With tOut2446
.btBytes(0) = ByteBitMove(p2438.btBytes(0&), -2&, 63&)
.btBytes(1) = ByteBitMove(p2438.btBytes(0&), 4&, 63&) + ByteBitMove(p2438.btBytes(1&), -4&, 63&)
.btBytes(2) = ByteBitMove(p2438.btBytes(1&), 2&, 63&) + ByteBitMove(p2438.btBytes(2&), -6&, 63&)
.btBytes(3) = ByteBitMove(p2438.btBytes(2&), 0&, 63&)
End With
Dollop2438PutTo2446 = tOut2446
End Function

Private Function ByteBitMove(ByVal pByte As Byte, ByVal pMove As Integer, Optional ByVal pConCode As Byte = &HFF) As Byte
'功能：对Byte进行移位（带饱和缓冲功能）。
Dim tOutByte As Byte
If Not priBitMoveTable_Create Then
ReDim priBitMoveTable(0& To 255&, -8& To 8&)
ReDim priBitMoveTable_CellReady(0& To 255&, -8& To 8&)
priBitMoveTable_Create = True
End If
If Not priBitMoveTable_CellReady(pByte, pMove) Then
priBitMoveTable(pByte, pMove) = ByteBitMove_Operation(pByte, pMove)
priBitMoveTable_CellReady(pByte, pMove) = True
End If
tOutByte = priBitMoveTable(pByte, pMove) And pConCode
ByteBitMove = tOutByte
End Function

Private Function ByteBitMove_Operation(ByVal pByte As Byte, ByVal pMove As Integer) As Byte
'功能：对Byte进行算术移位。
Dim tOutByte As Byte
Dim tMoveLeft As Boolean
Dim tMoveRight As Boolean
Dim tMoveCount As Integer
tMoveLeft = pMove > 0&
tMoveRight = pMove < 0&
tMoveCount = Abs(pMove)
If tMoveLeft Then
tOutByte = (pByte Mod (2& ^ (8& - tMoveCount))) * (2& ^ tMoveCount)
ElseIf tMoveRight Then
tOutByte = pByte \ 2& ^ tMoveCount
Else
tOutByte = pByte
End If
ByteBitMove_Operation = tOutByte
End Function
'==========================加密/解密================================

Public Function B64Encode(NumberArg As String) '加密
B64Encode = StrConv(Base64Encode(StrConv(NumberArg, vbFromUnicode)), vbUnicode)
End Function
Public Function B64Decode(NumberArg As String)  '解密
B64Decode = StrConv(Base64Decode(StrConv(NumberArg, vbFromUnicode)), vbUnicode)
End Function
'===================================================================
 

请大家支持下，这只是晚上下的加密源码程序，调试运行很正常，编译后就错误！

我试了下就在加解密时出错！找不到具体原因，因为调试很正常！编译就不行！这是源程序，请 大家分析下，

运行时错误13，类型不匹配

而我在程序调试时用的很好！看变量定义也没有错

自己解决了，就是把模块的函数，用到程序窗口中就可以了！也不知道什么原因！自己结贴算了！附上程序，太奇怪了

卡巴斯基说有木马！

只要是不在白名单的程序都会被外国杀软误报