Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

WinNT Accounts [D7]


iXT ©   (2006-12-28 11:26:00) 

Приветствую!

Задача следующая: Нуно создать учетную запись Windows в BeforeInstall.

Создаю средствами Windows: net user /add, НО. Надо поставить "галку" на "Срок действия пароля не ограничен", а в параметрах такой оции нет. :(

Собственно вопрос: Можно ли другими средствами создать? Или где храниться информация о настройках учетной записи?

iXT   (2006-12-29 17:40:00) [1]

procedure TServiceFTP.ServiceBeforeInstall(Sender: TService);
var
 acc: TUserInfo1;
 ParamERR: PDWORD;
begin
 try
   //New(acc);

   ZeroMemory(@acc, SizeOf(TUserInfo1));
   acc.usri1_name:=('Delphi');
   acc.usri1_password:='11111';
   acc.usri1_password_age:=0;
   acc.usri1_priv:=1;
   acc.usri1_comment:='Account for FTP Quick Host';
   acc.usri1_flags:=$10000 + $0040 + $0001;
   if NetUserAdd(nil, 1, @acc, ParamERR) <>
     then RaiseLastOSError;
 finally
   //Dispose(acc);
 end;
{}
end;

Ю-Зверь создается, вылетает AV и служба не инсталлируется.
Если закоментировать NetUserAdd, то служба инсталлируется.
Служба из под LocalSystem (пока). Запуск Manual.

iXT   (2006-12-29 17:02:00) [2]


> Rouse_ ©   (29.12.06 13:54) [11]

Как это:
> Parm_Err: DWORD


Ведь POINTER ?  :)

Rouse_   (2006-12-29 13:58:00) [3]

после чего, забыл:

function AddAccountToLocalGroup(const Accountname, Groupname: string): Boolean;
var
 Err: NET_API_STATUS;
 wAccountname, wGroupname: WideString;
 Details: LOCALGROUP_MEMBERS_INFO_3;
begin
 wGroupname := Groupname;
 wAccountname := AccountName;

 Details.lgrmi3_domainandname := PWideChar(wAccountname);
 Err := NetLocalGroupAddMembers(nil, PWideChar(wGroupname), 3, @Details, 1);
 Result := (Err = NERR_SUCCESS);
end;

Rouse_   (2006-12-29 13:54:00) [4]

unit Unit1;

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.

iXT   (2006-12-29 12:13:00) [5]

Да, но почему в моем случае не работает?


procedure TServiceFTP.ServiceBeforeInstall(Sender: TService);
var
acc: PUserInfo1;
begin
try
  New(acc);
  acc^.usri1_name:=('Delphi');
  acc^.usri1_password:='11111';
  acc^.usri1_password_age:=0;
  acc^.usri1_priv:=1;
  acc^.usri1_comment:='comment';
  acc^.usri1_flags:=$10000;
  NetUserAdd(nil, 1, acc, nil);
finally
  Dispose(acc);
end;

end;

Вернее создается пользованет, заблокированный, без групп, ... вобщем "пустой" и AV вылетает

BiN   (2006-12-29 00:30:00) [6]


>  usri1_priv:=USER_PRIV_ADMIN;

Упс, эта строка была для тестирования. Нужно
usri1_priv:=USER_PRIV_ USER;

BiN   (2006-12-29 00:11:00) [7]

Примерно так:

...
implementation
uses JwaLM, SysConst;

{$R *.dfm}

type
 ENetUserError = class(EOSError)
 public
   ParamNum: DWORD;
 end;

const
 ParamErrNames: array [USER_NAME_PARMNUM..USER_CODE_PAGE_PARMNUM] of String =
 (
 'NAME', '<unknown>', 'PASSWORD', 'PASSWORD_AGE', 'PRIV',
 'HOME_DIR', 'COMMENT', 'FLAGS', 'SCRIPT_PATH',
 'AUTH_FLAGS', 'FULL_NAME', 'USR_COMMENT', 'PARMS',
 'WORKSTATIONS', 'LAST_LOGON', 'LAST_LOGOFF', 'ACCT_EXPIRES',
 'MAX_STORAGE', 'UNITS_PER_WEEK', 'LOGON_HOURS', 'PAD_PW_COUNT',
 'NUM_LOGONS', 'LOGON_SERVER', 'COUNTRY_CODE', 'CODE_PAGE'
 );
 ParamErrNames2: array [USER_PRIMARY_GROUP_PARMNUM..USER_HOME_DIR_DRIVE_PARMNUM] of String =
 (
 'PRIMARY_GROUP',
 'USER_PROFILE',
 'HOME_DIR_DRIVE'
 );

function GetNetUserParamName(ParamNum: Byte): String;
begin
 case ParamNum of
   USER_NAME_PARMNUM..USER_CODE_PAGE_PARMNUM: Result:=ParamErrNames[ParamNum];
   USER_PRIMARY_GROUP_PARMNUM..USER_HOME_DIR_DRIVE_PARMNUM: Result:=ParamErrNames2[ParamNum];
   else Result:='<unknown>'
 end;
end;

procedure RaiseNetUserError(Status: NET_API_STATUS; ParamNum: DWORD);
var
 Error: ENetUserError;
begin
 if Status<>NERR_Success then
 begin
   Error:=ENetUserError.CreateResFmt(@SOSError, [Status,
     SysErrorMessage(Status)]);
   if Status=ERROR_INVALID_PARAMETER then
     Error.Message:=Error.Message+' - '+ GetNetUserParamName(ParamNum);
 end
 else
   Error:= ENetUserError.CreateRes(@SUnkOSError);
 Error.ErrorCode:=Status;
 Error.ParamNum:=ParamNum;
 raise Error;
end;

procedure AddUser(ServerName, AccountName, Password, HomeDir, Comments, Script: PWideChar;
 PasswordAge, Flags: DWORD);
var
 UserInfo: USER_INFO_1;
 Res: NET_API_STATUS;
 ParamErr: DWORD;
begin
 FillChar(UserInfo, SizeOf(UserInfo), 0);
 with UserInfo do
 begin
   usri1_name:=AccountName;
   usri1_password:=Password;
   usri1_home_dir:=HomeDir;
   usri1_comment:=Comments;
   usri1_script_path:=Script;
   usri1_priv:=USER_PRIV_ADMIN;
   usri1_flags:=Flags;
 end;
 Res:=NetUserAdd(ServerName, 1, @UserInfo, @ParamErr);
 if Res<>NERR_Success then
   RaiseNetUserError(Res, ParamErr)
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   AddUser(nil, 'test', '111', nil, 'comment', nil, 0, UF_DONT_EXPIRE_PASSWD);
end;

iXT   (2006-12-28 18:19:00) [8]

Вылетает любимая AV
Код:

unit main;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
 Registry;

type
 PUserInfo1 = ^TUserInfo1;
 TUserInfo1 = record
   usri1_name: LPWSTR;
   usri1_password: LPWSTR;
   usri1_password_age: DWORD;
   usri1_priv: DWORD;
   usri1_home_dir: LPWSTR;
   usri1_comment: LPWSTR;
   usri1_flags: DWORD;
   usri1_script_path: LPWSTR;
 end;

 NET_API_STATUS = DWORD;
 TServiceFTP = class(TService)
   procedure ServiceExecute(Sender: TService);
   procedure ServiceStart(Sender: TService; var Started: Boolean);
   procedure ServiceStop(Sender: TService; var Stopped: Boolean);
   procedure ServicePause(Sender: TService; var Paused: Boolean);
   procedure ServiceContinue(Sender: TService; var Continued: Boolean);
   procedure ServiceAfterInstall(Sender: TService);
   procedure ServiceBeforeInstall(Sender: TService);
   procedure ServiceAfterUninstall(Sender: TService);
 private
   { Private declarations }
 public
   function GetServiceController: TServiceController; override;
   { Public declarations }
 end;

var
...
 function NetUserAdd(ServerName: LPCWSTR; Level: DWORD; buf: Pointer; parm_err: PDWORD): NET_API_STATUS; stdcall;

implementation

{$R *.DFM}

function NetUserAdd; external 'netapi32.dll' name 'NetUserAdd';

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
 ServiceFTP.Controller(CtrlCode);
end;

function TServiceFTP.GetServiceController: TServiceController;
begin
 Result := ServiceController;
end;

procedure TServiceFTP.ServiceExecute(Sender: TService);
begin
//    Tester:=ControllThread.Create(false);
 try
   while not Terminated do
     ServiceThread.ProcessRequests(true);
 finally
//    Tester.Terminate;
 end;

end;

procedure TServiceFTP.ServiceStart(Sender: TService; var Started: Boolean);
begin
 Started:=true;
end;

procedure TServiceFTP.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
 Stopped:=true;
end;

procedure TServiceFTP.ServicePause(Sender: TService; var Paused: Boolean);
begin
 try
//    Tester.Terminate;
   Paused:=true;
 except
   Paused:=false;
 end;
end;

procedure TServiceFTP.ServiceContinue(Sender: TService;
 var Continued: Boolean);
begin
 try
//    Tester:=ControllThread.Create(false);
   Continued:=true;
 except
   Continued:=false;
 end;
end;

procedure TServiceFTP.ServiceAfterInstall(Sender: TService);
var
 Registry: TRegistry;
begin
 Registry:= TRegistry.Create(KEY_WRITE);
 try
   Registry.RootKey:= HKEY_LOCAL_MACHINE;
   Registry.OpenKey('SYSTEM\CurrentControlSet\Services\MyService', true);
   Registry.WriteString('Description', 'Авоматическая ...');
   Registry.CloseKey;
 finally
   Registry.Free;
 end;
end;

procedure TServiceFTP.ServiceBeforeInstall(Sender: TService);
var
 acc: PUserInfo1;
begin
 try
   New(acc);
   acc^.usri1_name:=('DelphiAwlan');
   acc^.usri1_password:='11111';
   acc^.usri1_password_age:=0;
   acc^.usri1_priv:=1;
   acc^.usri1_comment:='Account for FTP Quick Host';
   acc^.usri1_flags:=$10000;
   NetUserAdd(nil, 1, acc, nil);
 finally
   Dispose(acc);
 end;

end;

procedure TServiceFTP.ServiceAfterUninstall(Sender: TService);
begin
//  WinExec(PAnsiChar('net user Delphi /delete'), SW_SHOW);
end;

end.

iXT   (2006-12-28 17:36:00) [9]


> netapi32.dll

Спасибо!

> и вообще, msdn рулит


Не спорю. Я там и шарился.

BiN   (2006-12-28 16:51:00) [10]

netapi32.dll
и вообще, msdn рулит

iXT   (2006-12-28 16:49:00) [11]


> netapi32lib

А это откуда? Что-то я не нашел такую dll

BiN   (2006-12-28 16:00:00) [12]


> iXT ©   (28.12.06 15:41) [2]

function NetUserAdd(servername: LPCWSTR; level: DWORD; buf: Pointer;
 parm_err: PDWORD): NET_API_STATUS; stdcall;
function NetUserAdd; external netapi32lib name 'NetUserAdd';

Обычно пользуюсь EXPANDED WIN32 API от Marcel van Brakel
http://delphi-jedi.org/apilibrary.html

iXT   (2006-12-28 15:41:00) [13]


> BiN ©   (28.12.06 11:47) [1]

Благодарю!

Если не ошибаюсь
usri1_password_age:=0;

Тока вопросик. Где в дельфи NetUserAdd описна, или ее самому из библиотеки выдирать надо?

BiN   (2006-12-28 11:47:00) [14]

NetUserAdd

Наверх

Титульная страница Поиск, карта сайта Написать письмо