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.

 function GetCurrentUserName(var CurrentUserName: string): Boolean;
 var
   BufferSize: DWORD;
   pUser: PChar;
 begin
   BufferSize := 0;
   GetUserName(nil, BufferSize);
   pUser := StrAlloc(BufferSize);
   try
     Result := GetUserName(pUser, BufferSize);
     CurrentUserName := StrPas(pUser);
   finally
     StrDispose(pUser);
   end;
 end;

 procedure TForm1.Button1Click(Sender: TObject);
 var
   CurrentUserName: string;
 begin
   GetCurrentUserName(CurrentUserName);
   Label1.Caption :=  CurrentUserName;
 end;

function GetCurrentUserName(var CurrentUserName: string): Boolean;
 var
   BufferSize: DWORD;
   pUser: array[0..255] of char;
 begin
   BufferSize := 255;
   if GetUserName(pUser, BufferSize)<>0 then
     CurrentUserName := StrPas(pUser) else
     CurrentUserName := '';
   GetCurrentUserName:=CurrentUserName<>'';
end;