diff --git a/AnalyzerU.dfm b/AnalyzerU.dfm index e26f411..4881ee9 100644 --- a/AnalyzerU.dfm +++ b/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 - Height = 17 - Caption = 'Enum SMBus' + Width = 45 + Height = 21 + 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 diff --git a/AnalyzerU.pas b/AnalyzerU.pas index 9588820..1ec1d7e 100644 --- a/AnalyzerU.pas +++ b/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); - CheckPwd(d); - CheckUUID(d); - CheckOEM(d); - CheckMachine(d); - PageControl1.ActivePageIndex := 0; + DoAnalysis(d); + AForm.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. diff --git a/DLPORTIO.dll b/DLPORTIO.dll deleted file mode 100644 index 9849434..0000000 Binary files a/DLPORTIO.dll and /dev/null differ diff --git a/DLPORTIO.sys b/DLPORTIO.sys deleted file mode 100644 index d3d932c..0000000 Binary files a/DLPORTIO.sys and /dev/null differ diff --git a/SMBus.pas b/SMBus.pas index 0d1409e..d3a569d 100644 --- a/SMBus.pas +++ b/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 DlPortReadPortUlong(Port: cardinal): 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'; +// function DlPortReadPortUchar(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 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); - DlPortWritePortUlong($CF8, cc); - Result := DlPortReadPortUlong($CFC); - DlPortWritePortUlong($CF8, t); + //t := DlPortReadPortUlong($CF8); + //DlPortWritePortUlong($CF8, cc); + //Result := DlPortReadPortUlong($CFC); + //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 + 4, (Slave shl 1) or RW); - DlPortWritePortUchar(BaseAddr + 2, $48); - sleep(1); - Application.ProcessMessages; +// DlPortWritePortUchar(BaseAddr + 3, CMD); +// DlPortWritePortUchar(BaseAddr + 4, (Slave shl 1) or RW); +// DlPortWritePortUchar(BaseAddr + 2, $48); + PortWriteB(BaseAddr + 3, CMD); + PortWriteB(BaseAddr + 4, (Slave shl 1) or RW); + PortWriteB(BaseAddr + 2, $48); + Sleep(1); smbWaitForEnd(BaseAddr); - Dump1 := ( DlPortReadPortUchar(BaseAddr + 6) shl 8); - Dump1 := Dump1 or DlPortReadPortUchar(BaseAddr + 5); +// Dump1 := ( DlPortReadPortUchar(BaseAddr + 6) shl 8); +// 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 + 6, 0); +// DlPortWritePortUchar(BaseAddr + 5, 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 + 6, 0); +// DlPortWritePortUchar(BaseAddr + 5, 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); diff --git a/ddkint.pas b/ddkint.pas new file mode 100644 index 0000000..d5b36be --- /dev/null +++ b/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. diff --git a/zlportio.pas b/zlportio.pas new file mode 100644 index 0000000..5a87be8 --- /dev/null +++ b/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. diff --git a/zlportio.sys b/zlportio.sys new file mode 100644 index 0000000..a897a02 Binary files /dev/null and b/zlportio.sys differ