PDA

View Full Version : Visual Basic - Sample Project (1) for Igor Plugin



worel
March 15th, 2005, 10:28 AM
Hi,


below you find a VB6 (visual basic 6) sample project for the Igor plugin.
The "IgorPlug.dll" is a plugin DLL, written by Igor.

The project does the following :

When you press any button on the remote control, a
string like (e.g.) "A4F6" pops up in the girder-statusbar-window.

The vb program reads the girder statusbar text, and shows the string
in a huge Label with large characters.

The label is nearly as large as the whole screen.

-So you can be five meters far away from the monitor, and you'll still
be able to read the characters.

-If you are a visual basic programmer, you can also log the strings,
analyze the strings - et cetera.



Tested on Win98SE with girder3.2.9

Needs:
1 Button, 1 Label, 1 Timer
1 Module, named "drMemory"



____________________

Form1:
____________________

Dim bText As String, bTextOld As String, GirderHwnd As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long

Const WM_USER = &H400&
Const SB_GETTEXTLENGTH = (WM_USER + 3)
Const SB_GETPARTS = (WM_USER + 6)
Const SB_GETTEXT = (WM_USER + 2)
Const SB_ISSIMPLE = (WM_USER + 14)

Private Sub Command1_Click()
Shell "C:\Programs\girder3.2.9\Girder.exe", vbNormalNoFocus
End Sub

Private Sub Form_Load()
BackColor = RGB(144, 166, 166): Label1 = "": Command1.Caption = "Start Girder"
Label1.Alignment = 2: Label1.Font = "arial": Label1.FontSize = 96

Command1.Height = 15 * 40: Command1.Width = 15 * 120
Command1.Move Screen.Width - Command1.Width - 10 * 15, 15 * 10

Label1.Move 15 * 100, 15 * 100
Label1.Width = Screen.Width - 15 * 200: Label1.Height = 15 * 200

WindowState = 2: Timer1.Interval = 333: Find_Girder
End Sub

Sub GetStatusBarText(ByVal hStatusbar As Long, ByVal panel_Number As Long)
bText = ""
Dim xpBuffer As Long ' address of cross-process buffer
Dim myBuffer(255) As Byte

' Need a buffer? Ask Dr Memory!
'allocate the buffer, 255 bytes
xpBuffer = drMemoryAlloc(xpWindow, 255)

'Put the text into the buffer
'lRet = text length
'The first button has an index of 0
lRet = SendMessage(hStatusbar, SB_GETTEXT, panel_Number - 1, xpBuffer)

'if lRet > 0 then copy the buffer over to our local buffer
drMemoryRead xpBuffer, VarPtr(myBuffer(0)), 255

'free the remote buffer
drMemoryFree xpBuffer

'convert byte array to a VB string of proper length
If lRet > 0 Then
bText = StrConv(myBuffer, vbUnicode)
bText = Left(bText, lRet)

If bText <> bTextOld Then
Label1.Caption = bText: bTextOld = bText
End If
Else
If bTextOld = "" Then Label1.Caption = "wait"
End If

End Sub

Private Sub Find_Girder()
o = FindWindow("TForm1", vbNullString)
o = FindWindowEx(o, 0, "TStatusBar", vbNullString)
GirderHwnd = o
End Sub

Private Sub Timer1_Timer()
Call Find_Girder
If GirderHwnd = 0 Then Caption = "Girder missing": Exit Sub
If GirderHwnd > 0 Then Caption = "Girder Found"

GetStatusBarText GirderHwnd, 2
End Sub













____________________

Module1:
____________________

Option Explicit
Private PlatformKnown As Boolean ' have we identified the platform?
Private NTflag As Boolean ' if so, are we NT family (NT, 2K,XP) or non-NT (9x)?

Private fpHandle As Long ' the foreign-process instance handle. When we want
' memory on NT platforms, this is returned to us by
' OpenProcess, and we pass it in to VirtualAllocEx.

' We must preserve it, as we need it for read/write
' operations, and to release the memory when we've
' finished with it.

' For this reason, on NT/2K/XP platforms this module should only be used to
' interface with ONE TARGET PROCESS at a time. In the future I'll rewrite
' this as a class, which can handle multiple-targets, automatic allocation
' de-allocation, etc
'

'
'================== Platform Identification is necessary!
'
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Public WIN As OSVERSIONINFO

Private Declare Function GetVersionEx Lib "KERNEL32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
'
'================== Win95/98 Process Memory functions
Private Declare Function CreateFileMapping Lib "KERNEL32" Alias "CreateFileMappingA" (ByVal hFile As Long, ByVal lpFileMappigAttributes As Long, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Declare Function MapViewOfFile Lib "KERNEL32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function UnmapViewOfFile Lib "KERNEL32" (lpBaseAddress As Any) As Long
Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
'
'================== WinNT/2000 Process Memory functions
Private Declare Function OpenProcess Lib "KERNEL32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function VirtualAllocEx Lib "KERNEL32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "KERNEL32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function WriteProcessMemory Lib "KERNEL32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal lpBuffer As Long, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "KERNEL32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal lpBuffer As Long, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
'
'
'================== Common Platform
'
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Private Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (ByVal lpDest As Long, ByVal lpSource As Long, ByVal cBytes As Long)
Private Declare Function lstrlenA Lib "KERNEL32" (ByVal lpsz As Long) As Long
Private Declare Function lstrlenW Lib "KERNEL32" (ByVal lpString As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long

' ----------
Const PAGE_READWRITE = &H4
Const MEM_RESERVE = &H2000&
Const MEM_RELEASE = &H8000&
Const MEM_COMMIT = &H1000&
Const PROCESS_VM_OPERATION = &H8
Const PROCESS_VM_READ = &H10
Const PROCESS_VM_WRITE = &H20
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const SECTION_QUERY = &H1
Const SECTION_MAP_WRITE = &H2
Const SECTION_MAP_READ = &H4
Const SECTION_MAP_EXECUTE = &H8
Const SECTION_EXTEND_SIZE = &H10
Const SECTION_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SECTION_QUERY Or SECTION_MAP_WRITE Or SECTION_MAP_READ Or SECTION_MAP_EXECUTE Or SECTION_EXTEND_SIZE
Const FILE_MAP_ALL_ACCESS = SECTION_ALL_ACCESS


Public Function drMemoryAlloc(ByVal xpWindow As Long, ByVal nBytes As Long) As Long
'
' Returns pointer to a share-able buffer (size nBytes) in target process
' that owns xpWindow
'
Dim xpThread As Long ' target control's thread id
Dim xpID As Long ' process id
If WindowsNT Then
xpThread = GetWindowThreadProcessId(xpWindow, xpID)
drMemoryAlloc = VirtualAllocNT(xpID, nBytes)
Else
drMemoryAlloc = VirtualAlloc9X(nBytes)
End If
End Function

Public Sub drMemoryFree(ByVal mPointer As Long)
If WindowsNT Then
VirtualFreeNT mPointer
Else
VirtualFree9X mPointer
End If
End Sub

Public Sub drMemoryRead(ByVal xpBuffer As Long, ByVal myBuffer As Long, ByVal nBytes As Long)
If WindowsNT Then
ReadProcessMemory fpHandle, xpBuffer, myBuffer, nBytes, 0
Else
CopyMemory myBuffer, xpBuffer, nBytes
End If
End Sub

Public Sub drMemoryWrite(ByVal xpBuffer As Long, ByVal myBuffer As Long, ByVal nBytes As Long)
If WindowsNT Then
WriteProcessMemory fpHandle, xpBuffer, myBuffer, nBytes, 0
Else
CopyMemory xpBuffer, myBuffer, nBytes
End If
End Sub

Public Function WindowsNT() As Boolean
' return TRUE if NT-like platform (NT, 2000, XP, etc)
If Not PlatformKnown Then GetWindowsVersion
WindowsNT = NTflag
End Function

Public Function WindowsXP() As Boolean
' return TRUE only if XP
If Not PlatformKnown Then GetWindowsVersion
WindowsXP = NTflag And (WIN.dwMinorVersion <> 0)
End Function

Public Sub GetWindowsVersion()
WIN.dwOSVersionInfoSize = Len(WIN)
If (GetVersionEx(WIN)) = 0 Then Exit Sub ' in deep doo if this fails
NTflag = (WIN.dwPlatformId = 2)
PlatformKnown = True
End Sub

'============================================
' The NT/2000 Allocate and Release functions
'============================================

Private Function VirtualAllocNT(ByVal fpID As Long, ByVal memSize As Long) As Long
fpHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, fpID)
VirtualAllocNT = VirtualAllocEx(fpHandle, ByVal 0&, ByVal memSize, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
End Function

Private Sub VirtualFreeNT(ByVal MemAddress As Long)
Call VirtualFreeEx(fpHandle, ByVal MemAddress, 0&, MEM_RELEASE)
CloseHandle fpHandle
End Sub

'============================================
' The 95/98 Allocate and Release functions
'============================================

Private Function VirtualAlloc9X(ByVal memSize As Long) As Long
fpHandle = CreateFileMapping(&HFFFFFFFF, 0, PAGE_READWRITE, 0, memSize, vbNullString)
VirtualAlloc9X = MapViewOfFile(fpHandle, FILE_MAP_ALL_ACCESS, 0, 0, 0)
End Function

Private Sub VirtualFree9X(ByVal lpMem As Long)
UnmapViewOfFile lpMem
CloseHandle fpHandle
End Sub

Public Function dmWindowClass(ByVal hWindow As Long) As String
Dim className As String, cLen As Long
className = String(64, 0)
cLen = GetClassName(hWindow, className, 63)
If cLen > 0 Then className = Left(className, cLen)
dmWindowClass = className
End Function