Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  4 583

•  TDictionary Custom Sort  6 599

•  Fast Watermark Sources  6 369

•  3D Designer  9 319

•  Sik Screen Capture  6 703

•  Patch Maker  7 084

•  Айболит (remote control)  7 088

•  ListBox Drag & Drop  5 955

•  Доска для игры Реверси  97 496

•  Графические эффекты  7 290

•  Рисование по маске  6 584

•  Перетаскивание изображений  5 457

•  Canvas Drawing  5 826

•  Рисование Луны  5 537

•  Поворот изображения  5 058

•  Рисование стержней  3 623

•  Paint on Shape  2 864

•  Генератор кроссвордов  3 750

•  Головоломка Paletto  3 019

•  Теорема Монжа об окружностях  3 828

•  Пазл Numbrix  2 519

•  Заборы и коммивояжеры  3 219

•  Игра HIP  2 186

•  Игра Go (Го)  2 117

•  Симулятор лифта  2 499

•  Программа укладки плитки  2 149

•  Генератор лабиринта  2 633

•  Проверка числового ввода  2 303

•  HEX View  2 635

•  Физический маятник  2 255

 
скрыть

Получение сетевого имени пользователя



Защита от "дурака" спасает только от неизобретательного дурака.

Вы можете попробовать этот код. Я без проблем использовал его под Netware LAN в течение долгого времени. Работа программы зависит от наличия NWCALLS.DLL на машине пользователя, но если он использовал сеть хоть раз, данная библиотека должна присутствовать на его машине.


unit GetLogin;

{
Данный модуль инкапсулирует несколько внешних
функций библиотеки NWCALLS.DLL
Создан на основе кода Григория Трубецкого
Модуль содержит функции, возвращающие Netware User ID
и полное имя пользователя.
}

interface

uses
  SysUtils, Messages, Dialogs;
function GetUserLogin: string;
function GetUserFullName(SomeUser: string): string;

implementation

type
  NWTimeStamp = record
    Year: byte;
    Month: byte;
    Day: byte;
    Hour: byte;
    Minute: byte;
    Second: byte;
    DayOfWeek: byte;
  end;

  {Netware API - требуется NWCALLS.DLL}

function NWGetDefaultConnectionID(var Connection: word): word;
  far; external 'NWCALLS';

function NWGetConnectionNumber(Connection: word; var ConnectionNumber:
  word): word;

far; external 'NWCALLS';

function NWGetConnectionInformation(Connection: word;
  ConnectionNumber: word;
  ObjectName: pchar;
  var ObjectType: word;
  var ObjectID: word;
  var LoginTime: NWTimeStamp): word;
  far; external 'NWCALLS';

function NWReadPropertyValue(Connection: word;
  ObjectName: pChar;
  ObjectType: word;
  PropertyName: pChar;
  DataSetIndex: byte;
  DataBuffer: pChar;
  var More: byte;
  var Flags: byte): word;
  far; external 'NWCALLS';
{ конец секции работы с Netware API }

function GetUserLogin: string;
var

  ConnectionID: word;
  ConnectionNumber: word;
  RC: word;
  Name: array[0..50] of Char;
  ObjectType: word;
  ObjectID: word;
  LoginTime: NWTimeStamp;
begin

  RC := NWGetDefaultConnectionID(ConnectionID);
  RC := NWGetConnectionNumber(ConnectionID, ConnectionNumber);
  RC := NWGetConnectionInformation(ConnectionID,
    ConnectionNumber,
    Name,
    ObjectType,
    ObjectID,
    LoginTime);

  Result := StrPas(Name);
end;

function GetUserFullName(SomeUser: string): string;
{Реально имя пользователя является свойством 'IDENTIFICATON'.
Вы должны вызывать NWReadPropertyValue с параметрами (между прочим) вашего ConnectionID,
имени объекта (такое же, как и логин пользователя, сетевое имя которого мы пытаемся узнать)
и свойство name, которое нам необходимо получить, в нашем случае 'IDENTIFICATION'
(это и есть искомая величина - полное имя пользователя).}

var

  ConnectionID: word;
  RC: word;
  Name: array[0..50] of Char;
  ObjectType: word;
  PropName: array[0..14] of Char;
  DataSetIndex: byte;
  FullName: array[0..127] of Char;
  More: byte;
  Flags: byte;
begin

  RC := NWGetDefaultConnectionID(ConnectionID);
  ObjectType := 256; {пользователь}
  StrPCopy(PropName, 'IDENTIFICATION');
  DataSetIndex := 1;
  StrPCopy(Name, SomeUser);
  RC := NWReadPropertyValue(ConnectionID,
    Name,
    ObjectType,
    PropName,
    DataSetIndex,
    FullName,
    More,
    Flags);
  if RC = 35324 then
    MessageDlg('Пользователь ' + SomeUser + ' на этом сервере не обнаружен!',
      mtError, [mbOK], 0);
  Result := StrPas(FullName);
end;

end.





Похожие по теме исходники

Гадание по имени