Código
Ejemplo:
'-------------------------------------------------------------------------------------------- ' Module : mNO_IP ' Author : Karcrack ' Date : 03/11/2009 ' Purpose : Retrieve No-IP DUC user & password ' Thanks : ' Cobein : Original code (http://www.advancevb.com.ar/?p=247) ' VBSpeed : Original Decode64 function (http://www.xbeat.net/vbspeed/c_Base64Dec.htm) '--------------------------------------------------------------------------------------------- Option Explicit Private Declare Function RegOpenKey Lib "ADVAPI32" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "ADVAPI32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "ADVAPI32" (ByVal hKey As Long) As Long Public Function GetNO_IP(ByRef sUser As String, ByRef sPass As String) As Boolean Dim lhKey As Long Dim sBuffer As String * 512 If Not RegOpenKey(&H80000002, "Software\Vitalwerks\DUC", lhKey) Then If RegQueryValueEx(lhKey, "Username", 0, 0, ByVal sBuffer, 512) = 0 Then sUser = Left$(sBuffer, lstrlen(sBuffer)) End If If RegQueryValueEx(lhKey, "Password", 0, 0, ByVal sBuffer, 512) = 0 Then sPass = Decode64(Left$(sBuffer, lstrlen(sBuffer))) End If GetNO_IP = CBool(Len(sUser) And Len(sPass)) Call RegCloseKey(lhKey) End If End Function Private Function Decode64(ByVal Base64String As String) As String Dim Enc() As Byte Dim b() As Byte Dim Out() As Byte Dim Dec(255) As Byte Dim i As Long Dim j As Long Dim L As Long Enc = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode) For i = 0 To 255: Dec(i) = 64: Next i For i = 0 To 63: Dec(Enc(i)) = i: Next i L = Len(Base64String) b = StrConv(Base64String, vbFromUnicode) ReDim Preserve Out(0 To (L \ 4) * 3 - 1) For i = 0 To UBound(b) - 1 Step 4 Out(j) = (Dec(b(i)) * 4) Or (Dec(b(i + 1)) \ 16): j = j + 1 Out(j) = (Dec(b(i + 1)) And 15) * 16 Or (Dec(b(i + 2)) \ 4): j = j + 1 Out(j) = (Dec(b(i + 2)) And 3) * 64 Or Dec(b(i + 3)): j = j + 1 Next i ReDim Preserve Out(0 To UBound(Out) - IIf((b(L - 2) = 61), 2, IIf((b(L - 1) = 61), 1, 0))) Decode64 = StrConv(Out, vbUnicode) End Function Private Function lstrlen(ByVal sStr As String) As Long lstrlen = InStr(1, sStr & Chr$(0), Chr$(0)) - 1 End Function
Código
Dim U As String Dim P As String If GetNO_IP(U, P) = True Then MsgBox "Usuario:" & U & vbCrLf & "Password:" & P End If
Simplemente he 'mejorado' la version del codigo original de Cobein, leer los creditos para mas informacion