VB Net – List MSN Contacts

Public Shared Sub Getcontacts(ByVal ListViewAdd As ListView)
ListViewAdd.View = View.Details
ListViewAdd.FullRowSelect = True
ListViewAdd.GridLines = True
ListViewAdd.Columns.Clear()
ListViewAdd.Items.Clear()
ListViewAdd.Columns.Add(“Friendly Name”, 1, HorizontalAlignment.Left)
ListViewAdd.Columns.Add(“Status”, 1, HorizontalAlignment.Left)
ListViewAdd.Columns.Add(“Email Address”, 1, HorizontalAlignment.Left)
ListViewAdd.Columns.Add(“Something”, 1, HorizontalAlignment.Left)
ListViewAdd.Columns.Item(0).Width = ListViewAdd.Width – 160 – 5
ListViewAdd.Columns.Item(1).Width = 60
Dim oMessenger As MessengerAPI.Messenger
oMessenger = New MessengerAPI.Messenger
Dim msncontact As IMessengerContact
Dim msncontacts As IMessengerContacts
msncontacts = oMessenger.MyContacts

Dim Awaylist As New ListViewGroup
Dim BRBlist As New ListViewGroup
Dim Busylist As New ListViewGroup
Dim Idlelist As New ListViewGroup
Dim Invisilist As New ListViewGroup
Dim Offlist As New ListViewGroup
Dim Phonelist As New ListViewGroup
Dim Lunchlist As New ListViewGroup
Dim Unklist As New ListViewGroup
For Each msncontact In msncontacts
Dim item1 As New ListViewItem(msncontact.FriendlyName)
Dim Status As String = “Offline”
If msncontact.Status = MISTATUS.MISTATUS_AWAY Then
Status = “Away”
ElseIf msncontact.Status = MISTATUS.MISTATUS_BE_RIGHT_BACK Then
Status = “BRB”
ElseIf msncontact.Status = MISTATUS.MISTATUS_BUSY Then
Status = “Busy”
ElseIf msncontact.Status = MISTATUS.MISTATUS_IDLE Then
Status = “Idle”
ElseIf msncontact.Status = MISTATUS.MISTATUS_INVISIBLE Then
Status = “Invisible”
ElseIf msncontact.Status = MISTATUS.MISTATUS_OFFLINE Then
Status = “Offline”
ElseIf msncontact.Status = MISTATUS.MISTATUS_ON_THE_PHONE Then
Status = “On Phone”
ElseIf msncontact.Status = MISTATUS.MISTATUS_ONLINE Then
Status = “Online”
ElseIf msncontact.Status = MISTATUS.MISTATUS_OUT_TO_LUNCH Then
Status = “Lunch”
ElseIf msncontact.Status = MISTATUS.MISTATUS_UNKNOWN Then
Status = “Unknown”
End If
item1.SubItems.Add(Status)
item1.SubItems.Add(msncontact.SigninName)
If Status = “Away” Then
Awaylist.Items.Add(item1)
item1.SubItems(0).BackColor = Color.Red
ElseIf Status = “BRB” Then
BRBlist.Items.Add(item1)
item1.SubItems(0).BackColor = Color.LightGray
ElseIf Status = “Busy” Then
Busylist.Items.Add(item1)
item1.SubItems(0).BackColor = Color.Orange
ElseIf Status = “Idle” Then
Idlelist.Items.Add(item1)
item1.SubItems(0).BackColor = Color.Red
ElseIf Status = “Invisible” Then
Invisilist.Items.Add(item1)
item1.SubItems(0).BackColor = Color.Peru
ElseIf Status = “Offline” Then
Offlist.Items.Add(item1)
item1.SubItems(0).BackColor = Color.Peru
ElseIf Status = “On Phone” Then
Phonelist.Items.Add(item1)
item1.SubItems(0).BackColor = Color.Blue
item1.SubItems(0).ForeColor = Color.Pink
ElseIf Status = “Online” Then
ListViewAdd.Items.Add(item1)
item1.SubItems(0).BackColor = Color.Black
item1.SubItems(0).ForeColor = Color.Orange
ElseIf Status = “Lunch” Then
item1.SubItems(0).BackColor = Color.Blue
item1.SubItems(0).ForeColor = Color.Pink
Lunchlist.Items.Add(item1)
ElseIf Status = “Unknown” Then
Unklist.Items.Add(item1)
item1.SubItems(0).BackColor = Color.Black
item1.SubItems(0).ForeColor = Color.Red
End If

Next
ListViewAdd.Items.AddRange(BRBlist.Items)
ListViewAdd.Items.AddRange(Busylist.Items)
ListViewAdd.Items.AddRange(Awaylist.Items)
ListViewAdd.Items.AddRange(Idlelist.Items)
ListViewAdd.Items.AddRange(Phonelist.Items)
ListViewAdd.Items.AddRange(Lunchlist.Items)
ListViewAdd.Items.AddRange(Invisilist.Items)
ListViewAdd.Items.AddRange(Unklist.Items)
ListViewAdd.Items.AddRange(Offlist.Items)
ListViewAdd.Columns.Item(2).AutoResize(ColumnHeaderAutoResizeStyle.ColumnContent)
End Sub

Usage:

Getcontacts(ListView1)
ListView1.Columns(0).Width = ListView1.Width – ListView1.Columns(1).Width – ListView1.Columns(2).Width – 19
ListView1.Height = Me.Height – GroupBox2.Height – 50

VB Net – Change MSN Display Picture

Imports MessengerAPI

Public Shared Sub SetDisplayPic(ByVal path As String)
Const MCONTACTPROP_USERTILE_PATH As Long = 2
Dim oMessenger As MessengerAPI.Messenger
oMessenger = New MessengerAPI.Messenger
oMessenger.MyProperty(MCONTACTPROP_USERTILE_PATH) = path
End Sub

Usage:

Dim fbo As New OpenFileDialog
fbo.Filter = “All Images (*.bmp;*.gif;*.jpg;*.jpeg;*.png)|*.bmp;*.gif;*.jpg;*.jpeg;*.png”
fbo.ShowDialog()
Try
Functions.SetDisplayPic(fbo.FileName)
MessageBox.Show(“Done”, “Change Display Picture”, MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
Catch ex As Exception
End Try

Edit: updated the file dialog with image filter

VB Net – Change MSN Personal Message

Public Enum IconType
Music
Games
Office
End Enum
Public Declare Function SendMessage Lib “user32.dll” Alias “SendMessageA” (ByVal hwnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As IntPtr) As Int32
Public Declare Function FindWindowEx Lib “user32.dll” Alias “FindWindowExA” (ByVal hWnd1 As Int32, ByVal hWnd2 As Int32, ByVal lpsz1 As String, ByVal lpsz2 As String) As Int32
Public Structure COPYDATASTRUCT
Public dwData As Int32
Public cbData As Int32
Public lpData As IntPtr
End Structure
Public Const WM_COPYDATA As Int32 = &H4A

Public Shared Sub SetPlayingInfo(ByVal Artist As String, ByVal Album As String, ByVal Title As String, Optional ByVal Icon As IconType = IconType.Music, Optional ByVal WMContentID As String = vbNullString, Optional ByVal Format As String = “{0} – {1}”, Optional ByVal Show As Boolean = True)
Dim mess As String = String.Format(“{0}{1}{2}{3}{4}{5}{6}” & vbNullChar, Icon.ToString, Math.Abs(CInt(Show)), Format, Artist, Title, Album, WMContentID)
Dim lpMess As GCHandle = GCHandle.Alloc(mess, GCHandleType.Pinned)
Dim CD As COPYDATASTRUCT
With CD
.dwData = &H547
.cbData = mess.Length * 2
.lpData = lpMess.AddrOfPinnedObject
End With
Dim lpCD As GCHandle = GCHandle.Alloc(CD, GCHandleType.Pinned)
Dim hMSGRUI As Integer
Do
hMSGRUI = FindWindowEx(0, hMSGRUI, “MsnMsgrUIManager”, vbNullString)
If (hMSGRUI > 0) Then
SendMessage(hMSGRUI, WM_COPYDATA, 0, lpCD.AddrOfPinnedObject)
End If
Loop Until (hMSGRUI = 0)
lpMess.Free()
lpCD.Free()
End Sub

Vb Net – Get Dragon Fable Game SWF File

Private Function DFSWFFile() As String
Dim source As String
Dim path As String = Application.StartupPath & “/htmlsource.txt”
My.Computer.Network.DownloadFile(“http://dragonfable.battleon.com/game/”, path)
source = My.Computer.FileSystem.ReadAllText(path)
My.Computer.FileSystem.DeleteFile(path, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.DeletePermanently)
Dim startpos As Integer = InStr(source, “FLASHVARS=” & ControlChars.Quote & “strFileName”) + 22
If startpos = 0 Or source = “” Then
Exit Function
End If
source = source.Remove(0, startpos)
Dim endpos As Integer = InStr(source, “bgcolor=” & ControlChars.Quote & “#530000″) – 3
source = source.Remove(endpos, source.Length – endpos)
DFSWFFile = source
End Function

VB Net – Detect Windows Shutdown

Private Const WM_QUERYENDSESSION As Integer = 17

Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_QUERYENDSESSION Then
Application.Exit()
End If
End Sub

VB Net – Global Hotkey

Private Declare Function RegisterHotKey Lib “user32″ (ByVal hwnd As IntPtr, ByVal id As Integer, ByVal fsModifiers As Integer, ByVal vk As Integer) As Integer
Private Declare Function UnregisterHotKey Lib “user32″ (ByVal hwnd As IntPtr, ByVal id As Integer) As Integer
Private Declare Function GlobalAddAtom Lib “kernel32″ Alias “GlobalAddAtomA” (ByVal lpString As String) As Short
Private Declare Function GlobalDeleteAtom Lib “kernel32″ (ByVal nAtom As Short) As Short
Private Const MOD_ALT As Integer = 1
Private Const MOD_CONTROL As Integer = 2
Private Const MOD_SHIFT As Integer = 4
Private Const MOD_WIN As Integer = 8
Private Const MOD_NONE As Integer = 0
Private Const WM_HOTKEY As Integer = &H312
Dim hotkeyID As Short

Sub RegisterGHK(ByVal hotkey As Keys, ByVal modifiers As Integer)
Try
Dim atomName As String = Process.GetCurrentProcess.Id.ToString(“X8″) & Me.Name
hotkeyID = GlobalAddAtom(atomName)
If hotkeyID = 0 Then
Throw New Exception(“Unable to generate unique hotkey ID. Error code: ” & System.Runtime.InteropServices.Marshal.GetLastWin32Error().ToString)
End If

If RegisterHotKey(Me.Handle, hotkeyID, modifiers, CInt(hotkey)) = 0 Then
Throw New Exception(“Unable to register hotkey. Error code: ” & System.Runtime.InteropServices.Marshal.GetLastWin32Error.ToString)
End If
Catch ex As Exception
UnregisterGHK()
End Try
End Sub

Sub UnregisterGHK()
If Me.hotkeyID <> 0 Then
UnregisterHotKey(Me.Handle, hotkeyID)
GlobalDeleteAtom(hotkeyID)
hotkeyID = 0
End If
End Sub

Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
MyBase.WndProc(m)
If m.Msg = WM_HOTKEY Then
Me.Activate()
MessageBox.Show(“Hotkey has been pressed”)
End If