Monday, March 30, 2020

Multithreading in VB6

Module for working with multithreading in VB6

I present the module for working with multithreading in VB6 for Standard EXE projects. This module is based on this solution with some bug fixing and the new functionality is added. The module doesn't require any additional dependencies and type libraries, works as in the IDE (all the functions work in the main thread) as in the compiled form.
To start working with the module, you need to call the Initialize function, which initializes the necessary data (it initializes the critical sections for exclusive access to the heaps of marshalinig and threads, modifies VBHeader (here is description), allocates a TLS slot for passing the parameters to the thread).
The main function of thread creation is vbCreateThread, which is an analog of the CreateThread function.
' // Create a new thread
Public Function vbCreateThread(ByVal lpThreadAttributes As Long, _
                               ByVal dwStackSize As Long, _
                               ByVal lpStartAddress As Long, _
                               ByVal lpParameter As Long, _
                               ByVal dwCreationFlags As Long, _
                               ByRef lpThreadId As Long, _
                               Optional ByVal bIDEInSameThread As Boolean = True) As Long
The function creates a thread and calls the function passed in the lpStartAddress parameter with the lpParameter parameter. In the IDE, the call is reduced to a simple call by the pointer implemented through DispCallFunc. In the compiled form, this function works differently. Because a thread requires initialization of project-specific data and initialization of the runtime, the parameters passed to lpStartAddress and lpParameter are temporarily stored into the heap by the PrepareData function, and the thread is created in the ThreadProc function, which immediately deals with the initialization and calling of the user-defined function with the user parameter. This function creates a copy of the VBHeader structure via CreateVBHeaderCopy and changes the public variable placement data in the:
VbPublicObjectDescriptor.lpPublicBytesVbPublicObjectDescriptor.lpStaticBytes structures (BTW it wasn't implemented in the previous version) so that global variables are not affected during initialization. Further, VBDllGetClassObject calls the FakeMain function (whose address is written to the modified VBHeader structure). To transfer user parameters, it uses a TLS slot (since Main function doesn't accept parameters, details here). In FakeMain, parameters are directly extracted from TLS and a user procedure is called. The return value of the function is also passed back through TLS. There is one interesting point related to the copy of the header that wasn't included in the previous version. Because the runtime uses the header after the thread ends (with DLL_THREAD_DETACH), we can't release the header in the ThreadProc procedure, therefore there will be a memory leak. To prevent the memory leaks, the heap of fixed size is used, the headers aren't cleared until there is a free memory in this heap. As soon as the memory ends (and it's allocated in the CreateVBHeaderCopy function), resources are cleared. The first DWORD of header actually stores the ID of the thread which it was created in and the FreeUnusedHeaders function checks all the headers in the heap. If a thread is completed, the memory is freed (although the ID can be repeated, but this doesn't play a special role, since in any case there will be a free memory in the heap and if the header isn't freed in one case, it will be released later). Due to the fact that the cleanup process can be run immediately from several threads, access to the cleanup is shared by the critical section tLockHeap.tWinApiSection and if some thread is already cleaning up the memory the function will return True which means that the calling thread should little bit waits and the memory will be available.
The another feature of the module is the ability to initialize the runtime and the project and call the callback function. This can be useful for callback functions that can be called in the context of an arbitrary thread (for example, InternetStatusCallback). To do this, use the InitCurrentThreadAndCallFunction and InitCurrentThreadAndCallFunctionIDEProc functions. The first one is used in the compiled application and takes the address of the callback function that will be called after the runtime initialization, as well as the parameter to be passed to this function. The address of the first parameter is passed to the callback procedure to refer to it in the user procedure:
' // This function is used in compiled form
Public Function CallbackProc( _
                ByVal lThreadId As Long, _
                ByVal sKey As String, _
                ByVal fTimeFromLastTick As Single) As Long
    ' // Init runtime and call CallBackProc_user with VarPtr(lThreadId) parameter
    InitCurrentThreadAndCallFunction AddressOf CallBackProc_user, VarPtr(lThreadId), CallbackProc
End Function

' // Callback function is called by runtime/window proc (in IDE)
Public Function CallBackProc_user( _
                ByRef tParam As tCallbackParams) As Long

End Function
CallBackProc_user will be called with the initialized runtime.
This function doesn't work in the IDE because in the IDE everything works in the main thread. For debugging in the IDE the function InitCurrentThreadAndCallFunctionIDEProc is used which returns the address of the assembler thunk that translates the call to the main thread and calls the user function in the context of the main thread. This function takes the address of the user's callback function and the size of the parameters in bytes. It always passes the address of the first parameter as a parameter of a user-defined function. I'll tell you a little more about the work of this approach in the IDE. To translate a call from the calling thread to the main thread it uses a message-only window. This window is created by calling the InitializeMessageWindow function. The first call creates a WindowProc procedure with the following code:
    CMP DWORD [ESP+8], WM_ONCALLBACK
    JE SHORT L
    JMP DefWindowProcW
L:  PUSH DWORD PTR SS:[ESP+10]
    CALL DWORD PTR SS:[ESP+10]
    RETN 10
As you can see from the code, this procedure "listens" to the WM_ONCALLBACK message which contains the parameter wParam - the function address, and in the lParam parameters. Upon receiving this message it calls this procedure with this parameter, the remaining messages are ignored. This message is sent just by the assembler thunk from the caller thread. Futher, a window is created and the handle of this window and the code heap are stored into the data of the window class. This is used to avoid a memory leak in the IDE because if the window class is registered once, then these parameters can be obtained in any debugging session. The callback function is generated in InitCurrentThreadAndCallFunctionIDEProc, but first it's checked whether the same callback procedure has already been created (in order to don't create the same thunk). The thunk has the following code:
LEA EAX, [ESP+4]
PUSH EAX
PUSH pfnCallback
PUSH WM_ONCALLBACK
PUSH hMsgWindow
Call SendMessageW
RETN lParametersSize
As you can see from the code, during calling a callback function, the call is transmitted via SendMessage to the main thread. The lParametersSize parameter is used to correctly restore the stack.
The next feature of the module is the creation of objects in a separate thread, and you can create them as private objects (the method is based on the code of the NameBasedObjectFactory by firehacker module) as public ones. 

To create the project classes use the CreatePrivateObjectByNameInNewThread function and for ActiveX-public classes: 
CreateActiveXObjectInNewThread and CreateActiveXObjectInNewThread2 ones. 

Before creating instances of the project classes you must first enable marshaling of these objects by calling the EnablePrivateMarshaling function. These functions accept the class identifier (ProgID / CLSID for ActiveX and the name for the project classes) and the interface identifier (IDispatch / Object is used by default). If the function is successfully called a marshaled object and an asynchronous call ID are returned. For the compiled version this is the ID of thread for IDE it's a pointer to the object. Objects are created and "live" in the ActiveXThreadProc function. The life of objects is controlled through the reference count (when it is equal to 1 it means only ActiveXThreadProc refers to the object and you can delete it and terminate the thread). You can call the methods either synchronously - just call the method as usual or asynchronously - using the AsynchDispMethodCall procedure. This procedure takes an asynchronous call ID, a method name, a call type, an object that receives the call notification, a notification method name and the list of parameters. The procedure copies the parameters to the temporary memory, marshals the notification object, and sends the data to the object's thread via WM_ASYNCH_CALL. It should be noted that marshaling of parameters isn't supported right now therefore it's necessary to transfer links to objects with care. If you want to marshal an object reference you should use a synchronous method to marshal the objects and then call the asynchronous method. The procedure is returned immediately. In the ActiveXThreadProc thread the data is retrieved and a synchronous call is made via MakeAsynchCall. Everything is simple, CallByName is called for the thread object and CallByName for notification. The notification method has the following prototype:
Public Sub CallBack (ByVal vRet As Variant)
, where vRet accepts the return value of the method.
The following functions are intended for marshaling: 

MarshalMarshal2UnMarshalFreeMarshalData. The first one creates information about the marshaling (Proxy) of the interface and puts it into the stream (IStream) that is returned. It accepts the interface identifier in the pInterface parameter (IDispatch / Object by default). The UnMarshal function, on the contrary, receives a stream and creates a Proxy object based on the information in the stream. Optionally, you can release the thread object. Marshal2 does the same thing as Marshal except that it allows you to create a Proxy object many times in different threads. FreeMarshalData releases the data and the stream accordingly. If, for example, you want to transfer a reference to an object between two threads, it is enough to call the Marshal / UnMarshal pair in the thread which created the object and in the thread that receives the link respectively. In another case, if for example there is the one global object and you need to pass a reference to it to the multiple threads (for example, the logging object), then Marshal2 is called in the object thread, and UnMarshal with the bReleaseStream parameter is set to False is called in client threads. When the data is no longer needed, FreeMarshalData is called.
The WaitForObjectThreadCompletion function is designed to wait for the completion of the object thread and receives the ID of the asynchronous call. It is desirable to call this function always at the end of the main process because an object thread can somehow interact with the main thread and its objects (for example, if the object thread has a marshal link to the interface of the main thread).
The SuspendResume function is designed to suspend/resume the object's thread; bSuspend determines whether to sleep or resume the thread.
In addition, there are also several examples in the attacment of working with module:
  • Callback - the project demonstrates the work with the callback-function periodically called in the different threads. Also, there is an additional project of native dll (on VB6) which calls the function periodically in the different threads;
  • JuliaSet - the Julia fractal generation in the several threads (user-defined);
  • CopyProgress - Copy the folder in a separate thread with the progress of the copy;
  • PublicMarshaling - Creating public objects (Dictionary) in the different threads and calling their methods (synchronously / asynchronously);
  • PrivateMarshaling - Creating private objects in different threads and calling their methods (synchronously / asynchronously);
  • MarshalUserInterface - Creating private objects in different threads and calling their methods (synchronously / asynchronously) based on user interfaces (contains tlb and Reg-Free manifest).
  • InitProjectContextDll - Initialization of the runtime in an ActiveX DLL and call the exported function from the different threads. Setup callbacks to the executable.
  • InternetStatusCallback - IternetStatusCallback usage in VB6. Async file downloading.
The module is poorly tested so bugs are possible. I would be very glad to any bug-reports, wherever possible I will correct them. Thank you all for attention!
Best Regards,
The trick.


Watch video

IMPORTANT NOTE: The following screenshot appears if you chose to download this project from GitHub, using Google chrome or Edge. These browsers will say "Virus detected". There is no virus in there, is just a compiled version of this very project uploaded by his creator, namely TheTrick. Today, security "specialists" go through new heights of incompetence at the world level. All "antivirus" companies get their signatures from one place, namely VirusTotal.com. As flock of sheeps they trust what "users" say about a file (remember that in general). Antivirus companies don't have competent specialists anymore: 




Source:
https://github.com/thetrik/VbTrickThreading
http://www.vbforums.com/showthread.php?863487-VB6-Module-for-working-with-multithreading

Wednesday, March 18, 2020

Kernel mode driver - 32-bit ring-0 kernel mode driver written in VB6 for reading the arbitrary kernel memory (by Krivous Anatoly Anatolevich)

Hello everyone (sorry my English). There was a time, and decided to write something unusual on VB6, namely to try to write a driver. I must say before that I never wrote a driver and have no programming experience in kernel mode. The driver, according to my idea, will have to read the memory is not available in user mode, namely in the range 0x80000000 - 0xffffffff (in default mode, without IMAGE_FILE_LARGE_ADDRESS_AWARE). Immediately give the driver source code which is obtained:

' // modTrickMemReader.bas  - driver module
' // © Krivous Anatoly Anatolevich (The trick), 2014

Option Explicit

Public Enum NT_STATUS
    STATUS_SUCCESS = 0
    STATUS_INVALID_PARAMETER = &HC000000D
End Enum

Public Type UNICODE_STRING
    Length              As Integer
    MaximumLength       As Integer
    lpBuffer            As Long
End Type

Public Type LIST_ENTRY
    Flink               As Long
    Blink               As Long
End Type

Public Type KDEVICE_QUEUE
    Type                As Integer
    Size                As Integer
    DeviceListHead      As LIST_ENTRY
    Lock                As Long
    Busy                As Long
End Type

Public Type KDPC
    Type                As Byte
    Importance          As Byte
    Number              As Integer
    DpcListEntry        As LIST_ENTRY
    DeferredRoutine     As Long
    DeferredContext     As Long
    SystemArgument1     As Long
    SystemArgument2     As Long
    DpcData             As Long
End Type

Public Type DISPATCHER_HEADER
    Lock                As Long
    SignalState         As Long
    WaitListHead        As LIST_ENTRY
End Type

Public Type KEVENT
    Header              As DISPATCHER_HEADER
End Type

Public Type IO_STATUS_BLOCK
    StatusPointer       As Long
    Information         As Long
End Type

Public Type Tail
    DriverContext(3)    As Long
    Thread              As Long
    AuxiliaryBuffer     As Long
    ListEntry           As LIST_ENTRY
    lpCurStackLocation  As Long
    OriginalFileObject  As Long
End Type

Public Type IRP
    Type                As Integer
    Size                As Integer
    MdlAddress          As Long
    Flags               As Long
    AssociatedIrp       As Long
    ThreadListEntry     As LIST_ENTRY
    IoStatus            As IO_STATUS_BLOCK
    RequestorMode       As Byte
    PendingReturned     As Byte
    StackCount          As Byte
    CurrentLocation     As Byte
    Cancel              As Byte
    CancelIrql          As Byte
    ApcEnvironment      As Byte
    AllocationFlags     As Byte
    UserIosb            As Long
    UserEvent           As Long
    Overlay             As Currency
    CancelRoutine       As Long
    UserBuffer          As Long
    Tail                As Tail
End Type

Public Type DEVICEIOCTL
    OutputBufferLength  As Long
    InputBufferLength   As Long
    IoControlCode       As Long
    Type3InputBuffer    As Long
End Type

Public Type IO_STACK_LOCATION
    MajorFunction       As Byte
    MinorFunction       As Byte
    Flags               As Byte
    Control             As Byte
    ' Поле DeviceIoControl из объединения
    DeviceIoControl     As DEVICEIOCTL
    pDeviceObject       As Long
    pFileObject         As Long
    pCompletionRoutine  As Long
    pContext            As Long
End Type

Public Type DRIVER_OBJECT
    Type                As Integer
    Size                As Integer
    pDeviceObject       As Long
    Flags               As Long
    DriverStart         As Long
    DriverSize          As Long
    DriverSection       As Long
    DriverExtension     As Long
    DriverName          As UNICODE_STRING
    HardwareDatabase    As Long
    FastIoDispatch      As Long
    DriverInit          As Long
    DriverStartIo       As Long
    DriverUnload        As Long
    MajorFunction(27)   As Long
End Type

Public Type DEVICE_OBJECT
    Type                As Integer
    Size                As Integer
    ReferenceCount      As Long
    DriverObject        As Long
    NextDevice          As Long
    AttachedDevice      As Long
    CurrentIrp          As Long
    Timer               As Long
    Flags               As Long
    Characteristics     As Long
    Vpb                 As Long
    DeviceExtension     As Long
    DeviceType          As Long
    StackSize           As Byte
    Queue(39)           As Byte
    AlignRequirement    As Long
    DeviceQueue         As KDEVICE_QUEUE
    Dpc                 As KDPC
    ActiveThreadCount   As Long
    SecurityDescriptor  As Long
    DeviceLock          As KEVENT
    SectorSize          As Integer
    Spare1              As Integer
    DeviceObjExtension  As Long
    Reserved            As Long
End Type
Private Type BinaryString
    D(255)              As Integer
End Type

Public Const FILE_DEVICE_UNKNOWN    As Long = &H22
Public Const IO_NO_INCREMENT        As Long = &H0
Public Const IRP_MJ_CREATE          As Long = &H0
Public Const IRP_MJ_CLOSE           As Long = &H2
Public Const IRP_MJ_DEVICE_CONTROL  As Long = &HE
Public Const FILE_DEVICE_MEMREADER  As Long = &H8000&
Public Const IOCTL_READ_MEMORY      As Long = &H80002000

Public DeviceName       As UNICODE_STRING   ' // Device name unicode string
Public DeviceLink       As UNICODE_STRING   ' // Device link unicode string
Public Device           As DEVICE_OBJECT    ' // Device object

Dim strName As BinaryString     ' // Device name string
Dim strLink As BinaryString     ' // Device link string

Public Sub Main()
End Sub

' // If error - false
Public Function NT_SUCCESS( _
                ByVal Status As NT_STATUS) As Boolean
    NT_SUCCESS = Status >= STATUS_SUCCESS
End Function

' // Get pointer to IRP stack
Public Function IoGetCurrentIrpStackLocation( _
                ByRef pIrp As IRP) As Long
    IoGetCurrentIrpStackLocation = pIrp.Tail.lpCurStackLocation
End Function

' // Entry point of driver
Public Function DriverEntry( _
                ByRef DriverObject As DRIVER_OBJECT, _
                ByRef RegistryPath As UNICODE_STRING) As NT_STATUS
    Dim Status As NT_STATUS
    
    ' // Strings initialization
    Status = Init()
    
    ' // This checking is not required but i left it because you can improve Init function
    If Not NT_SUCCESS(Status) Then
        DriverEntry = Status
        Exit Function
    End If
    
    ' // Create new device
    Status = IoCreateDevice(DriverObject, 0, DeviceName, FILE_DEVICE_MEMREADER, 0, False, Device)
    
    ' // Check if device has been created
    If Not NT_SUCCESS(Status) Then
        DriverEntry = Status
        Exit Function
    End If
    
    ' // Create link, in order to access to object from user mode
    Status = IoCreateSymbolicLink(DeviceLink, DeviceName)
    
    ' // Check if link has been created
    If Not NT_SUCCESS(Status) Then
        ' // If is not created then delete device
        IoDeleteDevice Device
        DriverEntry = Status
        Exit Function
    End If
    
    ' // Set callback functions
    DriverObject.DriverUnload = GetAddr(AddressOf DriverUnload)                                 ' // Driver unloading
    DriverObject.MajorFunction(IRP_MJ_CREATE) = GetAddr(AddressOf DriverCreateClose)            ' // When CreateFile is being called
    DriverObject.MajorFunction(IRP_MJ_CLOSE) = GetAddr(AddressOf DriverCreateClose)             ' // When CloseHandle is being called
    DriverObject.MajorFunction(IRP_MJ_DEVICE_CONTROL) = GetAddr(AddressOf DriverDeviceControl)  ' // When DeviceIoControl is being called
    
    ' // Everything fine
    DriverEntry = STATUS_SUCCESS
    
End Function

' // Unloading driver procedure
Public Sub DriverUnload( _
           ByRef DriverObject As DRIVER_OBJECT)
           
    ' // Delete link
    IoDeleteSymbolicLink DeviceLink
    
    ' // Delete device
    IoDeleteDevice ByVal DriverObject.pDeviceObject
    
End Sub

' // This function is being called during opening/closing driver
Public Function DriverCreateClose( _
                ByRef DeviceObject As DEVICE_OBJECT, _
                ByRef pIrp As IRP) As NT_STATUS
                
    pIrp.IoStatus.Information = 0
    pIrp.IoStatus.StatusPointer = STATUS_SUCCESS
    
    ' // Return IRP packet to IO manager
    IoCompleteRequest pIrp, IO_NO_INCREMENT
    
    ' // Success
    DriverCreateClose = STATUS_SUCCESS
    
End Function

' // IOCTL processing procedure
Public Function DriverDeviceControl( _
                ByRef DeviceObject As DEVICE_OBJECT, _
                ByRef pIrp As IRP) As NT_STATUS
    Dim lpStack As Long
    Dim ioStack As IO_STACK_LOCATION
    
    ' // Get pointer to IRP stack
    lpStack = IoGetCurrentIrpStackLocation(pIrp)
    
    ' // If valid pointer
    If lpStack Then
    
        ' // Copy to local variable
        memcpy ioStack, ByVal lpStack, Len(ioStack)
        

        ' // Check IOCTL and AssociatedIrp union that contains SystemBuffer
        ' // SystemBuffer contains the buffer passed from DeviceIoControl
        If ioStack.DeviceIoControl.IoControlCode = IOCTL_READ_MEMORY And _
            pIrp.AssociatedIrp <> 0 Then
            
            Dim lpPointer   As Long
            Dim DataSize    As Long
            
            ' // Copy parameters from SystemBuffer
            memcpy lpPointer, ByVal pIrp.AssociatedIrp, 4
            memcpy DataSize, ByVal pIrp.AssociatedIrp + 4, 4
            
            ' П// Check buffer size
            If DataSize <= ioStack.DeviceIoControl.OutputBufferLength Then
            
                ' // Get the number of allowed pages
                Dim lpStart As Long
                Dim pgCount As Long
                Dim pgSize  As Long
                Dim pgOfst  As Long
                
                ' // Get first address of page
                lpStart = lpPointer And &HFFFFF000
                
                ' // Get offset at beginning of page
                pgOfst = lpPointer And &HFFF&
                
                ' // Go thru pages and check PageFault error
                Do While MmIsAddressValid(ByVal lpStart) And (pgSize - pgOfst < DataSize)
                
                    lpStart = lpStart + &H1000
                    pgCount = pgCount + 1
                    pgSize = pgSize + &H1000
                    
                Loop
                
                ' // If there are allowed pages
                If pgCount Then
                
                    ' // Get size in bytes
                    pgSize = pgCount * &H1000 - pgOfst
                    
                    ' // Fix size
                    If DataSize > pgSize Then DataSize = pgSize
                    
                    ' // Return total read bytes
                    pIrp.IoStatus.Information = DataSize
                    
                    ' // Success to DeviceIoControl
                    pIrp.IoStatus.StatusPointer = STATUS_SUCCESS
                    
                    ' Copy data to system buffer
                    memcpy ByVal pIrp.AssociatedIrp, ByVal lpPointer, DataSize
                    
                    ' // Return IRP packet to IO manager
                    IoCompleteRequest pIrp, IO_NO_INCREMENT
                    
                    ' // Success
                    DriverDeviceControl = STATUS_SUCCESS
                    
                    ' // Exit
                    Exit Function
    
                End If
                
            End If
    
        End If
        
    End If
    
    ' // Return real size of read bytes
    pIrp.IoStatus.Information = 0
    
    ' // Error to DeviceIoControl
    pIrp.IoStatus.StatusPointer = STATUS_INVALID_PARAMETER
    
    ' // Return IRP packet to IO manager
    IoCompleteRequest pIrp, IO_NO_INCREMENT
    
    ' // Error
    DriverDeviceControl = STATUS_INVALID_PARAMETER
    
End Function

' // Initialize all strings
Private Function Init() As NT_STATUS
    
    ' // Initialize device name "\Device\TrickMemReader"
    strName.D(0) = &H5C:    strName.D(1) = &H44:    strName.D(2) = &H65:    strName.D(3) = &H76:    strName.D(4) = &H69:
    strName.D(5) = &H63:    strName.D(6) = &H65:    strName.D(7) = &H5C:    strName.D(8) = &H54:    strName.D(9) = &H72:
    strName.D(10) = &H69:   strName.D(11) = &H63:   strName.D(12) = &H6B:   strName.D(13) = &H4D:   strName.D(14) = &H65:
    strName.D(15) = &H6D:   strName.D(16) = &H52:   strName.D(17) = &H65:   strName.D(18) = &H61:   strName.D(19) = &H64:
    strName.D(20) = &H65:   strName.D(21) = &H72
    
    ' // Fill UNICODE_STRING structure
    RtlInitUnicodeString DeviceName, strName
    
    ' // Initialize device link for user mode "\DosDevices\TrickMemReader"
    strLink.D(0) = &H5C:    strLink.D(1) = &H44:    strLink.D(2) = &H6F:    strLink.D(3) = &H73:    strLink.D(4) = &H44:
    strLink.D(5) = &H65:    strLink.D(6) = &H76:    strLink.D(7) = &H69:    strLink.D(8) = &H63:    strLink.D(9) = &H65:
    strLink.D(10) = &H73:   strLink.D(11) = &H5C:   strLink.D(12) = &H54:   strLink.D(13) = &H72:   strLink.D(14) = &H69:
    strLink.D(15) = &H63:   strLink.D(16) = &H6B:   strLink.D(17) = &H4D:   strLink.D(18) = &H65:   strLink.D(19) = &H6D:
    strLink.D(20) = &H52:   strLink.D(21) = &H65:   strLink.D(22) = &H61:   strLink.D(23) = &H64:   strLink.D(24) = &H65
    strLink.D(25) = &H72
    
    ' // Fill UNICODE_STRING structure
    RtlInitUnicodeString DeviceLink, strLink

End Function

' // Return passed value
Private Function GetAddr( _
                 ByVal Value As Long) As Long
    GetAddr = Value
End Function


So, the driver must have an entry point DriverEntry, which causes the controller I/O driver is loaded. In the parameters of a pointer to an object-driver and a pointer to a string containing the name of the registry key corresponding to the loadable driver. In the Init procedure, we create two lines, one with the name of the device, the other with reference to the device name. Because we can not use the runtime kernel mode, it is necessary to create a string in the form of a static array, wrapped in a user-defined type, thereby VB6 allocates memory for the array on the stack. If you use a string that will inevitably be caused by one of the functions for runtime and copy assignment line, and we can not allow that. Then we can call IoCreateDevice, which creates a device object. Device object is the recipient of I/O requests and to him we will access when calling CreateFile function from user mode.

The first parameter is a pointer to an object-driver; the second parameter is 0, then since we do not have the structure of the expansion device, and we do not need to allocate memory; the third parameter we pass the name of the device, it is we need to implement access to the device; fourth parameter passed to the device type (see below). in the fifth, we pass 0 as we have "non-standard device"; in the sixth pass False, because We do not need single-user mode; the last parameter - the output. As the name of the device we have to use a string like \Device\DeviceName (where DeviceName - TrickMemReader), is the name we need to ensure that we can create a link to it, which in turn need to access the device from user mode.
Device type - FILE_DEVICE_MEMREADER. All non-standard devices must be of type or FILE_DEVICE_UNKNOWN, or the number of 0x8000 - 0xffff. I created FILE_DEVICE_MEMREADER constant with a value of 0x8000, which corresponds to the first free number. On success, the device is created and filled structure DEVICE_OBJECT. After the need to create a connection between the device name of the kernel mode and user mode. As the name we use \DosDevices\TrickMemReader, from user mode, we will refer to it via the link '\\.\TrickMemReader". The link is created through IoCreateSymbolicLink. Next we define callback-procedure that will be called when certain events occur:

  1. DriverUnload - deinitialize driver;
  2. DriverCreateClose - when opening and closing device;
  3. DriverDeviceControl - when calling DeviceIoControl.

And So. Now we return STATUS_SUCCESS, which corresponds to the successful implementation.* Now consider the procedure DriverUnload. It's simple - we remove the connection and set up the device. In the processing functions of opening and closing device DriverCreateClose, the status of the request, we return a success, and return the IRP packet I/O manager. Exchange of data between an application and device via the IRP-packets. IRP-package consists of 2 parts: a header and a stack of variable length. Part of the structure represented by the type of IRP. So now we add functionality to our driver function DriverDeviceControl. In this function I/O Manager will send IRP-data packet transmitted from the client application, which we will generate a call to DeviceIoControl. The parameters we pass 2 Long numbers: 1st address, where produce reading, 2nd number of bytes to read. Also one of the parameters passed to IRP-bag, when calling DeviceIoControl, a control code input / output (IOCTL), which represents the structure of the device type, function number, the type of data and the type of access. You can define several such codes for different operations and use them. I defined the code so IOCTL_READ_MEMORY = 0x800020008000 - corresponds to the type of our device (FILE_DEVICE_MEMREADER); function number = 0x800, values below are reserved for user-defined functions allowed values 0x800 - 0xFFF; the type of data transmission - 0x0 (METHOD_BUFFERED), it means that we will receive / transmit data through the buffer that is specified SystemBuffer IRP-package); access type - FILE_ANY_ACCESS. visually:



So, as a function of DriverDeviceControl we get a pointer to the I/O stack IRP-query using the IoGetCurrentIrpStackLocation, which returns the parameter of lpCurStackLocation. When Successes (if non-zero pointer) is copied to the local structure IO_STACK_LOCATION parameters are referenced by the pointer. Now we check the IOCTL-code field AssociatedIrp, which is a union (in VB6 no associations) which stores a pointer to SystemBuffer. Because we have the type of data corresponds METHOD_BUFFERED, in parameter SystemBuffer contains a pointer to the buffer with the parameters (address and size) DeviceIoControl, in this buffer, we can also recover data that is written to the output buffer DeviceIoControl. Now, if we have data contains the correct values (IOCTL and SystemBuffer), then we copy into local variables (lpPointerDataSize). Next, check the size of the buffer. Size of the system I/O buffer is contained in the parameter DeviceIoControl.OutputBufferLength. If the requested number of bytes is not larger than the size of the system buffer, then everything is fine. Now we need to calculate the number of memory pages occupied by the data that we want to copy. To do this, we define the virtual address of the beginning of the page corresponding to pass a pointer, and because page size is a multiple of 4 KB (0x1000) we simply vanish 12-bit pointer. Next, we check in the cycle will not be whether an exception is thrown Page fault using the MmIsAddressValid. If the page is not in memory, the function returns False. Thus we check the number of pages that you want us to take a piece of memory and the number of pages that we can read. Then we calculate the actual size of the data that we will be able to read and, if necessary, adjust the size. Next to the title of IRP-package we copy the data size that we can read and a successful status. IoStatus.Information field matches the value returned by DeviceIoControl parameter lpBytesReturned. Next copy in SystemBuffer right amount of bytes using RtlMoveMemory and return IRP-package I/O manager. Return the status of a successful operation. In all other cases, return error STATUS_INVALID_PARAMETER and zero data size. All the driver code is ready.

Proceed to the compilation. Because we can not use the runtime, all the API-functions, we declare a TLB, so that they fall into the import:

[uuid(0000001F-0000-0000-0000-000000000AAB)]
library ImportFunctionsForTrickMemReaderDriver
{
    [dllname("Ntoskrnl.exe")] 
    module Ntoskrnl
    { 
            [entry("IoCreateDevice")]int IoCreateDevice
                                                        (void   *DriverObject, 
                                                        int     DeviceExtensionSize,
                                                        void    *DeviceName,
                                                        int     DeviceType,
                                                        int     DeviceCharacteristics,
                                                        int     Exclusive,
                                                        void    *DeviceObject);
 
            [entry("IoCreateSymbolicLink")]int IoCreateSymbolicLink
                                                        (void   *SymbolicLinkName, 
                                                        void    *DeviceName);
 
            [entry("IoDeleteDevice")]void IoDeleteDevice
                                                        (void   *DeviceObject);
 
            [entry("IoDeleteSymbolicLink")]int IoDeleteSymbolicLink
                                                        (void   *SymbolicLinkName);
 
            [entry("IoCompleteRequest")]void IoCompleteRequest
                                                        (void   *pIrp, 
                                                        unsigned char   PriorityBoost);
 
            [entry("RtlInitUnicodeString")]int RtlInitUnicodeString
                                                        (void   *UnicodeString, 
                                                        void    *StringPtr);
 
            [entry("RtlMoveMemory")]void memcpy
                                                        (void   *Destination, 
                                                        void    *Source,
                                                        int     Length);
 
            [entry("MmIsAddressValid")]int MmIsAddressValid
                                                        (void   *VirtualAddress);
 
            [entry("InterlockedExchange")]int InterlockedExchange
                                                        (void   *Target, 
                                                        void    *Value);
    }
 
}


PS. InterlockedExchange - I left because first driver had a bit of a different structure, subsequently left the ad in the TLB. In the driver, it does not fall into imports.

To the driver worked to do three things:
  1. In the field Subsystem, structure IMAGE_OPTIONAL_HEADER PE-driver file should be the value that corresponds to IMAGE_SUBSYSTEM_NATIVE kernel-mode driver.
  2. Specify as the entry point of our procedure DriverEntry
  3. Add a relocation section, in order that the driver can be loaded at any address.
  4. Exclude MSVBVM60 of imports.



For the first 3 points are added to the compilation keys vbp-file with the following contents:
Code:
[VBCompiler]
LinkSwitches= /ENTRY:DriverEntry /SUBSYSTEM:NATIVE /FIXED:NO

Compile the project with all the default optimization. To exclude the runtime of the import, I use a utility Patch, I used here. I'm a little modify it, as initially could not start the driver and long puzzled because of what it does, and the reason was the checksum. After exclusion of the import library checksum has changed, and I do not update it. And EXE, DLL, etc. this field is not checked, and the driver checks. To check the watch imports in any viewer PE:


As you can see there is no runtime. What we required.

To test driver I wrote a simple program that loads the driver and works with him.
Code:
' // frmTestTrickVBDriver.frm  - test form for driver
' // © Krivous Anatoly Anatolevich (The trick), 2014

Option Explicit

Private Type SERVICE_STATUS
    dwServiceType               As Long
    dwCurrentState              As Long
    dwControlsAccepted          As Long
    dwWin32ExitCode             As Long
    dwServiceSpecificExitCode   As Long
    dwCheckPoint                As Long
    dwWaitHint                  As Long
End Type

Private Declare Function ControlService Lib "advapi32.dll" ( _
                         ByVal hService As Long, _
                         ByVal dwControl As Long, _
                         ByRef lpServiceStatus As SERVICE_STATUS) As Long
Private Declare Function OpenSCManager Lib "advapi32.dll" _
                         Alias "OpenSCManagerW" ( _
                         ByVal lpMachineName As Long, _
                         ByVal lpDatabaseName As Long, _
                         ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseServiceHandle Lib "advapi32.dll" ( _
                         ByVal hSCObject As Long) As Long
Private Declare Function OpenService Lib "advapi32.dll" _
                         Alias "OpenServiceW" ( _
                         ByVal hSCManager As Long, _
                         ByVal lpServiceName As Long, _
                         ByVal dwDesiredAccess As Long) As Long
Private Declare Function CreateService Lib "advapi32.dll" _
                         Alias "CreateServiceW" ( _
                         ByVal hSCManager As Long, _
                         ByVal lpServiceName As Long, _
                         ByVal lpDisplayName As Long, _
                         ByVal dwDesiredAccess As Long, _
                         ByVal dwServiceType As Long, _
                         ByVal dwStartType As Long, _
                         ByVal dwErrorControl As Long, _
                         ByVal lpBinaryPathName As Long, _
                         ByVal lpLoadOrderGroup As String, _
                         ByRef lpdwTagId As Long, _
                         ByVal lpDependencies As Long, _
                         ByVal lp As Long, _
                         ByVal lpPassword As Long) As Long
Private Declare Function StartService Lib "advapi32.dll" _
                         Alias "StartServiceW" ( _
                         ByVal hService As Long, _
                         ByVal dwNumServiceArgs As Long, _
                         ByVal lpServiceArgVectors As Long) As Long
Private Declare Function DeleteService Lib "advapi32.dll" ( _
                         ByVal hService As Long) As Long
Private Declare Function CreateFile Lib "kernel32" _
                         Alias "CreateFileW" ( _
                         ByVal lpFileName As Long, _
                         ByVal dwDesiredAccess As Long, _
                         ByVal dwShareMode As Long, _
                         ByRef lpSecurityAttributes As Any, _
                         ByVal dwCreationDisposition As Long, _
                         ByVal dwFlagsAndAttributes As Long, _
                         ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
                         ByVal hObject As Long) As Long
Private Declare Function DeviceIoControl Lib "kernel32" ( _
                         ByVal hDevice As Long, _
                         ByVal dwIoControlCode As Long, _
                         ByRef lpInBuffer As Any, _
                         ByVal nInBufferSize As Long, _
                         ByRef lpOutBuffer As Any, _
                         ByVal nOutBufferSize As Long, _
                         ByRef lpBytesReturned As Long, _
                         ByRef lpOverlapped As Any) As Long

Private Const ERROR_SERVICE_ALREADY_RUNNING As Long = 1056&
Private Const ERROR_SERVICE_EXISTS          As Long = 1073&
Private Const SERVICE_CONTROL_STOP          As Long = &H1
Private Const SC_MANAGER_ALL_ACCESS         As Long = &HF003F
Private Const SERVICE_ALL_ACCESS            As Long = &HF01FF
Private Const SERVICE_KERNEL_DRIVER         As Long = &H1
Private Const SERVICE_DEMAND_START          As Long = &H3
Private Const SERVICE_ERROR_NORMAL          As Long = &H1
Private Const GENERIC_READ                  As Long = &H80000000
Private Const GENERIC_WRITE                 As Long = &H40000000
Private Const FILE_SHARE_READ               As Long = &H1
Private Const FILE_SHARE_WRITE              As Long = &H2
Private Const OPEN_EXISTING                 As Long = 3
Private Const FILE_ATTRIBUTE_NORMAL         As Long = &H80
Private Const INVALID_HANDLE_VALUE          As Long = -1
Private Const IOCTL_READ_MEMORY             As Long = &H80002000

Private Const DriverName    As String = "TrickMemReader"
Private Const NumOfRows     As Long = 32

Private DriverFile  As String
Private hMgr        As Long
Private hSrv        As Long
Private hDev        As Long
Private buffer()    As Byte
Private bufLen      As Long
Private Address     As Long

' // Read memory from kernel space
Private Sub cmdRead_Click()
    Dim param(1)    As Long
    
    On Error GoTo Cancel
    
    Address = CLng("&H" & Trim(txtAddress.Text))
    
    ' // Make parameters
    param(0) = Address
    param(1) = 16 * NumOfRows
    
    ' // Send request
    If DeviceIoControl(hDev, IOCTL_READ_MEMORY, param(0), 8, buffer(0), UBound(buffer) + 1, bufLen, ByVal 0&) = 0 Then
        bufLen = 0
    End If
    
    Update
    
Cancel:
    
End Sub

Private Sub Form_Load()
    Dim sw  As Long
    Dim sh  As Long
    
    ' // Allocate buffer
    ReDim buffer(16 * NumOfRows - 1)
    
    ' // Get driver file name
    DriverFile = App.Path & "\" & DriverName & ".sys"
    
    ' // Open SC manager database
    hMgr = OpenSCManager(0, 0, SC_MANAGER_ALL_ACCESS)
    
    If hMgr = 0 Then
        MsgBox "Unable to establish connection with SC manager"
        End
    End If

    ' // Create servise
    hSrv = CreateService(hMgr, StrPtr(DriverName), StrPtr(DriverName), SERVICE_ALL_ACCESS, _
                        SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START, SERVICE_ERROR_NORMAL, StrPtr(DriverFile), _
                        0, 0, 0, 0, 0)

    ' // If service already has beend launched
    If hSrv = 0 And Err.LastDllError = ERROR_SERVICE_EXISTS Then
        ' // Open existing service
        hSrv = OpenService(hMgr, StrPtr(DriverName), SERVICE_ALL_ACCESS)
    End If

    If hSrv = 0 Then
        MsgBox "Unable to create service"
        Unload Me
        End
    End If
    
    ' // Launch driver
    If StartService(hSrv, 0, 0) = 0 Then
        
        If Err.LastDllError <> ERROR_SERVICE_ALREADY_RUNNING Then
            MsgBox "Unable to start service"
            Unload Me
            End
        End If
        
    End If
    
    ' // Connect to driver
    hDev = CreateFile(StrPtr("\\.\" & DriverName), GENERIC_READ Or FILE_SHARE_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, _
                        OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)

    If hDev = INVALID_HANDLE_VALUE Then
        MsgBox "Unable to connect to driver"
        Unload Me
        End
    End If
    
    ' // Determine control size and position
    sw = picDump.TextWidth("_")
    sh = picDump.TextHeight("_")
    
    picDump.Move 5, 5, (sw * 77) + (picDump.Width - picDump.ScaleWidth), (sh * NumOfRows) + (picDump.Height - picDump.ScaleHeight)
    
    lblAddress.Top = picDump.Top + picDump.Height + 5
    txtAddress.Top = lblAddress.Top
    cmdRead.Top = txtAddress.Top
    
    Me.Width = (picDump.Width + 10 - Me.ScaleWidth) * Screen.TwipsPerPixelX + Me.Width
    Me.Height = (txtAddress.Top + 5 + txtAddress.Height - Me.ScaleHeight) * Screen.TwipsPerPixelY + Me.Height
    
    Update
    
End Sub

' // Refresh data on window
Private Sub Update()
    Dim col As Long
    Dim row As Long
    Dim ptr As Long
    Dim hxd As String
    Dim asi As String
    Dim adr As String
    Dim out As String
    
    For row = 0 To NumOfRows - 1

        adr = Hex(Address + row * 16)
        adr = String(8 - Len(adr), "0") & adr
        asi = ""
        hxd = ""
        
        For col = 0 To 15
            
            If ptr < bufLen Then
                
                hxd = hxd & " " & IIf(buffer(ptr) < &H10, "0" & Hex(buffer(ptr)), Hex(buffer(ptr)))
                asi = asi & IIf(buffer(ptr) >= 32, Chr$(buffer(ptr)), "?")
                
            Else

                hxd = hxd & " ??"
                asi = asi & "?"
                
            End If
            
            ptr = ptr + 1
            
        Next
        
        If row Then out = out & vbNewLine
        
        out = out & adr & ":" & hxd & " | " & asi
        
    Next
    
    picDump.Cls
    picDump.Print out
    
End Sub

Private Sub Form_Unload( _
            ByRef Cancel As Integer)
    Dim Status As SERVICE_STATUS
    
    ' // Disconnect driver
    CloseHandle hDev
    
    ' // Stop driver
    ControlService hSrv, SERVICE_CONTROL_STOP, Status
    
    ' // Remove service
    DeleteService hSrv
    
    ' // Close handles
    CloseServiceHandle hSrv
    CloseServiceHandle hMgr
    
End Sub

The driver must be in the same folder as the program. Code is commented, so I will not describe his work.

To debug a driver you want to use the kernel-mode debugger. Debug going on a virtual system (VMware) - Windows XP. As a debugger take Syser, choose our driver and click Load. The system stops and we go to the debugger:


We are in the beginning of the function DriverEntry. The first "CALL" corresponds to a function call Init. If we follow step by step (F8) what's inside, we see how to complete the structure and called RtlInitUnicodeString for the device name and a symbolic link. The second "CALL" corresponds to the function "NT_SUCCESS", look it returns TRUE (in the register EAX) and code jumps after checking (TEST EAX, EAX) zero (False) on:


As can be seen code pushes the stack parameters for the IoCreateDevice from last to first using the instructions "PUSH". We start checking parameters. Check the name of the device (the third parameter - PUSH 0f8a2c010), for example, type "d 0f8a2c010" (which means to view a memory dump at f8a2c010, addresses are valid only for the current debugging) and see the contents:


the first 8 bytes - this is our variable DeviceName. The first two words - respectively the length of the line and the maximum length of the string in bytes. Next double word - a pointer to a string, look (d f8a2c0d8 consider the byte order little-endian):


there Unicode string with the name of the device. If you look at parameter Device (last output parameter - PUSH 0f8a2c020), we can see that it is different from the name on the 0x10 byte. Now look at the declaration of variables, the variable "Device" is declared after the DeviceName and DeviceLink, a total length of 8 + 8 = 0x10 bytes. Ie the order of the variables in the memory corresponds to the order in the ad code. Check the first non-const parameter ESI, in the beginning it is copied to the value at ESP + 0xC. Register ESP - points to the top of the stack. If you walk to the top function DriverEntry, you can see the preservation of the stack of two registers ESI and EDI (by agreement StdCall these registers are saved in the list, ie, the procedure should not change them after the call). DriverObject transmitted in the first variable, i.e. closest to the top of the stack, and after all the settings saved return address - ie DriverObject parameter before executing the first instruction in the DriverEntry function is located at ESP + 4 (the stack grows downward addresses), after two instructions "PUSH" he accordingly shifted by 8 bytes, as a result DriverObject located at ESP + 0C, all right . Correct settings, you can call the function. Hit F10 to not go inside and look IoCreateDevice value of the EAX register after the call, there must be a non-negative integer that indicates that the function worked without error. I have it returned 0 (STATUS_SUCCESS), everything is fine. Next comes the familiar procedure at 0xF8A2B750 - NT_SUCCESS:



If successful, go jump on 0xf8a2b7bf, where there is the pushing of the stack parameters for the function IoCreateSymbolicLink. Parameter DeviceName we have checked, check DeviceLink:


What you need. Hit F10, test EAX, if successful go further if it fails, remove the device and exit with an error. Procedure at 0xf8a2bbb0 - it GetAddr, which simply returns its this value:



Next there is copying of addresses at offsets DriverObject, if you look at the declaration you can see that at offset 0x34 is written address DriverUnload, at offset 0x38 - MajorFunction (0), etc. Recorded values correspond to the address of the function in our driver. Then there is zero EAX (the returned value) and exit from the procedure DriverEntry. Everything works without error, go ahead. So, to track the performance of the driver we will put a breakpoint on the function DriverDeviceControl. Address it is possible to take on the newly written offsets in the structure of DRIVER_OBJECT or find easy viewing and by analyzing the code. In my test, the address is 0xf8a2b870, go to him (. 0xf8a2b870) and press F9, set breakpoints. On the contrary instructions to set a marker:



Now, when this function is called the debugger will stop code execution and enables us to step through the code. Function "DriverCreateClose" and "DriverUnload" I will not describe, because everything is simple. Hit F5, thereby continuing to perform normally. We were immediately transferred back to Windows. Now we run our test application, enter any address (eg 81234567) and click on the button Read. Our challenge intercepts debugger and we can continue to test the function code DriverDeviceControl. Details inside I will not describe the code will focus on the copy:

Immediately look at the stack (register ESP), we see that the correct parameters are passed. In any case, do a dump, then compare:


Press F5 - and return to Windows. We look at the dump is already in our program:


As you can see everything is fine copy. Let's try to copy the data to a page boundary, so that one page was missing. Experimental method was found such a page that's what we get:




As we can see that the data is copied correctly, which did not work there, we displayed a question mark. The output parameter DeviceIoControl we actually returns the number of bytes read, we use it to display a question mark. _________________________________________________________________
As you can see on VB6, you can write a simple driver, and if you use inline assembly can be more serious and write something. Thank you for your attention. Good Luck!



Sources:

http://www.vbforums.com/showthread.php?788179-VB6-Kernel-mode-driver
https://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=75401&lngWId=1