From 46bb010ca7c5eb04551c030105f9999ca80e472f Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 8 Jun 2008 15:33:48 +0000 Subject: - set svn:eol-style to native - removed some svn:executable properties from non-executable files git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1144 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/lib/zlportio/Example/README.TXT | 54 +-- Game/Code/lib/zlportio/Example/install.txt | 12 +- Game/Code/lib/zlportio/Example/mainform.pas | 410 ++++++++++---------- Game/Code/lib/zlportio/Example/portio.dpr | 28 +- Game/Code/lib/zlportio/README.TXT | 54 +-- Game/Code/lib/zlportio/ddkint.pas | 506 ++++++++++++------------ Game/Code/lib/zlportio/install.txt | 16 +- Game/Code/lib/zlportio/zlportio.pas | 570 ++++++++++++++-------------- 8 files changed, 825 insertions(+), 825 deletions(-) (limited to 'Game/Code/lib/zlportio') diff --git a/Game/Code/lib/zlportio/Example/README.TXT b/Game/Code/lib/zlportio/Example/README.TXT index dd71c689..f8eb7241 100644 --- a/Game/Code/lib/zlportio/Example/README.TXT +++ b/Game/Code/lib/zlportio/Example/README.TXT @@ -1,27 +1,27 @@ - -PortIO example -Copyright (C) 2001 Zloba Alexander -http://www.specosoft.com -Description ------------ - This example show how tow to get direct access port input and output under - all versions of Microsoft Windows using ZlPortio library, - -Terms of Use ------------- - -This software is provided "as is", without any guarantee made -as to its suitability or fitness for any particular use. It may -contain bugs, so use of this tool is at your own risk. We take -no responsilbity for any damage that may unintentionally be caused -through its use. - -Reporting Problems ------------------- - -If you encounter problems, please visit http://www.specosoft.com -and download the latest version to see if the issue has been resolved. -If not, please send a bug report to: - - zal@specosoft.com - + +PortIO example +Copyright (C) 2001 Zloba Alexander +http://www.specosoft.com +Description +----------- + This example show how tow to get direct access port input and output under + all versions of Microsoft Windows using ZlPortio library, + +Terms of Use +------------ + +This software is provided "as is", without any guarantee made +as to its suitability or fitness for any particular use. It may +contain bugs, so use of this tool is at your own risk. We take +no responsilbity for any damage that may unintentionally be caused +through its use. + +Reporting Problems +------------------ + +If you encounter problems, please visit http://www.specosoft.com +and download the latest version to see if the issue has been resolved. +If not, please send a bug report to: + + zal@specosoft.com + diff --git a/Game/Code/lib/zlportio/Example/install.txt b/Game/Code/lib/zlportio/Example/install.txt index 8d4f45a6..fed162bf 100644 --- a/Game/Code/lib/zlportio/Example/install.txt +++ b/Game/Code/lib/zlportio/Example/install.txt @@ -1,6 +1,6 @@ - -Installation: - -Copy files: zlportio.pas, ddkint.pas to your project directory -or common unit directory. - + +Installation: + +Copy files: zlportio.pas, ddkint.pas to your project directory +or common unit directory. + diff --git a/Game/Code/lib/zlportio/Example/mainform.pas b/Game/Code/lib/zlportio/Example/mainform.pas index 295958c2..2b26228e 100644 --- a/Game/Code/lib/zlportio/Example/mainform.pas +++ b/Game/Code/lib/zlportio/Example/mainform.pas @@ -1,205 +1,205 @@ -{$A-,H+} -unit mainform; - -interface - -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls,zlportio, ComCtrls, shellapi,rdtsc; - -type - TMain = class(TForm) - lb1: TLabel; - ePort: TEdit; - lb2: TLabel; - eData: TEdit; - eRData: TEdit; - btnExit: TButton; - lb3: TLabel; - coDataType: TComboBox; - Lb4: TLabel; - gb1: TGroupBox; - sbBar: TStatusBar; - lb5: TLabel; - btnWrite: TButton; - btnRead: TButton; - cbDirect: TCheckBox; - llbWWW: TLabel; - procedure btnExitClick(Sender: TObject); - procedure ePortKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure ePortKeyPress(Sender: TObject; var Key: Char); - procedure FormCreate(Sender: TObject); - procedure coDataTypeChange(Sender: TObject); - procedure ePortKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure btnWriteClick(Sender: TObject); - procedure eDataKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure btnReadClick(Sender: TObject); - procedure cbDirectClick(Sender: TObject); - procedure llbWWWClick(Sender: TObject); - private - { Private declarations } - public - { Public declarations } - procedure setrdata(const Data:dword); - function str2int(const value:string;const HEX:boolean):integer; - end; - -var - Main: TMain; -implementation - -{$R *.DFM} -{$R-} - -function TMain.str2int(const value:string;const HEX:boolean):integer; -begin - if HEX then - result := strtoint('$' + value) - else - result := strtoint(value); -end; - - -procedure TMain.btnExitClick(Sender: TObject); -begin - close; -end; - -procedure TMain.ePortKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); -begin -try - Case key of - 38: begin - key := 0; - end; - 40: begin - key := 0; - end - end; -except -end; -end; - -procedure TMain.ePortKeyPress(Sender: TObject; var Key: Char); -begin - // filter on hex - if pos(key,#13#8'0123456789abcdefABCDEF')=0 then - key := #0; -end; - -procedure TMain.FormCreate(Sender: TObject); -begin - coDataType.itemindex :=0; - coDataType.Tag := 2; - if ZLIOStarted then - sbBar.SimpleText := 'Driver successfully started !' - else - sbBar.SimpleText := 'Couldnt start driver. Something wrong !'; -end; - -procedure TMain.coDataTypeChange(Sender: TObject); -var s:string; -begin - coDataType.Tag := 2 shl (coDataType.itemindex); - erdata.MaxLength := coDataType.Tag; - edata.MaxLength := coDataType.Tag; - s := edata.Text; - delete(s,1,length(s)-coDataType.Tag); - edata.text := s; -end; - -procedure TMain.ePortKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); -var Port,data:dword; -begin -try - try - Port := str2int(ePort.Text,true); - except - Port := 0; - end; - Case key of - 13: begin - zlioportwrite(port,coDataType.itemindex,str2int(eData.Text, true)); - end; - 38: begin - inc(Port); - ePort.Text := inttohex(Port,3); - key := 0; - end; - 40: begin - if port > 0 then - dec(Port); - ePort.Text := inttohex(Port,3); - key := 0; - end - end; - setthreadpriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL); - data := zlioportread(Port,coDataType.itemindex); - setrdata(data); -except -end; - -end; - -procedure TMain.setrdata(const Data:dword); -begin - erData.Text := inttohex(Data,coDataType.Tag); -end; - -procedure TMain.btnWriteClick(Sender: TObject); -var i:word; -begin - i := 13; - ePortKeyDown( self,i,[]) -end; - - - -procedure TMain.eDataKeyDown(Sender: TObject; var Key: Word; - Shift: TShiftState); -var data:dword; -begin - try - Data := str2int(eData.Text,true); - except Data := 0; end; - Case key of - 13: begin - ePortKeyDown( self,key,[]) - end; - 38: begin - inc(Data); - eData.Text := inttohex(Data,coDataType.Tag); - key := 0; - end; - 40: begin - dec(Data); - eData.Text := inttohex(Data,coDataType.Tag); - key := 0; - end - end; - -end; - -procedure TMain.btnReadClick(Sender: TObject); -var k:word; -begin - k := 0; - ePortKeyDown(self, k,[]); -end; - -procedure TMain.cbDirectClick(Sender: TObject); -begin -zliosetiopm(cbDirect.Checked); -end; - -procedure TMain.llbWWWClick(Sender: TObject); -begin - shellexecute( 0,'open','http://www.specosoft.com/update/portio_15.htm',nil,nil,SW_SHOW); -end; - -end. +{$A-,H+} +unit mainform; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls,zlportio, ComCtrls, shellapi,rdtsc; + +type + TMain = class(TForm) + lb1: TLabel; + ePort: TEdit; + lb2: TLabel; + eData: TEdit; + eRData: TEdit; + btnExit: TButton; + lb3: TLabel; + coDataType: TComboBox; + Lb4: TLabel; + gb1: TGroupBox; + sbBar: TStatusBar; + lb5: TLabel; + btnWrite: TButton; + btnRead: TButton; + cbDirect: TCheckBox; + llbWWW: TLabel; + procedure btnExitClick(Sender: TObject); + procedure ePortKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure ePortKeyPress(Sender: TObject; var Key: Char); + procedure FormCreate(Sender: TObject); + procedure coDataTypeChange(Sender: TObject); + procedure ePortKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure btnWriteClick(Sender: TObject); + procedure eDataKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure btnReadClick(Sender: TObject); + procedure cbDirectClick(Sender: TObject); + procedure llbWWWClick(Sender: TObject); + private + { Private declarations } + public + { Public declarations } + procedure setrdata(const Data:dword); + function str2int(const value:string;const HEX:boolean):integer; + end; + +var + Main: TMain; +implementation + +{$R *.DFM} +{$R-} + +function TMain.str2int(const value:string;const HEX:boolean):integer; +begin + if HEX then + result := strtoint('$' + value) + else + result := strtoint(value); +end; + + +procedure TMain.btnExitClick(Sender: TObject); +begin + close; +end; + +procedure TMain.ePortKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin +try + Case key of + 38: begin + key := 0; + end; + 40: begin + key := 0; + end + end; +except +end; +end; + +procedure TMain.ePortKeyPress(Sender: TObject; var Key: Char); +begin + // filter on hex + if pos(key,#13#8'0123456789abcdefABCDEF')=0 then + key := #0; +end; + +procedure TMain.FormCreate(Sender: TObject); +begin + coDataType.itemindex :=0; + coDataType.Tag := 2; + if ZLIOStarted then + sbBar.SimpleText := 'Driver successfully started !' + else + sbBar.SimpleText := 'Couldnt start driver. Something wrong !'; +end; + +procedure TMain.coDataTypeChange(Sender: TObject); +var s:string; +begin + coDataType.Tag := 2 shl (coDataType.itemindex); + erdata.MaxLength := coDataType.Tag; + edata.MaxLength := coDataType.Tag; + s := edata.Text; + delete(s,1,length(s)-coDataType.Tag); + edata.text := s; +end; + +procedure TMain.ePortKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var Port,data:dword; +begin +try + try + Port := str2int(ePort.Text,true); + except + Port := 0; + end; + Case key of + 13: begin + zlioportwrite(port,coDataType.itemindex,str2int(eData.Text, true)); + end; + 38: begin + inc(Port); + ePort.Text := inttohex(Port,3); + key := 0; + end; + 40: begin + if port > 0 then + dec(Port); + ePort.Text := inttohex(Port,3); + key := 0; + end + end; + setthreadpriority(GetCurrentThread,THREAD_PRIORITY_TIME_CRITICAL); + data := zlioportread(Port,coDataType.itemindex); + setrdata(data); +except +end; + +end; + +procedure TMain.setrdata(const Data:dword); +begin + erData.Text := inttohex(Data,coDataType.Tag); +end; + +procedure TMain.btnWriteClick(Sender: TObject); +var i:word; +begin + i := 13; + ePortKeyDown( self,i,[]) +end; + + + +procedure TMain.eDataKeyDown(Sender: TObject; var Key: Word; + Shift: TShiftState); +var data:dword; +begin + try + Data := str2int(eData.Text,true); + except Data := 0; end; + Case key of + 13: begin + ePortKeyDown( self,key,[]) + end; + 38: begin + inc(Data); + eData.Text := inttohex(Data,coDataType.Tag); + key := 0; + end; + 40: begin + dec(Data); + eData.Text := inttohex(Data,coDataType.Tag); + key := 0; + end + end; + +end; + +procedure TMain.btnReadClick(Sender: TObject); +var k:word; +begin + k := 0; + ePortKeyDown(self, k,[]); +end; + +procedure TMain.cbDirectClick(Sender: TObject); +begin +zliosetiopm(cbDirect.Checked); +end; + +procedure TMain.llbWWWClick(Sender: TObject); +begin + shellexecute( 0,'open','http://www.specosoft.com/update/portio_15.htm',nil,nil,SW_SHOW); +end; + +end. diff --git a/Game/Code/lib/zlportio/Example/portio.dpr b/Game/Code/lib/zlportio/Example/portio.dpr index 5d86ae5d..42fcc9e9 100644 --- a/Game/Code/lib/zlportio/Example/portio.dpr +++ b/Game/Code/lib/zlportio/Example/portio.dpr @@ -1,14 +1,14 @@ -{$A-,H+} -program portio; - -uses - Forms, - mainform in 'mainform.pas' {Main}; - -{$R *.RES} - -begin - Application.Initialize; - Application.CreateForm(TMain, Main); - Application.Run; -end. +{$A-,H+} +program portio; + +uses + Forms, + mainform in 'mainform.pas' {Main}; + +{$R *.RES} + +begin + Application.Initialize; + Application.CreateForm(TMain, Main); + Application.Run; +end. diff --git a/Game/Code/lib/zlportio/README.TXT b/Game/Code/lib/zlportio/README.TXT index 137f5c07..3bce114e 100644 --- a/Game/Code/lib/zlportio/README.TXT +++ b/Game/Code/lib/zlportio/README.TXT @@ -1,27 +1,27 @@ - -ZLPortIO -Copyright (C) 2001 Zloba Alexander -http://www.specosoft.com -Description ------------ - This unit allow your application direct access port input and output under - all versions of Microsoft Windows, - -Terms of Use ------------- - -This software is provided "as is", without any guarantee made -as to its suitability or fitness for any particular use. It may -contain bugs, so use of this tool is at your own risk. We take -no responsilbity for any damage that may unintentionally be caused -through its use. - -Reporting Problems ------------------- - -If you encounter problems, please visit http://www.specosoft.com -and download the latest version to see if the issue has been resolved. -If not, please send a bug report to: - - zal@specosoft.com - + +ZLPortIO +Copyright (C) 2001 Zloba Alexander +http://www.specosoft.com +Description +----------- + This unit allow your application direct access port input and output under + all versions of Microsoft Windows, + +Terms of Use +------------ + +This software is provided "as is", without any guarantee made +as to its suitability or fitness for any particular use. It may +contain bugs, so use of this tool is at your own risk. We take +no responsilbity for any damage that may unintentionally be caused +through its use. + +Reporting Problems +------------------ + +If you encounter problems, please visit http://www.specosoft.com +and download the latest version to see if the issue has been resolved. +If not, please send a bug report to: + + zal@specosoft.com + diff --git a/Game/Code/lib/zlportio/ddkint.pas b/Game/Code/lib/zlportio/ddkint.pas index 2b70ee54..65b208d9 100644 --- a/Game/Code/lib/zlportio/ddkint.pas +++ b/Game/Code/lib/zlportio/ddkint.pas @@ -1,253 +1,253 @@ -{ -----------------------------------------------------------------------------} -{ 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. +{ -----------------------------------------------------------------------------} +{ 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/Game/Code/lib/zlportio/install.txt b/Game/Code/lib/zlportio/install.txt index 7a92b29d..2c242ed1 100644 --- a/Game/Code/lib/zlportio/install.txt +++ b/Game/Code/lib/zlportio/install.txt @@ -1,8 +1,8 @@ - -Installation: - -Copy files: zlportio.pas, ddkint.pas to your project directory -or common unit directory. - -Copy file zlportio.sys to your project directory. -It should be in the one directory with you application. + +Installation: + +Copy files: zlportio.pas, ddkint.pas to your project directory +or common unit directory. + +Copy file zlportio.sys to your project directory. +It should be in the one directory with you application. diff --git a/Game/Code/lib/zlportio/zlportio.pas b/Game/Code/lib/zlportio/zlportio.pas index 2cf57334..94cbfdd1 100644 --- a/Game/Code/lib/zlportio/zlportio.pas +++ b/Game/Code/lib/zlportio/zlportio.pas @@ -1,285 +1,285 @@ -{ -----------------------------------------------------------------------------} -{ 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. +{ -----------------------------------------------------------------------------} +{ 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. -- cgit v1.2.3