?
Solved

DLL From VB To Delphi

Posted on 2004-11-26
6
Medium Priority
?
608 Views
Last Modified: 2010-04-16
I have the Following DLL IN VB (ShlHook.dll)
Can anyone help me change it to Delphi?
thx
All the project is here:
http://www.coderheaven.com/forum/download.php?id=226

VB Class Module (cShellHook)
'[CODE]
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function RegisterShellHook Lib "Shell32" Alias "#181" (ByVal hwnd As Long, ByVal nAction As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)

Const GWL_WNDPROC = (-4)
Const RSH_DEREGISTER = 0

Public Enum SheelHookTypes
       RSH_REGISTER = 1
       RSH_REGISTER_PROGMAN = 2
       RSH_REGISTER_TASKMAN = 3
End Enum

Private Enum ShellEvents
      HSHELL_WINDOWCREATED = 1
      HSHELL_WINDOWDESTROYED = 2
      HSHELL_ACTIVATESHELLWINDOW = 3
      HSHELL_WINDOWACTIVATED = 4
      HSHELL_GETMINRECT = 5
      HSHELL_REDRAW = 6
      HSHELL_TASKMAN = 7
      HSHELL_LANGUAGE = 8
      HSHELL_ACCESSIBILITYSTATE = 11
End Enum

Public Event WindowCreated(ByVal hwnd As Long)
Public Event WindowDestroyed(ByVal hwnd As Long)
Public Event WindowActivated(ByVal hwnd As Long)
Public Event LocaleChanged(ByVal LocaleID As Long)
Public Event TaskBarButtonRedraw(ByVal hwnd As Long)
Public Event TaskManActivated(ByVal hwnd As Long)
Public Event ShellWindowActivated()
Public Event AccesibilityStateChanged()

Dim m_var_hwnd As Long, bHookSet As Boolean

Public Function RemoveShellHook() As Boolean
   If Not bHookSet Then Exit Function
   Call RegisterShellHook(hwnd, RSH_DEREGISTER)
   SetWindowLong hwnd, GWL_WNDPROC, OldProc
   bHookSet = False
End Function

Public Function SetShellHook(ByVal hwnd As Long, ByVal HookType As SheelHookTypes) As Boolean
   uRegMsg = RegisterWindowMessage(ByVal "SHELLHOOK")
   Call RegisterShellHook(hwnd, HookType)
   OldProc = GetWindowLong(hwnd, GWL_WNDPROC)
   SetWindowLong hwnd, GWL_WNDPROC, AddressOf WndProc
   bHookSet = True
   SetShellHook = bHookSet
End Function

Private Sub Class_Initialize()
  SHptr = ObjPtr(Me)
End Sub

Friend Function FireEvent(nEvent As ShellEvents, lExtraInfo As Long)
   Dim pId As Long, tId As Long
   Select Case nEvent
      Case HSHELL_WINDOWCREATED
           RaiseEvent WindowCreated(lExtraInfo)
      Case HSHELL_WINDOWDESTROYED
           RaiseEvent WindowDestroyed(lExtraInfo)
      Case HSHELL_ACTIVATESHELLWINDOW
           RaiseEvent ShellWindowActivated
      Case HSHELL_WINDOWACTIVATED
           RaiseEvent WindowActivated(lExtraInfo)
      Case HSHELL_GETMINRECT
           RaiseEvent TaskBarButtonRedraw(lExtraInfo)
      Case HSHELL_REDRAW
           RaiseEvent TaskBarButtonRedraw(lExtraInfo)
      Case HSHELL_TASKMAN
           RaiseEvent TaskManActivated(lExtraInfo)
      Case HSHELL_LANGUAGE
           tId = GetWindowThreadProcessId(lExtraInfo, pId)
           RaiseEvent LocaleChanged(LoWord(GetKeyboardLayout(tId)))
      Case HSHELL_ACCESSIBILITYSTATE
           RaiseEvent AccesibilityStateChanged
      Case Else
   End Select
End Function

Private Function LoWord(DWORD As Long) As Integer
   If DWORD And &H8000& Then
      LoWord = &H8000 Or (DWORD And &H7FFF&)
   Else
      LoWord = DWORD And &HFFFF&
   End If
End Function

Private Sub Class_Terminate()
  RemoveShellHook
End Sub
'[/CODE]

VB Module
'[CODE]
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)

Public OldProc As Long
Public uRegMsg As Long
Public SHptr As Long

Public Function WndProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If wMsg = uRegMsg Then
     ResolvePointer(SHptr).FireEvent wParam, lParam
  Else
     WndProc = CallWindowProc(OldProc, hwnd, wMsg, wParam, lParam)
  End If
End Function

Private Function ResolvePointer(ByVal lpObj&) As cShellHook
  Dim oSH As cShellHook
  CopyMemory oSH, lpObj, 4&
  Set ResolvePointer = oSH
  CopyMemory oSH, 0&, 4&
End Function
'[/CODE]
0
Comment
Question by:instant_new
  • 2
3 Comments
 
LVL 26

Expert Comment

by:Eddie Shipman
ID: 12696429
I'm not even going to try that one. There are many ShellHook examples out there try searchng them first.
0
 

Expert Comment

by:deathman5
ID: 12719149
mmmm
all in VB
searched google, didnt find Delphi
I'll try searching other things
0
 
LVL 26

Accepted Solution

by:
Eddie Shipman earned 800 total points
ID: 13345553
Delphi-Jedi has the JvShellHook example.

http://www.delphi-jedi.org

See Jedi-VCL
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an anti-spam), the admin…
This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …
Suggested Courses

807 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question