modified AnalyzerU.dfm

modified   AnalyzerU.pas
deleted    DLPORTIO.dll
deleted    DLPORTIO.sys
modified   SMBus.pas
added      ddkint.pas
added      zlportio.pas
added      zlportio.sys
i: converted to support ZlPortIO (because DLPortIO needed to be installed as a system service, didn't like it)
+: SONY SMBus controller support added
+: SMBus reading implemented

AnalyzerU.dfm

@@ -11,6 +11,7 @@ object AForm: TAForm
   Font.Name = 'MS Sans Serif'
   Font.Style = []
   OldCreateOrder = False
+  OnCreate = FormCreate
   PixelsPerInch = 96
   TextHeight = 13
   object LabelHeading: TLabel
@@ -442,20 +443,73 @@ object AForm: TAForm
         Left = 0
         Top = 56
         Width = 489
-        Height = 105
+        Height = 129
         Caption = 'SMBus'
-        Enabled = False
         TabOrder = 1
+        object LabelSMBStatus: TLabel
+          Left = 88
+          Top = 48
+          Width = 393
+          Height = 13
+          AutoSize = False
+          Caption = 'Push button to read selected SMBus device.'
+          Enabled = False
+        end
+        object LabelSMBScan: TLabel
+          Left = 165
+          Top = 20
+          Width = 316
+          Height = 13
+          AutoSize = False
+          Caption = 'Push button to scan SMBus for devices.'
+          Enabled = False
+        end
+        object Label13: TLabel
+          Left = 10
+          Top = 19
+          Width = 37
+          Height = 13
+          Caption = 'Device:'
+          Enabled = False
+        end
         object ButtonSMBScan: TButton
-          Left = 8
+          Left = 116
           Top = 16
-          Width = 75
+          Width = 45
-          Height = 17
+          Height = 21
-          Caption = 'Enum SMBus'
+          Caption = 'Scan'
           Enabled = False
           TabOrder = 0
           OnClick = ButtonSMBScanClick
         end
+        object ButtonSMBRead: TButton
+          Left = 8
+          Top = 40
+          Width = 75
+          Height = 25
+          Caption = 'Read'
+          Enabled = False
+          Font.Charset = DEFAULT_CHARSET
+          Font.Color = clWindowText
+          Font.Height = -11
+          Font.Name = 'MS Sans Serif'
+          Font.Style = [fsBold]
+          ParentFont = False
+          TabOrder = 1
+          OnClick = ButtonSMBReadClick
+        end
+        object ComboSMB: TComboBox
+          Left = 56
+          Top = 16
+          Width = 57
+          Height = 21
+          Enabled = False
+          ItemHeight = 13
+          TabOrder = 2
+          Text = '0x57'
+          Items.Strings = (
+            '0x57')
+        end
       end
     end
     object SheetAbout: TTabSheet

AnalyzerU.pas

@@ -55,8 +55,15 @@ type
     GroupSMBus: TGroupBox;
     ButtonSMBScan: TButton;
     Label1: TLabel;
+    ButtonSMBRead: TButton;
+    LabelSMBStatus: TLabel;
+    LabelSMBScan: TLabel;
+    Label13: TLabel;
+    ComboSMB: TComboBox;
     procedure ButtonOpenClick(Sender: TObject);
     procedure ButtonPCIScanClick(Sender: TObject);
+    procedure FormCreate(Sender: TObject);
+    procedure ButtonSMBReadClick(Sender: TObject);
     procedure ButtonSMBScanClick(Sender: TObject);
   private
     { Private declarations }
@@ -69,7 +76,7 @@ var
 
 implementation
 
-uses SMBus;
+uses SMBus, ZLPortIO;
 
 var
   MyPCI: PCI_Info;
@@ -221,6 +228,15 @@ begin
     else AForm.LabelCountry.Caption := '---';
 end;
 
+procedure DoAnalysis(d: array of byte);
+begin
+  ShowRAW(d);
+  CheckPwd(d);
+  CheckUUID(d);
+  CheckOEM(d);
+  CheckMachine(d);
+end;
+
 procedure TAForm.ButtonOpenClick(Sender: TObject);
 var f: file of byte;
     d: array[0..255] of byte;
@@ -231,12 +247,8 @@ begin
     Reset(f);
     for i:=0 to 255 do Read(f,d[i]);
     CloseFile(f);
-    ShowRAW(d);
+    DoAnalysis(d);
-    CheckPwd(d);
+    AForm.PageControl1.ActivePageIndex := 0;
-    CheckUUID(d);
-    CheckOEM(d);
-    CheckMachine(d);
-    PageControl1.ActivePageIndex := 0;
   end;
 end;
 
@@ -258,9 +270,60 @@ begin
   end;
 end;
 
+procedure TAForm.FormCreate(Sender: TObject);
+begin
+  if NOT ZlIOStarted then ShowMessage('The driver ZLPORTIO.SYS could not be loaded. The program won''t be able to read out SMBus under Windows NT/2000/XP! Make sure, the file is in path or in the program directory.');
+end;
+
+function PowerInt(base, exp: integer): Int64;
+begin
+  if (exp = 0) then Result := 1 else begin
+    Result := base;
+    while (exp>1) do begin
+      Result := Result * base;
+      Dec(exp);
+    end;
+  end;
+end;
+
+function HexToInt(x: string): int64;
+const hexset = '0123456789abcdef';
+var i, p: integer;
+begin
+  Result := 0;
+  if Length(x)<=8 then begin
+    x := LowerCase(x);
+    i := Pos('0x', x);
+    if (i>0) then Delete(x, 1, i+1);
+    for i:=1 to Length(x) do begin
+      p := Pos(x[i], hexset)-1;
+      if (p>0) then Result := Result + p*PowerInt(16, Length(x)-i);
+    end;
+  end;
+end;
+
+procedure TAForm.ButtonSMBReadClick(Sender: TObject);
+var i: integer;
+    dev: word;
+    d: TSMBData;
+begin
+  dev := HexToInt(AForm.ComboSMB.Text);
+  if dev=$57 then begin
+    Screen.Cursor := crHourGlass;
+    for i:=0 to 255 do begin
+      AForm.LabelSMBStatus.Caption := 'Now reading offset 0x'+IntToHex(i,2)+' ...';
+      Application.ProcessMessages;
+      d[i] := smbGetReg(MyPCI.SMB_Address, i, dev);
+    end;
+    Screen.Cursor := crDefault;
+  end;
+  DoAnalysis(d);
+  AForm.PageControl1.ActivePageIndex := 0;
+end;
+
 procedure TAForm.ButtonSMBScanClick(Sender: TObject);
 begin
-  //asd
+  AForm.LabelSMBScan.Caption := IntToHex(smbGetReg(MyPCI.SMB_Address, $01, $10), 2);
 end;
 
 end.

SMBus.pas

@@ -2,7 +2,7 @@ unit SMBus;
 
 interface
 
-  uses Forms, StdCtrls;
+  uses Forms, StdCtrls, ZLPortIO;
 
   type
     PCI_Info = record
@@ -16,8 +16,11 @@ interface
       Fun: byte;
       SMB_Address: word;
     end;
+    TSMBData = array[0..255] of byte;
 
     function Scan_PCI(Application: TApplication; Status: TLabel): PCI_Info;
+    function smbGetReg(BaseAddr: word; Reg: byte; Slave: byte): word;
+    function smbGetArray(BaseAddr: word; Reg: byte; Slave: byte; len: byte): TSMBData;
 
 implementation
 
@@ -27,10 +30,10 @@ const
   RW_WRITE = 0;
   RW_READ = 1;
 
-function DlPortReadPortUchar(Port: cardinal): cardinal; stdcall; external'dlportio.dll';
+// function DlPortReadPortUchar(Port: cardinal): cardinal; stdcall; external'dlportio.dll';
-function DlPortReadPortUlong(Port: cardinal): cardinal; stdcall; external'dlportio.dll';
+// function DlPortReadPortUlong(Port: cardinal): cardinal; stdcall; external'dlportio.dll';
-procedure DlPortWritePortUchar(Port: cardinal; Value: cardinal); stdcall; external'dlportio.dll';
+// procedure DlPortWritePortUchar(Port: cardinal; Value: cardinal); stdcall; external'dlportio.dll';
-procedure DlPortWritePortUlong(Port: cardinal; Value: cardinal); stdcall; external'dlportio.dll';
+// procedure DlPortWritePortUlong(Port: cardinal; Value: cardinal); stdcall; external'dlportio.dll';
 
 // http://www.tsgroup.it/smbus/index.htm
 function Get_PCI_Reg(Bus: cardinal;Dev: cardinal;Fun: cardinal;Reg: cardinal): cardinal;
@@ -42,10 +45,14 @@ begin
   cc := cc or ((Dev and $1F) shl 11);//Dev
   cc := cc or ((Fun and $07) shl 8);//func
   cc := cc or ((Reg and $FC));//Reg
-  t := DlPortReadPortUlong($CF8);
+  //t := DlPortReadPortUlong($CF8);
-  DlPortWritePortUlong($CF8, cc);
+  //DlPortWritePortUlong($CF8, cc);
-  Result := DlPortReadPortUlong($CFC);
+  //Result := DlPortReadPortUlong($CFC);
-  DlPortWritePortUlong($CF8, t);
+  //DlPortWritePortUlong($CF8, t);
+  t := PortReadL($CF8);
+  PortWriteL($CF8, cc);
+  Result := PortReadL($CFC);
+  PortWriteL($CF8, t);
 end;
 
 // http://www.tsgroup.it/smbus/index.htm
@@ -86,6 +93,13 @@ begin
         PCI_Structure.Vendor_Name := 'Intel®';
         PCI_Structure.Device_Name := '82801BA/ICH2';
       end;
+    $24C38086:
+      begin
+        PCI_Structure.SMB_Address := Get_PCI_Reg(Bus, Dev, Fun, $20) and $FFF0;
+        PCI_Structure.Rev := Get_PCI_Reg(Bus, Dev, Fun, 8) and $FF;
+        PCI_Structure.Vendor_Name := 'Intel®';
+        PCI_Structure.Device_Name := '82801DB/DBM';
+      end;
   else
     PCI_Structure.SMB_Address := 0;
     PCI_Structure.Rev := 0;
@@ -138,23 +152,29 @@ procedure smbWaitForFree(BaseAddr: word);
 var
   Status: byte;
 begin
-  Status := DlPortReadPortUchar(BaseAddr);
+  //Status := DlPortReadPortUchar(BaseAddr);
+  Status := PortReadB(BaseAddr);
   while (Status and 1) <> 0 do begin
     Application.ProcessMessages;
-    Status := DlPortReadPortUchar(BaseAddr);
+    //Status := DlPortReadPortUchar(BaseAddr);
+    Status := PortReadB(BaseAddr);
+  end;
+  if (Status and $1e) <> 0 then begin
+    //DlPortWritePortUchar(BaseAddr, Status);
+    PortWriteB(BaseAddr, Status);
   end;
-  if (Status and $1e) <> 0 then
-    DlPortWritePortUchar(BaseAddr, Status);
 end;
 
 procedure smbWaitForEnd(BaseAddr: word);
 var
   Status: byte;
 begin
-  Status := DlPortReadPortUchar(BaseAddr);
+  //Status := DlPortReadPortUchar(BaseAddr);
+  Status := PortReadB(BaseAddr);
   while (Status and 1) = 1 do begin
     Application.ProcessMessages;
-    Status := DlPortReadPortUchar(BaseAddr);
+    //Status := DlPortReadPortUchar(BaseAddr);
+    Status := PortReadB(BaseAddr);
   end;
 end;
 
@@ -163,14 +183,18 @@ var
   Dump1: word;
 begin
   smbWaitForFree(BaseAddr);
-  DlPortWritePortUchar(BaseAddr + 3, CMD);
+//  DlPortWritePortUchar(BaseAddr + 3, CMD);
-  DlPortWritePortUchar(BaseAddr + 4, (Slave shl 1) or RW);
+//  DlPortWritePortUchar(BaseAddr + 4, (Slave shl 1) or RW);
-  DlPortWritePortUchar(BaseAddr + 2, $48);
+//  DlPortWritePortUchar(BaseAddr + 2, $48);
-  sleep(1);
+  PortWriteB(BaseAddr + 3, CMD);
-  Application.ProcessMessages;
+  PortWriteB(BaseAddr + 4, (Slave shl 1) or RW);
+  PortWriteB(BaseAddr + 2, $48);
+  Sleep(1);
   smbWaitForEnd(BaseAddr);
-  Dump1 := ( DlPortReadPortUchar(BaseAddr + 6) shl 8);
+//  Dump1 := ( DlPortReadPortUchar(BaseAddr + 6) shl 8);
-  Dump1 := Dump1 or DlPortReadPortUchar(BaseAddr + 5);
+//  Dump1 := Dump1 or DlPortReadPortUchar(BaseAddr + 5);
+  Dump1 := ( PortReadB(BaseAddr + 6) shl 8);
+  Dump1 := Dump1 or PortReadB(BaseAddr + 5);
   Result := Dump1;
 end;
 
@@ -179,12 +203,34 @@ var
   Data: cardinal;
 begin
   smbWaitForFree(BaseAddr);
-  DlPortWritePortUchar(BaseAddr + 5, 0);
+//  DlPortWritePortUchar(BaseAddr + 5, 0);
-  DlPortWritePortUchar(BaseAddr + 6, 0);
+//  DlPortWritePortUchar(BaseAddr + 6, 0);
+  PortWriteB(BaseAddr + 5, 0);
+  PortWriteB(BaseAddr + 6, 0);
   Data := smbCallBus(BaseAddr, Reg, Slave, RW_READ);
   Result := (Data and $ff);
 end;
 
+function smbGetArray(BaseAddr: word; Reg: byte; Slave: byte; len: byte): TSMBData;
+var Data: cardinal;
+    i: byte;
+begin
+  smbWaitForFree(BaseAddr);
+  PortWriteB(BaseAddr + 5, 0);
+  PortWriteB(BaseAddr + 6, 0);
+  for i:=reg to reg+len-1 do begin
+    smbWaitForFree(BaseAddr);
+    PortWriteB(BaseAddr + 3, i);
+    PortWriteB(BaseAddr + 4, (Slave shl 1) or RW_READ);
+    PortWriteB(BaseAddr + 2, $48);
+    Sleep(1);
+    smbWaitForEnd(BaseAddr);
+    Data := ( PortReadB(BaseAddr + 6) shl 8);
+    Data := Data or PortReadB(BaseAddr + 5);
+    Result[i] := Data AND $FF;
+  end;
+end;
+
 function smbGetAddress(BaseAddr: word): string;
 var
   Data: word;
@@ -194,8 +240,10 @@ begin
   Cheque := '';
   for idx := $20 to $4F do begin
     smbWaitForFree(BaseAddr);
-    DlPortWritePortUchar(BaseAddr + 5, 0);
+//    DlPortWritePortUchar(BaseAddr + 5, 0);
-    DlPortWritePortUchar(BaseAddr + 6, 0);
+//    DlPortWritePortUchar(BaseAddr + 6, 0);
+    PortWriteB(BaseAddr + 5, 0);
+    PortWriteB(BaseAddr + 6, 0);
     Data := smbCallBus(BaseAddr, 0, idx, RW_READ);
     if (Data and $FF) <> 0 then begin
       Cheque := Cheque + IntToHex(idx,2);

ddkint.pas

@@ -0,0 +1,251 @@
+{ -----------------------------------------------------------------------------}
+{ Copyright 2000-2001, Zloba Alexander.  All Rights Reserved.                  }
+{ This unit can be freely used and distributed in commercial and private       }
+{ environments, provided this notice is not modified in any way.               }
+{ -----------------------------------------------------------------------------}
+{ Feel free to contact me if you have any questions, comments or suggestions at}
+{   zal@specosoft.com (Zloba Alexander)                                        }
+{ You can always find the latest version of this unit at:                      }
+{   http://www.specosoft.com                                                   }
+
+{ -----------------------------------------------------------------------------}
+{ Date last modified:  08/10/2001                                              }
+{ -----------------------------------------------------------------------------}
+{ Description:                                                                 }
+{   This unit include service function to work with NT drivers and some        }
+{    constant from ntddk.h                                                     }
+{------------------------------------------------------------------------------}
+{ Revision History:                                                            }
+{ 1.00:  + First public release                                                }
+{ 1.10:  + added compiler directives for correct compilation                   }
+{ 1.20:  + optimized code                                                      }
+{ 1.30:  + added constant for compatibility with delphi 3.0                    }
+{------------------------------------------------------------------------------}
+
+{$A-,H-}
+unit ddkint;
+
+interface
+uses windows,winsvc;
+
+function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal;
+
+const
+ FILE_DEVICE_BEEP               = $00000001;
+ FILE_DEVICE_CD_ROM             = $00000002;
+ FILE_DEVICE_CD_ROM_FILE_SYSTEM = $00000003;
+ FILE_DEVICE_CONTROLLER         = $00000004;
+ FILE_DEVICE_DATALINK           = $00000005;
+ FILE_DEVICE_DFS                = $00000006;
+ FILE_DEVICE_DISK               = $00000007;
+ FILE_DEVICE_DISK_FILE_SYSTEM   = $00000008;
+ FILE_DEVICE_FILE_SYSTEM        = $00000009;
+ FILE_DEVICE_INPORT_PORT        = $0000000a;
+ FILE_DEVICE_KEYBOARD           = $0000000b;
+ FILE_DEVICE_MAILSLOT           = $0000000c;
+ FILE_DEVICE_MIDI_IN            = $0000000d;
+ FILE_DEVICE_MIDI_OUT           = $0000000e;
+ FILE_DEVICE_MOUSE              = $0000000f;
+ FILE_DEVICE_MULTI_UNC_PROVIDER = $00000010;
+ FILE_DEVICE_NAMED_PIPE         = $00000011;
+ FILE_DEVICE_NETWORK            = $00000012;
+ FILE_DEVICE_NETWORK_BROWSER    = $00000013;
+ FILE_DEVICE_NETWORK_FILE_SYSTEM= $00000014;
+ FILE_DEVICE_NULL               = $00000015;
+ FILE_DEVICE_PARALLEL_PORT      = $00000016;
+ FILE_DEVICE_PHYSICAL_NETCARD   = $00000017;
+ FILE_DEVICE_PRINTER            = $00000018;
+ FILE_DEVICE_SCANNER            = $00000019;
+ FILE_DEVICE_SERIAL_MOUSE_PORT  = $0000001a;
+ FILE_DEVICE_SERIAL_PORT        = $0000001b;
+ FILE_DEVICE_SCREEN             = $0000001c;
+ FILE_DEVICE_SOUND              = $0000001d;
+ FILE_DEVICE_STREAMS            = $0000001e;
+ FILE_DEVICE_TAPE               = $0000001f;
+ FILE_DEVICE_TAPE_FILE_SYSTEM   = $00000020;
+ FILE_DEVICE_TRANSPORT          = $00000021;
+ FILE_DEVICE_UNKNOWN            = $00000022;
+ FILE_DEVICE_VIDEO              = $00000023;
+ FILE_DEVICE_VIRTUAL_DISK       = $00000024;
+ FILE_DEVICE_WAVE_IN            = $00000025;
+ FILE_DEVICE_WAVE_OUT           = $00000026;
+ FILE_DEVICE_8042_PORT          = $00000027;
+ FILE_DEVICE_NETWORK_REDIRECTOR = $00000028;
+ FILE_DEVICE_BATTERY            = $00000029;
+ FILE_DEVICE_BUS_EXTENDER       = $0000002a;
+ FILE_DEVICE_MODEM              = $0000002b;
+ FILE_DEVICE_VDM                = $0000002c;
+ FILE_DEVICE_MASS_STORAGE       = $0000002d;
+ FILE_DEVICE_SMB                = $0000002e;
+ FILE_DEVICE_KS                 = $0000002f;
+ FILE_DEVICE_CHANGER            = $00000030;
+ FILE_DEVICE_SMARTCARD          = $00000031;
+ FILE_DEVICE_ACPI               = $00000032;
+ FILE_DEVICE_DVD                = $00000033;
+ FILE_DEVICE_FULLSCREEN_VIDEO   = $00000034;
+ FILE_DEVICE_DFS_FILE_SYSTEM    = $00000035;
+ FILE_DEVICE_DFS_VOLUME         = $00000036;
+ FILE_DEVICE_SERENUM            = $00000037;
+ FILE_DEVICE_TERMSRV            = $00000038;
+ FILE_DEVICE_KSEC               = $00000039;
+
+ FILE_DEVICE_KRNLDRVR           = $80ff;
+
+ METHOD_BUFFERED   =              0;
+ METHOD_IN_DIRECT  =              1;
+ METHOD_OUT_DIRECT =              2;
+ METHOD_NEITHER    =              3;
+
+ FILE_ANY_ACCESS     =            0;
+ FILE_SPECIAL_ACCESS =   (FILE_ANY_ACCESS);
+ FILE_READ_ACCESS    =      ( $0001 );    // file & pipe
+ FILE_WRITE_ACCESS   =      ( $0002 );    // file & pipe
+
+ {$IFDEF VER100 or VER110}
+ // for compatibilty with delphi 3.0
+const
+  SERVICE_KERNEL_DRIVER         = $00000001;
+  SERVICE_DEMAND_START          = $00000003;
+  SERVICE_ERROR_NORMAL          = $00000001;
+
+{$ENDIF}
+
+function driverstart(const name:pchar):integer;
+function driverstop(const name:pchar):integer;
+
+// for this function must have Administrators or Power users rigths
+function driverinstall(const path,name:pchar):integer;
+function driverremove(const name:pchar):integer;
+
+
+// exlpanation function
+function messagestring(const error:integer):string;
+
+implementation
+
+function CTL_CODE(const DeviceType,Func,Method,Access:Cardinal):cardinal;
+begin
+ Result := DeviceType shl 16 or Access shl 14 or Func shl 2 or Method;
+end;
+
+
+function driverinstall(const path,name:pchar):integer;
+var hService: SC_HANDLE;
+    hSCMan  : SC_HANDLE;
+begin
+
+  Result := 0;
+
+  hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
+  if hSCMan = 0 then  begin
+   result := getlasterror;
+   exit;
+  end;
+
+  hService := CreateService(hSCMan, name,name,
+              SERVICE_ALL_ACCESS, SERVICE_KERNEL_DRIVER, SERVICE_DEMAND_START,
+              SERVICE_ERROR_NORMAL, path,
+              nil, nil, nil, nil, nil);
+
+  if (hService = 0) then begin
+    result := getlasterror;
+    CloseServiceHandle(hSCMan);
+    exit;
+  end
+  else
+    CloseServiceHandle(hService);
+  CloseServiceHandle(hSCMan);
+end;
+
+function driverstart(const name:pchar):integer;
+var
+  hService: SC_HANDLE;
+  hSCMan  : SC_HANDLE;
+  args:pchar;
+begin
+
+  hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
+  if hSCMan = 0 then  begin
+   result := getlasterror;
+   exit;
+  end;
+
+  // get a handle to the service
+  hService := OpenService(hSCMan, name, SERVICE_START);
+  if hService <> 0 then Begin
+     // start the driver
+    args := nil;
+    Result := 0;
+    if integer(StartService(hService, 0, args ))=0 then
+      result := getlasterror;
+    CloseServiceHandle(hService);
+  end
+  else
+    result := getlasterror;
+  CloseServiceHandle(hSCMan);
+end;
+
+function driverstop(const name:pchar):integer;
+Var
+  serviceStatus: TServiceStatus;
+  hService: SC_HANDLE;
+  hSCMan  : SC_HANDLE;
+begin
+
+  hSCMan := OpenSCManager(nil, nil, SC_MANAGER_CONNECT);
+  if hSCMan = 0 then  begin
+   result := getlasterror;
+   exit;
+  end;
+
+  // get a handle to the service
+  hService := OpenService(hSCMan, Name, SERVICE_STOP);
+  if hService <> 0 then Begin
+     // start the driver
+    Result := 0;
+    if integer(ControlService(hService, SERVICE_CONTROL_STOP, serviceStatus))=0 then
+      result := getlasterror;
+    CloseServiceHandle(hService);
+  end
+  else
+    result := getlasterror;
+  CloseServiceHandle(hSCMan);
+end;
+
+function driverremove(const name:pchar):integer;
+Var
+  hService: SC_HANDLE;
+  hSCMan  : SC_HANDLE;
+begin
+
+  hSCMan := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
+  if hSCMan = 0 then  begin
+    result := getlasterror;
+    exit;
+  end;
+
+  // get a handle to the service
+  hService := OpenService(hSCMan, Name, SERVICE_ALL_ACCESS);
+  if hService <> 0 then Begin
+    // remove driver description from the registry
+    Result := 0;
+    if integer(DeleteService(hService)) = 0 then
+      result := getlasterror;
+    CloseServiceHandle(hService);
+  end
+  else
+    result := getlasterror;
+  CloseServiceHandle(hSCMan);
+end;
+
+function messagestring(const error:integer):string;
+var p:pchar;
+begin
+  GetMem(p, 200);
+  FillChar(p^, 200, 0);
+  formatmessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,error,0,p,199,nil);
+  Result := p;
+  freemem(p,200);
+end;
+
+end.

zlportio.pas

@@ -0,0 +1,283 @@
+{ -----------------------------------------------------------------------------}
+{ Copyright 2000-2001, Zloba Alexander.  All Rights Reserved.                  }
+{ This unit can be freely used and distributed in commercial and private       }
+{ environments, provided this notice is not modified in any way.               }
+{ -----------------------------------------------------------------------------}
+{ Feel free to contact me if you have any questions, comments or suggestions at}
+{   zal@specosoft.com (Zloba Alexander)                                        }
+{ You can always find the latest version of this unit at:                      }
+{   http://www.specosoft.com                                                   }
+
+{ -----------------------------------------------------------------------------}
+{ Date last modified:  08/10/2001                                              }
+{ -----------------------------------------------------------------------------}
+{ ZLPortIO driver interface unit v1.20                                         }
+{ -----------------------------------------------------------------------------}
+{ Description:                                                                 }
+{   This unit allow your application direct access port input and output under }
+{   all versions of Microsoft Windows®                                         }
+{ Depends:                                                                     }
+{   zlportio.sys ddkint.pas                                                    }
+{   You must distribute zlportio.sys with your application                     }
+{ Procedures and functions:                                                    }
+{   procedure zlioportread( const Port,DataType:dword ):dword;                 }
+{   procedure zlioportwrite( const Port,DataType,Data:dword );                 }
+{                                                                              }
+{  function portreadb( const Port:dword ):byte;                                }
+{  function portreadw( const Port:dword ):word;                                }
+{  function portreadl( const Port:dword ):dword;                               }
+{                                                                              }
+{  procedure portwriteb( const Port:Dword;const Data:byte );                   }
+{  procedure portwritew( const Port:dword;const Data:word );                   }
+{  procedure portwritel( const Port,Data:dword );                              }
+{                                                                              }
+{   Examples:                                                                  }
+{    //  get data bits from LPT port                                           }
+{      databits := portreadb( $378 )                                           }
+{    //  set data bits from LPT port                                           }
+{      portwriteb( $378, databits )                                            }
+{    //  The second parameter determine the databus length for operation       }
+{ -----------------------------------------------------------------------------}
+{ Revision History:                                                            }
+{ 1.00:  + First public release                                                }
+{ 1.10:  + Added new functions (portreadX,portwriteX) for convenience of usage }
+{ 1.20:  + Added new function (zliosetiopm) for enabling direct access to ports}
+{ 1.30:  + added compiler directives for correct compilation                   }
+{ 1.40:  + added opportunity to run multiply instances client to driver        }
+{ 1.50:  - fixed bug with work under win98                                     }
+{------------------------------------------------------------------------------}
+
+{$A-,H-}
+unit zlportio;
+
+interface
+
+uses windows,sysutils,ddkint;
+
+Const
+  ZLIO_BYTE  = 0;
+  ZLIO_WORD  = 1;
+  ZLIO_DWORD = 2;
+
+var
+
+// if TRUE then driver was started
+// in other case something wrong
+// We start driver in initialization section of unit.
+
+  ZlIOStarted:boolean = false;
+
+// if TRUE then we can use asm IN,OUT under NT/2000
+// see zliosetiopm for more details
+  ZlIODirect:boolean = false;
+
+// handle to opened driver
+
+  HZLIO:THandle;
+
+
+function portreadb( const Port:dword ):byte;
+function portreadw( const Port:dword ):word;
+function portreadl( const Port:dword ):dword;
+
+procedure portwriteb( const Port:Dword;const Data:byte );
+procedure portwritew( const Port:dword;const Data:word );
+procedure portwritel( const Port,Data:dword );
+
+
+procedure zlioportwrite( const Port,DataType,Data:dword );
+function zlioportread( const Port,DataType:dword ):dword;
+
+// if you need the best perfomance for your IO operations
+// call zliosetiopm(TRUE). This allow your application
+// to use asm command IN,OUT directly in your code.
+
+procedure zliosetiopm( const Direct:boolean );
+
+// internal
+
+function zliostart:boolean;
+procedure zliostop;
+
+
+implementation
+
+const
+  ZLIODriverName='zlportio';
+
+var
+  IOCTL_ZLUNI_PORT_READ:cardinal;
+  IOCTL_ZLUNI_PORT_WRITE:cardinal;
+  IOCTL_ZLUNI_IOPM_ON:cardinal;
+  IOCTL_ZLUNI_IOPM_OFF:cardinal;
+
+type
+TzlIOData = record
+  Port,DataType,Data:dword;
+end;
+
+
+procedure zlioportwrite( const Port,DataType,Data:dword );
+var resdata:TZLIOData;
+    cBR:cardinal;
+begin
+ if (not ZLIODirect) then begin
+  resdata.Port := Port;
+  resdata.Data :=  Data;
+  resdata.DataType :=  DataType;
+  if ZLIOStarted then
+   DeviceIoControl(HZLIO,IOCTL_ZLUNI_PORT_WRITE,@resdata,sizeof(resdata),nil,0,cBR,nil );
+ end
+ else begin
+   Case DataType of
+    ZLIO_BYTE : asm mov edx,Port;mov eax,data;out dx,al; end;
+    ZLIO_WORD : asm mov edx,Port;mov eax,data;out dx,ax; end;
+    ZLIO_DWORD: asm mov edx,Port;mov eax,data;out dx,eax; end;
+   end;
+ end;
+end;
+
+function zlioportread(const Port,DataType:dword):dword;
+var resdata:TZLIOData;
+    cBR:cardinal;i:dword;
+begin
+ if (not ZLIODirect) then begin
+   resdata.Port := Port;
+   resdata.DataType :=  DataType;
+   if ZLIOStarted then
+    DeviceIoControl(HZLIO,IOCTL_ZLUNI_PORT_READ,@resdata,sizeof(resdata),@i,sizeof(dword),cBR,nil );
+ end
+ else begin
+   Case DataType of
+    ZLIO_BYTE : asm mov edx,Port;xor eax,eax;in al,dx;mov i,eax; end;
+    ZLIO_WORD : asm mov edx,Port;xor eax,eax;in ax,dx;mov i,eax; end;
+    ZLIO_DWORD: asm mov edx,Port;xor eax,eax;in eax,dx;mov i,eax end;
+   end;
+ end;
+  result := i;
+end;
+
+function portreadb( const Port:dword ):byte;
+begin
+ Result := zlioportread(Port,ZLIO_BYTE);
+end;
+
+function portreadw( const Port:dword ):word;
+begin
+ Result := zlioportread(Port,ZLIO_WORD);
+end;
+
+function portreadl( const Port:dword ):dword;
+begin
+ Result := zlioportread(Port,ZLIO_DWORD);
+end;
+
+procedure portwriteb( const Port:Dword;const Data:byte );
+begin
+ zlioportwrite(Port,ZLIO_BYTE,Data);
+end;
+
+procedure portwritew( const Port:dword;const Data:word );
+begin
+ zlioportwrite(Port,ZLIO_WORD,Data);
+end;
+
+procedure portwritel( const Port,Data:dword );
+begin
+ zlioportwrite(Port,ZLIO_DWORD,Data);
+end;
+
+procedure zliosetiopm( const Direct:boolean );
+var cBR:cardinal;
+begin
+ if Win32Platform=VER_PLATFORM_WIN32_NT then
+  if ZLIOStarted then begin
+   if Direct then
+     DeviceIoControl(HZLIO,IOCTL_ZLUNI_IOPM_ON,nil,0,nil,0,cBR,nil )
+   else
+     DeviceIoControl(HZLIO,IOCTL_ZLUNI_IOPM_OFF,nil,0,nil,0,cBR,nil );
+   ZLIODirect := Direct;
+ end
+end;
+
+
+
+
+function zliostart;
+var dir:shortstring;
+begin
+ if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
+  result := true;
+  exit;
+ end;
+// Result := false;
+ zliostop;
+ dir := ExtractFileDir(ParamStr(0))+'\'+ZLIODriverName+'.sys'#0;
+ driverinstall(pchar(@dir[1]),ZLIODriverName+#0);
+ Result := driverstart(ZLIODriverName) = 0;
+end;
+
+procedure zliostop;
+begin
+ if Win32Platform<>VER_PLATFORM_WIN32_NT then
+  exit;
+ driverstop(ZLIODriverName);
+ driverremove(ZLIODriverName);
+end;
+
+function zlioopen( var Handle:thandle):boolean;
+var cERR:integer;
+    s:string;
+begin
+ if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
+  result := true;
+  exit;
+ end;
+ Result := false;
+ Handle := THandle(-1);
+ Handle := createFile('\\.\ZLPORTIO',
+                  GENERIC_READ or GENERIC_WRITE,
+                  0,
+                  nil,
+                  OPEN_EXISTING,
+                  FILE_ATTRIBUTE_NORMAL,
+                  0 );
+ cERR := getlasterror;
+ s := messagestring( cerr);
+ if (cERR = ERROR_ALREADY_EXISTS)or(cERR = ERROR_SUCCESS) then Result := True;
+end;
+
+procedure zlioclose( const Handle:thandle);
+begin
+ if (Win32Platform=VER_PLATFORM_WIN32_NT) then
+ closehandle(Handle);
+end;
+
+
+initialization
+
+IOCTL_ZLUNI_PORT_READ := CTL_CODE(FILE_DEVICE_KRNLDRVR, 1, METHOD_BUFFERED, FILE_ANY_ACCESS);
+IOCTL_ZLUNI_PORT_WRITE := CTL_CODE(FILE_DEVICE_KRNLDRVR, 2, METHOD_BUFFERED, FILE_ANY_ACCESS);
+IOCTL_ZLUNI_IOPM_ON := CTL_CODE(FILE_DEVICE_KRNLDRVR, 3, METHOD_BUFFERED, FILE_ANY_ACCESS);
+IOCTL_ZLUNI_IOPM_OFF := CTL_CODE(FILE_DEVICE_KRNLDRVR, 4, METHOD_BUFFERED, FILE_ANY_ACCESS);
+
+ if Win32Platform<>VER_PLATFORM_WIN32_NT then begin
+   zliostarted := true;
+   zliodirect := true;
+ end
+ else begin
+   if not zlioopen(HZLIO) then begin
+    if zliostart then
+     ZLIOStarted := zlioopen(HZLIO) or (Win32Platform<>VER_PLATFORM_WIN32_NT);
+   end
+   else
+    ZLIOStarted := true;
+ end;
+finalization
+
+if ZLIOStarted then
+ zliostop;
+
+
+
+end.