Archief - [PROG]VB.NET probleem met delegate function adressof

Het archief is een bevroren moment uit een vorige versie van dit forum, met andere regels en andere bazen. Deze posts weerspiegelen op geen enkele manier onze huidige ideeën, waarden of wereldbeelden en zijn op sommige plaatsen gecensureerd wegens ontoelaatbaar. Veel zijn in een andere tijdsgeest gemaakt, al dan niet ironisch - zoals in het ironische subforum Off-Topic - en zouden op dit moment niet meer gepost (mogen) worden. Toch bieden we dit archief nog graag aan als informatiedatabank en naslagwerk. Lees er hier meer over of start een gesprek met anderen.
l

loopylama

Legacy Member
PHP: 
Option Explicit On
Module Module1
    Public Delegate Function hookmenuDelegate(ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
    Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Integer, ByRef lpdwProcessId As Integer) As Integer
    Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
    'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"'
    Public Declare Function AppendMenu Lib "user32.dll" Alias "AppendMenuA" (ByVal hMenu As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As Long) As Integer
    Public Declare Function CreatePopupMenu Lib "user32.dll" () As Integer
    'UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"'
    Public Declare Function InsertMenu Lib "user32.dll" Alias "InsertMenuA" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As Long) As Integer
    Public Declare Function GetMenu Lib "user32.dll" (ByVal hWnd As Integer) As Integer
    Public Declare Function DrawMenuBar Lib "user32.dll" (ByVal hWnd As Integer) As Integer
    '   Public Declare Function SetCWPMSGHook Lib "dscwpmsg" (ByVal hWnd As Integer, ByVal AdrCWP As Integer, ByVal AdrMSG As Integer) As Integer
    Public Declare Function SetCWPMSGHook Lib "dscwpmsg" (ByVal hWnd As Integer, ByVal AdrCWP As Integer, ByVal AdrMSG As hookmenuDelegate) As Integer
    Public Declare Function SetCBTSHLHook Lib "dscbtshl" (ByVal Hook As Integer, ByVal AdrCBT As hookmenuDelegate, ByVal AdrSHL As Integer) As Integer
    '   Public Declare Function SetCBTSHLHook Lib "dscbtshl" (ByVal Hook As Integer, ByVal AdrCBT As Integer, ByVal AdrSHL As Integer) As Integer
    Public Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Integer
    '   UPGRADE_ISSUE: Declaring a parameter 'As Any' is not supported. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1016"'
    Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As Long) As Integer

    Dim menuB As hookmenuDelegate()
    Public Const Offset As Integer = 2000
    Public Const HCBT_CREATEWND As Integer = 3
    Public Const HCBT_DESTROYWND As Integer = 4
    Public Const MF_BYCOMMAND As Integer = &H0
    Public Const MF_BYPOSITION As Integer = &H400
    Public Const MF_POPUP As Integer = &H10
    Public Const MF_STRING As Integer = &H0
    Public Const WM_COMMAND As Integer = &H111S

    Public Function hookfind(ByVal hWnd As Integer, ByVal nCode As Integer) As Integer

        Dim hHiddenWindowClass As Integer
        Dim sClassName As String
        Dim lRetVal As Integer
        Dim lProcessId As Integer

        If Not nCode = HCBT_CREATEWND Then
            If Not nCode = HCBT_DESTROYWND Then
                Exit Function
            End If
        End If

        sClassName = Space(256)
        lRetVal = GetClassName(hWnd, sClassName, 256)
        sClassName = Left(sClassName, lRetVal)
        lProcessId = GetWindowThreadProcessId(hWnd, 0)
        If sClassName = "MSNHiddenWindowClass" Then
            If nCode = HCBT_CREATEWND Then
                Call OnMessengerStart(lProcessId, hWnd)
            ElseIf nCode = HCBT_DESTROYWND Then
                Call OnMessengerClose(lProcessId, hWnd)
            End If
            Exit Function
        End If
        '**********note rest does not work with polygamy***********
        hHiddenWindowClass = FindWindow("MSNHiddenWindowClass", vbNullString)

        'If an instance is open
        If Not hHiddenWindowClass = 0 Then
            If lProcessId = GetWindowThreadProcessId(hHiddenWindowClass, 0) Then
                If nCode = HCBT_CREATEWND Then
                    Call OnWindowOpen(lProcessId, hWnd, sClassName)
                ElseIf nCode = HCBT_DESTROYWND Then
                    Call OnWindowClose(lProcessId, hWnd, sClassName)
                End If
            End If
        End If
    End Function

    Public Sub OnMessengerStart(ByRef r_lProcessId As Integer, ByRef r_hHiddenWnd As Integer)

        'UPGRADE_WARNING: Add a delegate for AddressOf hookmenu Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1048"'
        Call SetCWPMSGHook(r_hHiddenWnd, 0, AddressOf hookmenu)
        Form1.DefInstance.Text1.Text = Form1.DefInstance.Text1.Text & "Msn Messenger Opened" & vbCrLf

    End Sub

    Public Sub OnMessengerClose(ByRef r_lProcessId As Integer, ByRef r_hHiddenWnd As Integer)
        Form1.DefInstance.Text1.Text = Form1.DefInstance.Text1.Text & "Msn Messenger Closed" & vbCrLf
    End Sub


    Public Sub OnWindowOpen(ByRef r_lProcessId As Integer, ByRef r_hWnd As Integer, ByRef r_sClassName As String)

        Dim hMenu As Integer
        Dim hSubMenu As Integer

        Select Case r_sClassName
            Case "MSBLWindowClass"
                Form1.DefInstance.Text1.Text = Form1.DefInstance.Text1.Text & "Msn Messenger Contact List Window Opened" & vbCrLf

                Do
                    hMenu = GetMenu(r_hWnd)
                Loop While hMenu = 0

                hSubMenu = CreatePopupMenu
                Call AppendMenu(hSubMenu, MF_STRING, Offset + 1, "&Test 1")
                Call AppendMenu(hSubMenu, MF_STRING, Offset + 2, "&Test 2")
                Call AppendMenu(hSubMenu, MF_STRING, Offset + 3, "&Test 3")
                Call AppendMenu(hSubMenu, MF_STRING, Offset + 4, "&About")
                Call AppendMenu(hMenu, MF_BYPOSITION Or MF_POPUP, hSubMenu, "&VB Hook")
                Call DrawMenuBar(r_hWnd)

        End Select

    End Sub


    Public Sub OnWindowClose(ByRef r_lProcessId As Integer, ByRef r_hWnd As Integer, ByRef r_sClassName As String)

        Select Case r_sClassName
            Case "MSBLWindowClass"
                Form1.DefInstance.Text1.Text = Form1.DefInstance.Text1.Text & "Msn Messenger Contact List Window Closed" & vbCrLf

        End Select

    End Sub

    Public Function hookmenu(ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

        Select Case wMsg
            Case WM_COMMAND
                Form1.DefInstance.Text1.Text = Form1.DefInstance.Text1.Text & "SubMenu " & wParam - Offset & " was selected" & vbCrLf

                If wParam = 2001 Then MsgBox("Test 1")
                If wParam = 2002 Then MsgBox("Test 2")
                If wParam = 2003 Then MsgBox("Test 3")
                If wParam = 2004 Then MsgBox("VB Hook Tutorial" & vbCrLf & "Created by Stigmata" & vbCrLf & "(If you are going to steal, please credit)")
                If wParam > Offset Then
                End If
        End Select

    End Function
End Module


PHP: 
Option Strict Off
Option Explicit On 
Public Class Form1
    Inherits System.Windows.Forms.Form
#Region "Windows Form Designer generated code "
    Public Sub New()
        MyBase.New()
        If m_vb6FormDefInstance Is Nothing Then
            If m_InitializingDefInstance Then
                m_vb6FormDefInstance = Me
            Else
                Try
                    'For the start-up form, the first instance created is the default instance.
                    If System.Reflection.Assembly.GetExecutingAssembly.EntryPoint.DeclaringType Is Me.GetType Then
                        m_vb6FormDefInstance = Me
                    End If
                Catch
                End Try
            End If
        End If
        'This call is required by the Windows Form Designer.
        InitializeComponent()
    End Sub
    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal Disposing As Boolean)
        If Disposing Then
            If Not components Is Nothing Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(Disposing)
    End Sub
    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer
    Public ToolTip1 As System.Windows.Forms.ToolTip
    Public WithEvents Text1 As System.Windows.Forms.TextBox
    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Form1))
        Me.components = New System.ComponentModel.Container
        Me.ToolTip1 = New System.Windows.Forms.ToolTip(components)
        Me.ToolTip1.Active = True
        Me.Text1 = New System.Windows.Forms.TextBox
        Me.Text = "VB Messenger Hook Code"
        Me.ClientSize = New System.Drawing.Size(640, 315)
        Me.Location = New System.Drawing.Point(4, 30)
        Me.StartPosition = System.Windows.Forms.FormStartPosition.WindowsDefaultLocation
        Me.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.BackColor = System.Drawing.SystemColors.Control
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.Sizable
        Me.ControlBox = True
        Me.Enabled = True
        Me.KeyPreview = False
        Me.MaximizeBox = True
        Me.MinimizeBox = True
        Me.Cursor = System.Windows.Forms.Cursors.Default
        Me.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.ShowInTaskbar = True
        Me.HelpButton = False
        Me.WindowState = System.Windows.Forms.FormWindowState.Normal
        Me.Name = "Form1"
        Me.Text1.AutoSize = False
        Me.Text1.Size = New System.Drawing.Size(625, 249)
        Me.Text1.Location = New System.Drawing.Point(8, 8)
        Me.Text1.Multiline = True
        Me.Text1.ScrollBars = System.Windows.Forms.ScrollBars.Vertical
        Me.Text1.TabIndex = 0
        Me.Text1.Font = New System.Drawing.Font("Arial", 8.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
        Me.Text1.AcceptsReturn = True
        Me.Text1.TextAlign = System.Windows.Forms.HorizontalAlignment.Left
        Me.Text1.BackColor = System.Drawing.SystemColors.Window
        Me.Text1.CausesValidation = True
        Me.Text1.Enabled = True
        Me.Text1.ForeColor = System.Drawing.SystemColors.WindowText
        Me.Text1.HideSelection = True
        Me.Text1.ReadOnly = False
        Me.Text1.MaxLength = 0
        Me.Text1.Cursor = System.Windows.Forms.Cursors.IBeam
        Me.Text1.RightToLeft = System.Windows.Forms.RightToLeft.No
        Me.Text1.TabStop = True
        Me.Text1.Visible = True
        Me.Text1.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
        Me.Text1.Name = "Text1"
        Me.Controls.Add(Text1)
    End Sub
#End Region
#Region "Upgrade Support "
    Private Shared m_vb6FormDefInstance As Form1
    Private Shared m_InitializingDefInstance As Boolean
    Public Shared Property DefInstance() As Form1
        Get
            If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
                m_InitializingDefInstance = True
                m_vb6FormDefInstance = New Form1
                m_InitializingDefInstance = False
            End If
            DefInstance = m_vb6FormDefInstance
        End Get
        Set(ByVal Value As Form1)
            m_vb6FormDefInstance = Value
        End Set
    End Property
#End Region

    Public Function sethook() As Object
        Call SetCBTSHLHook(0, 0, 0)
        Call SetCWPMSGHook(0, 0, 0)
        If Not FindWindow("MSNHiddenWindowClass", vbNullString) = 0 Then
            MsgBox("Messenger is open, we must close it to continue." & vbCrLf & "It will be restarted after the hook is added")
            ShutdownMessenger((True))
Yeah:
            If Not FindWindow("MSNHiddenWindowClass", vbNullString) = 0 Then GoTo Yeah
            Call SetCBTSHLHook(-1, AddressOf hookmenu, 0)
            Shell("C:\Program Files\Msn Messenger\msnmsgr.exe")
            Exit Function
        End If

        Call SetCBTSHLHook(-1, AddressOf hookmenu, 0)
    End Function

    Private Sub Form1_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
        Call SetCBTSHLHook(0, 0, 0)
        Call SetCWPMSGHook(0, 0, 0)
    End Sub

    Private Sub ShutdownMessenger(ByRef bShowCloseMsg As Boolean)
        'Thanks to msnfanatic.com for this function.
        'http://www.fanatic.net.nz/2003/09/16/shutting-down-msn-messenger.html#more-13
        Dim hWnd As Integer
        Dim lMsg As Integer

        hWnd = FindWindow("MSNHiddenWindowClass", vbNullString)
        lMsg = RegisterWindowMessage("TryMsnMsgrShutdown")
        Call SendMessage(hWnd, lMsg, CInt(bShowCloseMsg) + 1, 0)

    End Sub

    Private Sub Text1_TextChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Text1.TextChanged
        Text1.SelectionLength = Len(Text1.Text)
    End Sub
End Class


wat doe ik verkeerd bij de delegate functie?
de compiler reageert dat integer (0) niet kan omgezet worden nr hookmenudelegate
Het archief is een bevroren moment uit een vorige versie van dit forum, met andere regels en andere bazen. Deze posts weerspiegelen op geen enkele manier onze huidige ideeën, waarden of wereldbeelden en zijn op sommige plaatsen gecensureerd wegens ontoelaatbaar. Veel zijn in een andere tijdsgeest gemaakt, al dan niet ironisch - zoals in het ironische subforum Off-Topic - en zouden op dit moment niet meer gepost (mogen) worden. Toch bieden we dit archief nog graag aan als informatiedatabank en naslagwerk. Lees er hier meer over of start een gesprek met anderen.
Terug
Bovenaan