portio.pas

这里介绍的一款多功能编程器

//---------------------------------------------------------------------------
// Connects to the WinNT Service Control Manager
function TDLPortIO.ConnectSCM : Boolean;
//---------------------------------------------------------------------------
const
   SC_MANAGER_CONNECT           = $0001;
   SC_MANAGER_QUERY_LOCK_STATUS = $0010;
   SC_MANAGER_ENUMERATE_SERVICE = $0004;
   SC_MANAGER_CREATE_SERVICE    = $0002;

   ERROR_ACCESS_DENIED          = $0005;
var
   dwStatus : DWORD;
   scAccess : DWORD;
begin
   dwStatus := 0;           // Assume success, until we prove otherwise

   // Try and connect as administrator
   scAccess := SC_MANAGER_CONNECT or
               SC_MANAGER_QUERY_LOCK_STATUS or
               SC_MANAGER_ENUMERATE_SERVICE or
               SC_MANAGER_CREATE_SERVICE;      // Admin only

   // Connect to the SCM
   hSCMan := OpenSCManager(nil, nil, scAccess);

   // If we're not in administrator mode, try and reconnect
   if ((hSCMan=0) and (GetLastError=ERROR_ACCESS_DENIED)) then
   begin
      scAccess := SC_MANAGER_CONNECT or
                  SC_MANAGER_QUERY_LOCK_STATUS or
                  SC_MANAGER_ENUMERATE_SERVICE;

      // Connect to the SCM
      hSCMan := OpenSCManager(nil, nil, scAccess);
   end;

   // Did it succeed?
   if (hSCMan=0) then
   begin
      // Failed, save error information
      dwStatus:=GetLastError;
      FLastError:='ConnectSCM: Error #'+IntToStr(dwStatus);
   end;

   Result := (dwStatus=0); // Success == 0
end;

//---------------------------------------------------------------------------
// Disconnects from the WinNT Service Control Manager
procedure TDLPortIO.DisconnectSCM;
//---------------------------------------------------------------------------
begin
   if (hSCMan<>0) then
   begin
      // Disconnect from our local Service Control Manager
      CloseServiceHandle(hSCMan);
      hSCMan:=0;
   end;
end;

//---------------------------------------------------------------------------
// Installs, starts, stops and removes the WinNT kernel mode driver
function TDLPortIO.DriverInstall : Boolean;
//---------------------------------------------------------------------------
const
   SERVICE_KERNEL_DRIVER  = $00001;
   SERVICE_DEMAND_START   = $00003;
   SERVICE_ERROR_NORMAL   = $00001;
   SERVICE_START          = $00010;
   SERVICE_STOP           = $00020;
   SERVICE_QUERY_STATUS   = $00004;
   DELETE                 = $10000;
var
   hService : SC_HANDLE;    // Handle to the new service
   dwStatus : DWORD;
   DriverPath : AnsiString; // Path including filename
Begin
   dwStatus := 0;           // Assume success, until we prove otherwise

   FDrvPrevInst := false;   // Assume the driver wasn't installed previously

   // Path including filename
   DriverPath := FDriverPath+'\'+DRIVER_NAME+'.SYS';

   // Is the DriverLINX driver already in the SCM? If so,
   // indicate success and set FDrvPrevInst to true.
   hService:=OpenService(hSCMan, PChar(DRIVER_NAME), SERVICE_QUERY_STATUS);
   if (hService<>0) then
   begin
      FDrvPrevInst := true;         // Driver previously installed, don't remove
      CloseServiceHandle(hService); // Close the service
      Result := true;               // Success
      Exit;
   end;

   // Add to our Service Control Manager's database
   hService:=CreateService(
                hSCMan,
                PChar(DRIVER_NAME),
                PChar(DISPLAY_NAME),
                SERVICE_START or SERVICE_STOP or DELETE or SERVICE_QUERY_STATUS,
                SERVICE_KERNEL_DRIVER,
                SERVICE_DEMAND_START,
                SERVICE_ERROR_NORMAL,
                PChar(DriverPath),
                PChar(DRIVER_GROUP),
                nil, nil, nil, nil);

   if (hService=0) then
      // Get the error that occurred
      dwStatus := GetLastError
   else
      // Close the service for now...
      CloseServiceHandle(hService);

   if (dwStatus<>0) then
      FLastError:='DriverInstall: Error #'+IntToStr(dwStatus);

   Result := (dwStatus=0); // Success == 0
end;

//---------------------------------------------------------------------------
function TDLPortIO.DriverStart : Boolean;
//---------------------------------------------------------------------------
const
   SERVICE_START          = $00010;
   SERVICE_QUERY_STATUS   = $00004;
   SERVICE_RUNNING        = $00004;
   SERVICE_STOPPED        = $00001;
var
   hService            : SC_HANDLE;    // Handle to the new service
   dwStatus            : DWORD;
   lpServiceArgVectors : PChar;
   sStatus             : TServiceStatus;
Begin
   dwStatus := 0;          // Assume success, until we prove otherwise

   FDrvPrevStart := false; // Assume the driver was not already running

   hService := OpenService(hSCMan, PChar(DRIVER_NAME), SERVICE_QUERY_STATUS);
   if ((hService<>0) and (QueryServiceStatus(hService, sStatus))) then
   begin
      // Got the service status, now check it
      if (sStatus.dwCurrentState=SERVICE_RUNNING) then
      begin
         FDrvPrevStart:=true;          // Driver was previously started
         CloseServiceHandle(hService); // Close service
         Result := true;               // Success
         Exit;
      end
      else if (sStatus.dwCurrentState=SERVICE_STOPPED) then
      begin
         // Driver was stopped. Start the driver.
         CloseServiceHandle(hService);
         hService := OpenService(hSCMan, PChar(DRIVER_NAME), SERVICE_START);
         if (not StartService(hService, 0, lpServiceArgVectors)) then
            dwStatus:=GetLastError;
         CloseServiceHandle(hService); // Close service
      end
      else dwStatus:=$FFFFFFFF; // Can't run the service
   end
   else
      dwStatus:=GetLastError;

   if (dwStatus<>0) then
      FLastError:='DriverStart: Error #'+IntToStr(dwStatus);

   Result := (dwStatus=0); // Success == 0
end;

//---------------------------------------------------------------------------
function TDLPortIO.DriverStop : Boolean;
//---------------------------------------------------------------------------
const
   SERVICE_QUERY_STATUS   = $00004;
   SERVICE_STOP           = $00020;
   SERVICE_CONTROL_STOP   = $00001;
var
   hService      : SC_HANDLE;    // Handle to the new service
   dwStatus      : DWORD;
   Temp          : LongBool;
   ServiceStatus : TServiceStatus;
begin
   dwStatus := 0; // Assume success, until we prove otherwise

   // If we didn't start the driver, then don't stop it.
   // Pretend we stopped it, by indicating success.
   if (FDrvPrevStart) then
   begin
      Result := true;
      Exit;
   end;

   // Get a handle to the service to stop
   hService := OpenService(
                  hSCMan,
                  PChar(DRIVER_NAME),
                  SERVICE_STOP or SERVICE_QUERY_STATUS);

   if (hService<>0) then
   begin
      // Stop the driver, then close the service
      Temp := ControlService(hService, SERVICE_CONTROL_STOP, ServiceStatus);
      if (not Temp) then
         dwStatus := GetLastError();

      // Close the service
      CloseServiceHandle(hService);
   end else
      dwStatus := GetLastError;

   if (dwStatus<>0) then
      FLastError:='DriverStop: Error #'+IntToStr(dwStatus);

   Result := (dwStatus=0); // Success == 0
end;

//---------------------------------------------------------------------------
function TDLPortIO.DriverRemove : Boolean;
//---------------------------------------------------------------------------
const
   DELETE                 = $10000;
var
   hService      : SC_HANDLE;    // Handle to the new service
   dwStatus      : DWORD;
   Temp          : LongBool;
begin
   dwStatus := 0; // Assume success, until we prove otherwise

   // If we didn't install the driver, then don't remove it.
   // Pretend we removed it, by indicating success.
   if (FDrvPrevInst) then
   begin
      Result := true;
      Exit;
   end;

   // Get a handle to the service to stop
   hService := OpenService(
                  hSCMan,
                  PChar(DRIVER_NAME),
                  DELETE);

   if (hService<>0) then
   begin
      // Remove the driver then close the service again
      Temp := DeleteService(hService);
      if (not Temp) then
         dwStatus := GetLastError;

      // Close the service
      CloseServiceHandle(hService);
   end else
      dwStatus := GetLastError;

   if (dwStatus<>0) then
      FLastError:='DriverRemove: Error #'+IntToStr(dwStatus);

   Result := (dwStatus=0); // Success == 0
end;

//---------------------------------------------------------------------------
// returns true if the DLL/Driver is loaded
function TDLPortIO.IsLoaded : Boolean;
//---------------------------------------------------------------------------
begin
   Result := FActiveHW;
end;

//---------------------------------------------------------------------------
function TDLPortIO.GetPortByte(Address : Word) : Byte;
//---------------------------------------------------------------------------
begin
   Result := DlReadByte(Address);
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.SetPortByte(Address : Word; Data : Byte);
//---------------------------------------------------------------------------
begin
   DlWriteByte(Address, Data);
end;

//---------------------------------------------------------------------------
function TDLPortIO.GetPortWord(Address : Word) : Word;
//---------------------------------------------------------------------------
begin
   Result := DlReadWord(Address);
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.SetPortWord(Address : Word; Data : Word);
//---------------------------------------------------------------------------
begin
   DlWriteWord(Address, Data);
end;

//---------------------------------------------------------------------------
function TDLPortIO.GetPortDWord(Address : Word) : Longword;
//---------------------------------------------------------------------------
begin
   Result := DlReadDWord(Address);
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.SetPortDWord(Address : Word; Data : Longword);
//---------------------------------------------------------------------------
begin
   DlWriteDWord(Address, Data);
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.OpenDriver;
//---------------------------------------------------------------------------
var
   LibraryFileName : AnsiString;
begin
   // If the DLL/driver is already open, then forget it!
   if (IsLoaded) then Exit;

   // If we're running Windows NT, install the driver then start it
   if (FRunningWinNT) then
   begin
      // Connect to the Service Control Manager
      if (not ConnectSCM) then Exit;

      // Install the driver
      if (not DriverInstall) then
      begin
         // Driver install failed, so disconnect from the SCM
         DisconnectSCM;
         Exit;
      end;

      // Start the driver
      if (not DriverStart) then
      begin
         // Driver start failed, so remove it then disconnect from SCM
         DriverRemove;
         DisconnectSCM;
         Exit;
      end;
   end;

   // Load DLL library
   LibraryFileName := LIBRARY_FILENAME;

   if (FDLLPath<>'') then
      LibraryFileName := FDLLPath+'\'+LIBRARY_FILENAME;

   FDLLInst:=LoadLibrary(PChar(LibraryFileName));
   if (FDLLInst<>0) then
   begin
      @DlReadByte:=GetProcAddress(FDLLInst,'DlPortReadPortUchar');
      @DlReadWord:=GetProcAddress(FDLLInst,'DlPortReadPortUshort');
      @DlReadDWord:=GetProcAddress(FDLLInst,'DlPortReadPortUlong');

      @DlWriteByte:=GetProcAddress(FDLLInst,'DlPortWritePortUchar');
      @DlWriteWord:=GetProcAddress(FDLLInst,'DlPortWritePortUshort');
      @DlWriteDWord:=GetProcAddress(FDLLInst,'DlPortWritePortUlong');

      @DlReadBufferByte:=GetProcAddress(FDLLInst,'DlPortReadPortBufferUchar');
      @DlReadBufferWord:=GetProcAddress(FDLLInst,'DlPortReadPortBufferUshort');
      @DlReadBufferDWord:=GetProcAddress(FDLLInst,'DlPortReadPortBufferUlong');

      @DlWriteBufferByte:=GetProcAddress(FDLLInst,'DlPortWritePortBufferUchar');
      @DlWriteBufferWord:=GetProcAddress(FDLLInst,'DlPortWritePortBufferUshort');