Форум: "WinAPI";
Текущий архив: 2007.06.03;
Скачать: [xml.tar.bz2];
Вниз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 вылетает
← →
Rouse_ © (2006-12-29 13:54) [11]
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.
← →
Rouse_ © (2006-12-29 13:58) [12]после чего, забыл:
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;
← →
iXT © (2006-12-29 17:02) [13]
> Rouse_ © (29.12.06 13:54) [11]
Как это:
> Parm_Err: DWORD
Ведь POINTER ? :)
← →
iXT © (2006-12-29 17:40) [14]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.
Страницы: 1 вся ветка
Форум: "WinAPI";
Текущий архив: 2007.06.03;
Скачать: [xml.tar.bz2];
Память: 0.5 MB
Время: 0.032 c