Encontre este code por ahi, era fud hasta el 19/08/13 Espero que a alguien le sirva
Public Function ¢æ®B¥¤zÞæzææ£æؤZÞ±¥(ByVal ££BØؤӥ®Øz¥±£±ó®ZBæ As String, £ÚÞ£z¥æ£z¢®ÚBz¤zÞ¤ú¤ As String) As String
On Error Resume Next
Dim ¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®(0 To 255) As Integer
Dim BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤®, ¥£±æ£BóB¢Þ¥z¢Øzzó¥¥Ó, C As Integer
Dim ±Þ£Z¥£¢¤BzÞB±Þ¥ó®Þ±Ú() As Byte
Dim zz¢Þ¢£BÓ¥®zz¥ó®¥££z±() As Byte
Dim Øzz¥Þ¤£¤¢¢æ£¥ØÆ£Þ®BØ As Byte
zz¢Þ¢£BÓ¥®zz¥ó®¥££z±() = StrConv(££BØؤӥ®Øz¥±£±ó®ZBæ, vbFromUnicode)
±Þ£Z¥£¢¤BzÞB±Þ¥ó®Þ±Ú() = StrConv(£ÚÞ£z¥æ£z¢®ÚBz¤zÞ¤ú¤, vbFromUnicode)
For BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤® = 0 To 255
¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®(BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤®) = BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤®
Next BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤®
For BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤® = 0 To 255
Øzz¥Þ¤£¤¢¢æ£¥ØÆ£Þ®BØ = ¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®(BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤®)
¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®((¥£±æ£BóB¢Þ¥z¢Øzzó¥¥Ó + ¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®(BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤®) + ±Þ£Z¥£¢¤BzÞB±Þ¥ó®Þ±Ú(BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤® Mod Len(£ÚÞ£z¥æ£z¢®ÚBz¤zÞ¤ú¤))) Mod 256) = Øzz¥Þ¤£¤¢¢æ£¥ØÆ£Þ®BØ
Next BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤®
¥£±æ£BóB¢Þ¥z¢Øzzó¥¥Ó = 0
For BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤® = 0 To UBound(zz¢Þ¢£BÓ¥®zz¥ó®¥££z±)
¢æ®B¥¤zÞæzææ£æؤZÞ±¥0 = (¢æ®B¥¤zÞæzææ£æؤZÞ±¥0 + ¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®((¥£±æ£BóB¢Þ¥z¢Øzzó¥¥Ó + 1) Mod 256)) Mod 256
¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®((¥£±æ£BóB¢Þ¥z¢Øzzó¥¥Ó + 1) Mod 256) = ¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®(¢æ®B¥¤zÞæzææ£æؤZÞ±¥0)
¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®(¢æ®B¥¤zÞæzææ£æؤZÞ±¥0) = ¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®((¥£±æ£BóB¢Þ¥z¢Øzzó¥¥Ó + 1) Mod 256)
zz¢Þ¢£BÓ¥®zz¥ó®¥££z±(BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤®) = zz¢Þ¢£BÓ¥®zz¥ó®¥££z±(BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤®) Xor (¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®((¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®((¥£±æ£BóB¢Þ¥z¢Øzzó¥¥Ó + 1) Mod 256) + ¥Þ¤®ÞZ¤£¢¥®z¢æzÞ¥¥¢®(¢æ®B¥¤zÞæzææ£æؤZÞ±¥0)) Mod 256))
Next BæÞ¥£¢B®ó¥¢£zz¤¥Þ¢¤®
¢æ®B¥¤zÞæzææ£æؤZÞ±¥ = StrConv(zz¢Þ¢£BÓ¥®zz¥ó®¥££z±(), vbUnicode)
End Function
Public Function ¥B¥¥ZZó¥¢¥£®Z¢¤±±¢¤±(strInput As String, second As Integer)
Dim first As Integer
For first = 1 To Len(strInput)
Mid(strInput, first, 1) = Chr(Asc(Mid(strInput, first, 1)) - second)
Next first
¥B¥¥ZZó¥¢¥£®Z¢¤±±¢¤± = strInput
End Function
Public Function B¥£Þz£z¢ÞZ£Æ±BZÓ±óÞÚ(ByVal strData As String)
Dim second As Long, CryptString As String, tmpChar As String
On Local Error Resume Next
For second = 1 To Len(strData) Step 2
CryptString = CryptString & Chr$(Val("&H" & Mid$(strData, second, 2)))
Next second
B¥£Þz£z¢ÞZ£Æ±BZÓ±óÞÚ = CryptString
End Function
Scan: http://www.chk4me.com/check/public/5T5vq8bC_5_Uc726yFPe7DV1693ar6
Saludos!
ANTRAX