Stop Button der IDE abfangen End-Anweisung und Stop-Button beim Ausführen dre Anwendung innerhalb der IDE abfangen, um Subclassing u.ä. rechtzeitig abzubrechen
Autor:   Arne Elster	Bewertung:     [ Jetzt bewerten ]	Views:  11.533
actorics.de/rm_code	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 19 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.3 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Hinweis:
Dieser Tipp bezieht sich nur auf VB6!

Mit simplem Subclassing und anderen Hooks läuft man schnell Gefahr, die Entwicklungsumgebung aus heiterem Himmel ins Nirvana zu schießen.

Dieser Tipp demonstriert eine Technik, zumindest den Stop Button der IDE sowie den End Befehl abzufangen, um in diesen Fällen das Programm noch sicher zu Ende zu bringen.

Die eigentliche Funktion für den Stop des Programms in der IDE heißt "EbProjectReset", und befindet sich in vba6.dll. Sie wird aufgerufen, wenn man in der Entwicklungsumgebung ein Programm startet, und wenn man es beendet. Könnte man also herausfinden, wann EbProjectReset wirksam wird, könnte man auch oben vorgestelltes Konzept umsetzen.

Die Lösung ist, den Eintrag "EbProjectReset" in der IAT (Import Address Table) von vb6.exe so umzubiegen, dass er auf eine eigene statt auf die tatsächliche Funktion zeigt. VB ruft dann erst unsere Funktion auf, die dann zu EbProjectReset weiterleitet. Es ist quasi ein Abhören der Funktion.

Umsetzung
Code des Moduls "StopProtect", der eigentliche Hook:

Option Explicit
 
Private Const IMAGE_NUMBEROF_DIRECTIRY_ENRIES As Long = 16&
Private Const STANDARD_RIGHTS_REQUIRED        As Long = &HF0000
Private Const PAGE_EXECUTE_READWRITE          As Long = &H40&
Private Const IMAGE_NT_SIGNATURE              As Long = &H4550
 
Private Type IMAGE_DATA_DIRECTORY
  VirtualAddress          As Long
  Size                    As Long
End Type
 
Private Type IMAGE_OPTIONAL_HEADER32
  Magic                   As Integer
  MajorLinkerVersion      As Byte
  MinorLinkerVersion      As Byte
  SizeOfCode              As Long
  SizeOfInitalizedData    As Long
  SizeOfUninitalizedData  As Long
  AddressOfEntryPoint     As Long
  BaseOfCode              As Long
  BaseOfData              As Long
  ImageBase               As Long
  SectionAlignment        As Long
  FileAlignment           As Long
  MajorOperatingSystemVer As Integer
  MinorOperatingSystemVer As Integer
  MajorImageVersion       As Integer
  MinorImageVersion       As Integer
  MajorSubsystemVersion   As Integer
  MinorSubsystemVersion   As Integer
  Reserved1               As Long
  SizeOfImage             As Long
  SizeOfHeaders           As Long
  CheckSum                As Long
  Subsystem               As Integer
  DllCharacteristics      As Integer
  SizeOfStackReserve      As Long
  SizeOfStackCommit       As Long
  SizeOfHeapReserve       As Long
  SizeOfHeapCommit        As Long
  LoaderFlags             As Long
  NumberOfRvaAndSizes     As Long
  DataDirectory(IMAGE_NUMBEROF_DIRECTIRY_ENRIES - 1) As _
    IMAGE_DATA_DIRECTORY
End Type
 
Private Type IMAGE_DOS_HEADER
  e_magic                 As Integer
  e_cblp                  As Integer
  e_cp                    As Integer
  e_crlc                  As Integer
  e_cparhdr               As Integer
  e_minalloc              As Integer
  e_maxalloc              As Integer
  e_ss                    As Integer
  e_sp                    As Integer
  e_csum                  As Integer
  e_ip                    As Integer
  e_cs                    As Integer
  e_lfarlc                As Integer
  e_onvo                  As Integer
  e_res(3)                As Integer
  e_oemid                 As Integer
  e_oeminfo               As Integer
  e_res2(9)               As Integer
  e_lfanew                As Long
End Type
 
Private Declare Sub CpyMem Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  pDst As Any, _
  pSrc As Any, _
  Optional ByVal dwLen As Long = 4)
 
Private Declare Function IsBadCodePtr Lib "kernel32" ( _
  ByVal addr As Long) As Long
 
Private Declare Function VirtualAlloc Lib "kernel32" ( _
  ByVal lpAddress As Long, _
  ByVal dwSize As Long, _
  ByVal flAllocType As Long, _
  ByVal flProtect As Long) As Long
 
Private Declare Function VirtualProtect Lib "kernel32" ( _
  lpAddress As Any, _
  ByVal dwSize As Long, _
  ByVal flNewProtect As Long, _
  lpflOldProtect As Long) As Long
 
Private Declare Function GetProcAddress Lib "kernel32" ( _
  ByVal hModule As Long, _
  ByVal lpProcName As String) As Long
 
Private Declare Function GetModuleHandle Lib "kernel32" _
  Alias "GetModuleHandleA" ( _
  ByVal lpModuleName As String) As Long
 
Private Const MEM_COMMIT    As Long = &H1000&
Private Const PAGE_EXEC_RW  As Long = &H40&
 
Private m_ptrASM            As Long
Private m_lngPtrRestore     As Long
Private m_lngOldAddress     As Long
 
Private Const HOOK_FNC_NAME As String = "EbProjectReset"

Public Sub InitStopProtection()
  Dim ptr As Long
 
  If IsInIDE() Then
    ' Ausführbaren Speicher für Maschinencode holen
    m_ptrASM = VirtualAlloc(0, 30, MEM_COMMIT, PAGE_EXEC_RW)
    ptr = m_ptrASM
 
    m_lngOldAddress = GetLibFncAddr("vba6.dll", HOOK_FNC_NAME)
    m_lngPtrRestore = HookIATEntry("vb6.exe", "vba6.dll", HOOK_FNC_NAME, m_ptrASM)
 
    ' Maschinencode der ausgeführt wird bei Programmstop
    '
    ' Ruft zunächst die Methode "StopProtection" auf,
    ' entfernt dann den Hook und springt zum Schluss
    ' zu EbProjectReset
    WriteCall ptr, GetFunctionPointer(AddressOf StopProtection)
    WriteByte ptr, &HC7                 ' MOV
    WriteByte ptr, &H5
    WriteLong ptr, m_lngPtrRestore      ' [IAT EINTRAG]
    WriteLong ptr, m_lngOldAddress      ' , ADRESSE VON EbProjectReset
    WriteJump ptr, m_lngOldAddress
  End If
End Sub

' Ermittelt die Adresse einer Funktion eines Moduls im eigenen Prozessraum
Private Function GetLibFncAddr(ByVal lib As String, ByVal fnc As String) As Long
  Dim hLib As Long
 
  hLib = GetModuleHandle(lib)
  If hLib <> 0 Then
    GetLibFncAddr = GetProcAddress(hLib, fnc)
  End If
End Function

' Ändert die Adresse, auf die ein Import Address
' Table Eintrag eines Moduls zeigt
Private Function HookIATEntry( _
  ByVal module As String, ByVal lib As String, _
  ByVal fnc As String, ByVal NewAddr As Long) As Long
 
  Dim hMod    As Long
  Dim lngOld  As Long
  Dim lpIAT   As Long
  Dim IATLen  As Long
  Dim IATPos  As Long
  Dim DOSHdr  As IMAGE_DOS_HEADER
  Dim PEHdr   As IMAGE_OPTIONAL_HEADER32
 
  hMod = GetModuleHandle(module)
  If hMod = 0 Then Exit Function
 
  lngOld = GetLibFncAddr(lib, fnc)
  If lngOld = 0 Then Exit Function
 
  CpyMem DOSHdr, ByVal hMod, LenB(DOSHdr)
  CpyMem PEHdr, ByVal hMod + DOSHdr.e_lfanew, LenB(PEHdr)
 
  If PEHdr.Magic = IMAGE_NT_SIGNATURE Then
    ' Position der IAT des Moduls im Speicher
    lpIAT = PEHdr.DataDirectory(15).VirtualAddress + hMod
    IATLen = PEHdr.DataDirectory(15).Size
    IATPos = lpIAT
 
    ' IAT Eintrag finden, indem alle Einträge mit der
    ' Adresse, die wir dank GetLibFncAddr bereits wissen,
    ' verglichen werden
    Do Until IATPos >= lpIAT + IATLen
      If DeRef(IATPos) = lngOld Then
        PutMem IATPos, NewAddr
        HookIATEntry = IATPos
        Exit Do
      End If
      IATPos = IATPos + 4
    Loop
  End If
End Function

' Liest 4 Bytes von einer Speicherstelle
Private Function DeRef(ByVal addr As Long) As Long
  CpyMem DeRef, ByVal addr
End Function

' Schreibt 4 Bytes an eine Speicherstelle und
' stellt sicher dass dort Schreibrechte gegeben sind
Private Function PutMem(ByVal lpAddr As Long, ByVal lVal As Long) As Boolean
  Dim lngOldProtect As Long
 
  If 0 <> VirtualProtect(ByVal lpAddr, 4, PAGE_EXECUTE_READWRITE, lngOldProtect) Then
    CpyMem ByVal lpAddr, lVal
    ' Alten Schutz der Page nicht wiederherstellen,
    ' da sonst der Maschinencode keine Schreibberechtigung haben könnte
    ' => Crash
    'VirtualProtect ByVal lpAddr, 4, lngOldProtect, lngOldProtect
    PutMem = True
  End If
End Function

' Schreibt eine JMP Instruktion an eine Speicherstelle
Private Sub WriteJump(pASM As Long, addr As Long)
  WriteByte pASM, &HE9
  WriteLong pASM, addr - pASM - 4
End Sub

' Schreibt eine CALL Instruktion an eine Speicherstelle
Private Sub WriteCall(pASM As Long, addr As Long)
  WriteByte pASM, &HE8
  WriteLong pASM, addr - pASM - 4
End Sub

' Schreibt 32 Bit Integer an eine Speicherstelle
Private Sub WriteLong(pASM As Long, lng As Long)
  CpyMem ByVal pASM, lng, 4
  pASM = pASM + 4
End Sub

' Schreibt Byte an eine Speicherstelle
Private Sub WriteByte(pASM As Long, Bt As Byte)
  CpyMem ByVal pASM, Bt, 1
  pASM = pASM + 1
End Sub

' Verbessertes AddressOf für VB 6
Private Function GetFunctionPointer(ByVal addrof As Long) As Long
  Dim pAddr As Long
 
  If IsInIDE() Then
    ' Wird das Programm aus der Entwicklungsumgebung heraus
    ' ausgeführt, befindet sich der eigentliche Zeiger auf
    ' eine Funktion bei (AddressOf X) + 22, AddressOf X
    ' selber zeigt nur auf einen Stub. (getestet mit VB 6)
    CpyMem pAddr, ByVal addrof + 22, 4
    If IsBadCodePtr(pAddr) Then pAddr = addrof
  Else
    pAddr = addrof
  End If
 
  GetFunctionPointer = pAddr
End Function

' Prüft ob Programm in der Entwicklungsumgebung läuft
Private Function IsInIDE() As Boolean
  On Error GoTo NotCompiled
 
  Debug.Print 1 / 0
  Exit Function
 
NotCompiled:
  IsInIDE = True
End Function

In ein Modul "StopHandler", die Funktion, die ausgeführt wird wenn das Projekt beendet wird:

Option Explicit
 
Public Sub StopProtection()
  ' Hier können beliebige Aktionen ausgeführt werden,
  ' wie etwa Subclassing abbrechen, Handles schließen o.ä.,
  ' bevor das Programm beendet wird.
 
  ' WIRD NUR IN DER ENTWICKLUNGSUMGEBUNG AUSGEFÜHRT!
 
  MsgBox "PROGRAMM WIRD GERADE GESTOPPT!", vbCritical, "HOOK"
End Sub

Um den Stop Schutz im eigenen Projekt zu nutzen, reicht ein einziger Funktionsaufruf:

Private Sub Form_Load()
  ' Um die Stopsicherung zu nutzen,
  ' einfach das Modul ins eigene Projekt kopieren
  ' und bei Projektstart folgende Zeile aufrufen
 
  InitStopProtection
 
  ' ACHTUNG! PRO START DES PROJEKTS WERDEN
  ' 4 KB RAM VERBRAUCHT DIE NICHT WIEDER
  ' FREIGEGEBEN WERDEN BIS ZUM BEENDEN VON VB 6!
End Sub