program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils, Windows, Classes;
procedure ListDevices(Devices : TStrings;
const Filter :
string = '
');
var
DevicesBuffer :
array of Char;
CharsWritten : Integer;
Device :
string;
i : Integer;
begin
Device := '
';
SetLength(DevicesBuffer, 0);
repeat
SetLength(DevicesBuffer, Length(DevicesBuffer) + 1000);
CharsWritten := QueryDosDevice(
nil, @DevicesBuffer[0], Length(DevicesBuffer) - 1)
until CharsWritten > 0;
for i := 0
to CharsWritten - 1
do
if DevicesBuffer[i] = #0
then
begin
if (Filter = '
')
or (Pos(Filter, Device) = 1)
then
Devices.Add(Device);
Device := '
';
end
else
Device := Device + DevicesBuffer[i];
end;
var
Devices : TStringList;
begin
Devices := TStringList.Create;
ListDevices(Devices, '
COM');
writeln(Devices.Text);
readln;
Devices.Free;
end.