aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/lib/zlportio
diff options
context:
space:
mode:
authortobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>2008-06-08 15:33:48 +0000
committertobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>2008-06-08 15:33:48 +0000
commit46bb010ca7c5eb04551c030105f9999ca80e472f (patch)
tree3cb6a6bdd7e4e62623c6a83b5d22c1c0dfad73e8 /Game/Code/lib/zlportio
parentf4425b4558b7fd86de874035f81ea290c987e96d (diff)
downloadusdx-46bb010ca7c5eb04551c030105f9999ca80e472f.tar.gz
usdx-46bb010ca7c5eb04551c030105f9999ca80e472f.tar.xz
usdx-46bb010ca7c5eb04551c030105f9999ca80e472f.zip
- 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
Diffstat (limited to 'Game/Code/lib/zlportio')
-rw-r--r--Game/Code/lib/zlportio/Example/README.TXT54
-rw-r--r--Game/Code/lib/zlportio/Example/install.txt12
-rw-r--r--Game/Code/lib/zlportio/Example/mainform.pas410
-rw-r--r--Game/Code/lib/zlportio/Example/portio.dpr28
-rw-r--r--Game/Code/lib/zlportio/README.TXT54
-rw-r--r--Game/Code/lib/zlportio/ddkint.pas506
-rw-r--r--Game/Code/lib/zlportio/install.txt16
-rw-r--r--Game/Code/lib/zlportio/zlportio.pas570
8 files changed, 825 insertions, 825 deletions
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.