📄 hw_32.pas
字号:
{========================================================================}
{========================================================================}
{================= TVicHW32 Shareware Version 3.0 =================}
{========== Copyright (c) 1997 Victor I.Ishikeev =======}
{========================================================================}
{========== mailto:ivi.ufanet.ru =======}
{========================================================================}
{$R-} {$S-} {$D-} {$Q-}
unit HW_32;
interface
uses SysUtils,Classes,Windows;
{$i HW_Types.pas}
type
TVicHw32 = class(TComponent)
private
fDriverName : array[0..7] of Char;
fSDriverName : String[8];
fPathToDriver : array[0..128] of Char;
fShortPathToDriver : array[0..12] of Char;
hDrv : THandle;
hDll : THandle;
fWin95 : Boolean;
fRegistry : Boolean;
fStarted : Boolean;
schSCManager : THandle;
fTerminated : Boolean;
fInterface : DWORD; // Isa, Eisa, etc....
fBus : DWORD; // Bus number
fPhysLoPart : DWORD; // Bus-relative address
fPhysHiPart : DWORD; // Zero
fTypeMem : DWORD; // 0 is memory, 1 is I/O
fMemorySize : DWORD; // Length of section to map
fMappedPointers : array[1..MaxMappedAreas] of Pointer;
fMappedSizes : array[1..MaxMappedAreas] of DWORD;
fMappedAddresses : array[1..MaxMappedAreas] of DWORD;
fMappedAreas : Word;
fpLockedMemory : Pointer;
fMdl : Pointer;
fLocEvent : THandle;
fDebugCode : DWORD;
fHardAccess : Boolean;
fOpenDrive : Boolean;
fOnHwInterrupt : TInterruptHandler;
fIsIRQSet : Boolean;
fIRQNumber : Byte;
fMasked : Boolean;
fThreadId : THandle;
fThreadHandle : THandle;
hDrvEvent : THandle;
OpenVxdHandle : TOpenVxdHandle;
fLPTAddresses : PLPTAddresses;
fLPTBasePort : Word;
fDataPorts : array[0..2] of Byte;
fLPTNumber : Byte;
fLPTs : Byte;
function InstallDriver : Boolean;
function StartDriver : Boolean;
function StopDriver : Boolean;
function RemoveDriver : Boolean;
procedure CloseStopUnloadDriver;
procedure InstallStartLoadDriver;
function CtlCode(Code : DWORD) : DWORD;
procedure ClearFields;
procedure SetHardAccess(parm : Boolean);
procedure SetLPTNumber(nNewValue : Byte);
procedure SetIRQMasked(bNewValue : Boolean);
procedure SetIRQNumber(nNewValue : Byte);
function GetLPTAckwl : Boolean;
function GetLPTBusy : Boolean;
function GetLPTPaperEnd : Boolean;
function GetLPTSlct : Boolean;
function GetLPTError : Boolean;
function GetPortB(PortAddr : Word) : Byte;
procedure SetPortB(PortAddr : Word; nNewValue : Byte);
function GetPortW(PortAddr : Word) : Word;
procedure SetPortW(PortAddr : Word; nNewValue : Word);
function GetPortL(PortAddr : Word) : DWORD;
procedure SetPortL(PortAddr : Word; nNewValue : DWORD);
function GetPin(nPin : Byte) : Boolean;
procedure SetPin(nPin : Byte; bNewValue : Boolean);
function GetMemB(MappedAddr : Pointer; Offset : DWORD) : Byte;
procedure SetMemB(MappedAddr : Pointer; Offset : DWORD; nNewValue : Byte);
function GetMemW(MappedAddr : Pointer; Offset : DWORD) : Word;
procedure SetMemW(MappedAddr : Pointer; Offset : DWORD; nNewValue : Word);
function GetMemL(MappedAddr : Pointer; Offset : DWORD) : DWORD;
procedure SetMemL(MappedAddr : Pointer; Offset : DWORD; nNewValue : DWORD);
public
constructor Create(Owner:TComponent); override;
destructor Destroy; override;
procedure CloseDriver;
function OpenDriver : Boolean;
function MapPhysToLinear(PhAddr : DWORD; PhSize : DWORD) : Pointer;
procedure UnmapMemory(PhAddr : DWORD; PhSize : DWORD);
function LPTPrintChar(ch : Char) : Boolean;
procedure LPTStrobe;
procedure LPTAutofd(Flag : Boolean);
procedure LPTInit;
procedure LPTSlctIn;
procedure PortControl ( Ports:pPortRec; NumPorts:Word);
procedure ReadPortFIFO ( PortAddr:Word; NumPorts:Word; var Buffer);
procedure WritePortFIFO( PortAddr:Word; NumPorts:Word; var Buffer);
procedure ReadPortWFIFO ( PortAddr:Word; NumPorts:Word; var Buffer);
procedure WritePortWFIFO( PortAddr:Word; NumPorts:Word; var Buffer);
property Port[Index:Word] : Byte read GetPortB write SetPortB;
property PortW[Index:Word] : Word read GetPortW write SetPortW;
property PortL[Index:Word] : DWORD read GetPortL write SetPortL;
property Mem[Base:Pointer; Offset:DWORD] : Byte read GetMemB write SetMemB;
property MemW[Base:Pointer; Offset:DWORD] : Word read GetMemW write SetMemW;
property MemL[Base:Pointer; Offset:DWORD] : DWORD read GetMemL write SetMemL;
property IRQMasked : Boolean read fMasked write SetIRQMasked;
property LPTAckwl : Boolean read GetLPTAckwl;
property LPTBusy : Boolean read GetLPTBusy;
property LPTPaperEnd : Boolean read GetLPTPaperEnd;
property LPTSlct : Boolean read GetLPTSlct;
property LPTError : Boolean read GetLPTError;
property LPTNumPorts : Byte read fLPTs;
property LPTBasePort : Word read fLPTBasePort;
property DebugCode : DWORD read fDebugCode;
property Pin[Index:Byte] : Boolean read GetPin write SetPin;
published
property ActiveHW : Boolean read fOpenDrive;
property OnHwInterrupt : TInterruptHandler read fOnHwInterrupt write fOnHwInterrupt;
property LPTNumber : Byte read fLPTNumber write SetLPTNumber default 1;
property IRQNumber : Byte read fIRQNumber write SetIRQNumber;
property HardAccess : Boolean read fHardAccess write SetHardAccess default TRUE;
end;
procedure Register;
implementation
{$R *.DCR}
const SC_MANAGER_CONNECT = $0001;
const SC_MANAGER_CREATE_SERVICE = $0002;
const SC_MANAGER_ENUMERATE_SERVICE = $0004;
const SC_MANAGER_LOCK = $0008;
const SC_MANAGER_QUERY_LOCK_STATUS = $0010;
const SC_MANAGER_MODIFY_BOOT_CONFIG = $0020;
const SC_MANAGER_ALL_ACCESS =(STANDARD_RIGHTS_REQUIRED OR
SC_MANAGER_CONNECT OR
SC_MANAGER_CREATE_SERVICE OR
SC_MANAGER_ENUMERATE_SERVICE OR
SC_MANAGER_LOCK OR
SC_MANAGER_QUERY_LOCK_STATUS OR
SC_MANAGER_MODIFY_BOOT_CONFIG);
const SERVICE_QUERY_CONFIG = $0001;
const SERVICE_CHANGE_CONFIG = $0002;
const SERVICE_QUERY_STATUS = $0004;
const SERVICE_ENUMERATE_DEPENDENTS = $0008;
const SERVICE_START = $0010;
const SERVICE_STOP = $0020;
const SERVICE_PAUSE_CONTINUE = $0040;
const SERVICE_INTERROGATE = $0080;
const SERVICE_USER_DEFINED_CONTROL = $0100;
const SERVICE_ALL_ACCESS =(STANDARD_RIGHTS_REQUIRED OR
SERVICE_QUERY_CONFIG OR
SERVICE_CHANGE_CONFIG OR
SERVICE_QUERY_STATUS OR
SERVICE_ENUMERATE_DEPENDENTS OR
SERVICE_START OR
SERVICE_STOP OR
SERVICE_PAUSE_CONTINUE OR
SERVICE_INTERROGATE OR
SERVICE_USER_DEFINED_CONTROL);
const SERVICE_KERNEL_DRIVER = $0000001;
const SERVICE_FILE_SYSTEM_DRIVER = $0000002;
const SERVICE_ADAPTER = $0000004;
const SERVICE_RECOGNIZER_DRIVER = $0000008;
const SERVICE_DRIVER =(SERVICE_KERNEL_DRIVER OR
SERVICE_FILE_SYSTEM_DRIVER OR
SERVICE_RECOGNIZER_DRIVER);
const SERVICE_BOOT_START = $0000000;
const SERVICE_SYSTEM_START = $0000001;
const SERVICE_AUTO_START = $0000002;
const SERVICE_DEMAND_START = $0000003;
const SERVICE_DISABLED = $0000004;
const SERVICE_ERROR_IGNORE = $0000000;
const SERVICE_ERROR_NORMAL = $0000001;
const SERVICE_ERROR_SEVERE = $0000002;
const SERVICE_ERROR_CRITICAL = $0000003;
const SERVICE_CONTROL_STOP = $0000001;
const SERVICE_CONTROL_PAUSE = $0000002;
const SERVICE_CONTROL_CONTINUE = $0000003;
const SERVICE_CONTROL_INTERROGATE = $0000004;
const SERVICE_CONTROL_SHUTDOWN = $0000005;
type SERVICE_STATUS = record
dwServiceType : DWORD;
dwCurrentState : DWORD;
dwControlsAccepted : DWORD;
dwWin32ExitCode : DWORD;
dwServiceSpecificExitCode : DWORD;
dwCheckPoint : DWORD;
dwWaitHint : DWORD;
end;
function TVicHW32.InstallDriver : Boolean;
var
schService : SC_HANDLE;
begin
schService := CreateService(SchSCManager, // SCManager database
fDriverName, // name of service
fDriverName, // name to display
SERVICE_ALL_ACCESS, // desired access
SERVICE_KERNEL_DRIVER, // service type
SERVICE_DEMAND_START, // start type
SERVICE_ERROR_NORMAL, // error control type
fPathToDriver, // service's binary
NIL, // no load ordering group
NIL, // no tag identifier
NIL, // no dependencies
NIL, // LocalSystem account
NIL); // no password)
Result:=(schService <> 0) or (GetLastError=ERROR_SERVICE_EXISTS);
CloseServiceHandle (schService);
end;
function TVicHW32.StartDriver:Boolean;
var
schService : SC_HANDLE;
ret : BOOL;
begin
Result:=FALSE;
schService := OpenService (SchSCManager,fDriverName,SERVICE_ALL_ACCESS);
if (schService = 0) then Exit;
ret := StartService (schService,0,NIL);
Result:=ret or (GetLastError=ERROR_SERVICE_ALREADY_RUNNING);
CloseServiceHandle (schService);
end;
function TVicHW32.StopDriver : Boolean;
var
schService : SC_HANDLE;
serviceStatus : SERVICE_STATUS;
begin
Result:=FALSE;
schService := OpenService (SchSCManager,fDriverName,SERVICE_ALL_ACCESS);
if (schService = 0) then Exit;
Result:=ControlService (schService,SERVICE_CONTROL_STOP,@serviceStatus);
CloseServiceHandle (schService);
end;
function TVicHW32.RemoveDriver : Boolean;
var
schService : SC_HANDLE ;
begin
Result:=FALSE;
schService := OpenService (SchSCManager,fDriverName,SERVICE_ALL_ACCESS);
if (schService = 0) then Exit;
Result := DeleteService (schService);
CloseServiceHandle (schService);
end;
procedure TVicHW32.CloseStopUnloadDriver;
begin
CloseHandle(hDrv);
if fWin95 then Exit;
{$ifndef DEMOVERSION}
if fStarted then Exit;
{$endif}
schSCManager := OpenSCManager(0, 0, SC_MANAGER_ALL_ACCESS);
if (schSCManager <> 0) then
begin
StopDriver();
{$ifndef DEMOVERSION}
if ( not fRegistry) then
{$endif}
RemoveDriver();
CloseServiceHandle(schSCManager);
end;
end;
procedure TVicHW32.InstallStartLoadDriver;
begin
// CloseStopUnloadDriver(); // Close before start
if fWin95 then // Windows 95/98
begin
hDrv := CreateFile(fPathToDriver,
0,
0,
NIL,
0,
FILE_FLAG_DELETE_ON_CLOSE,
0);
Exit;
end;
fDebugCode := DEB_ENTRY;
{$ifndef DEMOVERSION}
fRegistry := TRUE; // assume driver already installed to th registry
fStarted := TRUE; // assume driver already started
fDebugCode := fDebugCode or DEB_ENTRY_NOT_DEMO;
hDrv := CreateFile(fShortPathToDriver,
GENERIC_READ or GENERIC_WRITE,
0,
NIL,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
if (hDrv <> INVALID_HANDLE_VALUE) then Exit;
fDebugCode := fDebugCode or DEB_NOT_STARTED;
fStarted := FALSE;
{$endif}
schSCManager := OpenSCManager(0, 0, SC_MANAGER_ALL_ACCESS);
fDebugCode := fDebugCode or DEB_SC_NOT_OPEN;
if (schSCManager <> 0) then
begin
fDebugCode := fDebugCode or DEB_SC_OPEN;
{$ifndef DEMOVERSION}
// Driver already installed but not started? Try to start...
if StartDriver() then
begin
hDrv := CreateFile(fShortPathToDriver,
GENERIC_READ or GENERIC_WRITE,
0,
NIL,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
CloseServiceHandle (schSCManager);
fDebugCode := fDebugCode or DEB_INSTALLED;
Exit; // YES!
end;
fRegistry := FALSE; // not installed
fDebugCode := fDebugCode or DEB_NOT_INSTALLED;
{$endif}
if InstallDriver() then
begin
fDebugCode := fDebugCode or DEB_AFTER_INSTALL;
if StartDriver() then
begin
fDebugCode := fDebugCode or DEB_AFTER_START;
hDrv := CreateFile(fShortPathToDriver,
GENERIC_READ or GENERIC_WRITE,
0,
NIL,
OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL,
0);
end;
end;
CloseServiceHandle (schSCManager);
end;
end;
function TVicHw32.CtlCode(Code:DWORD):DWORD;
begin
if fWin95 then Result:=Code
else Result:=$80000000 or (($800+Code) shl 2);
end;
procedure IRQProcNT(HW32 : TVicHw32); stdcall;
var nByte,dwIRQ : DWORD;
CurrentProcess : tHandle;
pl : PLockedBuffer;
wrd,sel : Word;
begin
pl := PLockedBuffer(HW32.fpLockedMemory);
with HW32,pl^ do
begin
wrd := 0;
CurrentProcess := GetCurrentProcess();
SetPriorityClass(CurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread(), THREAD_PRIORITY_TIME_CRITICAL);
DeviceIoControl(hDrv,
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -