' // 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.
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:
- DriverUnload - deinitialize driver;
- DriverCreateClose - when opening and closing device;
- 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:
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.
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:
- In the field Subsystem, structure IMAGE_OPTIONAL_HEADER PE-driver file should be the value that corresponds to IMAGE_SUBSYSTEM_NATIVE kernel-mode driver.
- Specify as the entry point of our procedure DriverEntry
- Add a relocation section, in order that the driver can be loaded at any address.
- 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
No comments:
Post a Comment