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
This commit is contained in:
mbirth
parent
c9160d9591
commit
40710232fc
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
BIN
DLPORTIO.dll
BIN
DLPORTIO.dll
Binary file not shown.
BIN
DLPORTIO.sys
BIN
DLPORTIO.sys
Binary file not shown.
100
SMBus.pas
100
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);
|
||||
|
||||
251
ddkint.pas
Normal file
251
ddkint.pas
Normal file
@ -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.
|
||||
283
zlportio.pas
Normal file
283
zlportio.pas
Normal file
@ -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.
|
||||
BIN
zlportio.sys
Normal file
BIN
zlportio.sys
Normal file
Binary file not shown.
Reference in New Issue
Block a user