Page 1 of 2 12 LastLast
Results 1 to 40 of 43

Thread: [VB6] - Kernel mode driver.

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    [VB6] - Kernel mode driver.


    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:
    Code:
    ' // 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.
    Last edited by The trick; Jul 30th, 2016 at 08:13 AM. Reason: New version/translation to English

  2. #2

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Kernel mode driver.

    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 = 0x80002000, 8000 - 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:
    Name:  IOCTL_eng.jpg
Views: 6400
Size:  21.5 KB
    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 (lpPointer, DataSize). 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.
    Last edited by The trick; Jul 30th, 2016 at 11:39 AM. Reason: New version/translation to English

  3. #3

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Kernel mode driver.

    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:
    Code:
    [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.
    Last edited by The trick; Jul 30th, 2016 at 11:31 AM. Reason: New version/translation to English

  4. #4

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Kernel mode driver.

    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.
    Last edited by The trick; Jul 30th, 2016 at 11:22 AM. Reason: New version/translation to English

  5. #5

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Kernel mode driver.

    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!
    Attached Files Attached Files

  6. #6

  7. #7
    Member
    Join Date
    Dec 2018
    Posts
    45

    Re: [VB6] - Kernel mode driver.

    Quote Originally Posted by The trick View Post
    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.
    Hi The trick,

    Thank you for the post. I run the project on Windows 7 32bit, the system seemed to hang a bit (But only on the first run), then gave the message: "Unable to start service". I think the problem is in Driver, because with the same "TestDriver" project, I have successfully started another Kernel Driver written in C ++.

    Can you please help me handle this problem?

  8. #8
    Member
    Join Date
    Dec 2018
    Posts
    45

    Re: [VB6] - Kernel mode driver.

    Quote Originally Posted by The trick View Post
    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.
    Hi The trick,

    Thank you for the post. I run the project on Windows 7 32bit, the system seemed to hang a bit (But only on the first run), then gave the message: "Unable to start service". I think the problem is in Driver, because with the same "TestDriver" project, I have successfully started another Kernel Driver written in C ++.

    Can you please help me handle this problem?

  9. #9

  10. #10
    Member
    Join Date
    Dec 2018
    Posts
    45

    Re: [VB6] - Kernel mode driver.

    Hi The Trick,

    I'm sorry to have to bother you again, but the fact is that I searched a lot on the Internet and found that almost no one deeply understands the system Kernel in VB6 like you.

    I have a problem with Kernel mode driver, want to ask for your help.

    In the project that I attached, everything works fine: Driver OK (Tested), Start Service OK, Connect to driver OK. However, when sending a request with the DeviceIoControl function, I do not receive a response from the Driver.

    I send you both the source code of the program written in C ++, by Naveen (link: https://www.codeproject.com/Articles...ing-Used-Files), it is working fine. My project is rewritten in VB6, which is based on that source code. As for Driver, I still keep the original file written in Naveen's C ++, and if you can help me convert it to VB6 it is great.

    Note: The operating system I am using is Windows 7 32bit

    Best regards,
    ferrmask
    Last edited by ferrmask; Apr 23rd, 2019 at 03:10 AM.

  11. #11

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Kernel mode driver.

    Hi, ferrmask.
    You have an error with the declarations.
    As you can see the C code has the following declaration:
    Code:
    typedef struct _FILE_INFO
    {	
    	USHORT tcDeviceName[260];
    	USHORT tcFilleName[260];
        ULONG uType;
    }FILE_INFO;
    260 is the number of the elements in the array. On the contrary, you have the following declaration in the VB code:
    Code:
    Private Type HANDLE_INFO
        tcDeviceName(260) As Integer
        tcFileName(260) As Integer
        uType As Long
    End Type
    260 is the top bound of the arrays. If you don't have the Option Base 1 statement (and you don't have one) it means 261 elements (ie. from 0 to 260 inclusive). The proper declaration is:
    Code:
    Private Type HANDLE_INFO
        tcDeviceName(259) As Integer
        tcFileName(259) As Integer
        uType As Long
    End Type
    Then it'll work.

    and if you can help me convert it to VB6 it is great.
    It's possible but if you want to use only the pure VB you couldn't implement try/catch behavior (with rough approximation you can use MmIsAddressValid function).

  12. #12
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    597

    Re: [VB6] - Kernel mode driver.

    Typo:

    Private Type HANDLE_INFO
    tcDeviceName(259) As Integer
    tcFileName(259) As Integer
    uType As Long
    End Type

  13. #13

  14. #14
    Member
    Join Date
    Dec 2018
    Posts
    45

    Re: [VB6] - Kernel mode driver.

    Thank you very much, The trick
    Thank you very much, DaveDavis

    Thank you for spending time with me

    Best regards,
    ferrmask

  15. #15
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    A couple questions as I set out trying to write a file filter driver:

    Is there a particular reason for defining structures in the module when you have to declare APIs in a TLB?

    It's weird using void* for typed parameters lol... and it would save a lot of time with fewer conversion changes to types to have them in TLB.


    Second: Since I can't use the runtime, I can't use VarPtr, correct? (Unless it can possibly be called as a regular DLL import?) How could I get the address of a structure without it, for the purpose of assigning a pointer to a FAST_IO_DISPATCH type to DRIVER_OBJECT.FastIoDispatch?

  16. #16

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Kernel mode driver.

    Quote Originally Posted by fafalone View Post
    Is there a particular reason for defining structures in the module when you have to declare APIs in a TLB?
    No. You can declare structures (UDTs) in a module as well.

    Quote Originally Posted by fafalone View Post
    Since I can't use the runtime, I can't use VarPtr, correct? (Unless it can possibly be called as a regular DLL import?) How could I get the address of a structure without it, for the purpose of assigning a pointer to a FAST_IO_DISPATCH type to DRIVER_OBJECT.FastIoDispatch?
    You can't use any user-mode libraries in the kernel. You can get the address using several ways. For example use InterlockedExchange with void* parameter.

  17. #17
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    I'm a bit confused by where to import it from; Windows driver documentation suggests "OneCoreUAP.lib", if I imported from kernel32.dll where it's also listed, would that count as user mode or kernel mode as it's described as running in both, or could it be imported from ntoskrnl.exe, as other things suggest? I loaded ntoskrnl.exe in an export viewer and it's not coming up as exported in either Windows 10 or Windows 7, which contradicts other documentation (although Geoff Chappell's export list flags it as 'x86', perhaps meaning *only* 32bit Windows), so that just made me even more confused.

    Another question...
    How is the 64bit issue being dealt with here? I thought drivers needed to be 64bit on 64bit Windows. But some pointers in your declarations I know to be 64bits internally are declared as 32bits (e.g. as I had to deal with in my ETW project, FILE_OBJECT pointers have to be declared as 64bit). Is there some undocumented support for 32bit and it is able to successfully run 32bit drivers... or is something else going on here? Because I get 64bit IRP pointers too, but clearly your project here is working with 32bit ones. If it does recognize 32bit drivers, will this extend to API calls... e.g. if I call ZwCreateFile(PHANDLE FileHandle, ...), although as I understand it Windows will always use handles that fit in 32bits, it would still mean it's expected 8 bytes on the stack for each 64bit type like HANDLE.


    Sorry, very new to drivers but trying to learn, doesn't help that in C all I'd need is an include statement.
    Last edited by fafalone; Apr 12th, 2022 at 12:14 AM.

  18. #18

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Kernel mode driver.

    Quote Originally Posted by fafalone View Post
    I'm a bit confused by where to import it from;
    From ntoskrnl.exe.

    although Geoff Chappell's export list flags it as 'x86', perhaps meaning *only* 32bit Windows
    Yes, you could use x86 version of ntoskrnl.exe. You can't use a 32 bit driver in a 64 bit system. So your target OS should be 32 bit one.

    How is the 64bit issue being dealt with here?
    32 bit drivers won't work on 64 bit systems. There is no WOW64 layer in the kernel mode.

  19. #19
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    Ah I see. I saw Windows 10 in the video and forgot there even was a 32bit edition, since it was so uncommon and MS said they weren't doing 32bit anymore after Win10 2004, although it appears they've backtracked on that. (and the VM I was testing this project in was 32bit).

  20. #20
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    Putting the APIs in a typelib-- is this because the runtime is needed for the late binding, or because they're late bound at all, rather than in the import table?

  21. #21

  22. #22
    Frenzied Member
    Join Date
    Oct 2008
    Posts
    1,181

    Re: [VB6] - Kernel mode driver.

    How did you get anything to work from VB6 in a driver? The first thing that any VB6 EXE program does is to run something called ThunRTMain, which is a function in the VB6 runtime DLL. How did you make that not happen? From my understanding, a driver (SYS file) is just an EXE file designed to run in kernel mode, instead of user mode. And VB6 doesn't have a special driver building mode to directly create a SYS file with no dependencies on the runtime. All kinds of auto-generated code within a function in VB6, contain various references to the VB6 runtime.

    Also how do you run a driver like this? It's certainly unsigned.

    Also how do you even install it? Drivers need to be associated with a specific piece of hardware, so when you plug it in Windows detects the hardware. When you plug in a device for which Windows doesn't have a builtin driver results in it asking you to manually locate the driver files. In fact, plugging in a device is really the only time Windows asks you to select a driver to install.

    So how did you make and install a driver that has no association with any external hardware?

  23. #23
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    Did you even read the post? The trick made it pretty easy to follow, all the code is there, and a link to the tool to remove msvbvm60.

    The vbp makes use of an undocumented option to provide instructions to the linker. This is used to override the default entry point (making it DriverEntry instead of ThunRTMain), and specify native subsystem instead of GUI.

    The trick created a tool that then removes the msvbvm60.dll dependency (obviously, this means tons of stuff isn't useable for instance I had to use the InterlockedExchange API to replace VarPtr).

    Hardware isn't the only thing that has drivers. Windows comes with numerous drivers unrelated to hardware. I'm working on file system filter drivers now... antivirus tools like Windows Defender use these, among others.

    The project comes with code that loads it. It's in post #4. You use the Service API; CreateService with SERVICE_KERNEL_DRIVER.

    There's ways to load unsigned drivers; obviously developers can't send every single test build off to Microsoft for signing. There's an advanced boot option to allow them; or attaching a kernel debugger. Earlier Windows versions allow you to enable installing unsigned drivers.

    This is still the coolest VB6 project I've ever seen, and I've run the project myself and am working on my own--- I've got Wayne interested and it looks like we'll get this functionality easier in twinBasic, so that should mean being able to compile them for x64 Windows too (you need 32bit Windows for VB6 projects like this).
    Last edited by fafalone; Jul 24th, 2022 at 08:32 AM.

  24. #24
    Frenzied Member
    Join Date
    Oct 2008
    Posts
    1,181

    Re: [VB6] - Kernel mode driver.

    Quote Originally Posted by fafalone View Post
    Did you even read the post? The trick made it pretty easy to follow, all the code is there, and a link to the tool to remove msvbvm60.

    The vbp makes use of an undocumented option to provide instructions to the linker. This is used to override the default entry point (making it DriverEntry instead of ThunRTMain), and specify native subsystem instead of GUI.

    The trick created a tool that then removes the msvbvm60.dll dependency (obviously, this means tons of stuff isn't useable for instance I had to use the InterlockedExchange API to replace VarPtr).

    Hardware isn't the only thing that has drivers. Windows comes with numerous drivers unrelated to hardware. I'm working on file system filter drivers now... antivirus tools like Windows Defender use these, among others.

    The project comes with code that loads it. It's in post #4. You use the Service API; CreateService with SERVICE_KERNEL_DRIVER.

    There's ways to load unsigned drivers; obviously developers can't send every single test build off to Microsoft for signing. There's an advanced boot option to allow them; or attaching a kernel debugger. Earlier Windows versions allow you to enable installing unsigned drivers.

    This is still the coolest VB6 project I've ever seen, and I've run the project myself and am working on my own--- I've got Wayne interested and it looks like we'll get this functionality easier in twinBasic, so that should mean being able to compile them for x64 Windows too (you need 32bit Windows for VB6 projects like this).

    So does the CreateService API function require a signed driver (or alternatively enabling test-signing mode) to function? It also clearly runs runs it as a service, which usually means adding it to the registry. Right? So how do you uninstall (remove the registry entries) for the driver when you don't want to use it anymore? And regarding test-signing mode, does enabling test-signing mode disable the signing requirement altogether, or does it now mean you need to generate your own self signed certificate, and then sign the driver manually? If so, how do you do that (easiest way to generate cert, and sign your own driver)?

  25. #25
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    Driver signing is enforced at a lower level; I don't think the service manager itself cares. You could presumably use a .inf to put it into the startup to load it that way too.

    The demo here removes it when you stop it; you just use the DeleteService API like removing any other service.

    The signing requirement is disabled all together if you boot into test mode; otherwise from the link I posted,
    Enforcing Kernel-Mode Signature Verification in Kernel Debugging Mode
    However, there are situations in which a developer might need to have a kernel debugger attached, yet also need to maintain load-time signature enforcement. For example, when a driver stack has an unsigned driver (such as a filter driver) that fails to load it may invalidate the entire stack. Because attaching a debugger allows the unsigned driver to load, the problem appears to vanish as soon as the debugger is attached. Debugging this type of issue may be difficult.

    In order to facilitate debugging such issues, the kernel-mode code signing policy supports the following registry value:

    C++

    Copy
    HKLM\SYSTEM\CurrentControlSet\Control\CI\DebugFlags
    This registry value is of type REG_DWORD, and can be assigned a value based on a bitwise OR of one or more of the following flags:

    0x00000001
    This flag value configures the kernel to break into the debugger if a driver is unsigned. The developer or tester can then choose to load the unsigned driver by entering g at the debugger prompt.

    0x00000010
    This flag value configures the kernel to ignore the presence of the debugger and to always block an unsigned driver from loading.
    There's endless contradictory information about self-signing out there. Boot vs not boot, x64 vs x86, SecureBoot... I honestly have no idea under what conditions self-signing will work for kernel mode.

    There might be an undocumented, unlicensed method.

  26. #26
    Frenzied Member
    Join Date
    Oct 2008
    Posts
    1,181

    Re: [VB6] - Kernel mode driver.

    Quote Originally Posted by fafalone View Post
    Driver signing is enforced at a lower level; I don't think the service manager itself cares. You could presumably use a .inf to put it into the startup to load it that way too.

    The demo here removes it when you stop it; you just use the DeleteService API like removing any other service.

    The signing requirement is disabled all together if you boot into test mode; otherwise from the link I posted,


    There's endless contradictory information about self-signing out there. Boot vs not boot, x64 vs x86, SecureBoot... I honestly have no idea under what conditions self-signing will work for kernel mode.

    There might be an undocumented, unlicensed method.
    I looked at that, and it looked WAY too complicated for testing this one VB6 driver.

  27. #27
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    Well when it's just yourself testing it you can use one of the methods for unsigned driver testing.

  28. #28

  29. #29
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    Some questions about declarations... (not suggesting they're wrong as I'm just learning about kernel mode, but want to understand why they are as they are so I can apply it in new scenarios)

    • Why is the Exclusive argument in IoCreateDevice declared as 'int'?

      [in] BOOLEAN Exclusive,
      and
      typedef UCHAR BOOLEAN; // winnt

      ?
    • In KDPC, DpcListEntry As LIST_ENTRY, but it's a SINGLE_LIST_ENTRY, which is

      Code:
      typedef struct _SINGLE_LIST_ENTRY {
          struct _SINGLE_LIST_ENTRY *Next;
      } SINGLE_LIST_ENTRY, *PSINGLE_LIST_ENTRY;
      LIST_ENTRY has two members like that.

      I think it works because KAFFINITY ProcessorHistory; is missing (the next member).
    Last edited by fafalone; Jul 25th, 2022 at 01:21 PM.

  30. #30

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Kernel mode driver.

    Quote Originally Posted by fafalone View Post
    [*]Why is the Exclusive argument in IoCreateDevice declared as 'int'?
    There is no difference if you pass UCHAR (a byte) or int (four bytes) in STDCALL convention because the both cases uses 4 bytes in the stack. The proper variant is a byte of course. I don't remember why i used that probably i forgot to change the type. You could use a byte of course.


    Quote Originally Posted by fafalone View Post
    [*]In KDPC, DpcListEntry As LIST_ENTRY, but it's a SINGLE_LIST_ENTRY
    Definition from WDM.h (Windows Driver Kit version 7.1.0):

    Code:
    typedef struct _KDPC {
        UCHAR Type;
        UCHAR Importance;
        volatile USHORT Number;
        LIST_ENTRY DpcListEntry;
        PKDEFERRED_ROUTINE DeferredRoutine;
        PVOID DeferredContext;
        PVOID SystemArgument1;
        PVOID SystemArgument2;
        __volatile PVOID DpcData;
    } KDPC, *PKDPC, *PRKDPC;

  31. #31
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    Oh good, I love it when Microsoft redefines things in seemingly incompatible ways without explanation lol

    In WDM.h from WDK 10.0.2261.1 I have

    Code:
    typedef struct _KDPC {
        union {
            ULONG TargetInfoAsUlong;
            struct {
                UCHAR Type;
                UCHAR Importance;
                volatile USHORT Number;
            } DUMMYSTRUCTNAME;
        } DUMMYUNIONNAME;
    
        SINGLE_LIST_ENTRY DpcListEntry;
        KAFFINITY ProcessorHistory;
        PKDEFERRED_ROUTINE DeferredRoutine;
        PVOID DeferredContext;
        PVOID SystemArgument1;
        PVOID SystemArgument2;
        __volatile PVOID DpcData;
    } KDPC, *PKDPC, *PRKDPC;

  32. #32
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    I couldn't figure out why a similar driver I made based on this method was bluescreening; and I eventually worked all the way back to trying to compile the sample simply with a name change. That worked. But in a new VBP (again, only your code besides name change) it does not; blue screen. I compared the VBPs;

    TrickMemReader.vbp
    NoAliasing=-1
    BoundsCheck=-1
    OverflowCheck=-1
    FlPointCheck=-1
    FDIVCheck=-1
    UnroundedFP=-1

    Defaults (in my vbp; "Compile with all default optimizations", so I changed nothing)

    NoAliasing=0
    BoundsCheck=0
    OverflowCheck=0
    FlPointCheck=0
    FDIVCheck=0
    UnroundedFP=0

    I'm not sure which one(s) are mandatory, but at least one is, and it's not mentioned. When I enabled them all like your project, the bluescreening was resolved and my own code (to do something different) now works.

  33. #33

  34. #34
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    So I did some experimenting.

    Only "Remove integer overflow checks' is required.

    But checking 'No optimizations' and leaving "Remove integer overflow checks" blue screens.

    Do you know if 'No optimizations' is overriding 'Remove integer overflow checks'; or is this a different issue?

    (Note... Further testing for the floating point ops might be needed if you actually use floating point operations)

  35. #35
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    Thanks to the techniques and information from this project, I created a (simpler) x64-compatible kernel mode driver in twinBASIC



    This project has been quite the inspiration. The_trick figured out how to hack VB to do this and posted this brilliant project... I was endlessly fascinated with the possibilities, I got Wayne interested, he added the ability to target the native subsystem in tB... and now it's possible for VB programmers to make drivers for the dominant 64-bit Windows versions

    There's a lot fewer limitations in tB... the lack of runtime means things like VarPtr can be used directly, and it looks like soon it'll have a way to use String literals instead of the manually-defined arrays here.

  36. #36
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    Forgive me as I'm very bad at this kind of logic: For 64bit addresses, would lpStart be extended to &HFFFFFFFFFFFFF000, or the same? I'd assume pgOfst &HFFF and the &H1000 count would stay the same as that's just for the 4KB page size (which is the same on x64).

    I'm making a utility driver with a number of functions and wanted to include the memory reading command from this.

  37. #37
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] - Kernel mode driver.

    Interlocked Exchange API to replace VarPtr
    Excuse me, how to write this code?

    Did you make any driver for the write driver? What is the specific purpose?

    Maybe now the 32-bit driver can only run in a virtual machine?

  38. #38
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,092

    Re: [VB6] - Kernel mode driver.

    Quote Originally Posted by xiaoyao View Post
    Interlocked Exchange API to replace VarPtr
    Excuse me, how to write this code?

    Did you make any driver for the write driver? What is the specific purpose?

    Maybe now the 32-bit driver can only run in a virtual machine?
    Does hijacking threads work for you? Do you get more responses this way?

    Can you exercise some common sense when posting in these forums?

    cheers,
    </wqw>

  39. #39
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,625

    Re: [VB6] - Kernel mode driver.

    The trick's typelib for this project already answers the question anyway.

    Note that if you're doing code verification/bug checking between VB for 32bit and tB for 64bit, InterlockedExchange is not exported on x64, but you can use VarPtr in tB as it doesn't rely on an outside runtime.

  40. #40

    Thread Starter
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] - Kernel mode driver.

    Quote Originally Posted by fafalone View Post
    Forgive me as I'm very bad at this kind of logic: For 64bit addresses, would lpStart be extended to &HFFFFFFFFFFFFF000, or the same? I'd assume pgOfst &HFFF and the &H1000 count would stay the same as that's just for the 4KB page size (which is the same on x64).

    I'm making a utility driver with a number of functions and wanted to include the memory reading command from this.
    Yes. The kernel address space is negative numbers.

Page 1 of 2 12 LastLast

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width