Foro de elhacker.net

'--------------------------------------------------------------------------------------------
' 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

Ejemplo:

    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 ;D