Code:

procedure TForm1.Button1Click(Sender: TObject);

const

TokenSize = 800; //  (SizeOf(Pointer)=4 *200)

var

hToken: THandle;

pTokenInfo: PTOKENPRIVILEGES;

ReturnLen: Cardinal;

i: Integer;

PrivName: PChar;

DisplayName: PChar;

NameSize: Cardinal;

DisplSize: Cardinal;

LangId: Cardinal;

begin

GetMem(pTokenInfo, TokenSize);

if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,

   hToken) then ShowMessage('OpenProcessToken error');

if not GetTokenInformation(hToken, TokenPrivileges, pTokenInfo, TokenSize, ReturnLen) then

   ShowMessage('GetTokenInformation error');

GetMem(PrivName, 255);

GetMem(DisplayName, 255);

for i := 0 to pTokenInfo.PrivilegeCount - 1 do

begin

   DisplSize := 255;

   NameSize  := 255;

   LookupPrivilegeName(nil, pTokenInfo.Privileges[i].Luid, PrivName, Namesize);

   LookupPrivilegeDisplayName(nil, PrivName, DisplayName, DisplSize, LangId);

   ListBox1.Items.Add(PrivName +^I + DisplayName);

end;

FreeMem(PrivName);

FreeMem(DisplayName);

FreeMem(pTokenInfo);

end;

 

 

Code:

function OnSystemAccount(): Boolean;

const

cnMaxNameLen = 254;

var

sName: string;

dwNameLen: DWORD;

begin

dwNameLen := cnMaxNameLen - 1;

SetLength(sName, cnMaxNameLen);

GetUserName(PChar(sName), dwNameLen);

SetLength(sName, dwNameLen);

if UpperCase(Trim(sName)) = 'SYSTEM' then Result := True

else

   Result := False;

end;

 

SID-это структура данных переменной длины, которая идентифицирует пользователя, группу, и учетные записи компьютеров.

Каждой учетной записи в сети выдается уникальный идентификатор безопасности при первом создании учетной записи.

 

Code:

uses

JwaWinBase;

 

//...

 

procedure TForm1.Button1Click(Sender: TObject);

var

si: STARTUPINFOW;

pif: PROCESS_INFORMATION;

res: Bool;

s: string;

begin

//set StartUpInfoW first

si.cb := SizeOf(startupinfow);

si.dwFlags  := STARTF_USESHOWWINDOW;

si.wShowWindow := SW_SHOWDEFAULT;

si.lpReserved := nil;

si.lpDesktop := nil;

si.lpTitle := 'Konsole';

// run CreateProcessWithLogonW...

res := CreateProcessWithLogonW('Security', 'ArViCor', 'test', LOGON_WITH_PROFILE,

   'c:\win2kas\system32\regedt32.exe', nil

   , CREATE_DEFAULT_ERROR_MODE, nil, nil, si, pif);

if booltostr(res) = '0' then

begin

 

   //if an error occures, show the error-code

   //this code can be 'translated' with 'net helpmsg ' on command-prompt

   str(GetLastError, s);

   ShowMessage('CreateProcessWithLogonResult: ' + booltostr(res) + #10 +

     'GetLastError: ' + s);

end;

end;

 

 Пример получения имени пользователя и домена под которым работает текущий поток или процесс.

 Если вам необходимо получить только имя пользователя - используйте GetUserName. Данный пример можно использовать и для определения - запущен ли процесс

системой или пользователем.  Учетной записи Localsystem соответствует имя пользователя - SYSTEM и домен NT AUTORITY (лучше проверить на практике).

 

 

GetLocalUserList - возвращает список пользователей (Windows NT, Windows 2000)

Впринципе эти команды можно запускать в меню "Выполнить..." (Run), кнопки Пуск. Ну а в Delphi они запускаются путём всем извесной команды winexec(Pchar('ABCD'),sw_Show);

где 'ABCD' - одна из следующих команд ...

 

 

Code:

unit Unit1;

{©Drkb v.3}

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

 

type

TForm1 = class(TForm)

   Button1: TButton;

   procedure Button1Click(Sender: TObject);

private

   { Private declarations }

public

   { Public declarations }

end;

 

LPUSER_INFO_2 = ^USER_INFO_2;

{$EXTERNALSYM LPUSER_INFO_2}

PUSER_INFO_2 = ^USER_INFO_2;

{$EXTERNALSYM PUSER_INFO_2}

_USER_INFO_2 = record

   usri2_name: LPWSTR;

   usri2_password: LPWSTR;

   usri2_password_age: DWORD;

   usri2_priv: DWORD;

   usri2_home_dir: LPWSTR;

   usri2_comment: LPWSTR;

   usri2_flags: DWORD;

   usri2_script_path: LPWSTR;

   usri2_auth_flags: DWORD;

   usri2_full_name: LPWSTR;

   usri2_usr_comment: LPWSTR;

   usri2_parms: LPWSTR;

   usri2_workstations: LPWSTR;

   usri2_last_logon: DWORD;

   usri2_last_logoff: DWORD;

   usri2_acct_expires: DWORD;

   usri2_max_storage: DWORD;

   usri2_units_per_week: DWORD;

   usri2_logon_hours: PBYTE;

   usri2_bad_pw_count: DWORD;

   usri2_num_logons: DWORD;

   usri2_logon_server: LPWSTR;

   usri2_country_code: DWORD;

   usri2_code_page: DWORD;

end;

{$EXTERNALSYM _USER_INFO_2}

USER_INFO_2 = _USER_INFO_2;

{$EXTERNALSYM USER_INFO_2}

TUserInfo2 = USER_INFO_2;

PUserInfo2 = puser_info_2

 

function NetUserAdd(ServerName: LPCWSTR; Level: DWORD;

   Buff: PByte; var Parm_Err: DWORD): DWORD; stdcall;

   external 'netapi32.dll';

 

var

Form1: TForm1;

 

implementation

 

{$R *.dfm}

 

procedure TForm1.Button1Click(Sender: TObject);

const

NERR_Success = 0;

USER_PRIV_USER  = 1;

UF_SCRIPT = $0001;

UF_DONT_EXPIRE_PASSWD = $10000;

var

UserInfo: TUserInfo2;

Parm_Err: DWORD;

begin

ZeroMemory(@UserInfo, SizeOf(TUserInfo2));

UserInfo.usri2_name := 'TestUser';

UserInfo.usri2_password := '123';

UserInfo.usri2_priv := USER_PRIV_USER;

UserInfo.usri2_flags := UF_SCRIPT or UF_DONT_EXPIRE_PASSWD;

if NetUserAdd(nil, 2, @UserInfo, Parm_Err) <> NERR_Success then

   RaiseLastOSError

else

   ShowMessage('Пользователь TestUser с паролем 123 успешно добавлен.');

end;

 

end.

 

Для этого надо импортировать Microsoft Shell Controls & Automation Type Library.

 В меню Project..Import Type Library

 Выберите Microsoft Shell Controls & Automation (version 1.0).

 Нажмите Install...

 На панели компонентов, в закладке ActiveX появится несколько компонентов. Перетащите на форму компонент TShell. После этого, например, можно всё минимизировать:

 Shell1.MinimizeAll;

 

 

Code:

function GetUserFromWindows: string;

var

UserName : string;

UserNameLen : Dword;

begin

UserNameLen := 255;

SetLength(userName, UserNameLen);

if GetUserName(PChar(UserName), UserNameLen) then

   Result := Copy(UserName,1,UserNameLen - 1)

else

   Result := '';

end;

 

 

Code:

Uses Registry;

{©Drkb v.3 ®Vit (Vitaly Nevzorov) - Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра.}

 

procedure RegisterFileType(FileType,FileTypeName, Description,ExecCommand:string);

begin

if (FileType='') or (FileTypeName='') or (ExecCommand='') then exit;

if FileType[1]<>'.' then FileType:='.'+FileType;

if Description='' then Description:=FileTypeName;

with Treginifile.create do

try

rootkey := hkey_classes_root;

writestring(FileType,'',FileTypeName);

writestring(FileTypeName,'',Description);

writestring(FileTypeName+'\shell\open\command','',ExecCommand+' "%1"');

finally

free;

end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

RegisterFileType('txt','TxtFile', 'Plain text','notepad.exe');

end;