Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0657: Gewähltes Programm aus dem "Öffnen mit"-Dialog auslesen

VB 5/6-Tipp 0657: Gewähltes Programm aus dem "Öffnen mit"-Dialog auslesen

 von Philipp Stephani

Schwierigkeitsgrad:

Verwendete API-Aufrufe: CreateProcessA, CreateProcessW, FreeLibrary, GetMem4, ImageNtHeader, LoadLibraryA, OpenAs_RunDLLA, PutMem4, RtlMoveMemory, VirtualProtect, lstrcmpA, lstrcmpiA, lstrlenA, lstrlenW

Download: Download des Beispielprojektes [3,37 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'------- Anfang Modul "Module1" alias modOpenWith.bas -------

Option Explicit

Private Declare Sub GetMem4 Lib "msvbvm60.dll" ( _
    ByVal Source As Long, _
    ByRef Destination As Long _
    )
    
Private Declare Sub PutMem4 Lib "msvbvm60.dll" ( _
    ByVal Destination As Long, _
    ByVal Source As Long _
    )
    
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" ( _
    ByVal Destination As Long, _
    ByVal Source As Long, _
    ByVal Length As Long _
    )
    
Private Declare Function CreateProcessW Lib "kernel32.dll" ( _
    ByVal lpApplicationName As Long, _
    ByVal lpCommandLine As Long, _
    ByVal lpProcessAttributes As Long, _
    ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, _
    ByVal lpStartupInfo As Long, _
    ByVal lpProcessInformation As Long _
    ) As Long
    
Private Declare Function CreateProcessA Lib "kernel32.dll" ( _
    ByVal lpApplicationName As Long, _
    ByVal lpCommandLine As Long, _
    ByVal lpProcessAttributes As Long, _
    ByVal lpThreadAttributes As Long, _
    ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, _
    ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, _
    ByVal lpStartupInfo As Long, _
    ByVal lpProcessInformation As Long _
    ) As Long
    
Private Declare Function LoadLibraryA Lib "kernel32.dll" ( _
    ByVal lpLibFileName As String _
    ) As Long
    
Private Declare Function FreeLibrary Lib "kernel32.dll" ( _
    ByVal hLibModule As Long _
    ) As Long
    
Private Declare Function VirtualProtect Lib "kernel32.dll" ( _
    ByVal lpAddress As Long, _
    ByVal dwSize As Long, _
    ByVal flNewProtect As Long, _
    ByRef lpflOldProtect As Long _
    ) As Long
    
Private Declare Function lstrlenW Lib "kernel32.dll" ( _
    ByVal lpString As Long _
    ) As Long
    
Private Declare Function lstrlenA Lib "kernel32.dll" ( _
    ByVal lpString As Long _
    ) As Long
    
Private Declare Function lstrcmpA Lib "kernel32.dll" ( _
    ByVal lpString1 As Long, _
    ByVal lpString2 As String _
    ) As Long
    
Private Declare Function lstrcmpiA Lib "kernel32.dll" ( _
    ByVal lpString1 As Long, _
    ByVal lpString2 As String _
    ) As Long
    
Private Declare Function ImageNtHeader Lib "imagehlp.dll" ( _
    ByVal ImageBase As Long _
    ) As Long
    
Private Declare Function OpenAs_RunDLLA Lib "shell32.dll" ( _
    ByVal hWnd As Long, _
    ByVal hInstance As Long, _
    ByVal lpszCmdLine As String, _
    ByVal nCmdShow As Long _
    ) As Long

Private Const PAGE_READWRITE As Long = &H4&
Private Const IMAGE_NUMBEROF_DIRECTORY_ENTRIES As Long = 16&
Private Const IMAGE_DIRECTORY_ENTRY_IMPORT As Long = 1&

Private Type IMAGE_FILE_HEADER
    Machine As Integer
    NumberOfSections As Integer
    TimeDateStamp As Long
    PointerToSymbolTable As Long
    NumberOfSymbols As Long
    SizeOfOptionalHeader As Integer
    Characteristics As Integer
End Type

Private Type IMAGE_DATA_DIRECTORY
    VirtualAddress As Long
    Size As Long
End Type

Private Type IMAGE_OPTIONAL_HEADER
    Magic As Integer
    MajorLinkerVersion As Byte
    MinorLinkerVersion As Byte
    SizeOfCode As Long
    SizeOfInitializedData As Long
    SizeOfUninitializedData As Long
    AddressOfEntryPoint As Long
    BaseOfCode As Long
    BaseOfData As Long
    ImageBase As Long
    SectionAlignment As Long
    FileAlignment As Long
    MajorOperatingSystemVersion As Integer
    MinorOperatingSystemVersion 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(0 To IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1) As _
        IMAGE_DATA_DIRECTORY
End Type

Private Type IMAGE_NT_HEADERS
    Signature As Long
    FileHeader As IMAGE_FILE_HEADER
    OptionalHeader As IMAGE_OPTIONAL_HEADER
End Type

Private Type IMAGE_IMPORT_DESCRIPTOR
    ImportLookupTableRVA As Long
    TimeDateStamp As Long
    ForwarderChain As Long
    NameRVA As Long
    ImportAddressTableRVA As Long
End Type


Private Sub Main()
    Dim ModuleBase As Long
    Dim HeaderPointer As Long
    Dim HeaderData As IMAGE_NT_HEADERS
    Dim ImportTablePointer As Long
    Dim ImportTableData As IMAGE_IMPORT_DESCRIPTOR
    Dim LookupTablePointer As Long
    Dim LookupTableData As Long
    Dim AddressTablePointer As Long
    Dim FunctionName As Long
    Dim FunctionPointerW As Long
    Dim FunctionPointerA As Long
    Dim OriginalAddressW As Long
    Dim OriginalAddressA As Long
    Dim Protection As Long

    ModuleBase = LoadLibraryA("shell32.dll")
    
    HeaderPointer = ImageNtHeader(ModuleBase)
    
    RtlMoveMemory VarPtr(HeaderData), HeaderPointer, Len(HeaderData)
    
    With HeaderData.OptionalHeader
        ImportTablePointer = ModuleBase + _
            .DataDirectory(IMAGE_DIRECTORY_ENTRY_IMPORT).VirtualAddress
    End With
    
    Do
        RtlMoveMemory VarPtr(ImportTableData), ImportTablePointer, _
            Len(ImportTableData)
        
        If lstrcmpiA(ModuleBase + ImportTableData.NameRVA, _
            "kernel32.dll") = 0 Then
            
            LookupTablePointer = ModuleBase + _
                ImportTableData.ImportLookupTableRVA
                
            AddressTablePointer = ModuleBase + _
                ImportTableData.ImportAddressTableRVA
            
            Do
                GetMem4 LookupTablePointer, LookupTableData
                
                If LookupTableData = 0 Then Exit Do
                
                    If (LookupTableData And &H80000000) = &H0& Then
                        FunctionName = ModuleBase + _
                            (LookupTableData And &H7FFFFFFF) + 2
                        
                        If lstrcmpA(FunctionName, "CreateProcessW") = 0 Then
                            FunctionPointerW = AddressTablePointer
                        ElseIf lstrcmpA(FunctionName, "CreateProcessA") = 0 Then
                            FunctionPointerA = AddressTablePointer
                        End If
                End If
                    
                LookupTablePointer = LookupTablePointer + 4
                AddressTablePointer = AddressTablePointer + 4
            Loop
            
            Exit Do
        End If
        
        ImportTablePointer = ImportTablePointer + Len(ImportTableData)
    Loop

    If FunctionPointerW Then
        VirtualProtect FunctionPointerW, 4, PAGE_READWRITE, Protection
        GetMem4 FunctionPointerW, OriginalAddressW
        PutMem4 FunctionPointerW, AddressOf CreateProcessHookW
    End If
    
    If FunctionPointerA Then
        VirtualProtect FunctionPointerW, 4, PAGE_READWRITE, Protection
        GetMem4 FunctionPointerA, OriginalAddressA
        PutMem4 FunctionPointerA, AddressOf CreateProcessHookA
    End If
    
    OpenAs_RunDLLA 0, 0, "C:\Bootlog.txt", 0

    If FunctionPointerW Then PutMem4 FunctionPointerW, OriginalAddressW
    If FunctionPointerA Then PutMem4 FunctionPointerA, OriginalAddressA

    FreeLibrary ModuleBase
End Sub

Private Function CreateProcessHookW(ByVal lpApplicationName As Long, _
    ByVal lpCommandLine As Long, ByVal lpProcessAttributes As Long, _
    ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, ByVal lpStartupInfo As Long, _
    ByVal lpProcessInformation As Long) As Long
    
    If Prompt(PtrToStrW(lpApplicationName), PtrToStrW(lpCommandLine)) Then
        CreateProcessHookW = CreateProcessW(lpApplicationName, _
            lpCommandLine, lpProcessAttributes, lpThreadAttributes, _
            bInheritHandles, dwCreationFlags, lpEnvironment, _
            lpCurrentDirectory, lpStartupInfo, lpProcessInformation)
    End If
End Function


Private Function CreateProcessHookA(ByVal lpApplicationName As Long, _
    ByVal lpCommandLine As Long, ByVal lpProcessAttributes As Long, _
    ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, _
    ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, _
    ByVal lpCurrentDirectory As Long, ByVal lpStartupInfo As Long, _
    ByVal lpProcessInformation As Long) As Long
    
    If Prompt(PtrToStrA(lpApplicationName), PtrToStrA(lpCommandLine)) Then
        CreateProcessHookA = CreateProcessA(lpApplicationName, lpCommandLine, _
            lpProcessAttributes, lpThreadAttributes, bInheritHandles, _
            dwCreationFlags, lpEnvironment, lpCurrentDirectory, _
            lpStartupInfo, lpProcessInformation)
    End If
End Function


Private Function PtrToStrW(ByVal Pointer As Long) As String
    Dim Length As Long
    
    If Pointer Then
        Length = lstrlenW(Pointer)
        If Length > 0 Then
            PtrToStrW = String$(Length, 0)
            RtlMoveMemory StrPtr(PtrToStrW), Pointer, Length * 2
        End If
    End If
End Function

Private Function PtrToStrA(ByVal Pointer As Long) As String
    Dim Length As Long
    Dim Buffer() As Byte
    
    If Pointer Then
        Length = lstrlenA(Pointer)
        If Length > 0 Then
            ReDim Buffer(0 To Length - 1)
            RtlMoveMemory VarPtr(Buffer(0)), Pointer, Length
            PtrToStrA = StrConv(Buffer, vbUnicode)
        End If
    End If
End Function

Private Function Prompt(ByRef AppName As String, _
    ByRef CmdLine As String) As Boolean
    
    Prompt = (MsgBox("Es wird versucht, folgende Befehlszeile " & _
        "auszuführen:" & vbNewLine & CmdLine & vbNewLine & vbNewLine & _
        "Dazu soll folgendes Programm verwendet werden: " & vbNewLine & _
        AppName & vbNewLine & vbNewLine & _
        "Wollen Sie das zulassen?", vbYesNo Or vbQuestion) = vbYes)
End Function
'-------- Ende Modul "Module1" alias modOpenWith.bas --------
'-------------- Ende Projektdatei Projekt1.vbp --------------