jcllanman.pas

East make Tray Icon in delphi

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is JclLANMan.pas.                                                              }
{                                                                                                  }
{ The Initial Developer of the Original Code is Peter Friese.                                      }
{ Portions created by Peter Friese are Copyright (C) Peter Friese. All Rights Reserved.            }
{                                                                                                  }
{ Contributors:                                                                                    }
{   Peter Friese                                                                                   }
{   Andreas Hausladen (ahuser)                                                                     }
{   Robert Marquardt (marquardt)                                                                   }
{   Matthias Thoma (mthoma)                                                                        }
{   Petr Vones (pvones)                                                                            }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ This unit contains routines and classes to handle user and group management tasks. As the name   }
{ implies, it uses the LAN Manager API.                                                            }
{                                                                                                  }
{**************************************************************************************************}

// Last modified: $Date: 2005/02/25 07:20:15 $
// For history see end of file


// Comments to Win9x compatibility of the functions used in this unit

// The following function exist at last since Win95C, but return always
// the error ERROR_CALL_NOT_IMPLEMENTED
//   AllocateAndInitializeSid, LookupAccountSID, FreeSID

unit JclLANMan;

{$I jcl.inc}

interface

uses
  Windows, SysUtils, Classes;

// User Management
type
  TNetUserFlag = (ufAccountDisable, ufHomedirRequired, ufLockout,
    ufPasswordNotRequired, ufPasswordCantChange, ufDontExpirePassword,
    ufMNSLogonAccount);
  TNetUserFlags = set of TNetUserFlag;
  TNetUserInfoFlag = (uifScript, uifTempDuplicateAccount, uifNormalAccount,
    uifInterdomainTrustAccount, uifWorkstationTrustAccount, uifServerTrustAccount);
  TNetUserInfoFlags = set of TNetUserInfoFlag;
  TNetUserPriv = (upUnknown, upGuest, upUser, upAdmin);
  TNetUserAuthFlag = (afOpPrint, afOpComm, afOpServer, afOpAccounts);
  TNetUserAuthFlags = set of TNetUserAuthFlag;
  TNetWellKnownRID = (wkrAdmins, wkrUsers, wkrGuests, wkrPowerUsers, wkrBackupOPs,
    wkrReplicator, wkrEveryone);

function CreateAccount(const Server, Username, Fullname, Password, Description,
  Homedir, Script: string;
  const PasswordNeverExpires: Boolean = True): Boolean;
function CreateLocalAccount(const Username, Fullname, Password, Description,
  Homedir, Script: string;
  const PasswordNeverExpires: Boolean = True): Boolean;
function DeleteAccount(const Servername, Username: string): Boolean;
function DeleteLocalAccount(Username: string): Boolean;
function CreateLocalGroup(const Server, Groupname, Description: string): Boolean;
function CreateGlobalGroup(const Server, Groupname, Description: string): Boolean;
function DeleteLocalGroup(const Server, Groupname: string): Boolean;

function GetLocalGroups(const Server: string; const Groups: TStrings): Boolean;
function GetGlobalGroups(const Server: string; const Groups: TStrings): Boolean;
function LocalGroupExists(const Group: string): Boolean;
function GlobalGroupExists(const Server, Group: string): Boolean;

function AddAccountToLocalGroup(const Accountname, Groupname: string): Boolean;
function LookupGroupName(const Server: string; const RID: TNetWellKnownRID): string;
procedure ParseAccountName(const QualifiedName: string; var Domain, UserName: string);
function IsLocalAccount(const AccountName: string): Boolean;

implementation

uses
  JclBase, JclStrings, JclSysInfo, JclWin32;

function CreateAccount(const Server, Username, Fullname, Password, Description,
  Homedir, Script: string; const PasswordNeverExpires: Boolean): Boolean;
var
  wServer, wUsername, wFullname,
  wPassword, wDescription, wHomedir, wScript: WideString;
  Details: USER_INFO_2;
  Err: NET_API_STATUS;
  ParmErr: DWORD;
begin
  wServer := Server;
  wUsername := Username;
  wFullname := Fullname;
  wPassword := Password;
  wDescription := Description;
  wScript := Script;
  wHomedir := Homedir;

  FillChar(Details, SizeOf(Details), #0);
  with Details do
  begin
    usri2_name := PWideChar(wUsername);
    usri2_full_name := PWideChar(wFullname);
    usri2_password := PWideChar(wPassword);
    usri2_comment := PWideChar(wDescription);
    usri2_priv := USER_PRIV_USER;
    usri2_flags := UF_SCRIPT;
    if PassWordNeverExpires then
      usri2_flags := usri2_flags or UF_DONT_EXPIRE_PASSWD;
    usri2_script_path := PWideChar(wScript);
    usri2_home_dir := PWideChar(wHomedir);
    usri2_acct_expires := TIMEQ_FOREVER;
  end;

  Err := RtdlNetUserAdd(PWideChar(wServer), 2, @Details, @ParmErr);
  Result := (Err = NERR_SUCCESS);
end;

function CreateLocalAccount(const Username, Fullname, Password, Description,
  Homedir, Script: string; const PasswordNeverExpires: Boolean): Boolean;
begin
  Result := CreateAccount('', Username, Fullname, Password, Description, Homedir,
    Script, PassWordNeverExpires);
end;

function DeleteAccount(const Servername, Username: string): Boolean;
var
  wServername, wUsername: WideString;
  Err: NET_API_STATUS;
begin
  wServername := Servername;
  wUsername := Username;
  Err := RtdlNetUserDel(PWideChar(wServername), PWideChar(wUsername));
  Result := (Err = NERR_SUCCESS);
end;

function DeleteLocalAccount(Username: string): Boolean;
begin
  Result := DeleteAccount('', Username);
end;

function CreateGlobalGroup(const Server, Groupname, Description: string): Boolean;
var
  wServer, wGroupname, wDescription: WideString;
  Details: GROUP_INFO_1;
  Err: NET_API_STATUS;
  ParmErr: DWORD;
begin
  wServer := Server;
  wGroupname := Groupname;
  wDescription := Description;

  FillChar(Details, SizeOf(Details), #0);
  Details.grpi1_name := PWideChar(wGroupName);
  Details.grpi1_comment := PWideChar(wDescription);

  Err := RtdlNetGroupAdd(PWideChar(wServer), 1, @Details, @ParmErr);
  Result := (Err = NERR_SUCCESS);
end;

function CreateLocalGroup(const Server, Groupname, Description: string): Boolean;
var
  wServer, wGroupname, wDescription: WideString;
  Details: LOCALGROUP_INFO_1;
  Err: NET_API_STATUS;
  ParmErr: DWORD;
begin
  wServer := Server;
  wGroupname := Groupname;
  wDescription := Description;

  FillChar(Details, SizeOf(Details), #0);
  Details.lgrpi1_name := PWideChar(wGroupName);
  Details.lgrpi1_comment := PWideChar(wDescription);

  Err := RtdlNetLocalGroupAdd(PWideChar(wServer), 1, @Details, @ParmErr);
  Result := (Err = NERR_SUCCESS);
end;

function DeleteLocalGroup(const Server, Groupname: string): Boolean;
var
  wServername, wUsername: WideString;
  Err: NET_API_STATUS;
begin
  wServername := Server;
  wUsername := Groupname;
  Err := RtdlNetLocalGroupDel(PWideChar(wServername), PWideChar(wUsername));
  Result := (Err = NERR_SUCCESS);
end;

function GetLocalGroups(const Server: string; const Groups: TStrings): Boolean;
var
  Err: NET_API_STATUS;
  wServername: WideString;
  Buffer: PByte;
  Details: PLocalGroupInfo0;
  EntriesRead, TotalEntries: Cardinal;
  I: Integer;
begin
  wServername := Server;
  Err := RtdlNetLocalGroupEnum(PWideChar(wServername), 0, Buffer, MAX_PREFERRED_LENGTH,
    EntriesRead, TotalEntries, nil);

  if Err = NERR_SUCCESS then
  begin
    Details := PLocalGroupInfo0(Buffer);
    Groups.BeginUpdate;
    try
      for I := 0 to EntriesRead - 1 do
      begin
        Groups.Add(Details^.lgrpi0_name);
        Inc(Details);
      end;
    finally
      Groups.EndUpdate;
    end;
  end;

  RtdlNetApiBufferFree(Buffer);
  Result := (Err = NERR_SUCCESS);
end;