portio.pas

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

   DEVICE_PARALLEL : AnsiString = '\Device\Parallel';

   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

   ValueList  : TStringList;     // List of Value names
   ValueIndex : DWord;           // For loop variable
   ValueCount : DWord;           // Count of the number of items in KeyList

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

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

   // Key value for \DosDevices\LPT
   DosDev         : array[0..MAX_PATH] of char;

   DataType,
   DataSize       : DWord;      // Type and Size of data in the registry

   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
   if (RegOpenKeyEx(
         HKEY_LOCAL_MACHINE, PChar(BASE_KEY), 0, KEY_PERMISSIONS, CurKey
                     ) <> ERROR_SUCCESS) then
      exit; // Can't do anything without this BASE_KEY

   // Grab all the value names under HKEY_LOCAL_MACHINE

   ValueList := TStringList.create;

   ValueCount := 0;
   DummyLength := MAX_PATH;
   while (RegEnumValue(
            CurKey, ValueCount, DummyString, DummyLength,
            nil, @DataType, nil, nil
                       ) <> ERROR_NO_MORE_ITEMS) do
   begin
      ValueList.Add(DummyString);
      DummyLength := MAX_PATH;
      inc(ValueCount);
   end;

   // Close the key
   RegCloseKey(CurKey);

   for ValueIndex :=0 to ValueCount-1 do
   begin
      // Is it a \DosDevices\LPT key?
      KeyName := BASE_KEY;
      if (RegOpenKeyEx(
            HKEY_LOCAL_MACHINE, PChar(KeyName), 0, KEY_PERMISSIONS, CurKey
                        ) = ERROR_SUCCESS) then
      begin
         DataSize := MAX_PATH;
         RegQueryValueEx(
            CurKey, PChar(ValueList.Strings[ValueIndex]), nil,
            @DataType, @DosDev, @DataSize
                         );
         RegCloseKey(CurKey);

         // Make sure it was a string
         if (DataType <> REG_SZ) then
            DosDev := '';
      end
      else
         DosDev := '';

      if (StrPos(DosDev, PChar(DOS_DEVICES)) <> nil) then
      begin
         // Get the port number
         for index:=0 to MAX_PATH do
            DummyString[index] := #0;

         StrLCopy(DummyString,
                  StrPos(DosDev, PChar(DOS_DEVICES))
                     + StrLen(PChar(DOS_DEVICES)),
                  StrLen(DosDev)
                     - (StrPos(DosDev, PChar(DOS_DEVICES)) - @DosDev)
                     - StrLen(PChar(DOS_DEVICES)) + 1
                  );
         try
            PortNumber := StrToInt(DummyString);
         except
            PortNumber := 0;
         end;

         // Get the Port ID
         for index:=0 to MAX_PATH do
            DummyString[index] := #0;

         StrLCopy(DummyString,
                  StrPos(PChar(ValueList.Strings[ValueIndex]), PChar(DEVICE_PARALLEL))
                     + StrLen(PChar(DEVICE_PARALLEL)),
                  StrLen(PChar(ValueList.Strings[ValueIndex]))
                     - (StrPos(
                           PChar(ValueList.Strings[ValueIndex]),
                           PChar(DEVICE_PARALLEL)
                               )
                        - PChar(ValueList.Strings[ValueIndex]))
                     - StrLen(PChar(DEVICE_PARALLEL)) + 1
                  );

         // Get the port address
         RegOpenKeyEx(HKEY_LOCAL_MACHINE, PChar(LOADED_KEY), 0, KEY_PERMISSIONS, CurKey);

         StrCopy(DosDev, PChar('\Device\ParallelPort' + DummyString + '.Raw'));

         if ((RegQueryValueEx(
                CurKey, DosDev, nil, @DataType, nil, nil
                              ) = ERROR_SUCCESS) and
             (DataType = REG_RESOURCE_LIST)) then
         begin
            // Read in the binary data
            DataSize := sizeof(PortAllocation);
            RegQueryValueEx(
               CurKey, @DosDev, nil, nil,
               @PortAllocation, @DataSize
                            );

            // Found a port; add it to the list
            if ((DataSize>0) and (PortNumber<=MAX_LPT_PORTS)) then
            begin
               FLPTAddress[PortNumber] := PortAllocation[12];
               inc(FLPTCount);
            end;
         end;

         RegCloseKey(CurKey);
      end;
   end;

   // Destroy our value list
   ValueList.Free;
end;

//---------------------------------------------------------------------------
function TDLPrinterPortIO.GetLPTNumPorts : Byte;
//---------------------------------------------------------------------------
begin
   Result := FLPTCount;
end;

//---------------------------------------------------------------------------
function TDLPrinterPortIO.GetLPTBasePort : Word;
//---------------------------------------------------------------------------
begin
   Result := FLPTBase;
end;

//---------------------------------------------------------------------------
procedure TDLPrinterPortIO.SetLPTNumber(Number : Byte);
//---------------------------------------------------------------------------
begin
   // Note that we don't make sure it is within the range 1..FLPTCount
   // because there _might_ (can someone claify this?) be a port numbered
   // as #2, where it may be the _only_ port installed on the system.
   if ((Number>0) and (Number<=MAX_LPT_PORTS)) then
   begin
      FLPTNumber:=Number;
      FLPTBase:=FLPTAddress[Number];
   end;
end;

//---------------------------------------------------------------------------
function TDLPrinterPortIO.GetPin(Index : TPinNumber) : Boolean;
//---------------------------------------------------------------------------
begin
   case Index of
      1:  Result := (Port[FLPTBase+2] and BIT0)=0; // Inverted
      2:  Result := (Port[FLPTBase] and BIT0)<>0;
      3:  Result := (Port[FLPTBase] and BIT1)<>0;
      4:  Result := (Port[FLPTBase] and BIT2)<>0;
      5:  Result := (Port[FLPTBase] and BIT3)<>0;
      6:  Result := (Port[FLPTBase] and BIT4)<>0;
      7:  Result := (Port[FLPTBase] and BIT5)<>0;
      8:  Result := (Port[FLPTBase] and BIT6)<>0;
      9:  Result := (Port[FLPTBase] and BIT7)<>0;
      10: Result := (Port[FLPTBase+1] and BIT6)<>0;
      11: Result := (Port[FLPTBase+1] and BIT7)=0; // Inverted
      12: Result := (Port[FLPTBase+1] and BIT5)<>0;
      13: Result := (Port[FLPTBase+1] and BIT4)<>0;
      14: Result := (Port[FLPTBase+2] and BIT1)=0; // Inverted
      15: Result := (Port[FLPTBase+1] and BIT3)<>0;
      16: Result := (Port[FLPTBase+2] and BIT2)<>0;
      17: Result := (Port[FLPTBase+2] and BIT3)=0; // Inverted
   else
          Result := false; // pins 18-25 (GND), and other invalid pins
   end;
end;

//---------------------------------------------------------------------------
procedure TDLPrinterPortIO.SetPin(Index : TPinNumber; State : Boolean);
//---------------------------------------------------------------------------
begin
   if (State) then
   begin
      case Index of
         1:  Port[FLPTBase+2] := Port[FLPTBase+2] and (not BIT0);  // Inverted
         2:  Port[FLPTBase] := Port[FLPTBase] or BIT0;
         3:  Port[FLPTBase] := Port[FLPTBase] or BIT1;
         4:  Port[FLPTBase] := Port[FLPTBase] or BIT2;
         5:  Port[FLPTBase] := Port[FLPTBase] or BIT3;
         6:  Port[FLPTBase] := Port[FLPTBase] or BIT4;
         7:  Port[FLPTBase] := Port[FLPTBase] or BIT5;
         8:  Port[FLPTBase] := Port[FLPTBase] or BIT6;
         9:  Port[FLPTBase] := Port[FLPTBase] or BIT7;
         (*
         10: Port[FLPTBase+1] := Port[FLPTBase+1] or BIT6;
         11: Port[FLPTBase+1] := Port[FLPTBase+1] and (not BIT7);  // Inverted
         12: Port[FLPTBase+1] := Port[FLPTBase+1] or BIT5;
         13: Port[FLPTBase+1] := Port[FLPTBase+1] or BIT4;
         *)
         14: Port[FLPTBase+2] := Port[FLPTBase+2] and (not BIT1);  // Inverted
         (*
         15: Port[FLPTBase+1] := Port[FLPTBase+1] or BIT3;
         *)
         16: Port[FLPTBase+2] := Port[FLPTBase+2] or BIT2;
         17: Port[FLPTBase+2] := Port[FLPTBase+2] and (not BIT3);  // Inverted
      else
         // pins 18-25 (GND), and other invalid pins
      end
   end else
   begin
      case Index of
         1:  Port[FLPTBase+2] := Port[FLPTBase+2] or BIT0;    // Inverted
         2:  Port[FLPTBase] := Port[FLPTBase] and (not BIT0);
         3:  Port[FLPTBase] := Port[FLPTBase] and (not BIT1);
         4:  Port[FLPTBase] := Port[FLPTBase] and (not BIT2);
         5:  Port[FLPTBase] := Port[FLPTBase] and (not BIT3);
         6:  Port[FLPTBase] := Port[FLPTBase] and (not BIT4);
         7:  Port[FLPTBase] := Port[FLPTBase] and (not BIT5);
         8:  Port[FLPTBase] := Port[FLPTBase] and (not BIT6);
         9:  Port[FLPTBase] := Port[FLPTBase] and (not BIT7);
         (*
         10: Port[FLPTBase+1] := Port[FLPTBase+1] and (not BIT6);
         11: Port[FLPTBase+1] := Port[FLPTBase+1] or BIT7;    // Inverted
         12: Port[FLPTBase+1] := Port[FLPTBase+1] and (not BIT5);
         13: Port[FLPTBase+1] := Port[FLPTBase+1] and (not BIT4);
         *)
         14: Port[FLPTBase+2] := Port[FLPTBase+2] or BIT1;    // Inverted
         (*
         15: Port[FLPTBase+1] := Port[FLPTBase+1] and (not BIT3);
         *)
         16: Port[FLPTBase+2] := Port[FLPTBase+2] and (not BIT2);
         17: Port[FLPTBase+2] := Port[FLPTBase+2] or BIT3;    // Inverted
      else
         // pins 18-25 (GND), and other invalid pins
      end
   end;
end;

//---------------------------------------------------------------------------
function TDLPrinterPortIO.GetLPTAckwl : Boolean;
//---------------------------------------------------------------------------
begin
   Result := GetPin(ACK_PIN);
end;

//---------------------------------------------------------------------------
function TDLPrinterPortIO.GetLPTBusy : Boolean;
//---------------------------------------------------------------------------
begin
   Result := GetPin(BUSY_PIN);
end;

//---------------------------------------------------------------------------
function TDLPrinterPortIO.GetLPTPaperEnd : Boolean;
//---------------------------------------------------------------------------
begin
   Result := GetPin(PAPEREND_PIN);
end;

//---------------------------------------------------------------------------
function TDLPrinterPortIO.GetLPTSlct : Boolean;
//---------------------------------------------------------------------------
begin
   Result := GetPin(SELECTOUT_PIN);
end;

//---------------------------------------------------------------------------
function TDLPrinterPortIO.GetLPTError : Boolean;
//---------------------------------------------------------------------------
begin
   Result := GetPin(ERROR_PIN);
end;

//---------------------------------------------------------------------------
procedure TDLPrinterPortIO.LPTStrobe;
//---------------------------------------------------------------------------
begin
   // Set to strobe pin to 0V
   SetPin(STROBE_PIN, false);
   // Wait one millisecond
   Sleep(1);
   // Set strobe pin back to 5V
   SetPin(STROBE_PIN, true);
end;

//---------------------------------------------------------------------------
procedure TDLPrinterPortIO.LPTAutofd(Flag : Boolean);
//---------------------------------------------------------------------------
begin
   // Set the auto line feed pin
   SetPin(AUTOFD_PIN, Flag);
end;

//---------------------------------------------------------------------------
procedure TDLPrinterPortIO.LPTInit;
//---------------------------------------------------------------------------
begin
   // Set pin to a 0V
   SetPin(INIT_PIN, false);
   // Wait 1 ms
   Sleep(1);
   // Set pin back to 5V
   SetPin(INIT_PIN, true);
end;

//---------------------------------------------------------------------------
procedure TDLPrinterPortIO.LPTSlctIn;
//---------------------------------------------------------------------------
begin
   // Send the signal (0V)
   SetPin(SELECTIN_PIN, false);
end;

//---------------------------------------------------------------------------
function TDLPrinterPortIO.LPTPrintChar(Ch : Char) : Boolean;
//---------------------------------------------------------------------------
begin
    // Write data to Base+0
    Port[FLPTBase]:=Byte(Ch);
    // Write 0Dh to Base+2.
    Port[FLPTBase+2]:=$0D;
    // Make sure there's a delay of at least one microsecond
    Sleep(1);
    // Write 0Ch to Base+2.
    Port[FLPTBase+2]:=$0C;
    // Input from Base+1 and check if Bit 7 is 1.
    // Return this status as whether the character was printed
    Result := ((Port[FLPTBase+1] and BIT7)<>0);
end;


procedure Register;
begin
  RegisterComponents('DiskDude', [TDLPortIO, TDLPrinterPortIO]);
end;

end.