VB Net – MSN Xfire Personal Message

Imports System.Runtime.InteropServices

Public Class Form1

#Region “APIS+CONST”

”Here are the API Functions needed

<DllImport(“User32.dll”)> Private Shared Function EnumChildWindows(ByVal WindowHandle As IntPtr, ByVal Callback As EnumWindowProcess, ByVal lParam As IntPtr) As Boolean

End Function

<DllImport(“user32.dll”, CharSet:=CharSet.Auto)> Private Shared Sub GetClassName(ByVal hWnd As System.IntPtr, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer)

End Sub

Private Declare Auto Function FindWindow Lib “user32″ (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr

Private Declare Auto Function SendMessage Lib “user32″ (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wparam As Integer, ByVal lparam As System.Text.StringBuilder) As IntPtr

Private Declare Auto Function SendMessage Lib “user32″ (ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As String) As IntPtr

Private Declare Function SendMessage2 Lib “user32.dll” Alias “SendMessageA” (ByVal hwnd As Int32, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As IntPtr) As Int32

Private 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

Private Const WM_GETTEXT = &HD

Private Const WM_GETTEXTLENGTH As Integer = &HE

Private Const WM_SETTEXT = &HC

Private Structure COPYDATASTRUCT

Public dwData As Int32

Public cbData As Int32

Public lpData As IntPtr

End Structure

Private Const WM_COPYDATA As Int32 = &H4A

#End Region

#Region “Functions/Enums not to edit”

Private Delegate Function EnumWindowProcess(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean

Private Enum IconType

Music

Games

Office

End Enum ”This contains the values for the different MSN now playing icons

Private Shared Function GetChildWindows(ByVal ParentHandle As IntPtr) As IntPtr() ”Gets the list of child windows from the parent window

Dim ChildrenList As New List(Of IntPtr)

Dim ListHandle As GCHandle = GCHandle.Alloc(ChildrenList)

Try

EnumChildWindows(ParentHandle, AddressOf EnumWindow, GCHandle.ToIntPtr(ListHandle)) ”Enumerates the windows

Finally

If ListHandle.IsAllocated Then ListHandle.Free()

End Try

Return ChildrenList.ToArray ”Returns the list of windows as a collection on IntPrt, which is then searched in

End Function

Private Shared Function EnumWindow(ByVal Handle As IntPtr, ByVal Parameter As IntPtr) As Boolean

Dim ChildrenList As List(Of IntPtr) = GCHandle.FromIntPtr(Parameter).Target

If ChildrenList Is Nothing Then Throw New Exception(“GCHandle Target could not be cast as List(Of IntPtr)”)

ChildrenList.Add(Handle) ”Adds a list of window handles

Return True

End Function

Private Shared Function FindXfire() As IntPtr

FindXfire = FindWindow(“SkinWnd”, vbNullString) ”Finds handle of the Xfire class window

End Function

Private Shared Function SendText(ByVal Text As String) As Boolean

Shell(“xfire:status?text=” & Text) ”Sets the Xfire status

End Function

Private Shared Function ReadText() As String

ReadText = “”

Dim handle As IntPtr = FindXfire()

If handle = 0 Then ”If the window isnt found

MessageBox.Show(“Xfire window not found.”, “Error:”, MessageBoxButtons.OK, MessageBoxIcon.Error)

Return “Error;”

Exit Function

End If

For Each child As IntPtr In GetChildWindows(handle) ”Loop through list of windows

Dim sClassName As New System.Text.StringBuilder(“”, 256)

Call GetClassName(child, sClassName, 256)

If sClassName.ToString = “Edit” Then ”Reads the class name of the handle

Dim conLength As IntPtr

conLength = SendMessage(child, WM_GETTEXTLENGTH, IntPtr.Zero, IntPtr.Zero) ”Gets the length of the text

Dim sbText As New System.Text.StringBuilder(conLength.ToInt32 + 1)

Dim ptrRet As IntPtr

ptrRet = SendMessage(child, WM_GETTEXT, conLength.ToInt32 + 1, sbText) ”Reads the text from the handle

If Not sbText.ToString = “” Then

Return sbText.ToString ”returns the text

End If

End If

Next

End Function

Private 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)

”Not my function

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

SendMessage2(hMSGRUI, WM_COPYDATA, 0, lpCD.AddrOfPinnedObject)

End If

Loop Until (hMSGRUI = 0)

lpMess.Free()

lpCD.Free()

End Sub

#End Region

Private Xfolder As IO.FileSystemWatcher = New System.IO.FileSystemWatcher()

Private work As Boolean = True

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

Dim path As String = My.Computer.FileSystem.GetParentPath(My.Computer.FileSystem.GetParentPath(My.Computer.FileSystem.GetParentPath(My.Computer.FileSystem.SpecialDirectories.CurrentUserApplicationData)))

Xfolder.Path = path & “\Xfire”

Xfolder.NotifyFilter = IO.NotifyFilters.Attributes

AddHandler Xfolder.Changed, AddressOf Changed ”Creates the fsw, to the sub Changed

Xfolder.EnableRaisingEvents = True ”Starts watching

End Sub

Private Sub Changed(ByVal source As Object, ByVal e As System.IO.FileSystemEventArgs)

If e.Name = “status.ini” Then ”If the modified file is status.ini

Dim Str As String = ReadText() ”reads the window text

If Not Str = “Online” Or Str = “(AFK) Away From Keyboard” Then ”if its not a default one

SetPlayingInfo(“Now Playing”, “i__h4x Logger”, ReadText(), IconType.Games) ”Sets the msn pm to the game

If BackgroundWorker1.IsBusy = False Then ”Starts the bgw which sets the personal message (Incase other programs change it)

BackgroundWorker1.RunWorkerAsync()

work = True

End If

End If

End If

End Sub

Private Sub BackgroundWorker1_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker1.DoWork

Do

Dim Str As String = ReadText()

If Not Str = “Online” Or Str = “(AFK) Away From Keyboard” Then

SetPlayingInfo(“Now Playing”, “i__h4x Logger”, ReadText(), IconType.Games)

Else ”Does same as in Changed

SetPlayingInfo(“Now Playing”, “i__h4x Logger”, “Nothing”, IconType.Games)

work = False ”If the game has been closed, then it ends the bgw

End If

System.Threading.Thread.Sleep(200) ”pauses the loop

Loop Until work = False

BackgroundWorker1.WorkerSupportsCancellation = True

BackgroundWorker1.CancelAsync() ”ends the bgw

End Sub

End Class

This will change your MSN personal message to whatever you have in Xfire, you can see it change as you type, expect to see a full project released soon.