Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "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.047 c
8-1158519889
ProgRAMmer Dimonych
2006-09-17 23:04
2007.06.03
DCT (дискретные косинусные преобразования)


15-1178734080
ProgRAMmer Dimonych
2007-05-09 22:08
2007.06.03
Помогите, пожалуйста, продолжить рассказ


2-1179156321
Ski1
2007-05-14 19:25
2007.06.03
как типу PAnsiChar присвоить тип String


15-1178275864
Motorola Phone (L6)
2007-05-04 14:51
2007.06.03
Подзарядка мобилы через USB компьютера


15-1178470182
ArtemESC
2007-05-06 20:49
2007.06.03
Диски FAT в OpenSuse 10.2





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский