WinNT Accounts

← →
iXT © (2006-12-28 11:26) [0]

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

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

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

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

← →
BiN © (2006-12-28 11:47) [1]

NetUserAdd

← →
iXT © (2006-12-28 15:41) [2]

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

Благодарю!

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

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

← →
BiN © (2006-12-28 16:00) [3]

> 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 16:49) [4]

> netapi32lib

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

← →
BiN © (2006-12-28 16:51) [5]

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

← →
iXT © (2006-12-28 17:36) [6]

> netapi32.dll

Спасибо!

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

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

← →
iXT © (2006-12-28 18:19) [7]

Вылетает любимая 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.

← →
BiN © (2006-12-29 00:11) [8]

Примерно так:
... 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;

← →
BiN © (2006-12-29 00:30) [9]

> usri1_priv:=USER_PRIV_ADMIN;

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

← →
iXT © (2006-12-29 12:13) [10]

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

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 вылетает

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.

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

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;

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.

WinNT Accounts Найти похожие ветки