Treiber Handling

[nanix]

Ok i translated this from opensyslib which is an open source driver.I just cant figure out where the bug is becouse it wont do nothing. :oops:

I just can't find the bug.. :?

Delphi-Quellcode:

unit DriverFuncs;

interface

uses winsvc, Classes, SysUtils, Variants, Windows, driverConSTS;

function InstallDriver(hSCManager: SC_HANDLE; DriverId, DriverPath: string):
  Boolean;
function RemoveDriver(hSCManager: SC_HANDLE; DriverId: string): Boolean;
function StartDriver(hSCManager: SC_HANDLE; DriverId: string): Boolean;
function StopDriver(hSCManager: SC_HANDLE; DriverId: string): Boolean;
function SystemInstallDriver(hSCManager: SC_HANDLE; DriverId, DriverPath:
  string): Boolean;
function IsSystemInstallDriver(hSCManager: SC_HANDLE; DriverId, DriverPath:
  string): Boolean;
function ManageDriver(DriverId, DriverPath: string; _Function: Integer):
  Boolean;

function OpenDriver():Boolean;

implementation

var
 gHandle:THANDLE;

//-----------------------------------------------------------------------------
//
// Open Driver
//
//-----------------------------------------------------------------------------

function OpenDriver():boolean;
begin
   gHandle:= CreateFile(Driver_DRIVER_ID,
        GENERIC_READ or GENERIC_WRITE,
        0,
        nil,
        OPEN_EXISTING,
        FILE_ATTRIBUTE_NORMAL,
        0
        );


    if gHandle = INVALID_HANDLE_VALUE then
    begin
    result:=FALSE;
    end
    else
   result:=TRUE;
end;

//-----------------------------------------------------------------------------
//
// Manage Driver
//
//-----------------------------------------------------------------------------

function ManageDriver(DriverId, DriverPath: string; _Function: Integer):
  Boolean;
  var
  hSCManager: SC_HANDLE;
  rCode: Boolean;
  error: Dword;
begin

  hSCManager := 0;
  rCode := False;
  error := NO_ERROR;

  if (DriverId = '') and (DriverPath = '') then
  begin
    result := FALSE;
  end;

  hSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);

  if hSCManager = 0 then
  begin
    result := FALSE;
  end;



  if _Function=OLS_DRIVER_INSTALL then begin
        if InstallDriver(hSCManager, DriverId, DriverPath) then
        rCode := rCode = StartDriver(hSCManager, DriverId);
  end;

  if _Function=OLS_DRIVER_REMOVE then begin
      if  IsSystemInstallDriver(hSCManager, DriverId,
      DriverPath)=false then
      begin
        StopDriver(hSCManager, DriverId);
        rCode := RemoveDriver(hSCManager, DriverId);
      end;
  end;


  if _Function=OLS_DRIVER_SYSTEM_INSTALL then begin
      if IsSystemInstallDriver(hSCManager, DriverId, DriverPath) then
      rCode := True

      else
      begin

        if OpenDriver()=false then
        begin
          StopDriver(hSCManager, DriverId);
          RemoveDriver(hSCManager, DriverId);

          if InstallDriver(hSCManager, DriverId, DriverPath) then
          begin
            StartDriver(hSCManager, DriverId);
          end;
          OpenDriver();
         end;

        rCode := SystemInstallDriver(hSCManager, DriverId, DriverPath);
      end;
   end;


   if _Function=OLS_DRIVER_SYSTEM_UNINSTALL then begin

    if IsSystemInstallDriver(hSCManager, DriverId, DriverPath)=false then
       rCode:=True
       else begin
          if not gHandle=INVALID_HANDLE_VALUE then begin
          CloseHandle(gHandle);
          gHandle:=INVALID_HANDLE_VALUE;
          end;

          if StopDriver(hSCManager, DriverId) then begin
          rCode:=RemoveDriver(hSCManager,DriverId);
          end;

          if not hSCManager=0 then begin
          CloseServiceHandle(hSCManager);
          end;

          result:=rCode;

       end;
     end;
   end;

//-----------------------------------------------------------------------------
//
// Install Driver
//
//-----------------------------------------------------------------------------

function InstallDriver(hSCManager: SC_HANDLE; DriverId, DriverPath: string):Boolean;
var
  hService: SC_HANDLE;
  rCode: Boolean;
  error: Dword;
begin
  hService := 0;
  rCode := False;
  error := NO_ERROR;

   hService:= CreateService(hSCManager,
                     pchar(DriverId),
                     pchar(DriverId),
                     SERVICE_ALL_ACCESS,
                     SERVICE_KERNEL_DRIVER,
                     SERVICE_DEMAND_START,
                     SERVICE_ERROR_NORMAL,
                     pchar(DriverPath),
                     Nil,
                     Nil,
                     Nil,
                     Nil,
                     Nil);


    if hService= 0 then
    error:= GetLastError();

  if error=ERROR_SERVICE_EXISTS then
     rCode:= TRUE
   else
        rCode:= TRUE;
      CloseServiceHandle(hService);
      result:=rCode;
end;

//-----------------------------------------------------------------------------
//
// System Install Driver
//
//-----------------------------------------------------------------------------

function SystemInstallDriver(hSCManager: SC_HANDLE; DriverId, DriverPath:
  string): Boolean;
var
  hService:SC_HANDLE;
   rCode:boolean;
begin
  hService:=0;
  rCode:=False;

   hService:=OpenService(hSCManager, pchar(DriverId), SERVICE_ALL_ACCESS);

   if not hService= 0 then begin
      rCode:= ChangeServiceConfig(hService,
                     SERVICE_KERNEL_DRIVER,
                     SERVICE_AUTO_START,
                     SERVICE_ERROR_NORMAL,
                     pchar(DriverPath),
                     Nil,
                     Nil,
                     Nil,
                     Nil,
                     Nil,
                     Nil
                     );
      CloseServiceHandle(hService);
  end;

   result:=rCode;
end;

//-----------------------------------------------------------------------------
//
// Remove Driver
//
//-----------------------------------------------------------------------------

function RemoveDriver(hSCManager: SC_HANDLE; DriverId: string): Boolean;
var
 hService:SC_HANDLE;
 rCode:Boolean;
begin
hService:=0;
rCode:=False;

hService:= OpenService(hSCManager,pchar(DriverId), SERVICE_ALL_ACCESS);

    if hService=0 then begin
       rCode:= TRUE
       end
   else begin
      rCode := DeleteService(hService);
      CloseServiceHandle(hService);
   end;

   result:=rCode;
end;

//-----------------------------------------------------------------------------
//
// Start Driver
//
//-----------------------------------------------------------------------------

function StartDriver(hSCManager: SC_HANDLE; DriverId: string): Boolean;
var
  hService:SC_HANDLE;
  rCode:Boolean;
  error:DWORD;
  b:pchar;
begin
  b:=nil;
  hService:=0;
  rCode:=False;
  error:=NO_ERROR;

   hService:= OpenService(hSCManager, pchar(DriverId), SERVICE_ALL_ACCESS);

    if not hService=0 then begin
          if StartService(hService, 0, b) = false then
             error:= GetLastError();
             if error=ERROR_SERVICE_ALREADY_RUNNING then
                  rCode:=True
             else begin
             rCode:=True;
             CloseServiceHandle(hService);
             end;


  end;
 result:=rCode;
end;

//-----------------------------------------------------------------------------
//
// Stop Driver
//
//-----------------------------------------------------------------------------

function StopDriver(hSCManager: SC_HANDLE; DriverId: string): Boolean;
var
  hService:SC_HANDLE;
  rCode:Boolean;
  error:DWORD;
  serviceStatus:_SERVICE_STATUS;
begin
  hService:=0;
  rCode:=False;
  error:=NO_ERROR;

   hService:= OpenService(hSCManager, pchar(DriverId), SERVICE_ALL_ACCESS);

    if not hService=0 then begin
      rCode:= ControlService(hService, SERVICE_CONTROL_STOP,serviceStatus);
      error:= GetLastError();
    CloseServiceHandle(hService);
    end;
    result:=rCode;
end;

//-----------------------------------------------------------------------------
//
// IsSystemInstallDriver
//
//-----------------------------------------------------------------------------

function IsSystemInstallDriver(hSCManager: SC_HANDLE; DriverId, DriverPath:
  string): Boolean;
var
  ServiceConfig: PQueryServiceConfig;
  hService  : SC_HANDLE;
  Ss    : TServiceStatus;
  dw_size:dword;
  MemToFree: integer;

begin
  result:=true;
  exit;


      hService := OpenService(hSCManager, PChar(DriverId), SERVICE_ALL_ACCESS);

      if not hService = 0 then
      begin
      Exit;
      end;

      try
        QueryServiceConfig(hService, nil, 0, dw_size); // Get Buffer Length
        GetMem(ServiceConfig, dw_size + 1);
        MemToFree := dw_size + 1;
        try
          if not  QueryServiceConfig(hService, ServiceConfig, dw_size + 1, dw_size) then // Get Buffer Length
          begin
            Exit;
          end;
        
        finally
        FreeMem(ServiceConfig);
        end;

        if ServiceConfig.dwServiceType=SERVICE_AUTO_START then
        result:=True;

      finally
        CloseServiceHandle(hService);
        CloseServiceHandle(hSCManager);
    end;
  end;


  end.

[himitsu]

Classes, SysUtils, Variants and the DelphiMemoryManager (String) do not belong in a driver.

Only use low level funktions (kernel mode) and no fuctions from user mode.
And the original System.dcu is also "highly" developed. That lends itself seems to be a limited version.

http://www.google.de/search?q=%22Treiber+in+Delphi%22

[wicht]

The source posted here does not seem to belong to a driver.
It looks more like an application the user runs to install/start/stop/remove a driver.

[nanix]

Who said this is an driver?This is a unit to install and uninstall the driver :zwinker:

How would this look in delphi?

Zitat:

NTSTATUS WritePciConfig(
void *lpInBuffer,
ULONG nInBufferSize,
void *lpOutBuffer,
ULONG nOutBufferSize,
ULONG *lpBytesReturned
);

Delphi-Quellcode:

Function WritePCIConfig(.......

[himitsu]

probably

Delphi-Quellcode:

function WritePciConfig(lpInBuffer: Pointer; nInBufferSize: LongWord; lpOutBuffer: Pointer;
  nOutBufferSize: LongWord; lpBytesReturned: PLongWord): LongWord; StdCall;

// or

function WritePciConfig(lpInBuffer: Pointer; nInBufferSize: LongWord; lpOutBuffer: Pointer;
  nOutBufferSize: LongWord; var lpBytesReturned: LongWord): LongWord; StdCall;

Here there is nothing difficult, and it should all easily translate itself.

[nanix]

Is there a tool to make this a bit easier? :stupid:

It should be function

Delphi-Quellcode:

WritePciConfig(lpInBuffer: Pointer; nInBufferSize: LongWord; lpOutBuffer: Pointer; 
  nOutBufferSize: LongWord; lpBytesReturned: PLongWord): NTSTATUS; StdCall;

[JamesTKirk]

Try h2pas which is included with Free Pascal. It allows you to (mostly) convert C declarations to Pascal ones. Don't forget to study its options. I may not translate everything you feed it with, but it's rather helpful.

Regards,
Sven

Edit: Where did you find this OpenSysLib? I'm curious. :mrgreen:

[nanix]

Contact me and ill tell you everything you need to know aswell which functions you should translate. :)

I am nearly done translating it then ill just need to modify it a bit for FPC compiler :-D

[JamesTKirk]

Zitat:

Zitat von nanix

Contact me and ill tell you everything you need to know aswell which functions you should translate. :)

I meant "It may not translate everything (...)" :oops:

Zitat:

Zitat von nanix

I am nearly done translating it then ill just need to modify it a bit for FPC compiler :-D

The converted code can also be used with Delphi. You may remember this tool in the future, because it's really helpful ;)

Regards,
Sven

[nanix]

I mean the system functions like WRMSR/RDMSR CPUID functions and similar.Don't go too crazy on it though.

ntddk.cpp is like 400kb translating all of it would be craaazyyy.But would be perfect and mad at the same time. :gruebel:

[JamesTKirk]

Zitat:

Zitat von nanix

ntddk.cpp is like 400kb translating all of it would be craaazyyy.But would be perfect and mad at the same time.

That's why I decided to follow the "translate on demand" approach. At least until the port is mature enough to "stand on its own feet" and others start to contribute. ;)

Regards,
Sven

[Muetze1]

CPUID is not a privileged instruction and can be used in user mode (ring 3). So there is no need to use a driver for this instruction.

RDMSR is mostly usable from user mode, example is the TSC MSR register 10h, so RDTSC is also executable in user mode.

[nanix]

Yea correct Muetze but then you got PCI Config Read and Write which very usefull IMHO :-D

[Muetze1]

Zitat:

Zitat von nanix

Yea correct Muetze but then you got PCI Config Read and Write which very usefull IMHO :-D

Why write? PCI Configuration Registered are written (and configured) partly by the BIOS (PnP OS false) and at least by the OS. The OS is the system knowing all memory, port and address spaces and can configure the devices. When you write anything under an OS like Windows to these registers, you get in trouble as the OS does not get informed about these changes.

If you just want to get information for an system information tool, you can use the WMI and HAL interfaces to gather these informations.

All your posts just reminds me of razor...

[nanix]

Becouse i will make write.No i am not Razor.I find this forum very interesting.Lots of good people here.Sad to see you equal every english people :oops:

[alzaimar]

Zitat:

Zitat von nanix

No i am not Razor.

"Only the true Messiah denies His divinity."

Zitat:

Zitat von nanix

Sad to see you equal every english people :oops:

Sure you're english? :zwinker:

[nanix]

Yes i speak english.I mean english as english i am only one on this forum.

[nanix]

:) Ok i fully translated it.

But now how do i convert the units to lazarus.And how would the make file look.
Thanks!

[JamesTKirk]

Just try to compile the units with FPC.

E. g. in a shell run

Code:

fpc -Pi386 -FuPath/To/Other/Units yourunit.pas

When you try this on Windows you should use "\" of course. If you need to compile for Win64 then you need to use this instead of "-Pi386":

Code:

-Px86_64 -Twin64

If you get errors you might need to add the following between "unit bla;" and "interface":

Delphi-Quellcode:

{$ifdef fpc}
  {$mode delphi}{$H+}
{$endif}

Also you might need to correct some types. If you have types that are different from Delphi to Free Pascal then use the following construct:

Delphi-Quellcode:

{$ifdef fpc}TMyFPCType{$else}TMyDelphiType{$endif}

You can also use this inside the declaration of a function.

If you have errors you can't solve by yourself, then you might start a new topic in the FPC subforum.

Regards,
Sven

[nanix]

I tested the driver on a 32 bit Vista Home Premium and it works OK.Just like the original one coded with C.Now just the 64 bit one. :zwinker:

[nanix]

Okay so should i use 32 bit with delphi and FPC for 64 or FPC for both.

What do you advise? :)

[cookie22]

doesn't matter if both work, does it? ;)

[nanix]

Yes that is true but how would it look in lazarus the make file?

in delphi i now use this..

Delphi-Quellcode:

bin\dcc32 -UC:\test1\include -B -CG -JP -$A-,C-,D-,G-,H-,I-,L-,P-,V-,W+,Y- -O+ driver.pas
bin\rmcoff2 driver.obj
bin\link /NOLOGO /ALIGN:32 /BASE:0x10000 /SUBSYSTEM:NATIVE /DRIVER /LIBPATH:C:\test1\lib /ENTRY:DriverEntry ntoskrnl.lib hal.lib win32k.lib ntdll.lib ntutils.lib /out:driver.sys driver.obj

Does FPC/lazarus compile only for normal x64 becouse there is IA x64 and AMD x64 :gruebel: :gruebel:

[JamesTKirk]

Zitat:

Zitat von nanix

Yes that is true but how would it look in lazarus the make file?

in delphi i now use this..

Delphi-Quellcode:

bin\dcc32 -UC:\test1\include -B -CG -JP -$A-,C-,D-,G-,H-,I-,L-,P-,V-,W+,Y- -O+ driver.pas
bin\rmcoff2 driver.obj
bin\link /NOLOGO /ALIGN:32 /BASE:0x10000 /SUBSYSTEM:NATIVE /DRIVER /LIBPATH:C:\test1\lib /ENTRY:DriverEntry ntoskrnl.lib hal.lib win32k.lib ntdll.lib ntutils.lib /out:driver.sys driver.obj

You may try this (it's a suggestion and not tested):

Code:

fpc -FuC:\test1\include -Mdelphi driver.pas
bin\rmcoff2 driver.o
bin\link /NOLOGO /ALIGN:32 /BASE:0x10000 /SUBSYSTEM:NATIVE /DRIVER /LIBPATH:C:\test1\lib /ENTRY:DriverEntry ntoskrnl.lib hal.lib win32k.lib ntdll.lib ntutils.lib /out:driver.sys driver.obj

I don't know what options link needs to link a 64-bit file. Perhaps

Code:

/ALIGN:64

is enough.
For compiling 64-bit code you also need the 64-bit version of FPC. You can then define the target plattform with

Code:

-Pi386

for 32-bit and

Code:

-Px86_64

for 64-bit.

I currently don't know how to define the switches (after -$ in your code) in the command line, so you might need to define these in your code like this (example for H-):

Delphi-Quellcode:

{$H-}

Zitat:

Zitat von nanix

Does FPC/lazarus compile only for normal x64 becouse there is IA x64 and AMD x64 :gruebel: :gruebel:

Currently FPC only supports AMD x86.

Note: IA x64 is something completly different to normal 64-bit found on common processors (including Intel processors). So AMD x86 is normally sufficient!

Regards,
Sven

[nanix]

Thank you for your information.I am a bit amazed that i am the only one that figured this out :)

The driver itself has about 3000 lines of code.


Also James what do you think about adding dbpring on exceptions and errors.This would make debuging much easier.Becouse you can then inspect the driver.See whats going on in realtime.

Regards,
nanix

[JamesTKirk]

Zitat:

Zitat von nanix

Thank you for your information.I am a bit amazed that i am the only one that figured this out :)

Perhaps that's because noone else (in this forum) is using the kit you are using ;)

Zitat:

Zitat von nanix

Also James what do you think about adding dbpring on exceptions and errors.This would make debuging much easier.Becouse you can then inspect the driver.See whats going on in realtime.

That's basically the purpose of DbgPrint :D If possible I'll try to implement the stack trace feature of Free Pascal, which allows you to find the unit and line where an exception occured. (That will be very handy when used with DbgPrint ;) )

I don't know how well the Delphi kernel mode handles exceptions, but in the case of my port I've not yet enabled the interaction with system exceptions (like Access Violation, Div By Zero, etc.), but exceptions that are thrown by Pascal code (with raise) are handled if there is a surrounding except block. One should nevertheless catch all exceptions because the result of not doing this might be an infamous BSOD :mrgreen:

Regards,
Sven

[nanix]

Ah yes James but how are you going to see which line it was if you get an BSOD fast.I think ill add some kind of dump soon as it happens it will dump it to the HDD even before BSOD happens.

[JamesTKirk]

The kernel already creates a dump for you if you enable that (you can sometimes see the progress of saving it on the bottom of a BSOD) and WinDbg can extract the last DbgPrint messages for you out of this dump. That's one of those parts the guys at Microsoft did well :mrgreen:

A note about BSODs: The kernel still runs when a BSOD occurs, that's the reason why it can print to the screen and dump the memory. You can also connect to a NT machine via Null Modem cable and activate the built in kernel debugger. This debugger is also activated when a BSOD occurs, so you can debug around :) (you might need a debug build of Windows to be able to use the kernel debugger, though)

Regards,
Sven