Sure, it needs you to first register on www.Codes-SourceS.com , I
forget that 'Detail'
I know VbFrance.Com Is french, but english people are welcome...
I'm spying clipboard (I'm in the windows clipboard chain)
and as soon as i detect that clipboard as been changed from within the
VB6 IDE, I launch the convert process.
then, I put my brand new sContent String (HTML) in the clipboard,
under the 'HTML Format' Clipboard format. IE, Word etc recognize that
format, and prefer it over Text format...
quite simple, isn't it ?
I'm enhancing my syntax coloring class... The process runs faster, and
I added some new options... I will upload soon.
'moHighlighter' is my syntax coloring class
Here is the code of the spying module...
just launch StartSpying/StopSpying from outside
Option Explicit
Private Const GWL_WNDPROC As Long = -4
Private Const WM_CHANGECBCHAIN = &H30D
Private Const WM_DESTROY = &H2
Private Const WM_DESTROYCLIPBOARD As Long = &H307
Private Const WM_DRAWCLIPBOARD = &H308
Private Const GMEM_MOVEABLE As Long = &H2
Private Const PROCESS_VM_READ As Long = (&H10)
Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)
Private Const CF_TEXT As Long = 1
Private Declare Function DefWindowProc Lib "user32.dll" Alias
"DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam
As Long, ByVal lParam As Long) As Long
Private Declare Function GetModuleHandle Lib "kernel32.dll" Alias
"GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal
dwNewLong As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias
"RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal
Length As Long)
Private Declare Function CreateWindowEx Lib "user32.dll" Alias
"CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As
String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x
As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long,
ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As
Long, ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hWnd As
Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal
wFormat As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags
As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As
Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As
Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem
As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As
Long) As Long
Private Declare Function RegisterClipboardFormat Lib "user32.dll"
Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal
wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function SetClipboardViewer Lib "user32.dll" (ByVal
hWnd As Long) As Long
Private Declare Function ChangeClipboardChain Lib "user32.dll" (ByVal
hWnd As Long, ByVal hWndNext As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam
As Long, ByRef lParam As Any) As Long
Private Declare Function GetClipboardOwner Lib "user32.dll" () As Long
Private Declare Function GetModuleFileNameEx Lib "psapi.dll" Alias
"GetModuleFileNameExA" (ByVal hProcess As Long, ByVal hModule As Long,
ByVal lpFilename As String, ByVal nSize As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib
"user32.dll" (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject
As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal
dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal
dwProcessId As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib
"user32.dll" (ByVal wFormat As Long) As Long
Private mhCBWindow As Long
Private mhNextInCBChain As Long
Private HTML_FORMAT As Long
Private mhData As Long
Public VbPath As String
Public VBInstance As VBE
Public moHighlighter As CSyntaxHighlighter
Public Sub StartSpying()
HTML_FORMAT = RegisterClipboardFormat("HTML Format")
mhCBWindow = CreateWindowEx(0, "STATIC", vbNullString, 0, 0, 0, 0,
0, 0, 0, 0, ByVal 0&)
If mhCBWindow Then
SetWindowLong mhCBWindow, GWL_WNDPROC, ProcPtr(AddressOf
CBProc)
mhNextInCBChain = SetClipboardViewer(mhCBWindow)
End If
End Sub
Public Sub StopSpying()
ChangeClipboardChain mhCBWindow, mhNextInCBChain
DestroyWindow mhCBWindow
End Sub
Private Function ProcPtr(ByVal vnProc As Long) As Long
ProcPtr = vnProc
End Function
Private Function CBProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal
wParam As Long, ByVal lParam As Long) As Long
Dim hPid As Long
Dim hProcess As Long
Dim sBuffer As String
Dim nLength As Long
Select Case uMsg
Case WM_CHANGECBCHAIN
If wParam = mhNextInCBChain Then
mhNextInCBChain = lParam
ElseIf mhNextInCBChain Then
SendMessage mhNextInCBChain, uMsg, wParam, ByVal
lParam
End If
Case WM_DRAWCLIPBOARD
If 0 = IsClipboardFormatAvailable(HTML_FORMAT) And
IsClipboardFormatAvailable(CF_TEXT) <> 0 Then
GetWindowThreadProcessId GetClipboardOwner, hPid
hProcess = OpenProcess(PROCESS_VM_READ Or
PROCESS_QUERY_INFORMATION, 0, hPid)
If hProcess Then
sBuffer = Space$(260)
nLength = GetModuleFileNameEx(hProcess, 0,
sBuffer, 260)
sBuffer = Left$(sBuffer, nLength)
CloseHandle hProcess
If StrComp(sBuffer, ModMain.VbPath, vbTextCompare)
= 0 Then
On Error Resume Next
GenerateHTMLClipboard
End If
End If
End If
If mhNextInCBChain Then
SendMessage mhNextInCBChain, uMsg, wParam, ByVal
lParam
End If
Case WM_DESTROYCLIPBOARD
If mhData Then
GlobalFree mhData
mhData = 0
End If
Case Else
DefWindowProc hWnd, uMsg, wParam, lParam
End Select
End Function
Private Sub GenerateHTMLClipboard()
Dim pData As Long
Dim nLength As Long
Dim sCode As String
sCode = moHighlighter.Convert(Clipboard.GetText)
nLength = Len(sCode)
'# On génère l'entête HTML Format
sCode = "Version:0.9" & vbNewLine & _
"StartHTML:00000097" & vbNewLine & _
"EndHTML:" & Format$(170 + nLength, "00000000") &
vbNewLine & _
"StartFragment:00000134" & vbNewLine & _
"EndFragment:" & Format$(134 + nLength, "00000000") &
vbNewLine & _
"<html><body>" & vbNewLine & _
"<!--StartFragment -->" & vbNewLine & _
sCode & vbNewLine & _
"<!--EndFragment-->" & vbNewLine & _
"</body></html>" & vbNewLine
'# On place notre buffer dans le presse papiers
mhData = GlobalAlloc(GMEM_MOVEABLE, Len(sCode))
If mhData Then
pData = GlobalLock(mhData)
If pData Then
CopyMemory ByVal pData, ByVal sCode, Len(sCode)
GlobalUnlock mhData
End If
OpenClipboard mhCBWindow
SetClipboardData HTML_FORMAT, mhData
CloseClipboard
End If
End Sub
Renfield - Microsoft Visual Basic MVP