管理者権限で実行

Delphi

最近は、Delphiでこんなことをやってます。
カレントユーザーが管理者権限が無い場合は、管理者権限のユーザー名とパスワード指定して、実行ファイルを実行させる。
以下は、ドメイン名、ユーザー名、パスワードを指定して実行する部分。
Win2000,WinXPでのみ動作可です。NT4.0では不可です。



//======================================================================

// 実行プログラムをユーザとドメインを指定して実行する関数

//======================================================================

unit AdCreateProcess;
interface
uses

  Windows, Classes, Forms, SysUtils, Dialogs, Controls;
const

  LIB_NAME = 'advapi32.DLL';

  CREATE_PROCESS_WITH_LOGON = 'CreateProcessWithLogonW';

  LOGON_WITH_PROFILE = $00000001;
type
  TCreateProcessWithLogonW =

    function (lpUsername, lpDomain, lpPassword:PWideChar; dwLogonFlags: 

dword;  lpApplicationName: PWideChar;

              lpCommandLine: PWideChar; dwCreationFlags: DWORD; 

lpEnvironment: Pointer;lpCurrentDirectory: PWideChar;

        const lpStartupInfo: TSTARTUPINFO; var lpProcessInformation: 

TProcessInformation): BOOL; stdcall;
  function CreateProcessWith(UserName, Password, ServerName, ExeName, 

CmdLine:String; var retCd: Integer): Boolean;
var

  CreateProcessWithLogonW: TCreateProcessWithLogonW;

  Lib: HModule = 0;

  FErrCode: DWORD;
implementation
resourcestring

  Error_NoDLL  = '%sがLoadできません。';

  Error_NoFunc = '%sが壊れています。';
function Valid: Boolean;

begin

  if Lib = 0 then begin

    Lib := LoadLibrary(LIB_NAME);

    if Lib = 0 then

      MessageDlg(Format(Error_NoDLL, [LIB_NAME]), mtError, [mbOK], 0);

  end;

  if Lib <> 0 then begin

    @CreateProcessWithLogonW := GetProcAddress(Lib, 

CREATE_PROCESS_WITH_LOGON);

    if @CreateProcessWithLogonW = nil then

      MessageDlg(Format(Error_NoFunc, [LIB_NAME]), mtError, [mbOK], 0);

  end;

  Result:=(@CreateProcessWithLogonW <> nil);

end;
// プロセスの待機処理を行うメソッド

function WaitProcess(hProcess : THandle): boolean;

var

  FExitCode: DWORD;  //ExitCodeは特に使用しない

begin

  result := true;

  // プロセスが取得できなかったときは待たない(エラーコードがセットされるため) 
  if hProcess <> 0 then begin

    while WaitForSingleObject(hProcess, 0) = WAIT_TIMEOUT do begin

      Application.ProcessMessages;

    end;

    if GetExitCodeProcess(hProcess, FExitCode) then begin

      CloseHandle(hProcess);

    end else begin

      FErrCode := GetLastError;

    end;

  end;

end;
//他ユーザでログオンして、プログラムを実行する

function CreateProcessWith(UserName, Password, ServerName, ExeName, 

CmdLine:String; var retCd: Integer): Boolean;

var

  pi: TProcessInformation;

  si: TSTARTUPINFO;

  lpServer, lpUserName, lpPassWord, lpExeName, lpDirect: LPCWSTR;

  lpCmdLine: LPWSTR;

  Direct:String;

  aryDefDir: array[0..MAX_PATH] of char;

  pcDefDir: PChar;

  svCur: TCursor;

begin

  result := False;//ログオンが成功したかどうか

  retCd := 0;//ExeName実行後のGetLastError

  FErrCode := 0;
  if not(((UserName = '') and (Password = '') and (ServerName = '')) then

    if not Valid then exit;



  GetMem(lpServer, Length(ServerName) * 2 +1);

  if Servername = '' then

    lpServer := nil

  else

    StringtoWideChar(ServerName, lpServer, Length(ServerName) * 2 +1);
  GetMem(lpUserName, Length(UserName) * 2 +1);

  if UserName = '' then

    lpUserName := nil

  else

    StringtoWideChar(UserName, lpUserName, Length(UserName) * 2 +1);
  GetMem(lpPassword, Length(Password) * 2 +1);

  if Password = '' then

    lpPassword := nil

  else

    StringtoWideChar(Password, lpPassword, Length(Password) * 2 +1);
  //EXENameを1CmdLineに集約する 別々だと引数が有効にならない

  if CmdLine <> '' then

    CmdLine := ExeName + ' ' +  CmdLine

  else

    CmdLine := ExeName;

  ExeName := '';

  lpExeName := nil;
  //コマンドライン（EXE名も集約する）

  GetMem(lpCmdLine, Length(CmdLine) * 2 +1);

  if CmdLine = '' then

    lpCmdLine := nil

  else

    StringtoWideChar(CmdLine, lpCmdLine, Length(CmdLine) * 2 +1);

  //カレントディレクトリ

  Direct := GetCurrentDir;

  GetMem(lpDirect, Length(Direct) * 2 +1);
  svCur := Screen.Cursor;

  Screen.Cursor := crHourGlass;
  try

    if (UserName = '') and (Password = '') and (ServerName = '') then begin

      //カレントディレクトリ

      pcDefDir := nil;

      if Length(Direct) > 0 then begin

        StrPCopy(aryDefDir, Direct);

        pcDefDir := aryDefDir;

      end;

      //StartupInfo

      GetStartupInfo(si);

      si.dwFlags := STARTF_USESHOWWINDOW;

      si.wShowWindow := SW_SHOWNORMAL;

      result := Windows.CreateProcess(nil,           // モジュール名のアドレス 
                                      PChar(CmdLine),       // コマンドラインのアドレス

                                      nil,           // プロセスのセキュリティ属性のアドレス

                                      nil,           // スレッドのセキュリティ属性のアドレス

                                      False,         // 新しいプロセスがハンドルを継承するか？

                                      CREATE_DEFAULT_ERROR_MODE,      // 作成フラグ

                                      nil,           // 新しい環境ブロックのアドレス

                                      pcDefDir,      // 現在のディレクトリ名のアドレス

                                      si,            // STARTUPINFO のアドレス 
                                      pi);           // PROCESS_INFORMATION 

のアドレス

      FErrCode := GetLastError();

    end else begin

      //カレントディレクトリ

      if Direct = '' then

        lpDirect := nil

      else

        StringtoWideChar(Direct, lpDirect, Length(Direct) * 2 +1);

      //StartupInfo

      FillChar(si, sizeof(TSTARTUPINFO), #0);

      si.dwFlags := STARTF_USESHOWWINDOW;

      si.wShowWindow := SW_SHOWNORMAL;

      result := CreateProcessWithLogonW(lpUsername,                 // ユーザ名

                                        lpServer,                   // ドメイン名

                                        lpPassWord,                 // パスワード 
                                        LOGON_WITH_PROFILE,         // ログオンオプション

                                        lpExeName,                  // 実行可能モジュールの名前

                                        lpCmdLine,                  // コマンドライン文字列

                                        CREATE_DEFAULT_ERROR_MODE,  // 作成フラグ

                                        nil,                        // 新しい環境ブロック

                                        lpDirect,                   // カレントディレクトリの名前

                                        si,                         // スタートアップ情報

                                        pi);                        // プロセス情報

      FErrCode := GetLastError();

    end;

  finally

    if result then

      CloseHandle(pi.hThread);

    if Lib <> 0 then

      FreeLibrary(Lib);

    FreeMem(lpServer);

    FreeMem(lpUserName);

    FreeMem(lpPassWord);

    FreeMem(lpDirect);

    FreeMem(lpCmdLine);

    Screen.Cursor := svCur;

  end;
  if result then

    WaitProcess(pi.hProcess);
  retCd := FErrCode;//ExeName実行後のGetLastError
end;

end.
カレントユーザーが管理者権限か、ユーザー名一覧を取得する、取得したユーザー名が管理者権限があるか、の関数です。NT系のOSでのみ有効です。


//======================================================================

// ドメイン情報、ユーザ名情報、管理者権限情報を取得する関数

//======================================================================

unit AdLogonInfo;
interface
uses

  Windows, Classes, Forms, Dialogs, SysUtils;
type

  //ユーザ名取得用

  PNET_DISPLAY_USER = ^NET_DISPLAY_USER;

  NET_DISPLAY_USER = record

    usri1_name: LPCWSTR;

    usri1_comment: LPCWSTR;

    usri1_flags: DWORD;

    usri1_full_name: LPCWSTR;

    usri1_user_id: DWORD;

    usri1_next_index: DWORD;

  end;
  //ドメイン取得用

  PWKSTA_USER_INFO_1 = ^WKSTA_USER_INFO_1;

  WKSTA_USER_INFO_1 = packed record

    wkui1_username: PWideChar;

    wkui1_logon_domain: PWideChar;

    wkui1_oth_domains: PWideChar;

    wkui1_logon_server: PWideChar;

  end;
  //管理者権限の取得用

  PUSER_INFO_1 = ^USER_INFO_1;

  USER_INFO_1 = 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;
  //PDCサーバ情報取得

  PSERVER_INFO_101 = ^SERVER_INFO_101;

  SERVER_INFO_101 = record

    sv101_platform_id : Integer;

    sv101_name : PWideChar;

    sv101_version_major : Integer;

    sv101_version_minor : Integer;

    sv101_type : Integer;

    sv101_comment : PWideChar;

  end;
  procedure NetQueryDisplayInformation(Server: string; UsersList: TStrings);

  function GetLogonDomain: String;

  function isAdminUser(userName: string; serverName: string): Boolean;

  function GetPDCName(ServerName: String): String;



const

  LIB_NAME = 'NetAPI32.DLL';

  BUFF_CLEAR = 'NetApiBufferFree';

  NET_QUERY_DISPINFO = 'NetQueryDisplayInformation';

  NET_WKSTA_USER_GETINFO = 'NetWkstaUserGetInfo';

  NET_USER_GETINFO = 'NetUserGetInfo';

  NET_SERVER_ENUM = 'NetServerEnum';
  NERR_Success = 0;

  USER_PRIV_ADMIN = 2;

  SV_TYPE_DOMAIN_CTRL = $00000008;

  MAX_PREFERRED_LENGTH = DWORD(-1);



type
  TNetAPIBufferFree = function(Buff: Pointer): Integer; stdcall;
  TNetQueryDisplayInformation =

    function (ServerName: LPCWSTR; Level, Index, EntriesRequested, 

PreferredMaximumLength: DWORD;

          var ReturnedEntryCount: LongWord; SortedBuffer: Pointer): Integer; 

stdcall;
  TNetWkstaUserGetInfo =

    function (Reserved: LPCWSTR; Level: DWORD; Buffer: Pointer): Integer; 

stdcall;
  TNetUserGetInfo =

    function 

(Server:PWideChar;UserName:PWideChar;Level:DWORD;Buffer:Pointer):LongInt; 

stdcall;
  TNetServerEnum =

    function (ServerName: PWideChar; Level: DWORD; var BufPtr: pointer; 

PrefMaxLen: DWORD;

          var EntriesRead, TotalEntries: DWORD; ServType: DWORD; Domain: 

PWideChar;

              ResumeHandle: DWORD): longint;  stdcall;
var

  querydispinfo: TNetQueryDisplayInformation;

  buffclear: TNetAPIBufferFree;

  WkstaUserGetInfo: TNetWkstaUserGetInfo;

  NetUserGetInfo: TNetUserGetInfo;

  NetServerEnum: TNetServerEnum;

  Lib: HModule = 0;
implementation
resourcestring

  Error_NoDLL  = '%sがLoadできません。';

  Error_NoFunc = '%sが壊れています。';
function ValidDispInfo: Boolean;

begin

  if Lib = 0 then begin

    Lib := LoadLibrary(LIB_NAME);

    if Lib = 0 then

      MessageDlg(Format(Error_NoDLL, [LIB_NAME]), mtError, [mbOK], 0);

  end;

  if Lib <> 0 then begin

    @buffclear := GetProcAddress(Lib, BUFF_CLEAR);

    @querydispinfo := GetProcAddress(Lib, NET_QUERY_DISPINFO);

    if (@buffclear = nil)

    or (@querydispinfo = nil) then

      MessageDlg(Format(Error_NoFunc, [LIB_NAME]), mtError, [mbOK], 0);

  end;

  Result:=(@buffclear <> nil) and (@querydispinfo <> nil);

end;
function ValidWksta: Boolean;

begin

  if Lib = 0 then begin

    Lib := LoadLibrary(LIB_NAME);

    if Lib = 0 then

      MessageDlg(Format(Error_NoDLL, [LIB_NAME]), mtError, [mbOK], 0);

  end;

  if Lib <> 0 then begin

    @buffclear := GetProcAddress(Lib, BUFF_CLEAR);

    @WkstaUserGetInfo := GetProcAddress(Lib, NET_WKSTA_USER_GETINFO);

    if (@buffclear = nil)

    or (@WkstaUserGetInfo = nil) then

      MessageDlg(Format(Error_NoFunc, [LIB_NAME]), mtError, [mbOK], 0);

  end;

  Result:=(@buffclear <> nil) and (@WkstaUserGetInfo <> nil);

end;
function ValidGetInfo: Boolean;

begin

  if Lib = 0 then begin

    Lib := LoadLibrary(LIB_NAME);

    if Lib = 0 then

      MessageDlg(Format(Error_NoDLL, [LIB_NAME]), mtError, [mbOK], 0);

  end;

  if Lib <> 0 then begin

    @buffclear := GetProcAddress(Lib, BUFF_CLEAR);

    @NetUserGetInfo := GetProcAddress(Lib, NET_USER_GETINFO);

    if (@buffclear = nil)

    or (@NetUserGetInfo = nil) then

      MessageDlg(Format(Error_NoFunc, [LIB_NAME]), mtError, [mbOK], 0);

  end;

  Result:=(@buffclear <> nil) and (@NetUserGetInfo <> nil);

end;
function ValidServerEnum: Boolean;

begin

  if Lib = 0 then begin

    Lib := LoadLibrary(LIB_NAME);

    if Lib = 0 then

      MessageDlg(Format(Error_NoDLL, [LIB_NAME]), mtError, [mbOK], 0);

  end;

  if Lib <> 0 then begin

    @buffclear := GetProcAddress(Lib, BUFF_CLEAR);

    @NetServerEnum := GetProcAddress(Lib, NET_SERVER_ENUM);

    if (@buffclear = nil)

    or (@NetServerEnum = nil) then

      MessageDlg(Format(Error_NoFunc, [LIB_NAME]), mtError, [mbOK], 0);

  end;

  Result:=(@buffclear <> nil) and (@NetServerEnum <> nil);

end;
//PDCの取得（プライマリドメインコントローラー名の取得）プライマリドメイン名からサーバ名の取得

function GetPDCName(ServerName: String): String;

var

  lpServer: LPCWSTR;

  ret: Integer;

  SvInfo: PSERVER_INFO_101;

  entread, TotalEntries: DWORD;

  buff: Pointer;

begin

  result := '';

  if not ValidServerEnum then exit;
  GetMem(lpServer, Length(ServerName) * 2 +1);

  try

    StringtoWideChar(ServerName, lpServer, Length(ServerName) * 2 +1);
    ret := NetServerEnum(nil,                   // 予約済み

                         101,                   // 情報レベル

                         buff,                  // 情報が格納されるバッファ

                         MAX_PREFERRED_LENGTH,  // バッファの最大サイズ

                         entread,               // 格納されたエントリの数

                         TotalEntries,          // 利用可能なエントリの総数

                         SV_TYPE_DOMAIN_CTRL,   // サーバーのタイプ

                         lpServer,              // 列挙対象のドメイン

                         0);                    // レジュームハンドル 0固定

    if (ret = ERROR_SUCCESS) or (ret = ERROR_MORE_DATA) then begin

      SvInfo := PSERVER_INFO_101(buff);

      if entread > 0 then               //サーバ名は１つのはず？（複数取得できるが）

        result := WideCharToString(SvInfo^.sv101_name);

      buffclear(buff);

    end;

  finally

    FreeMem(lpserver);

  end;

end;
//ユーザ名一覧を取得する（取得するドメインを指定する）

procedure NetQueryDisplayInformation(Server: string; UsersList: TStrings);

var

  lpServer: LPCWSTR;

  ret, cnt: Integer;

  idx, entread: DWORD;

  p1: PNET_DISPLAY_USER;

  buff: Pointer;

begin

  UsersList.Clear;

  if not ValidDispInfo then exit;
  GetMem(lpServer, Length(Server) * 2 +1);

  try

    idx := 0;

    if Server = '' then

      lpServer := nil

    else begin

      StringtoWideChar(Server, lpServer, Length(Server) * 2 +1);

    end;
    repeat

      ret := querydispinfo(lpServer, // コンピュータ名

                           1,        // 取得値(ユーザーアカウント情報)

                           idx,      // エントリのインデックス番号

                           1000,     // エントリの最大数

                           256,      // バッファの最大のサイズ

                           entread,  // エントリの数を格納するポインタ

                           @buff);   // 取得データへのポインタ

      if (ret = ERROR_SUCCESS) or (ret = ERROR_MORE_DATA) then begin

        p1 := PNET_DISPLAY_USER(buff);

        for cnt := 0 to entread - 1 do begin

          UsersList.Add(WideCharToString(p1^.usri1_name));

          idx := p1^.usri1_next_index;

          Inc(p1);

          Application.ProcessMessages;

        end;

        buffclear(buff);

      end else begin

        Break;

      end;

    until ret <> ERROR_MORE_DATA;
  finally

    FreeMem(lpserver);

  end;

end;
//ログオンしているドメイン名の取得

function GetLogonDomain: String;

var

  ret: Integer;

  p1: PWKSTA_USER_INFO_1;

begin

  result := '';

  if not ValidWksta then exit;
  ret := WkstaUserGetInfo(nil, // 予約済み

                          1,   // 情報レベル

                          @p1);// 格納バッファ

  if (ret = NERR_Success) then begin

    if p1 <> nil then

      result := WideCharToString(p1^.wkui1_logon_domain);

    buffclear(p1);

  end;

end;
//指定のユーザが管理者権限かどうか？

function isAdminUser(userName: string; serverName: string): Boolean;

var

  lpServer, lpUserName: LPCWSTR;

  p1: PUSER_INFO_1;

  ret: Integer;

begin

  result := False;

  if not ValidGetInfo then exit;

  P1 := nil;

  GetMem(lpServer, (Length(ServerName) + 2) * 2 +1);

  GetMem(lpUserName, Length(userName) * 2 +1);

  StringToWideChar(userName, lpUserName, Length(userName) +1);

  try

    if serverName <> '' then begin

      serverName := '\\' + serverName;

      StringToWideChar(serverName, lpServer, Length(serverName) +1);

    end else

      lpServer := nil;

    ret := NetUserGetInfo(lpServer,   // コンピュータ指定

                          lpUserName, // ユーザ名へのポインタ

                          1,          // 情報レベル

                          @P1);       // 情報が格納される領域へのポインタ

    if (ret = ERROR_SUCCESS)

    and (P1 <> nil) then begin

      result := p1^.usri1_priv = USER_PRIV_ADMIN;//管理者権限か

    end else begin

      result := False;

    end;

  finally

    FreeMem(lpServer);

    FreeMem(lpUserName);

    if P1 <> nil then

      buffclear(P1);

  end;

end;
Initialization

begin

  //

end;

Finalization

begin

  FreeLibrary(Lib);

end;
end.
今悩んでいるのが、ドメインに参加している場合に、ログインユーザーが管理者権限が無い場合に、管理者のユーザー名、パスワードを指定しても実行できないことです。
なぜだろ、また明日も調査しなくちゃ。