portio.pas

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

      @DlWriteBufferDWord:=GetProcAddress(FDLLInst,'DlPortWritePortBufferUlong');

      // Make sure all our functions are there
      if ((@DlReadByte<>nil) and (@DlReadWord<>nil) and
          (@DlReadDWord<>nil) and (@DlWriteByte<>nil) and
          (@DlWriteWord<>nil) and (@DlWriteDWord<>nil) and
          (@DlReadBufferByte<>nil) and (@DlReadBufferWord<>nil) and
          (@DlReadBufferDWord<>nil) and (@DlWriteBufferByte<>nil) and
          (@DlWriteBufferWord<>nil) and (@DlWriteBufferDWord<>nil)) then
         FActiveHW:=true; // Success
   end;

   // Did we fail?
   if (not FActiveHW) then
   begin
      // If we're running Windows NT, stop the driver then remove it
      // Forget about any return (error) values we might get...
      if (FRunningWinNT) then
      begin
         DriverStop;
         DriverRemove;
         DisconnectSCM;
      end;

      // Free the library
      if (FDLLInst<>0) then
      begin
         FreeLibrary(FDLLInst);
         FDLLInst:=0;
      end;
   end;
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.CloseDriver;
//---------------------------------------------------------------------------
begin
   // Don't close anything if it wasn't opened previously
   if (not IsLoaded) then Exit;

   // If we're running Windows NT, stop the driver then remove it
   if (FRunningWinNT) then
   begin
      if (not DriverStop) then Exit;
      if (not DriverRemove) then Exit;
      DisconnectSCM;
   end;

   // Free the library
   if (not FreeLibrary(FDLLInst)) then Exit;
   FDLLInst:=0;

   FActiveHW:=false; // Success
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.PortControl(Ports : array of TPortRec; NumPorts : Word);
//---------------------------------------------------------------------------
var
   Index : Word;
begin
   for Index := 1 to NumPorts do
      if (Ports[Index].fWrite) then
         DlWriteByte(Ports[Index].PortAddr, Ports[Index].PortData)
      else
         Ports[Index].PortData:=DlReadByte(Ports[Index].PortAddr);
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.PortCommand(Ports : array of TPortCommand; NumPorts : Word);
//---------------------------------------------------------------------------
var
   Index : Word;
begin
   for Index := 1 to NumPorts do
      case (Ports[Index].PortMode) of
         tmReadByte:
            Ports[Index].PortData:=DlReadByte(Ports[Index].PortAddr);
         tmReadWord:
            Ports[Index].PortData:=DlReadWord(Ports[Index].PortAddr);
         tmReadDWord:
            Ports[Index].PortData:=DlReadDWord(Ports[Index].PortAddr);
         tmWriteByte:
            DlWriteByte(Ports[Index].PortAddr, Ports[Index].PortData);
         tmWriteWord:
            DlWriteWord(Ports[Index].PortAddr, Ports[Index].PortData);
         tmWriteDWord: 
            DlWriteDWord(Ports[Index].PortAddr, Ports[Index].PortData);
      end;
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.ReadPortFIFO(PortAddr : Word; NumPorts : Word; var Buffer);
//---------------------------------------------------------------------------
begin
   DlReadBufferByte(PortAddr, @Buffer, NumPorts);
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.WritePortFIFO(PortAddr : Word; NumPorts : Word; var Buffer);
//---------------------------------------------------------------------------
begin
   DlWriteBufferByte(PortAddr, @Buffer, NumPorts);
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.ReadWPortFIFO(PortAddr : Word; NumPorts : Word; var Buffer);
//---------------------------------------------------------------------------
begin
   DlReadBufferWord(PortAddr, @Buffer, NumPorts);
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.WriteWPortFIFO(PortAddr : Word; NumPorts : Word; var Buffer);
//---------------------------------------------------------------------------
begin
   DlWriteBufferWord(PortAddr, @Buffer, NumPorts);
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.ReadLPortFIFO(PortAddr : Word; NumPorts : Word; var Buffer);
//---------------------------------------------------------------------------
begin
   DlReadBufferDWord(PortAddr, @Buffer, NumPorts);
end;

//---------------------------------------------------------------------------
procedure TDLPortIO.WriteLPortFIFO(PortAddr : Word; NumPorts : Word; var Buffer);
//---------------------------------------------------------------------------
begin
   DlWriteBufferDWord(PortAddr, @Buffer, NumPorts);
end;


//---------------------------------------------------------------------------
constructor TDLPrinterPortIO.Create(Owner : TComponent);
//---------------------------------------------------------------------------
begin
   inherited Create(Owner); // Set up our inherited methods, and properties

   FLPTNumber := 0;   // No LPT selected
   FLPTBase := 0;     // No base address
   FLPTCount := 0;    // No printer ports counted

   DetectPorts();     // Detect the printer ports available

   SetLPTNumber(1);   // Default LPT number
end;

//---------------------------------------------------------------------------
procedure TDLPrinterPortIO.DetectPorts;
//---------------------------------------------------------------------------
var
   RunningWinNT : Boolean;
   os : TOSVersionInfo;
begin
   // Are we running Windows NT?
   os.dwPlatformId := 0;
   os.dwOSVersionInfoSize := sizeof(os);
   GetVersionEx(os);
   RunningWinNT:=(os.dwPlatformId=VER_PLATFORM_WIN32_NT);

   // Detect the printer ports available
   if (RunningWinNT) then
      DetectPortsNT()  // WinNT version
   else
      DetectPorts9x(); // Win9x version
end;

//---------------------------------------------------------------------------
procedure TDLPrinterPortIO.DetectPorts9x;
//---------------------------------------------------------------------------
const
   BASE_KEY     : AnsiString = 'Config Manager\Enum';
   PROBLEM      : AnsiString = 'Problem';
   ALLOCATION   : AnsiString = 'Allocation';
   PORT_NAME    : AnsiString = 'PortName';
   HARDWARE_KEY : AnsiString = 'HardwareKey';

   KEY_PERMISSIONS : REGSAM = KEY_ENUMERATE_SUB_KEYS or KEY_QUERY_VALUE;

var
   CurKey   : HKEY;            // Current key when using the registry
   KeyName  : AnsiString;      // A key name when using the registry

   KeyList  : TStringList;     // List of keys
   KeyIndex : DWord;           // For loop variable
   KeyCount : DWord;           // Count of the number of keys in KeyList

   index    : DWord;           // Index for 'for' loops

   DummyFileTime  : TFileTime;
   DummyLength    : DWord;
   DummyString    : array[0..MAX_PATH] of char;

   HasProblem     : Boolean;   // Does a port entry have any problems?
   DataType,
   DataSize       : DWord;     // Type and Size of data in the registry

   // Data from "Problem" sub-key
   ProblemData    : array[0..63] of Byte;

   PortName       : AnsiString; // Name of a port
   PortNumber     : Integer;    // The number of a port

   // Holds the registry data for the port address allocation
   PortAllocation : array[0..63] of Word;

begin
   // Clear the port count
   FLPTCount := 0;

   // Clear the port array
   for index :=0 to MAX_LPT_PORTS do
      FLPTAddress[index] := 0;

   // Open the registry
   RegOpenKeyEx(HKEY_DYN_DATA, PChar(BASE_KEY), 0, KEY_PERMISSIONS, CurKey);

   // Grab all the key names under HKEY_DYN_DATA
   KeyList := TStringList.create;
   DummyLength := MAX_PATH;
   KeyCount := 0;
   while (RegEnumKeyEx(
            CurKey, KeyCount, @DummyString, DummyLength,
            nil, nil, nil, @DummyFileTime
                       ) <> ERROR_NO_MORE_ITEMS) do
   begin
      KeyList.Add(DummyString);
      DummyLength := MAX_PATH;
      inc(KeyCount);
   end;

   // Close the key
   RegCloseKey(CurKey);

   // Cycle through all keys; looking for a string valued subkey called
   // 'HardWareKey' which is not nil, and another subkey called 'Problem'
   // whose fields are all valued 0.
   for KeyIndex :=0 to KeyCount-1 do
   begin
      HasProblem := false; // Is 'Problem' non-zero? Assume it is Ok

      // Open the key
      KeyName := BASE_KEY + '\' + KeyList.Strings[KeyIndex];
      if (RegOpenKeyEx(
            HKEY_DYN_DATA, PChar(KeyName), 0, KEY_PERMISSIONS, CurKey
                        ) <> ERROR_SUCCESS) then
         Continue;

      // Test for a 0 valued Problem sub-key,
      // which must only consist of raw data
      RegQueryValueEx(CurKey, PChar(PROBLEM), nil, @DataType, nil, @DataSize);
      if (DataType = REG_BINARY) then
      begin
         // We have a valid, binary "Problem" sub-key
         // Test to see if the fields are zero

         // Read the data from the "Problem" sub-key
         if (RegQueryValueEx(
                  CurKey, PChar(PROBLEM), nil,
                  nil, @ProblemData, @DataSize
                             ) = ERROR_SUCCESS) then
         begin
            // See if it has any problems
            for index :=0 to DataSize-1 do
               if ProblemData[index] <> 0 then
                  HasProblem := true;
         end
         else
            HasProblem := true; // No good

         // Now try and read the Hardware sub-key
         DataSize := MAX_PATH;
         RegQueryValueEx(
            CurKey, PChar(HARDWARE_KEY), nil, @DataType, @DummyString, @DataSize
                         );
         if (DataType <> REG_SZ) then
            HasProblem := true; // No good

         // Do we have no problem, and a non-nil Hardware sub-key?
         if ((not HasProblem) and (StrLen(DummyString) > 0)) then
         begin
            // Now open the key which is "pointed at" by HardwareSubKey
            RegCloseKey(CurKey);

            KeyName := 'Enum\'+DummyString;
            if (RegOpenKeyEx(
                  HKEY_LOCAL_MACHINE, PChar(KeyName), 0, KEY_PERMISSIONS, CurKey
                              ) <> ERROR_SUCCESS) then
               Continue;

            // Now read in the PortName and obtain the LPT number from it
            DataSize := MAX_PATH;
            RegQueryValueEx(
               CurKey, PChar(PORT_NAME), nil, @DataType, @DummyString, @DataSize
                            );
            PortName := DummyString;
            if (DataType <> REG_SZ) then
               PortName := ''; // No good

            // Make sure it has LPT in it
            if (StrPos(PChar(PortName), 'LPT') <> nil) then
            begin
               for index:=0 to MAX_PATH do
                  DummyString[index] := #0;

               StrLCopy(DummyString,
                        StrPos(PChar(PortName), 'LPT') + 3,
                        StrLen(PChar(PortName))
                           - (StrPos(PChar(PortName), 'LPT')
                           - @PortName) - 2
                        );

               // Find the port number
               try
                  PortNumber := StrToInt(DummyString);
               except
                  PortNumber := 0;
               end;

               // Find the address
               RegCloseKey(CurKey);

               KeyName := BASE_KEY + '\' + KeyList.Strings[KeyIndex];
               RegOpenKeyEx(HKEY_DYN_DATA, PChar(KeyName), 0, KEY_PERMISSIONS, CurKey);

               DataSize := sizeof(PortAllocation);
               RegQueryValueEx(
                  CurKey, PChar(ALLOCATION), nil, @DataType,
                  @PortAllocation, @DataSize
                               );
               if (DataType = REG_BINARY) then
               begin
                  // Decode the Allocation data: the port address is present
                  // directly after a 0x000C entry (which doesn't have 0x0000
                  // after it).
                  for index := 0 to 63 do
                     if ((PortAllocation[index] = $000C) and
                         (PortAllocation[index+1] <> $0000) and
                         (PortNumber<=MAX_LPT_PORTS)) then
                     begin
                        // Found a port; add it to the list
                        FLPTAddress[PortNumber] := PortAllocation[index+1];
                        inc(FLPTCount);
                        Break;
                     end;

               end;

            end;

         end;
      end;

      RegCloseKey(CurKey);
   end;

   // Destroy our key list
   KeyList.Free;
end;

//---------------------------------------------------------------------------
procedure TDLPrinterPortIO.DetectPortsNT;
//---------------------------------------------------------------------------
const
   BASE_KEY        : AnsiString = 'HARDWARE\DEVICEMAP\PARALLEL PORTS';
   LOADED_KEY      : AnsiString = 'HARDWARE\RESOURCEMAP\LOADED PARALLEL DRIVER RESOURCES\Parport';
   DOS_DEVICES     : AnsiString = '\DosDevices\LPT';