Как получить список работающих пользователей?

(11) Рискую быть заплеваным за очевидные недостатки нижеприведенного модуля (но "работает - не трожь). Возможно, пригодится кому-нибудь.

метод ВК, возвращающий таблицу значений с информацией о подключениях
Function TAddInObject.GetLinks(): OleVariant;
var
Obj1C: OleVariant;
LinksWork: TLinksWork;
i: integer;
begin
Obj1C:= OleVariant(pCon).AppDispatch;
IDispatch(obj1C)._AddRef;
Result:=Obj1C.CreateObject('ТаблицаЗначений');
Result.NewColumn('Имя', 'Строка');
Result.NewColumn('Режим', 'Строка');
Result.NewColumn('Компьютер', 'Строка');
Result.NewColumn('ВремяВхода', 'Строка');
try
LinksWork:=TLinksWork.Create;
if LinksWork.CheckLinks(Obj1C.IBDir+'\Syslog\Links.tmp') then
for i:=0 to LinksWork.Count-1 do
begin
Result.NewLine;
Result.Имя:= LinksWork.Links[i]^.usrName;
Result.Режим:= LinksWork.Links[i]^.usrMode;
Result.Компьютер:= LinksWork.Links[i]^.usrComp;
Result.ВремяВхода:= LinksWork.Links[i]^.usrTime;
end;
finally
if Assigned(LinksWork) then LinksWork.Free;
End;
end;

вспомогательный модуль

unit LinksWork;

interface
uses Windows, SysUtils, Classes;

type
//элемент - подключение пользователя
TLinkInfo = record
usrName: string;
usrMode: char;
usrTime: string;
usrComp: string;
end;
PLinkInfo=^TLinkInfo;

TLinksList=Class(TList)
end;

TLinksWork=class
protected
function Get(Index: Integer): PLinkInfo;
private
FFileName: string;
FFileHandle: THandle;
FMapHandle: THandle;
FFileOpened: Boolean;
FLinks: TLinksList;
FDataSize: Integer;
PData: PByte;
function GetFileIsOpened: Boolean;
function GetLinksCnt: integer;
Function OpenFile(): boolean;
Procedure CloseFile();
function CreateFileMap: Boolean;
Function TestRecordAlive(RecNum: integer): boolean;
public
Constructor Create;
Destructor Destroy; override;
procedure Clear;
property Count: Integer read GetLinksCnt;
property FileIsOpened: Boolean read GetFileIsOpened;
property Links[Index: Integer]: PLinkInfo read Get; default;
function CheckLinks(FileName: string): boolean;
end;

implementation

{ TLinksWork }

//*****************************************************************************
//определим, является ли запись живой, для этого
//попытаемся залочить байт по адресу 2000001+ номер записи
//*****************************************************************************
function TLinksWork.TestRecordAlive(RecNum: integer): boolean;
var LockAddr: integer;
begin
if not (FFileOpened) then
begin
Result := False;
Exit;
end;
LockAddr:=$1E8481 + RecNum - 1;
Result := True;
if not (LockFile(FFileHandle, LockAddr, 0, 1, 0)) then Exit;
Result := False;
UnLockFile(FFileHandle, LockAddr, 0, 1, 0);
end;

function TLinksWork.CheckLinks(FileName: string): boolean;
var
usrName, usrTime, usrComp: string;
Cur, UsrMode: char;
PTempData: Pchar;
RecNum, DataSize: integer;
Item: PLinkInfo;
strWin: string[8];

procedure AppendChar(c: Char);
var i: byte;
begin
for i := 1 to 7 do strWin[i] := strWin[i + 1];
strWin[8] := c;
end;
procedure StepOut();
begin
inc(PTempData);
Dec(DataSize);
end;
function GetSubstr():string ;
begin
Result:='';
repeat
StepOut;
Result := Result + PTempData^;
until (PTempData^ = '"') or (DataSize = 0);
end;

begin
FFileName:=FileName;
Result:=false;
Clear;
if FFileOpened then CloseFile;
if Not(OpenFile) then Exit;
if not (CreateFileMap()) then Exit;

PTempData := PChar(PData);
strWin := '12345678';
RecNum := 0;
DataSize:=FDataSize;
while DataSize > 0 do
begin
cur := PTempData^;
//ищем строку "Name","
AppendChar(Cur);
if StrWin = '"Name","' then
begin
UsrName:='';
usrMode := '?';
usrTime := '';
usrComp := '';
usrName:=GetSubstr;
usrName := Copy(UsrName, 1, Length(usrName) - 1); //удалили правую кавычку
Inc(RecNum);
//ищем режим запуска
//' mode","'
strWin := '12345678';
while DataSize > 0 do
begin
//ищем строку ' mode","'
cur := PTempData^;
AppendChar(Cur);
if StrWin = ' mode","' then
begin
//считываем букву режима
AppendChar(Cur);
StepOut;
Cur := PTempData^;
case Cur of
'E': UsrMode := 'П';
'C': UsrMode := 'К';
'M': UsrMode := 'М';
'D': UsrMode := 'О';
end;
Break;
end;
StepOut;
end;

//определяем время входа
//&Time","
strWin := '12345678';
while DataSize > 0 do
begin
//ищем строку '&Time","'
cur := PTempData^;
AppendChar(Cur);
if StrWin = '&Time","' then
begin
UsrTime:=GetSubstr();
break;
end;
StepOut;
end;

strWin := '12345678';
while DataSize > 0 do
begin
//ищем строку 'rName","'
cur := PTempData^;
AppendChar(Cur);
if StrWin = 'rName","' then
begin
UsrComp := GetSubstr;
break;
end;
StepOut;
end;

//добавляем считанную информацию
if TestRecordAlive(RecNum) then
begin
UsrComp := Copy(UsrComp, 1, Length(usrComp) - 1);
UsrTime := Copy(UsrTime, 1, Length(usrTime) - 1);
New(Item);
Item^.usrName:=UsrName;
Item^.usrMode:=UsrMode;
Item^.usrTime:=UsrTime;
Item^.usrComp:=UsrComp;
FLinks.Add(Item);
end;
strWin := '12345678';
end;
StepOut;
end;
CloseFile;
Result:=True;
end;

procedure TLinksWork.Clear;
begin
FLinks.Clear;
end;

procedure TLinksWork.CloseFile;
begin
if FFileOpened then
begin
CloseHandle(FFileHandle);
CloseHandle(FMapHandle);
UnmapViewOfFile(PData);
FFileOpened:=false;
end;
PData:=Nil;
FFileHandle:=0;
FMapHandle:=0;
end;

function TLinksWork.CreateFileMap: Boolean;
begin
result := False;
FDataSize := GetFileSize(FFileHandle, nil);
FMapHandle := CreateFileMapping(FFileHandle, nil, PAGE_READWRITE, 0, FDataSize,
nil);
if FMapHandle = 0 then Exit;
PData := MapViewOfFile(FMapHandle, FILE_MAP_ALL_ACCESS, 0, 0, FDataSize);
if PData = nil then Exit;
Result := True;
end;

destructor TLinksWork.Destroy;
begin
Clear;
CloseFile;
if Assigned(FLinks) then FreeAndNil(FLinks);
inherited;
end;

function TLinksWork.Get(Index: Integer): PLinkInfo;
begin
Result:=Nil;
if Index>FLinks.Count then
begin
raise Exception.Create('Неверный индекс подключения');
Exit;
end;
Result:=PLinkInfo(FLinks[Index]);
end;

function TLinksWork.GetFileIsOpened: Boolean;
begin
Result:=FFileOpened;
end;

function TLinksWork.GetLinksCnt: integer;
begin
Result:=FLinks.Count;
end;

function TLinksWork.OpenFile(): boolean;
begin
if Not(FileExists(FFileName)) then
begin
FFileOpened:=False;
Result:=False;
Exit;
end;
FFileHandle:=FileOpen(FFileName, fmOpenReadWrite or fmShareDenyNone);
result := FFileHandle >0;
FFileOpened:=Result;
end;

constructor TLinksWork.Create;
begin
inherited;
FLinks:=TLinksList.Create;
FFileOpened:=False;
end;