Форум программистов [Powered by Invision Power Board]

Код

unit uCOM;

interface

uses
  Classes;

const
  CDB_REPORT_BITS = 0;
  DB_REPORT_BYTES = 1;

function ComDBOpen(PHComDB: PLongWord): Longint; stdcall;
function ComDBClose(HComDB: LongWord): Longint; stdcall;
function ComDBGetCurrentPortUsage(HCOMDB: LongWord;
  Buffer: Pointer; BufferSize: LongWord; ReportType: LongInt;
  MaxPortsReported: PLongWord): Longint; stdcall;

procedure GetCOMList(List: TStrings);

implementation

uses
  SysUtils, Windows;

const
  msports = 'msports.dll';

function ComDBOpen; external msports name 'ComDBOpen';
function ComDBClose; external msports name 'ComDBClose';
function ComDBGetCurrentPortUsage; external msports name 'ComDBGetCurrentPortUsage';

procedure GetCOMList(List: TStrings);
var
  ComDB: LongWord;
  Buffer: array of Byte;
  BufferSize: LongWord;
  I: Integer;
begin
  if ComDBOpen(@ComDB) <> ERROR_SUCCESS then RaiseLastOSError;
  try
    ComDBGetCurrentPortUsage(ComDB, nil, 0, DB_REPORT_BYTES, @BufferSize);
    SetLength(Buffer, BufferSize);
    ComDBGetCurrentPortUsage(ComDB, Buffer, BufferSize, DB_REPORT_BYTES, @BufferSize);
  finally
    ComDBClose(ComDB);
  end;
  List.Clear;
  for I := 0 to BufferSize - 1 do
    if Buffer[I] = 1 then List.Add('COM' + IntToStr(I + 1));
end;

end.