How to retrieve and change display settings

Problem/Question/Abstract:

I can't find a way to enumerate or test display frequencies. When I use ChangeDisplaySettings to test for a given mode it returns DISP_CHANGE_SUCCESSFUL, no matter what I put in for dmDisplayFrequency. Should I just attempt to set a good median freq such as 75Hz and forget about it? Any other ideas?

Answer:

type
  PdmArray = ^TDmArray;
  TDmArray = array[0..0] of TDeviceMode;

  TForm1 = class(TForm)
    { ... }
  private
    lpDmArray: PDmArray;
    NumModes: integer;
    BitsPerPixel: DWord;
    RefreshRate: DWord;
    CurrentDisplayMode: integer;
    SelectedDisplayMode: integer;
    { ... }
  public
  end;

procedure TForm1.RetrieveDisplayModes;
var
  I: Integer;
  MoreModes: Bool;
  dm: TDeviceMode;
begin
  StringGridDisplayModes.ColCount := 5;
  StringGridDisplayModes.RowCount := 2;
  StringGridDisplayModes.Cells[0, 0] := 'Mode';
  StringGridDisplayModes.Cells[1, 0] := 'Resulution';
  StringGridDisplayModes.Cells[2, 0] := 'Bits per Pixel (Colors)';
  StringGridDisplayModes.Cells[3, 0] := 'DisplayFrequency';
  StringGridDisplayModes.Cells[4, 0] := 'DeviceName';
  for I := 0 to StringGridDisplayModes.ColCount do
    StringGridDisplayModes.Cells[I, 1] := '';
  MoreModes := TRUE;
  I := 0;
  while MoreModes do
  begin
    MoreModes := EnumDisplaySettings(nil, I, dm);
    StringGridDisplayModes.Cells[0, StringGridDisplayModes.RowCount - 1] :=
      IntToStr(I);
    StringGridDisplayModes.Cells[1, StringGridDisplayModes.RowCount - 1] :=
      IntToStr(dm.dmPelsWidth) + ' * ' + IntToStr(dm.dmPelsHeight);
    StringGridDisplayModes.Cells[2, StringGridDisplayModes.RowCount - 1] :=
      IntToStr(dm.dmBitsPerPel);
    StringGridDisplayModes.Cells[3, StringGridDisplayModes.RowCount - 1] :=
      IntToStr(dm.dmDisplayFrequency);
    StringGridDisplayModes.Cells[4, StringGridDisplayModes.RowCount - 1] :=
      dm.dmDeviceName;
    if (dm.dmPelsWidth = Screen.Width) and (dm.dmPelsHeight = Screen.Height) and
      (dm.dmBitsPerPel = BitsPerPixel) and (dm.dmDisplayFrequency = RefreshRate) then
      CurrentDisplayMode := I;
    StringGridDisplayModes.RowCount := StringGridDisplayModes.RowCount + 1;
    Inc(i);
  end;
  StringGridDisplayModes.RowCount := StringGridDisplayModes.RowCount - 1;
  NumModes := I;
  GetMem(lpDmArray, sizeof(TDeviceMode) * NumModes);
  FillChar(lpDmArray^, sizeof(TDeviceMode) * NumModes, #0);

{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}

  for I := 0 to (NumModes - 1) do
    EnumDisplaySettings(nil, I, lpDmArray[i]);

{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}

end;

procedure TForm1.ButtonRetrieveDisplayModesClick(Sender: TObject);
begin
  RetrieveDisplayModes;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  try
    FreeMem(lpDmArray, sizeof(TDeviceMode) * NumModes);
  except
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  DC: hDC;
begin
  DC := GetDC(0);
  BitsPerPixel := GetDeviceCaps(DC, BITSPIXEL);
  RefreshRate := GetDeviceCaps(DC, VREFRESH);
  ReleaseDC(0, DC);
  StatusBar.Panels[2].Text := 'Resolution: ' + IntToStr(Screen.Width) + ' * ' +
    IntToStr(Screen.Height)
    + ', ColorDept: ' + IntToStr(BitsPerPixel) + ', RefreshRate: '
    + IntToStr(RefreshRate);
  ButtonRetrieveDisplayModesClick(Sender);
end;

procedure Tform1.SetDisplayMode(Mode: integer);
var
  ReturnVal: LongInt;
begin

{$IFOPT R+}
{$DEFINE CKRANGE}
{$R-}
{$ENDIF}

  ReturnVal := ChangeDisplaySettings(lpDmArray[Mode], CDS_UPDATEREGISTRY);

{$IFDEF CKRANGE}
{$UNDEF CKRANGE}
{$R+}
{$ENDIF}

  if ReturnVal <> DISP_CHANGE_SUCCESSFUL then
    case ReturnVal of
      DISP_CHANGE_SUCCESSFUL: ShowMessage('DISP_CHANGE_SUCCESSFUL');
      DISP_CHANGE_RESTART: ShowMessage('DISP_CHANGE_RESTART');
      DISP_CHANGE_BADFLAGS: ShowMessage('DISP_CHANGE_BADFLAGS');
      DISP_CHANGE_FAILED: ShowMessage('DISP_CHANGE_FAILED');
      DISP_CHANGE_BADMODE: ShowMessage('DISP_CHANGE_BADMODE');
      DISP_CHANGE_NOTUPDATED: ShowMessage('DISP_CHANGE_NOTUPDATED');
    end;
end;

How to call and display a form, when its name is stored in the field of a TTable

Problem/Question/Abstract:

My table has a field named FormName, in which I store the name of the forms my application is using. How can I display the form of which the name is stored in the table?

Answer:

The best you can do is:

if Table1.FieldByName('NameForm').AsString = 'SomeForm' then
  SomeForm.Show
else if Table1.FieldByName('NameForm').AsString = 'SomeOtherForm' then
  SomeOtherForm.Show;

How to copy all files from one directory to another

Problem/Question/Abstract:

Creating a new directory (folder) is no problem. There is the MkDir() procedure. But how does one copy all files from another directory into this new one within Delphi run time? I am also concerned that any pseudo DOS command will not be available in the future, especially Windows NT 5 (2000).

Answer:

Solve 1:

uses
  shellapi

function FileManager(xSourcePath, xDestPath, xPara: string): Boolean;
var
  PFileMsg: TSHFileOpStruct;
  mNowPath: string;
begin
  Result := False;
  FillChar(PFileMsg, sizeof(PFileMsg), #0);
  if pos('.', xpara) = 0 then
    exit;
  mNowPath := GetCurrentDir;
  if xSourcePath <> '' then
    if not DirectoryExists(xSourcePath) then
    begin
      showmessage('The source path does not exist !');
      exit;
    end;
  if xDestPath <> '' then
    if not DirectoryExists(xDestPath) then
    begin
      showmessage('The destination path does not exist !');
      exit;
    end;
  if SetCurrentDirectory(Pchar(xSourcePath)) then
  begin
    with PFileMsg do
    begin
      if Owner is TForm then
        Wnd := TForm(Owner).Handle
      else
        Wnd := Application.Handle;
      if xDestPath <> '' then
      begin
        wFunc := FO_COPY;
        PTo := pChar(xDestPath);
        fFlags := FOF_MULTIDESTFILES + FOF_NOCONFIRMATION;
      end
      else
      begin
        wFunc := FO_DELETE;
        fFlags := FOF_ALLOWUNDO + FOF_NOCONFIRMATION;
      end;
      pFrom := PChar(xPara + #0#0);
    end;
    SHFileOperation(PFileMsg);
    SetCurrentDirectory(Pchar(mNowPath));
    Application.ProcessMessages;
    Result := True;
  end;
end;


Example:

CopyFile:
FileManager('C:\Demo', 'C:\Temp', '*.*');

DeleteFile: (delete C: \Demo\ * . * )
FileManager('C:\Demo', '', '*.*');


Solve 2:

uses
  ShellAPI;

procedure TForm1.BtnCopyClick(Sender: TObject);
var
  fileOp: TShFileOpStruct;
  fromDir: string;
  toDir: string;
begin
  FillChar(fileOp, Sizeof(TShFileOpStruct), 0);
  fromDir := DirectoryListBox1.Directory + '\*.*'#0;
  toDir := DirectoryListBox2.Directory + #0;
  with fileOp do
  begin
    wnd := Handle;
    wfunc := FO_COPY;
    pFrom := PChar(fromDir);
    pTo := PChar(toDir);
    fFlags := FOF_ALLOWUNDO;
    fAnyOperationsAborted := false;
    hNameMappings := nil;
    lpszProgressTitle := nil;
  end;
  SHFileOperation(fileOp);
end;

Justify the caption of a TForm

Problem/Question/Abstract:

I'd like to insert enough spaces between two strings to make a caption for a titlebar show the pieces justified left and right. For example, program name on the left and copyright notice on the right.

Answer:

The DrawText API function supports drawing justified text. Below is an example:

{ ... }
var
  R: TRect;
  fmt: UINT;
begin
  R := ClientRect; {define your rectangle to draw the text}
  with Canvas do {canvas to paint on}
  begin
    fmt := DT_LEFT;
    DrawText(Handle, PChar(LeftSide), Length(LeftSide), R, fmt);
    fmt := DT_RIGHT;
    DrawText(Handle, PChar(RightSide), Length(RightSide), R, fmt);
  end;
end;

How to store events in a TList

Problem/Question/Abstract:

How do you store events in a list? Let's say a TTimer descendant has to process a number of events of other components.

Answer:

Since TNotifyEvents are methods of objects, you need to store the objects in the list so the hidden "self" parameter can also be stored in the list. Example:


unit timeru;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls,
    StdCtrls;

type
  TMethodContainer = class
    TheMethod: TNotifyEvent;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    x, y, z: integer;
    FOnTimerList: TList;
    procedure UpdateEdits(Sender: TObject);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure ClearTimer(Value: TNotifyEvent);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  inc(x);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  inc(y);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  inc(z);
end;

procedure TForm1.UpdateEdits(Sender: TObject);
begin
  edit1.text := 'X = ' + inttostr(x);
  edit2.text := 'Y = ' + inttostr(y);
  edit3.text := 'Z = ' + inttostr(z);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to FOnTimerList.Count - 1 do
    with TMethodContainer(FOnTimerList.Items[i]) do
      if assigned(TheMethod) then
        TheMethod(Self);
end;

procedure TForm1.SetOnTimer(Value: TNotifyEvent);
var
  TM: TMethodContainer;
begin
  if Assigned(Value) then
  begin
    Timer1.enabled := false;
    TM := TMethodContainer.create;
    TM.TheMethod := value;
    FOnTimerList.Add(pointer(TM));
    Timer1.enabled := true;
  end;
end;

procedure TForm1.ClearTimer(Value: TNotifyEvent);
var
  i: integer;
  found: boolean;

  function IsEqual(var p1, p2): boolean;
  begin
    result := pointer(p1) <> pointer(p2);
  end;

begin
  if Assigned(Value) then
  begin
    Timer1.enabled := false;
    i := 0;
    found := false;
    while (i < FOnTimerList.count) and not (found) do
    begin
      with TMethodContainer(FOnTimerList.Items[i]) do
        found := IsEqual(TheMethod, Value);
      if not (found) then
        inc(i);
    end;
    if found then
    begin
      TMethodContainer(FOnTimerList.Items[i]).Free;
      FOnTimerList.delete(i);
    end;
    Timer1.enabled := true;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FOnTimerList := TList.create;
  SetOnTimer(Button1Click);
  SetOnTimer(Button2Click);
  SetOnTimer(Button3Click);
  SetOnTimer(UpdateEdits);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClearTimer(UpdateEdits);
  ClearTimer(Button3Click);
  ClearTimer(Button2Click);
  ClearTimer(Button1Click);
  FOnTimerList.free;
end;

end.

How to activate the previous instance of an application

Problem/Question/Abstract:

How to activate the previous instance of an application

Answer:

Place the following at the start of your project file:

begin
  if HPrevInst < > 0 then
  begin
    ActivatePreviousInstance;
    Exit;
  end;
  { ... }

and include the following unit:

unit PrevInst;

interface

uses
  WinProcs, WinTypes, SysUtils;

type
  PHWnd = ^HWnd;

function EnumFunc(Wnd: HWnd; TargetWindow: PHWnd): Bool; export;
procedure ActivatePreviousInstance;

implementation

function EnumFunc(Wnd: HWnd; TargetWindow: PHWnd): Bool;
var
  ClassName: array[0..30] of char;
begin
  Result := True;
  if GetWindowWord(Wnd, GWW_HINSTANCE) = HPrevInst then
  begin
    GetClassName(Wnd, ClassName, 30);
    if StrIComp(ClassName, 'TApplication') = 0 then
    begin
      TargetWindow^ := Wnd;
      Result := False;
    end;
  end;
end;

procedure ActivatePreviousInstance;
var
  PrevInstWnd: HWnd;
begin
  PrevInstWnd := 0;
  EnumWindows(@EnumFunc, Longint(@PrevInstWnd));
  if PrevInstWnd <> 0 then
    if IsIconic(PrevInstWnd) then
      ShowWindow(PrevInstWnd, SW_RESTORE)
    else
      BringWindowToTop(PrevInstWnd);
end;

end.

How to trap changes of the clipboard content

Problem/Question/Abstract:

Is there a way to use an OnChange event for the clipboard? I want to avoid to check for a change of the clipboard content every millisecond.

Answer:

An application can register itself in the clipboard viewer chain. The first window in this chain always receives the messages. Every window is responsible to pass the messages on to the next one.

unit Unit1;

interface

uses
  Windows, Messages, Forms, Classes, Controls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FNextClipboardViewer: HWND;
    procedure WMChangeCBChain(var Msg: TWMChangeCBChain); message WM_CHANGECBCHAIN;
    procedure WMDrawClipboard(var Msg: TWMDrawClipboard); message WM_DRAWCLIPBOARD;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  { Initialize variable }
  FNextClipboardViewer := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if FNextClipboardViewer <> 0 then
    MessageBox(0, 'This window is already registered!', nil, 0)
  else
    { Add to clipboard chain }
    FNextClipboardViewer := SetClipboardViewer(Handle);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  { Remove from clipboard chain }
  ChangeClipboardChain(Handle, FNextClipboardViewer);
  FNextClipboardViewer := 0;
end;

procedure TForm1.WMChangeCBChain(var Msg: TWMChangeCBChain);
begin
  inherited;
  { mark message as done }
  Msg.Result := 0;
  { the chain has changed }
  if Msg.Remove = FNextClipboardViewer then
    { The next window in the clipboard viewer chain had been removed. We recreate it. }
    FNextClipboardViewer := Msg.Next
  else
    { Inform the next window in the clipboard viewer chain }
    SendMessage(FNextClipboardViewer, WM_CHANGECBCHAIN, Msg.Remove, Msg.Next);
end;

procedure TForm1.WMDrawClipboard(var Msg: TWMDrawClipboard);
begin
  inherited;
  { Clipboard content has changed }
  try
    MessageBox(0, 'Clipboard content has changed!', 'Clipboard Viewer', MB_ICONINFORMATION);
  finally
    { Inform the next window in the clipboard viewer chain }
    SendMessage(FNextClipboardViewer, WM_DRAWCLIPBOARD, 0, 0);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if FNextClipboardViewer <> 0 then
  begin
    { Remove from clipboard chain }
    ChangeClipboardChain(Handle, FNextClipboardViewer);
    FNextClipboardViewer := 0;
  end;
end;

end.

Detecting Softice in W9x and NT (W2K - dunno)

Problem/Question/Abstract:

Detecting Softice in W9x and NT (W2K - dunno)

Answer:

The Cracker can still defeat this protection by using FrogIce, nothing can stop SoftIce hehe. Anyway here is sum code you just instert into your Applcation.

//SoftIce in W9x

function IsSoftIce95Loaded: boolean;
var
  hFile: Thandle;
begin
  result := false;
  hFile := CreateFileA('\.SICE', GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL, 0);
  if (hFile <> INVALID_HANDLE_VALUE) then
  begin
    CloseHandle(hFile);
    result := TRUE;
  end;
end;
// SoftIce in NT OS

function IsSoftIceNTLoaded: boolean;
var
  hFile: Thandle;
begin
  result := false;
  hFile := CreateFileA('\.NTICE', GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL, 0);
  if (hFile <> INVALID_HANDLE_VALUE) then
  begin
    CloseHandle(hFile);
    result := TRUE;
  end;
end;
//to detect it
if IsSoftIce95Loaded or IsSoftIceNTLoaded then
  Application.Terminate
    {if you insert a "Nag" (Message telling him he uses SoftIce) then a amatuer cracker w'll find this protection in notime}
  //bestway of using this thing is in "project Unit"

Get rid of the BDE

Problem/Question/Abstract:

I have (mostly) converted an application from Paradox to DBISAM. How do I know if I have really got the BDE out of my program? I have 150 forms in the application and I have been through them all fairly methodically, but how can I be sure that I'm not compiling in bits of BDE every time? Is there a thing in the "uses" clause that is there for BDE and not for DBISAM? Is there a way of looking at the EXE to see if there is BDE stuff in it?

Answer:

Here is a list of possible approaches:

Build the application with a MAP file (under linker options) and examine the map file looking for DBTABLES, BDE, or BDECONST. If any of these are included you're using the BDE. Having DBTABLES in a uses clause anywhere in the program is the most likely reason for the BDE to be used.
Another option would be to remove or rename DBTABLES.DCU before doing a build all. That way the compiler will show you exactly where you are inadvertently using the BDE. Just searching unit files for particular units may not be good enough as you may be using third party components without source code that may themselves use the BDE.
I know 2 ways to do that: Look out for calls in the uses clause: dbtables, bde, bdi. And the final killer is if you can test the app in a machine without BDE. If you want to do that in your own machine you can simply rename the HKEY_current_user/Software/Borland to something else (I use something like xxBorland) and the HKEY_Local_Machine/Software/Borland to something else also (as before, I use xxBorland). After renaming these keys in the registry the BDE is out and you can test your app in your machine. If it works, it'll be ok. Don't forget to rename back those keys in the registry to be able to use your Delphi again.
All I did was rename the BDE directory. A lot easier than messing with the registry

How to change the volume

Problem/Question/Abstract:

How can I change the volume?

Answer:

procedure SetVolume(X: Word);
var
  iErr: Integer;
  i: integer;
  a: TAuxCaps;
begin
  for i := 0 to auxGetNumDevs do
  begin
    auxGetDevCaps(i, Addr(a), SizeOf(a));
    if a.wTechnology = AUXCAPS_CDAUDIO then
      break;
  end;

  // Sets volume equally for left and right channels.
  // VOLUME := LEFT * $10000 + RIGHT * 1 (or the other way? :)

  iErr := auxSetVolume(i, (X * $10001));
  if (iErr = 0) then
    ShowMessage('No audio devices are available!');
end;

function GetVolume: Word;
var
  iErr: Integer;
  i: integer;
  a: TAuxCaps;
  vol: word;
begin
  for i := 0 to auxGetNumDevs do
  begin
    auxGetDevCaps(i, Addr(a), SizeOf(a));
    if a.wTechnology = AUXCAPS_CDAUDIO then
      break;
  end;
  iErr := auxGetVolume(i, addr(vol));
  GetVolume := vol;
  if (iErr = 0) then
    ShowMessage('No audio devices are available!');
end;

You'll have to modify AUXCAPS_CDAUDIO to whatever suits
(check out available values via the Ctrl+Space shortcut in Delphi 3)

Remote NT/W2000 Server Admin and Information Classes

Problem/Question/Abstract:

Remote NT/W2000 Server Admin and Information Classes  

Version 1.0.1 Available from mheydon@pgbison.co.za

  Added property LastErrorStr to ALL classes ( Stores last error string on a failed API call)

  Added property ShowErrorDialog to ALL classes ( Denotes whether LastErrorStr should be automatically
                                                                                   displayed or handled by user from property LastErrorStr)

  Added property Active to ALL classes (except TNTServerEventLog)  ( Denotes that the class created OK and all                                                                                                                  lib functions  are loaded and active.)

  Added property LogIsOpen to TNTServerEventLog  ( Denotes if an eventlog is currently Open)

  Added OVERLOAD parameters to ValidateUserLogonAPI and  ValidateUserLogonSSP to accomodate Error                 Message on failure.

  Added OPTION ShowCreateErrDialog : boolean = false to Create constructors to enable/disable error dialog on              class create.


Answer:

This unit defines Classes that access remote machines and gains information from them. The unit currentlty only reads information. Many of the calls eg. NetServerGetInfo have equivalent NetServerSetInfo calls. It will be easy enough to modify these classes if write functionality is desired. (Bravehearts ONLY)

The following classes are implemeted ...

   TNTServerInfo      = class(TObject)

   TNTServerEventLog  = class(TObject)

   TNTServerServices  = class(TObject)

   TNTServerSessions  = class(TObject)

   TNTServerOpenFiles = class(TObject)

   TNTServerGroups    = class(TObject)

   TNTServerDisks     = class(TObject)

Plus Procedures and Functions ...

    procedure GetServerResources(const RootObject : string;
                                StringList : TStrings;
                                RecursiveEnum : boolean;
                                ResourceTypes : TNTServerResSet = [resAny])


   function ValidateUserLogon(const UserName : string;
                              const Domain : string;
                              const PassWord : string) : boolean;

NOTE : for Remote Registry Access see Borland's "TRegistry.RegistryConnect()"


Methods that set TStrings set the Items or Lines property to semi-colon ";" delimited fields. This format is ideal for my component TMultiColListBox or function General.ExtractField(). Flag DWORD fields can be tested via function General.AndEqual()
eg.
        if AndEqual(SI.ServerType,SV_TYPE_SERVER_UNIX) then ...

Most of the functions that set TStrings also allow a SET of Field Options which control the information returned in the columns of the individual Items/Lines of the TStringList.

Certain Classes have OVERLOADED Create constructors. This allows you to either Create an ATTACHED instance or a Simple UNATTACHED instance.In the case of TNTServerEventLog you can Create an instance that attachesto the server an opens the SourceName eventlog immediately, or just create the Class and then call OpenLog() to attach to the log. NOTE : OpenLog and similar methods in other classes will automatically close any previously opened log before opening the new log. Calling the Free method also closes any open log thus there is no need for a CloseLog() or similar methods.

DOCUMENTATION

----------------------------------------------------------------------------------------------------------------------------------------------

CLASS
  TNTServerInfo

  This class retrieves info on the specified server and users on that server. Use GetServerInfo() and GetUserInfo()       to load the Read Only info properties. Set properties LoadLoggedOnUserList and LoadActualUserList to true or
  false depending on wether this info is required or not. If they are NOT required then it is advisable to set them to     false form performance reasons.

METHODS
  Create
  Create an instance. No parameters required.

  GetServerInfo(const MachineName : string) : boolean
  Loads the read only properties of the specified server.

  GetUserInfo(const MachineName : string const UserName : string) : boolean
  Loads the read only properties of the Sub-Properties of  property UserInfo.

PROPERTIES
  Comment                                         - read only string of Server Comment
  Version                                                 - read only string of LAN manager version
  UserPath                                         - read only string of path to User directories
  ServerType                                 - read only DWORD flag of server types (see Constants)
  MaxUserAccounts                 - read only DWORD user count who can log in
  ServerVisible                                 - read only boolean denotes if server is visible on network
  AutoDisconnectTime         - read only DWORD AutoDisconnectTime in minutes
  AnnounceRate                         - read only DWORD server network announce rate i seconds
  AnnounceDelta                         - read only DWORD delta value of announce rate in msecs
  ServerDateTime                 - read only TDateTime System Date and Time of server
  OffsetFromGMT                 - read only integer number of hours diff to GMT
  LoggedOnUsers                         - read only DWORD number of logged on users
  LoggedOnUserList         - TStringList of names of logged on users
  ActualUserList                         - TStringList of names of actual user accounts

  LoadLoggedOnUserList - boolean flag to optimize performance
  LoadActualUserList                 - boolean flag to optimize performance

  UserInfo - read only TNetUserInfo that has sub-properties ..
             .AccountName                     : string
             .PasswordAgeDays         : double num days since password changed
             .Privilege                               : byte (see constants)
             .HomeDirectory                  : string
             .Comment                                : string
             .UserFlags                              : LongWord determines features (see constants)
             .ScriptPath                              : string path of login script if any
             .FullName                                : string
             .UserComment             : string
             .Workstations                    : string comma sep list of logon workstations
             .LastLogon                       : TdateTime
             .LastLogoff                      : TDateTime
             .AcctExpires                            : TDateTime
             .MaxStorage                     : LongWord max amount of diskspace for user
             .BadPWCount              : LongWord number of incorrect password tries
             .LogonCount                      : LongWord number of successful logons
             .LogonServer                     : string of server for logon requests
             .CountryCode                     : LongWord
             .CodePage                        : LongWord
             .UserID                                  : LongWord relative ID (RID) of user
             .Profile                                 : string
             .HomeDirDrive            : string drive letter of home directory
             .PasswordExpired         : boolean of password expired or not

----------------------------------------------------------------------------------------------------------------------------------------------

CLASS
  TNTServerEventLog

  Allows reading of remote server event logs. Can create class to  connect immediately connect to required log, or      to manually open logs. Source Names are the names refered to in registry key                                                            "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Eventlog".
  These names can be loaded into a list via method SourceNames(). The logs can be read either first to last or last      to first and can be traversed in either direction. The Read() method load the  read only property fields.

METHODS
  Create(const MachineName : string; const SourceName : string;
             StartingRecord : TEventLogStartPos); overload
  or
  Create(const MachineName : string); overload
  Overloaded Create for instance creation. Either connect to event log immediately or later using OpenLog()

  OpenLog(const SourceName : string; StartingRecord : TEventLogStartPos) : boolean
  Attempts to open the specified log. If a previous log was active it is closed first.

  Read(Direction : TEventLogReadDir) : boolean
  Loads the read only property fields of property LogInfo in the direction specified. Properties EOF and BOF              indicate end of file and beginning of file error conditions. The method returns false in these cases. Direction may    be rForwards or rBackwards.

  SourceNames(StringList : TStrings)
  Loads the Source Names from the registry of the remote server into a stringlist.

  Clear
  Clears ALL entries in the open event log.

PROPERTIES
  Active                         - read only set to true if an event log is currently open
  NumEntries         - read only DWORD number of entries in current log
  Bof                                 - read only boolean indicating Beginning of File after Read()
  Eof                                 - read only boolean indicating End of File after Read()

  LogInfo - read only TLogInfoRecord that has Sub-Properties ...
            .RecordNumber          : DWORD
            .LogTime                       : TDateTime of time generated
            .LogText                       : TStrings containg text of log message
            .EventType                     : string of type of event
            .EventID                               : DWORD
            .EventCategory         : word
            .SourceName                    : string application source name
            .ComputerName          : string of computer name that created event

----------------------------------------------------------------------------------------------------------------------------------------------

CLASS
  TNTServerServices

  Allows control of remote server services. Information can be loaded into the read only Sub-Properties of                  ServiceInfo by the method GetServiceInfo(). A string list can be loaded with optional field selection
  and Types and States. Service controls only support Stop and Start at this stage.

METHODS
  Create(const MachineName : string)
  Creates an instance that connects to specified server

  ServiceNames(StringList : TStrings;
                         ServiceFields : TNTServerServiceFieldSet = [fServiceName];
                         ServiceTypes : TNTServerServiceTypes = stAllServices;
                         ServiceStates : TNTServerServiceStates = sAllStates);
  Loads a string list with optional field set of [fServiceName,fDisplayName,fStatus]. Services types can be
  stWin32,stDrivers or stAllServices. Service states can be sActive,sInActive  or sAllStates.

  GetServiceInfo(const ServiceName : string) : boolean
  Loads read only Sub-Properties of property ServiceInfo

  ServiceStop(const ServiceName : string) : boolean
  Stop the service specified by name

  ServiceStart(const ServiceName : string) : boolean
  Start the service specified by name

PROPERTIES
  ServiceInfo - read only that has Sub-Properties ...
                .DisplayName                      : string
                .Status                                           : string
                .StartType                                : string specifies how the service is started
                .ErrorControl                     : string specifies error severity
                .BinaryPathName           : string actual exe/binary file
                .ServiceStartName         : string account name of "Run As"
                .TypeFlag                                 : DWORD flag (see SERVER_STATUS WinApi Help)
                .ControlsFlag                     : DWORD flag (see SERVER_STATUS WinApi Help)

----------------------------------------------------------------------------------------------------------------------------------------------

CLASS
  NTServerSessions

  Retrieves information on sessions of remote server. Selectable fields are available in the returned list.

METHODS
  Create
  Create an instance of class.

  SessionNames(const MachineName : string;
                          StringList : TStrings;
                          SessionFields : TNTServerSessionsFieldSet = [fClientName])
  Loads a string list of sessions. Optional fields can be specified as a set
  [fClientName,fUserName,fNumOpens,fTimeActive,fIdleTime,fUserFlag,fClientType,fTransport]

----------------------------------------------------------------------------------------------------------------------------------------------

CLASS
  TNTServerOpenFiles

  Retrieves information of open files on remote server. Selectable fields are available in the returned list.

METHODS
  Create
  Create an instance of class.

  OpenFiles(const MachineName : string;
                   StringList : TStrings;
                   OpenFileFields : TNTServerOpenFileFieldSet = [fPathName])
  Loads a string list of open files. Optional fields can be specified as a set of                                                                [fPathName,fUser,fFileID,fPermissions,fNumLocks]

----------------------------------------------------------------------------------------------------------------------------------------------

CLASS
  TNTServerGroups

  Retrieves information of groups on remote server. Selectable fields are available in the returned list.

METHODS
  Create
  Create an instance of the class.

  GroupNames(const MachineName : string;
                        StringList : TStrings;
                        GroupFields : TNTServerGroupsFieldSet = [fGroupName])
  Loads a string list of groups. Optional fields can be specified as a set of                                                                     [fGroupname,fComment,fGroupID,fAttributeFlag]

----------------------------------------------------------------------------------------------------------------------------------------------

CLASS
  TNTServerDisks

  Retrieves a list of disks on the remote server

METHODS
  Create
  Create an instance of the class.

  DiskNames(const MachineName : string; StringList : TStrings)
  Loads a string list of disks on the specified server. eg. "A:" "C:" etc.

----------------------------------------------------------------------------------------------------------------------------------------------

procedure GetServerResources(const RootObject : string;
                                                 StringList : TStrings;
                                                 RecursiveEnum : boolean;
                                                 ResourceTypes : TNTServerResSet = [resAny])

  Loads a string list of resources from a remote server. RootObject is the starting point eg. '\\pgbbxbfs1'. If                  RootObject is '' then the start point is the root of the network. RecursiveEnum denotes whether
  to recurse through all sub containers as well. ResourceType may be a set of                                                               [resAny,resDomain,resServer,resDisk,resPrinter]

----------------------------------------------------------------------------------------------------------------------------------------------

function ValidateUserLogon(const UserName : string;
                                             const Domain : string;
                                             const PassWord : string) : boolean

  Validates a users Name,Domain and Password returning true if OK else false

----------------------------------------------------------------------------------------------------------------------------------------------


unit W2000Admin;
interface

uses Windows, SysUtils, Classes, DateUtils, Forms, Controls, WinSvc,
  Registry;

const
  // Property TNTServerInfo.UserInfo.UserFlags constants Mask
  UF_SCRIPT = 1;
  UF_ACCOUNTDISABLE = 2;
  UF_HOMEDIR_REQUIRED = 8;
  UF_LOCKOUT = $10;
  UF_PASSWD_NOTREQD = $20;
  UF_PASSWD_CANT_CHANGE = $40;
  UF_DONT_EXPIRE_PASSWD = $10000;
  UF_MNS_LOGON_ACCOUNT = $20000;

  // Property TNTServerInfo.UserInfo.Privilege constants
  USER_PRIV_GUEST = 0;
  USER_PRIV_USER = 1;
  USER_PRIV_ADMIN = 2;

  // Property TNTServerInfo.ServerType Mask of following values
  SV_TYPE_UNKNOWN = 0;
  SV_TYPE_WORKSTATION = $00000001;
  SV_TYPE_SERVER = $00000002;
  SV_TYPE_SQLSERVER = $00000004;
  SV_TYPE_DOMAIN_CTRL = $00000008;
  SV_TYPE_DOMAIN_BAKCTRL = $00000010;
  SV_TYPE_TIME_SOURCE = $00000020;
  SV_TYPE_AFP = $00000040;
  SV_TYPE_NOVELL = $00000080;
  SV_TYPE_DOMAIN_MEMBER = $00000100;
  SV_TYPE_PRINTQ_SERVER = $00000200;
  SV_TYPE_DIALIN_SERVER = $00000400;
  SV_TYPE_SERVER_UNIX = $00000800;
  SV_TYPE_NT = $00001000;
  SV_TYPE_WFW = $00002000;
  SV_TYPE_SERVER_MFPN = $00004000;
  SV_TYPE_SERVER_NT = $00008000;
  SV_TYPE_POTENTIAL_BROWSER = $00010000;
  SV_TYPE_BACKUP_BROWSER = $00020000;
  SV_TYPE_MASTER_BROWSER = $00040000;
  SV_TYPE_DOMAIN_MASTER = $00080000;
  SV_TYPE_SERVER_OSF = $00100000;
  SV_TYPE_SERVER_VMS = $00200000;
  SV_TYPE_WINDOWS = $00400000;
  SV_TYPE_DFS = $00800000;
  SV_TYPE_ALTERNATE_XPORT = $20000000;
  SV_TYPE_LOCAL_LIST_ONLY = $40000000;
  SV_TYPE_DOMAIN_ENUM = $80000000;
  SV_TYPE_ALL = $FFFFFFFF;

  // Event Log Read Constants
  EVENTLOG_SEQUENTIAL_READ = 1;
  EVENTLOG_SEEK_READ = 2;
  EVENTLOG_FORWARDS_READ = 4;
  EVENTLOG_BACKWARDS_READ = 8;
  MAX_PREFERRED_LENGTH = $FFFFFFFF;

  // Session Info User Flags
  SESS_GUEST = 1;
  SESS_NOENCRYPTION = 2;

  // Open File Permiisions
  PERM_FILE_READ = 1;
  PERM_FILE_WRITE = 2;
  PERM_FILE_CREATE = 4;

type
  // Types for GetServerResources()
  TNTServerRes = (resAny, resDomain, resServer, resDisk, resPrinter);
  TNTServerResSet = set of TNTServerRes;

  // Types for NTServerServices
  TNTServerServiceTypes = (stWin32, stDrivers, stAllServices);
  TNTServerServiceStates = (sActive, sInActive, sAllStates);
  TNTServerServiceFields = (fServiceName, fDisplayName, fStatus);
  TNTServerServiceFieldSet = set of TNTServerServiceFields;

  // Types for NTServerSessions
  TNTServerSessionsFields = (fClientName, fUserName, fNumOpens,
    fTimeActive, fIdleTime, fUserFlag,
    fClientType, fTransport);
  TNTServerSessionsFieldSet = set of TNTServerSessionsFields;

  // Types for TNTServerOpenFiles
  TNTServerOpenFileFields = (fPathName, fUser, fFileID, fPermissions,
    fNumLocks);
  TNTServerOpenFileFieldSet = set of TNTServerOpenFileFields;

  // Types for TNTServerGroups
  TNTServerGroupsFields = (fGroupname, fComment, fGroupID, fAttributeFlag);
  TNTServerGroupsFieldSet = set of TNTServerGroupsFields;

  // Types for TNTServerEventLog
  TEventLogReadDir = (rForwards, rBackwards);
  TEventLogStartPos = (sFirst, sLast);

  // -------------------------------------
  // External DLL mappings to NETAPI32.DLL
  // -------------------------------------

  TNetRemoteTOD = function(pszServer: PWideChar;
    var pbBuffer: pointer): DWORD; stdcall;

  TNetServerGetInfo = function(pszServer: PWideChar;
    Level: DWORD;
    var pbBuffer: pointer): DWORD; stdcall;

  TNetWkstaGetInfo = function(pszServer: PWideChar;
    Level: DWORD;
    var pbBuffer: pointer): DWORD; stdcall;

  TNetApiBufferFree = function(Buffer: pointer): DWORD; stdcall;

  TNetWkstaUserEnum = function(pszServer: PWideChar;
    Level: DWORD;
    var pbBuffer: pointer;
    PrefMaxLen: LongInt;
    var EntriesRead: DWORD;
    var TotalEntries: DWORD;
    var ResumeHandle: DWORD): DWORD; stdcall;

  TNetUserEnum = function(pszServer: PWideChar;
    Level: DWORD;
    Filter: DWORD;
    var pbBuffer: pointer;
    PrefMaxLen: LongInt;
    var EntriesRead: DWORD;
    var TotalEntries: DWORD;
    var ResumeHandle: DWORD): DWORD; stdcall;

  TNetUserGetInfo = function(pszServer: PWideChar;
    pszUserName: PWideChar;
    Level: DWORD;
    var pbBuffer: pointer): DWORD; stdcall;

  TNetSessionEnum = function(pszServer: PWideChar;
    pszClientName: PWideChar;
    pszUserName: PWideChar;
    Level: DWORD;
    var pbBuffer: pointer;
    PrefMaxLen: LongInt;
    var EntriesRead: DWORD;
    var TotalEntries: DWORD;
    var ResumeHandle: DWORD): DWORD; stdcall;

  TNetFileEnum = function(pszServer: PWideChar;
    pszBasePath: PWideChar;
    pszUserName: PWideChar;
    Level: DWORD;
    var pbBuffer: pointer;
    PrefMaxLen: LongInt;
    var EntriesRead: DWORD;
    var TotalEntries: DWORD;
    var ResumeHandle: DWORD): DWORD; stdcall;

  TNetGroupEnum = function(pszServer: PWideChar;
    Level: DWORD;
    var pbBuffer: pointer;
    PrefMaxLen: LongInt;
    var EntriesRead: DWORD;
    var TotalEntries: DWORD;
    var ResumeHandle: DWORD): DWORD; stdcall;

  TNetServerDiskEnum = function(pszServer: PWideChar;
    Level: DWORD;
    var pbBuffer: pointer;
    PrefMaxLen: LongInt;
    var EntriesRead: DWORD;
    var TotalEntries: DWORD;
    var ResumeHandle: DWORD): DWORD; stdcall;

  // Record Structure as returned by NTServerInfo.GetUserInfo()
  // in property TNTServerInfo.UserInfo
  TNetUserInfo = record
    AccountName: string;
    PasswordAgeDays: double;
    Privilege: byte;
    HomeDirectory: string;
    Comment: string;
    UserFlags: LongWord;
    ScriptPath: string;
    FullName: string;
    UserComment: string;
    Workstations: string;
    LastLogon: TdateTime;
    LastLogoff: TDateTime;
    AcctExpires: TDateTime;
    MaxStorage: LongWord;
    BadPWCount: LongWord;
    LogonCount: LongWord;
    LogonServer: string;
    CountryCode: LongWord;
    CodePage: LongWord;
    UserID: LongWord;
    Profile: string;
    HomeDirDrive: string;
    PasswordExpired: boolean;
  end;

  // ======================
  // Class TNTServerInfo
  // ======================
  TNTServerInfo = class(TObject)
  private
    FUserInfo: TNetUserInfo;
    FLoggedOnUserList,
      FActualUserList: TStringList;
    FServerdateTime: TDateTime;
    FLoadActualUserList,
      FLoadLoggedOnUserList,
      FServerVisible: boolean;
    FOffsetFromGMT: integer;
    FLoggedOnUsers,
      FAnnounceRate,
      FAnnounceDelta,
      FAutoDisconnectTime,
      FMaxUserAccounts,
      FServerType: DWORD;
    FUserPath,
      FVersion,
      FComment: string;
    FLibHandle: THandle;
    FNetRemoteTOD: TNetRemoteTOD;
    FNetServerGetInfo: TNetServerGetInfo;
    FNetWkstaGetInfo: TNetWkstaGetInfo;
    FNetWkstaUserEnum: TNetWkstaUserEnum;
    FNetUserEnum: TNetUserEnum;
    FNetUserGetInfo: TNetUserGetInfo;
    FNetApiBufferFree: TNetApiBufferFree;
  public
    constructor Create;
    destructor Destroy; override;
    // Call to load read-only properties
    function GetServerInfo(const MachineName: string): boolean;
    function GetUserInfo(const MachineName: string;
      const UserName: string): boolean;

    // Read only server properties
    property Comment: string read FComment;
    property Version: string read FVersion;
    property UserPath: string read FUserPath;
    property ServerType: DWORD read FServerType;
    property MaxUserAccounts: DWORD read FMaxUserAccounts;
    property ServerVisible: boolean read FServerVisible;
    property AutoDisconnectTime: DWORD read FAutoDisconnectTime;
    property AnnounceRate: DWORD read FAnnounceRate;
    property AnnounceDelta: DWORD read FAnnounceDelta;
    property ServerDateTime: TDateTime read FServerDateTime;
    property OffsetFromGMT: integer read FOffsetFromGMT;
    property LoggedOnUsers: DWORD read FLoggedOnUsers;
    property LoggedOnUserList: TStringList read FLoggedOnUserList;
    property ActualUserList: TStringList read FActualUserList;
    property UserInfo: TNetUserInfo read FUserInfo;

    // performance properties
    property LoadLoggedOnUserList: boolean read FLoadLoggedOnUserList
      write FLoadLoggedOnUserList;
    property LoadActualUserList: boolean read FLoadActualUserList
      write FLoadActualUserList;
  end;

  // Record structure for property TNTServerEventLog.LogInfo
  TLogInfoRecord = record
    RecordNumber: DWORD;
    LogTime: TDateTime;
    LogText: TStrings;
    EventType: string;
    EventID: DWORD;
    EventCategory: word;
    SourceName: string;
    ComputerName: string;
  end;

  // ========================
  // Class NTServerEventLog
  // ========================
  TNTServerEventLog = class(TObject)
  private
    FMachineName: string;
    FBof, FEof: boolean;
    FLogText: TStringList;
    FLogInfo: TLogInfoRecord;
    FBaseDate: TDateTime;
    ELogHandle: THandle;
    FActive: boolean;
    FRecordOffset,
      FNumEntries: DWORD;
  public
    constructor Create(const MachineName: string;
      const SourceName: string;
      StartingRecord: TEventLogStartPos); overload;
    constructor Create(const MachineName: string); overload;
    destructor Destroy; override;
    function OpenLog(const SourceName: string;
      StartingRecord: TEventLogStartPos): boolean;
    function Read(Direction: TEventLogReadDir): boolean;
    procedure SourceNames(StringList: TStrings);
    procedure Clear;
    property Active: boolean read FActive;
    property NumEntries: DWORD read FNumEntries;
    property Bof: boolean read FBof;
    property Eof: boolean read FEof;
    property LogInfo: TLogInfoRecord read FLogInfo;
  end;

  // Record Structure for TNTServerServices.ServiceInfo
  TNTServerServiceInfo = record
    DisplayName: string;
    Status: string;
    StartType: string;
    ErrorControl: string;
    BinaryPathName: string;
    ServiceStartName: string;
    TypeFlag: DWORD;
    ControlsFlag: DWORD;
  end;

  // ==================
  // TNTServerServices
  // ==================
  TNTServerServices = class(TObject)
  private
    FHandle: THandle;
    FActive: boolean;
    FServiceInfo: TNTServerServiceInfo;
  public
    constructor Create(const MachineName: string);
    destructor Destroy; override;
    procedure ServiceNames(StringList: TStrings;
      ServiceFields: TNTServerServiceFieldSet = [fServiceName];
      ServiceTypes: TNTServerServiceTypes = stAllServices;
      ServiceStates: TNTServerServiceStates = sAllStates);
    function GetServiceInfo(const ServiceName: string): boolean;
    function ServiceStop(const ServiceName: string): boolean;
    function ServiceStart(const ServiceName: string): boolean;
    property ServiceInfo: TNTServerServiceInfo read FServiceInfo;
  end;

  // ====================
  // TNTServerSessions
  // ====================
  TNTServerSessions = class(TObject)
  private
    FLibHandle: THandle;
    FNetSessionEnum: TNetSessionEnum;
    FNetApiBufferFree: TNetApiBufferFree;
  public
    constructor Create;
    destructor Destroy; override;
    procedure SessionNames(const MachineName: string;
      StringList: TStrings;
      SessionFields: TNTServerSessionsFieldSet = [fClientName]);
  end;

  // ====================
  // TNTServerGroups
  // ====================
  TNTServerGroups = class(TObject)
  private
    FLibHandle: THandle;
    FNetGroupEnum: TNetGroupEnum;
    FNetApiBufferFree: TNetApiBufferFree;
  public
    constructor Create;
    destructor Destroy; override;
    procedure GroupNames(const MachineName: string;
      StringList: TStrings;
      GroupFields: TNTServerGroupsFieldSet = [fGroupName]);
  end;

  // ====================
  // TNTServerDiskc
  // ====================
  TNTServerDisks = class(TObject)
  private
    FLibHandle: THandle;
    FNetServerDiskEnum: TNetServerDiskEnum;
    FNetApiBufferFree: TNetApiBufferFree;
  public
    constructor Create;
    destructor Destroy; override;
    procedure DiskNames(const MachineName: string;
      StringList: TStrings);
  end;

  // =======================
  // TNTServerOpenFiles
  // =======================
  TNTServerOpenFiles = class(TObject)
  private
    FLibHandle: THandle;
    FNetFileEnum: TNetFileEnum;
    FNetApiBufferFree: TNetApiBufferFree;
  public
    constructor Create;
    destructor Destroy; override;
    procedure OpenFiles(const MachineName: string;
      StringList: TStrings;
      OpenFileFields: TNTServerOpenFileFieldSet = [fPathName]);

  end;

  // ====================
  // System Functions
  // ====================

procedure GetServerResources(const RootObject: string;
  StringList: TStrings;
  RecursiveEnum: boolean;
  ResourceTypes: TNTServerResSet = [resAny]);

function ValidateUserLogon(const UserName: string;
  const Domain: string;
  const PassWord: string): boolean;

// -----------------------------------------------------------------------------
implementation

type

  // NetGetServerInfo Internal Structure
  PServerInfo102 = ^TServerInfo102;
  TServerInfo102 = packed record
    sv102_platform_id: DWORD;
    sv102_name: PWideChar;
    sv102_version_major: DWORD;
    sv102_version_minor: DWORD;
    sv102_type: DWORD;
    sv102_comment: PWideChar;
    sv102_users: DWORD;
    sv102_disc: LongWord;
    sv102_hidden: BOOL;
    sv102_announce: DWORD;
    sv102_anndelta: DWORD;
    sv102_userpath: PWideChar;
  end;

  // NetRemoteTOD Internal Structure
  PTimeOfDayInfo = ^TTimeOfDayInfo;
  TTimeOfDayInfo = packed record
    tod_elapsedt: DWORD;
    tod_msecs: DWORD;
    tod_hours: LongInt;
    tod_mins: DWORD;
    tod_secs: DWORD;
    tod_hunds: DWORD;
    tod_timezone: LongInt;
    tod_tinterval: DWORD;
    tod_day: DWORD;
    tod_month: DWORD;
    tod_year: DWORD;
    tod_weekday: DWORD;
  end;

  // NetWkstaGetInfo Internal Structure
  PWkstaInfo102 = ^TWkstaInfo102;
  TWkstaInfo102 = packed record
    wki102_platform_id: DWORD;
    wki102_computername: PWideChar;
    wki102_langroup: PWideChar;
    wki102_ver_major: DWORD;
    wki102_ver_minor: DWORD;
    wki102_lanroot: PWideChar;
    wki102_logged_on_users: DWORD;
  end;

  // NetWkstaUserEnum - NetUserEnum Internal Structure
  PWkstaUserInfo = ^TWkstaUserInfo;
  TWkstauserInfo = packed record
    wkui1_username: PWideChar;
  end;

  // Internal structure for GetUserInfo
  // maps into TNetUserInfo
  PNetUserInfoInternal = ^TNetUserInfoInternal;
  TNetUserInfoInternal = packed record
    AccountName: PWideChar;
    Password: PWideChar;
    PasswordAge: DWORD;
    Priv: DWORD;
    HomeDir: PWideChar;
    Comment: PWideChar;
    Flags: DWORD;
    ScriptPath: PWideChar;
    AuthFlags: PWideChar;
    FullName: PWideChar;
    UsrComment: PWideChar;
    Parms: PWideChar;
    Workstations: PWideChar;
    LastLogon: DWORD;
    LastLogoff: DWORD;
    AcctExpires: DWORD;
    MaxStorage: DWORD;
    UnitsPerWeek: DWORD;
    LogonHours: PBYTE;
    BadPWCount: DWORD;
    NumLogons: DWORD;
    LogonServer: PWideChar;
    CountryCode: DWORD;
    CodePage: DWORD;
    UserID: DWORD;
    PrimaryGroupID: DWORD;
    Profile: PWideChar;
    HomeDirDrive: PWideChar;
    PasswordExpired: DWORD;
  end;

  // Internal Structure for TNTServerSessions
  PSessionInfoStruc = ^TSessionInfoStruc;
  TSessionInfoStruc = packed record
    ses_cname: PWideChar;
    ses_username: PWideChar;
    ses_numopens: DWORD;
    ses_time: DWORD;
    ses_idletime: DWORD;
    ses_userflags: DWORD;
    ses_cltypename: PWideChar;
    ses_transport: PWideChar;
  end;

  // Internal Structure for TNTServerOpenFiles
  PFileInfoStruc = ^TFileInfoStruc;
  TFileInfoStruc = packed record
    f_id: DWORD;
    f_permissions: DWORD;
    f_numlocks: DWORD;
    f_pathname: PWideChar;
    f_username: PWideChar;
  end;

  // Internal Structure for TNTServerGroups
  PGroupInfoStruc = ^TGroupInfoStruc;
  TGroupInfoStruc = packed record
    g_name: PWideChar;
    g_comment: PWideChar;
    g_id: DWORD;
    g_attributes: DWORD;
  end;

  // Internal Structure for TNTServerDisks
  PDiskInfoStruc = ^TDiskInfoStruc;
  TDiskInfoStruc = packed record
    d_name: array[1..6] of char;
  end;

  // Internal structure for event logs
  PEventLogStruc = ^TEventLogStruc;
  TEventLogStruc = packed record
    Length: DWORD;
    Reserved: DWORD;
    RecordNumber: DWORD;
    TimeGenerated: DWORD;
    TimeWritten: DWORD;
    EventID: DWORD;
    EventType: WORD;
    NumStrings: WORD;
    EventCategory: WORD;
    ReservedFlags: WORD;
    ClosingRecordNumber: DWORD;
    StringOffset: DWORD;
    UserSidLength: DWORD;
    UserSidOffset: DWORD;
    DataLength: DWORD;
    DataOffset: DWORD;
    // Then follows Variant Area .....
    // TCHAR SourceName[]
    // TCHAR Computername[]
    // SID   UserSid
    // TCHAR Strings[]
    // BYTE  Data[]
    // CHAR  Pad[]
    // DWORD Length;
  end;

  // =============================================================================
  // TNTServerInfo
  // =============================================================================

constructor TNTServerInfo.Create;
begin
  FLoggedOnUserList := TStringList.Create;
  FActualUserList := TStringList.Create;
  FAutoDisconnectTime := 0;
  FComment := '';
  FVersion := '';
  FServerType := 0;
  FMaxUserAccounts := 0;
  FUserPath := '';
  FServerVisible := false;
  FAnnounceRate := 0;
  FAnnounceDelta := 0;
  FServerDateTime := 0.0;
  FOffsetFromGMT := 0;
  FLoggedOnUsers := 0;
  FLoadLoggedOnuserList := true;
  FLoadActualUserList := true;

  FLibHandle := LoadLibrary('NETAPI32.DLL');

  if FLibHandle <> 0 then
  begin
    @FNetRemoteTOD := GetProcAddress(FLibHandle, 'NetRemoteTOD');
    @FNetServerGetInfo := GetProcAddress(FLibHandle, 'NetServerGetInfo');
    @FNetWkstaGetInfo := GetProcAddress(FLibHandle, 'NetWkstaGetInfo');
    @FNetWkstaUserEnum := GetProcAddress(FLibHandle, 'NetWkstaUserEnum');
    @FNetUserEnum := GetProcAddress(FLibHandle, 'NetUserEnum');
    @FNetUserGetInfo := GetProcAddress(FLibHandle, 'NetUserGetInfo');
    @FNetApiBufferFree := GetProcAddress(FLibHandle, 'NetApiBufferFree');
  end;
end;

destructor TNTServerInfo.Destroy;
begin
  if FLibHandle <> 0 then
  try
    FreeLibrary(FLibHandle);
  except
  end;
  FLoggedOnUserList.Free;
  FActualUserList.Free;

  inherited Destroy;
end;

// ======================================
// Retrieve all server information
// ======================================

function TNTServerInfo.GetServerInfo(const MachineName: string): boolean;
var
  pBuffer, pDateBuffer,
    pWkstaBuffer, pUserBuffer: pointer;
  pIncUser: PWkstaUserInfo;
  Retvar: boolean;
  pszServer: array[0..128] of WideChar;
  i, NetResult: integer;
  EntriesRead, TotalEntries,
    ResumeHandle: DWORD;
begin
  FLoggedOnUserList.Clear;
  FActualUserList.Clear;
  pBuffer := nil;
  pDateBuffer := nil;
  pWkstaBuffer := nil;
  pUserBuffer := nil;
  Retvar := false;

  if FLibHandle <> 0 then
  begin
    NetResult := FNetServerGetInfo(StringToWideChar(MachineName, pszServer,
      129), 102, pBuffer);
    if NetResult = 0 then
    begin
      // SUCCESS
      Retvar := true;

      with PServerInfo102(pBuffer)^ do
      begin
        if sv102_comment <> nil then
          FComment := WideCharToString(sv102_comment)
        else
          FComment := '';

        if sv102_userpath <> nil then
          FUserPath := WideCharToString(sv102_userpath)
        else
          FUserPath := '';

        FVersion := IntToStr(sv102_version_major) + '.' +
          IntToStr(sv102_version_minor);
        FServerType := sv102_type;
        FMaxUserAccounts := sv102_users;
        FServerVisible := not boolean(sv102_hidden);
        FAutoDisconnectTime := sv102_disc;
        FAnnounceRate := sv102_announce;
        FAnnounceDelta := sv102_anndelta;
      end;

      // Try get Server Date Time
      NetResult := FNetRemoteTOD(pszServer, pDateBuffer);

      if NetResult = 0 then
      begin
        with PTimeOfDayInfo(pDateBuffer)^ do
        begin
          // Adjust to GMT
          FOffsetFromGMT := tod_timezone div 60;
          tod_hours := tod_hours - FOffsetFromGMT;
          FOffsetFromGMT := FOffsetFromGMT * -1;
          if not TryEncodeDateTime(tod_year, tod_month, tod_day,
            tod_hours, tod_mins, tod_secs, 0,
            FServerDateTime) then
            FServerDateTime := 0.0;
        end;
      end
      else
        FServerDateTime := 0.0;

      if pDateBuffer <> nil then
        FNetApiBufferFree(pDateBuffer);

      // Try get logged on user count
      NetResult := FNetWkstaGetInfo(pszServer, 102, pWkstaBuffer);
      if NetResult = 0 then
      begin
        with PWkstaInfo102(pWkstaBuffer)^ do
        begin
          FLoggedOnUsers := wki102_logged_on_users;
        end;
      end
      else
        FLoggedOnUsers := 0;

      if pWkstaBuffer <> nil then
        FNetApiBufferFree(pWkstaBuffer);

      // Add logged on user name to string list if required
      if FLoadLoggedOnUserList then
      begin
        ResumeHandle := 0;
        NetResult := FNetWkstaUserEnum(pszServer, 0, pUserBuffer, -1, EntriesRead,
          TotalEntries, Resumehandle);
        if NetResult = 0 then
        begin
          pIncUser := pUserBuffer;

          for i := 1 to EntriesRead do
          begin
            FLoggedOnUserList.Add(WideCharToString(pIncUser^.wkui1_username));
            inc(pIncUser);
          end;
        end;

        if pUserBuffer <> nil then
          FNetApiBufferFree(pUserBuffer);
      end;

      // Add actual user name to string list if required
      if FLoadActualUserList then
      begin
        pUserBuffer := nil;
        ResumeHandle := 0;
        NetResult := FNetUserEnum(pszServer, 0, 0, pUserBuffer, -1, EntriesRead,
          TotalEntries, Resumehandle);
        if NetResult = 0 then
        begin
          pIncUser := pUserBuffer;

          for i := 1 to EntriesRead do
          begin
            FActualUserList.Add(WideCharToString(pIncUser^.wkui1_username));
            inc(pIncUser);
          end;
        end;

        if pUserBuffer <> nil then
          FNetApiBufferFree(pUserBuffer);
      end;
    end
    else
    begin
      // FAILURE
      Retvar := false;
      FAutoDisconnectTime := 0;
      FComment := '';
      FVersion := '';
      FServerType := 0;
      FMaxUserAccounts := 0;
      FUserPath := '';
      FServerVisible := false;
      FAnnounceRate := 0;
      FAnnounceDelta := 0;
      FServerDateTime := 0.0;
      FOffsetFromGMT := 0;
      FLoggedOnUsers := 0;
    end;

    if pBuffer <> nil then
      FNetApiBufferFree(pBuffer);
  end;

  Result := Retvar;
end;

// ==============================================
// Load userinfo into property userinfo
// ==============================================

function TNTServerInfo.GetUserInfo(const MachineName: string;
  const UserName: string): boolean;
var
  pBuffer: pointer;
  Retvar: boolean;
  pszUserName,
    pszServer: array[0..128] of WideChar;
  NetResult: integer;
  BaseDate: TDateTime;
begin
  pBuffer := nil;
  Retvar := false;
  BaseDate := EncodeDateTime(1970, 1, 1, 0, 0, 0, 0);

  if FLibHandle <> 0 then
  begin
    NetResult := FNetUserGetInfo(StringToWideChar(MachineName, pszServer, 129),
      StringToWideChar(UserName, pszUserName, 129),
      3, pBuffer);
    if NetResult = 0 then
    begin
      // SUCCESS
      Retvar := true;
      with PNetUserInfoInternal(pBuffer)^ do
      begin
        FUserInfo.AccountName := WideCharToString(AccountName);
        FUserInfo.PasswordAgeDays := PasswordAge / 60.0 / 60.0 / 24.0;
        FUserInfo.Privilege := priv;
        FUserInfo.HomeDirectory := WideCharToString(HomeDir);
        FUserInfo.Comment := WideCharToString(Comment);
        FuserInfo.UserFlags := Flags;
        FUserInfo.ScriptPath := WideCharToString(ScriptPath);
        FUserInfo.FullName := WideCharToString(FullName);
        FUserInfo.UserComment := WideCharToString(UsrComment);
        FUserInfo.WorkStations := WideCharToString(WorkStations);
        FUserInfo.LastLogOn := IncSecond(BaseDate, LastLogon);
        FUserInfo.LastLogOff := IncSecond(BaseDate, LastLogOff);
        FUserInfo.AcctExpires := IncSecond(BaseDate, AcctExpires);
        FUserInfo.MaxStorage := MaxStorage;
        FUserInfo.BadPWCount := BadPWCount;
        FUserInfo.LogonCount := NumLogons;
        FUserInfo.LogonServer := LogonServer;
        FUserInfo.CountryCode := CountryCode;
        FUserInfo.CodePage := CodePage;
        FUserInfo.UserID := UserID;
        FUserInfo.Profile := WideCharToString(Profile);
        FUserInfo.HomeDirDrive := WideCharToString(HomeDirDrive);
        FUserInfo.PasswordExpired := (PasswordExpired <> 0);
      end;
    end
    else
    begin
      // FAILURE
      Retvar := false;
      FuserInfo.AccountName := '';
      FUserInfo.PasswordAgeDays := 0.0;
      FUserInfo.Privilege := 0;
      FUserInfo.HomeDirectory := '';
      FUserInfo.Comment := '';
      FUserInfo.UserFlags := 0;
      FUserInfo.ScriptPath := '';
      FUserInfo.FullName := '';
      FUserInfo.UserComment := '';
      FUserInfo.Workstations := '';
      FUserInfo.LastLogon := BaseDate;
      FUserInfo.LastLogoff := BaseDate;
      FUserInfo.AcctExpires := BaseDate;
      FUserInfo.MaxStorage := 0;
      FUserInfo.BadPWCount := 0;
      FUserInfo.LogonCount := 0;
      FUserInfo.LogonServer := '';
      FUserInfo.CountryCode := 0;
      FUserInfo.CodePage := 0;
      FUserInfo.UserID := 0;
      FUserInfo.Profile := '';
      FUserInfo.HomeDirDrive := '';
      FUserInfo.PasswordExpired := true;
    end;

    if pBuffer <> nil then
      FNetApiBufferFree(pBuffer);
  end;

  Result := Retvar;
end;

// =============================================================================
// TNTServerEventLog
// =============================================================================

constructor TNTServerEventLog.Create(const MachineName: string;
  const SourceName: string;
  StartingRecord: TEventLogStartPos);
begin
  FMachineName := MachineName;
  FBaseDate := EncodeDateTime(1970, 1, 1, 0, 0, 0, 0);
  ELogHandle := OpenEventLog(PChar(FMachineName), PChar(SourceName));
  FLogText := TStringList.Create;

  if ELogHandle <> 0 then
  begin
    FActive := true;
    if not GetNumberOfEventLogRecords(ELogHandle, FNumEntries) then
      FNumEntries := 0;

    if FNumEntries = 0 then
    begin
      FBof := true;
      FEof := true;
    end
    else
    begin
      if StartingRecord = sFirst then
        FRecordOffset := 1
      else
        FRecordOffset := FNumEntries;
      FBof := false;
      FEof := false;
    end;
  end
  else
  begin
    FActive := false;
    FNumEntries := 0;
    FRecordOffset := 0;
    FEof := true;
    FBof := true;
  end;

end;

constructor TNTServerEventLog.Create(const MachineName: string);
begin
  FMachineName := MachineName;
  FBaseDate := EncodeDateTime(1970, 1, 1, 0, 0, 0, 0);
  ELogHandle := 0;
  FLogText := TStringList.Create;
  FActive := false;
  FNumEntries := 0;
  FRecordOffset := 0;
  FEof := true;
  FBof := true;
end;

function TNTServerEventLog.OpenLog(const SourceName: string;
  StartingRecord: TEventLogStartPos): boolean;
begin
  if FActive then
    CloseEventLog(ELogHandle);
  ELogHandle := OpenEventLog(PChar(FMachineName), PChar(SourceName));

  if ELogHandle <> 0 then
  begin
    FActive := true;
    if not GetNumberOfEventLogRecords(ELogHandle, FNumEntries) then
      FNumEntries := 0;

    if FNumEntries = 0 then
    begin
      FBof := true;
      FEof := true;
    end
    else
    begin
      if StartingRecord = sFirst then
        FRecordOffset := 1
      else
        FRecordOffset := FNumEntries;
      FBof := false;
      FEof := false;
    end;
  end
  else
  begin
    FActive := false;
    FNumEntries := 0;
    FRecordOffset := 0;
    FEof := true;
    FBof := true;
  end;

  Result := FActive;
end;

destructor TNTServerEventLog.Destroy;
begin
  if FActive then
    CloseEventLog(ELogHandle);
  FLogText.Free;
  inherited Destroy;
end;

function TNTServerEventLog.Read(Direction: TEventLogReadDir): boolean;
var
  Retvar: boolean;
  ReadDirection,
    BytesToRead,
    i, BytesRead,
    BytesNeeded: DWORD;
  Rec: TEventLogStruc;
  Buffer: pointer;
  TxtStrings: PChar;
begin
  if FActive and (FNumEntries > 0) then
  begin
    FLogText.Clear;

    if Direction = rForwards then
      ReadDirection := EVENTLOG_SEEK_READ or EVENTLOG_FORWARDS_READ
    else
      ReadDirection := EVENTLOG_SEEK_READ or EVENTLOG_BACKWARDS_READ;

    // Cause buffer too small error to get actual buffer size
    ReadEventLog(ELogHandle, ReadDirection, FRecordOffset, @Rec,
      SizeOf(TEventLogStruc), BytesRead, BytesNeeded);
    // Calc actual size required
    GetMem(Buffer, BytesNeeded);
    BytesToRead := BytesNeeded;
    // Now read the record into correct sized buffer
    Retvar := ReadEventLog(ELogHandle, ReadDirection, FRecordOffset, Buffer,
      BytesToRead, BytesRead, BytesNeeded);

    if Retvar then
    begin
      with PEventLogStruc(Buffer)^ do
      begin
        FLogInfo.RecordNumber := FRecordOffset;
        FLogInfo.LogTime := IncSecond(FBaseDate, TimeGenerated);
        FLogInfo.EventID := EventID;
        FLogInfo.EventCategory := EventCategory;

        case EventType of
          EVENTLOG_ERROR_TYPE: FLogInfo.EventType := 'ERROR';
          EVENTLOG_WARNING_TYPE: FLogInfo.EventType := 'WARNING';
          EVENTLOG_INFORMATION_TYPE: FLogInfo.EventType := 'INFORMATION';
          EVENTLOG_AUDIT_SUCCESS: FLogInfo.EventType := 'AUDIT SUCCESS';
          EVENTLOG_AUDIT_FAILURE: FLogInfo.EventType := 'AUDIT FAILURE';
        else
          FLogInfo.EventType := 'UNKNOWN';
        end;

        // Message Text
        TxtStrings := Buffer;
        inc(TxtStrings, StringOffset);
        FLogText.Add(TxtStrings);
        BytesNeeded := System.Length(TxtStrings);

        for i := 2 to NumStrings do
        begin
          inc(TxtStrings, BytesNeeded + 1);
          FLogText.Add(TxtStrings);
          BytesNeeded := System.Length(TxtStrings);
        end;

        FLogInfo.LogText := FLogText;

        // SourceName
        TxtStrings := Buffer;
        inc(TxtStrings, SizeOf(TEventLogStruc));
        BytesNeeded := System.Length(TxtStrings);
        FLogInfo.SourceName := TxtStrings;

        // ComputerName
        inc(TxtStrings, BytesNeeded + 1);
        FLogInfo.ComputerName := TxtStrings;
      end;
    end
    else
    begin
      FLogInfo.RecordNumber := 0;
      FLogInfo.LogTime := FBaseDate;
      FLogInfo.EventType := '';
      FLogInfo.EventID := 0;
      FLogInfo.EventCategory := 0;
      FLogInfo.SourceName := '';
    end;

    FreeMem(Buffer);
    FBof := false;
    FEof := false;

    if Direction = rForwards then
    begin
      inc(FRecordOffset);
      if FRecordOffset > FNumEntries then
      begin
        FEof := true;
        FRecordOffset := FNumEntries;
      end;
    end
    else
    begin
      dec(FRecordOffset);
      if FRecordOffset = 0 then
      begin
        FBof := true;
        FRecordOffset := 1;
      end;
    end;
  end
  else
    Retvar := false;

  Result := Retvar;
end;

procedure TNTServerEventLog.Clear;
begin
  if FActive then
    ClearEventLog(ELogHandle, nil);
  FNumEntries := 0;
end;

procedure TNTServerEventLog.SourceNames(StringList: TStrings);
const
  KEYPATH = 'SYSTEM\CurrentControlSet\Services\Eventlog';
var
  WinReg: TRegistry;
begin
  StringList.Clear;
  StringList.BeginUpdate;
  WinReg := TRegistry.Create;
  WinReg.RootKey := HKEY_LOCAL_MACHINE;

  if WinReg.RegistryConnect(FMachineName) then
  begin
    if WinReg.OpenKeyReadOnly(KEYPATH) then
    begin
      WinReg.GetKeyNames(StringList);
      WinReg.CloseKey;
    end;
  end;

  WinReg.Free;
  StringList.EndUpdate;
end;

// =============================================================================
// TNTServerServices
// =============================================================================

constructor TNTServerServices.Create(const MachineName: string);
begin
  FHandle := OpenSCManager(PChar(MachineName), nil, SC_MANAGER_ALL_ACCESS);
  FActive := FHandle <> 0;
end;

destructor TNTServerServices.Destroy;
begin
  if FActive then
    CloseServiceHandle(FHandle);
  inherited Destroy;
end;

procedure TNTServerServices.ServiceNames(StringList: TStrings;
  ServiceFields: TNTServerServiceFieldSet = [fServiceName];
  ServiceTypes: TNTServerServiceTypes = stAllServices;
  ServiceStates: TNTServerServiceStates = sAllStates);
const
  MAXSERVICE = 100;

var
  SvcArr: array[1..MAXSERVICE] of _ENUM_SERVICE_STATUSA;
  ListServices, ListStates,
    E, i, BuffSize, NumEntries,
    BytesNeeded, ResumeHandle: DWORD;
  Data: string;
begin
  StringList.Clear;
  StringList.BeginUpdate;

  if FActive then
  begin
    if ServiceFields = [] then
      ServiceFields := [fServiceName];
    ResumeHandle := 0;

    case ServiceTypes of
      stWin32: ListServices := SERVICE_WIN32;
      stDrivers: ListServices := SERVICE_DRIVER;
      stAllServices: ListServices := SERVICE_TYPE_ALL;
    else
      ListServices := SERVICE_TYPE_ALL;
    end;

    case ServiceStates of
      sActive: ListStates := SERVICE_ACTIVE;
      sInActive: ListStates := SERVICE_INACTIVE;
      sAllStates: ListStates := SERVICE_STATE_ALL;
    else
      ListStates := SERVICE_STATE_ALL;
    end;

    while true do
    begin
      BuffSize := SizeOf(SvcArr);
      EnumServicesStatus(FHandle, ListServices, ListStates, SvcArr[1],
        BuffSize, BytesNeeded, NumEntries, ResumeHandle);
      E := GetLastError;

      if E in [NO_ERROR, ERROR_MORE_DATA] then
      begin
        for i := 1 to NumEntries do
        begin
          Data := '';
          if fServiceName in ServiceFields then
            Data := Data + ';' + SvcArr[i].lpServiceName;
          if fDisplayName in ServiceFields then
            Data := Data + ';' + SvcArr[i].lpDisplayName;

          if fStatus in ServiceFields then
          begin
            case SvcArr[i].ServiceStatus.dwCurrentState of
              SERVICE_STOPPED: Data := Data + ';' + 'STOPPED';
              SERVICE_START_PENDING: Data := Data + ';' + 'STARTING';
              SERVICE_STOP_PENDING: Data := Data + ';' + 'STOPPING';
              SERVICE_RUNNING: Data := Data + ';' + 'RUNNING';
              SERVICE_CONTINUE_PENDING: Data := Data + ';' + 'CONTINUING';
              SERVICE_PAUSE_PENDING: Data := Data + ';' + 'PAUSING';
              SERVICE_PAUSED: Data := Data + ';' + 'PAUSED';
            else
              Data := Data + ';' + 'UNKNOWN';
            end;
          end;

          delete(Data, 1, 1);
          StringList.Add(Data);
        end;
      end;

      if (E = NO_ERROR) or (E <> ERROR_MORE_DATA) then
        break;
    end;
  end;

  StringList.EndUpdate;
end;

function TNTServerServices.GetServiceInfo(const ServiceName: string): boolean;
var
  SHandle: THandle;
  Retvar: boolean;
  Status: TServiceStatus;
  Buffer: pointer;
  Dummy: DWORD;
  Config: PQueryServiceConfig;
  ActualSize, BytesNeeded: DWORD;
begin
  FillChar(FServiceInfo, SizeOf(TNTServerServiceInfo), 0);
  Retvar := false;

  if FActive then
  begin
    SHandle := OpenService(FHandle, PChar(ServiceName), SERVICE_ALL_ACCESS);

    if SHandle <> 0 then
    begin
      if QueryServiceStatus(SHandle, Status) then
      begin
        case Status.dwCurrentState of
          SERVICE_STOPPED: FServiceInfo.Status := 'STOPPED';
          SERVICE_START_PENDING: FServiceInfo.Status := 'STARTING';
          SERVICE_STOP_PENDING: FServiceInfo.Status := 'STOPPING';
          SERVICE_RUNNING: FServiceInfo.Status := 'RUNNING';
          SERVICE_CONTINUE_PENDING: FServiceInfo.Status := 'CONTINUING';
          SERVICE_PAUSE_PENDING: FServiceInfo.Status := 'PAUSING';
          SERVICE_PAUSED: FServiceInfo.Status := 'PAUSED';
        else
          FServiceInfo.Status := 'UNKNOWN';
        end;

        FServiceInfo.TypeFlag := Status.dwServiceType;
        FServiceInfo.ControlsFlag := Status.dwControlsAccepted;
      end;

      // Force error to get actual size required
      QueryServiceConfig(SHandle, @Dummy, SizeOf(Dummy), BytesNeeded);
      GetMem(Buffer, BytesNeeded);
      ActualSize := BytesNeeded;

      if QueryServiceConfig(SHandle, Buffer, ActualSize, BytesNeeded) then
      begin
        Config := Buffer;

        case Config.dwStartType of
          SERVICE_BOOT_START: FServiceInfo.StartType := 'BOOT';
          SERVICE_SYSTEM_START: FServiceInfo.StartType := 'SYSTEM';
          SERVICE_AUTO_START: FServiceInfo.StartType := 'AUTO';
          SERVICE_DEMAND_START: FServiceInfo.StartType := 'MANUAL';
          SERVICE_DISABLED: FServiceInfo.StartType := 'DISABLED';
        else
          FServiceInfo.StartType := 'UNKNOWN';
        end;

        case Config.dwErrorControl of
          SERVICE_ERROR_IGNORE: FServiceInfo.ErrorControl := 'IGNORE';
          SERVICE_ERROR_NORMAL: FServiceInfo.ErrorControl := 'NORMAL';
          SERVICE_ERROR_SEVERE: FServiceInfo.ErrorControl := 'SEVERE';
          SERVICE_ERROR_CRITICAL: FServiceInfo.ErrorControl := 'CRITICAL';
        else
          FServiceInfo.ErrorControl := 'UNKNOWN';
        end;

        FServiceInfo.BinaryPathName := Config.lpBinaryPathName;
        FServiceInfo.DisplayName := Config.lpDisplayName;
        FServiceInfo.ServiceStartName := Config.lpServiceStartName;
      end;

      FreeMem(Buffer);
      CloseServiceHandle(SHandle);
    end;
  end;

  Result := Retvar;
end;

function TNTServerServices.ServiceStop(const ServiceName: string): boolean;
var
  SHandle: THandle;
  Status: TServiceStatus;
  dwCheckPoint: DWORD;
  Retvar: boolean;
begin
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;
  Retvar := false;

  if FActive then
  begin
    SHandle := OpenService(FHandle, PChar(ServiceName), SERVICE_ALL_ACCESS);

    if SHandle <> 0 then
    begin
      if (ControlService(SHandle, SERVICE_CONTROL_STOP, Status)) then
      begin
        if (QueryServiceStatus(SHandle, Status)) then
        begin
          while (SERVICE_STOPPED <> Status.dwCurrentState) do
          begin
            dwCheckPoint := Status.dwCheckPoint;
            Sleep(Status.dwWaitHint);

            if (not QueryServiceStatus(SHandle, Status)) then
            begin
              // couldn't check status
              break;
            end;

            if (Status.dwCheckPoint < dwCheckPoint) then
              break;
          end;
        end;
      end;
      CloseServiceHandle(SHandle);
    end;

    Retvar := (SERVICE_STOPPED = Status.dwCurrentState);
  end;

  Screen.Cursor := crDefault;
  Result := Retvar;
end;

function TNTServerServices.ServiceStart(const ServiceName: string): boolean;
var
  SHandle: THandle;
  Status: TServiceStatus;
  Temp: PChar;
  dwCheckPoint: DWORD;
  Retvar: boolean;
begin
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;
  Retvar := false;

  if FActive then
  begin
    Status.dwCurrentState := 1;

    SHandle := OpenService(FHandle, PChar(ServiceName), SERVICE_ALL_ACCESS);

    if SHandle <> 0 then
    begin
      Temp := nil;
      if (StartService(SHandle, 0, Temp)) then
        if (QueryServiceStatus(SHandle, Status)) then
        begin
          while (SERVICE_RUNNING <> Status.dwCurrentState) do
          begin
            dwCheckPoint := Status.dwCheckPoint;
            Sleep(Status.dwWaitHint);
            if (not QueryServiceStatus(SHandle, Status)) then
              break;
            if (Status.dwCheckPoint < dwCheckPoint) then
            begin
              // QueryServiceStatus didn't increment dwCheckPoint
              break;
            end;
          end;
        end;
      CloseServiceHandle(SHandle);
    end;

    Retvar := (SERVICE_RUNNING = Status.dwCurrentState);
  end;

  Screen.Cursor := crDefault;
  Result := Retvar;
end;

// =============================================================================
// TNTServerSessions
// =============================================================================

constructor TNTServerSessions.Create;
begin
  FLibHandle := LoadLibrary('NETAPI32.DLL');

  if FLibHandle <> 0 then
  begin
    @FNetSessionEnum := GetProcAddress(FLibHandle, 'NetSessionEnum');
    @FNetApiBufferFree := GetProcAddress(FLibHandle, 'NetApiBufferFree');
  end;

end;

destructor TNTServerSessions.Destroy;
begin
  if FLibHandle <> 0 then
  try
    FreeLibrary(FLibHandle);
  except
  end;

  inherited Destroy;
end;

procedure TNTServerSessions.SessionNames(const MachineName: string;
  StringList: TStrings;
  SessionFields: TNTServerSessionsFieldSet = [fClientName]);
var
  i, E, ResumeHandle,
    TotalEntries, EntriesRead: DWORD;
  pSessBuffer: pointer;
  pIncSess: PSessionInfoStruc;
  pszServer: array[0..128] of WideChar;
  Data: string;
begin
  StringList.Clear;
  StringList.BeginUpdate;

  if FLibHandle <> 0 then
  begin
    pSessBuffer := nil;
    if SessionFields = [] then
      SessionFields := [fClientName];
    ResumeHandle := 0;
    E := FNetSessionEnum(StringToWideChar(MachineName, pszServer, 129), nil,
      nil, 502, pSessBuffer, -1, EntriesRead, TotalEntries,
      Resumehandle);
    if E = 0 then
    begin
      pIncSess := pSessBuffer;

      for i := 1 to EntriesRead do
      begin
        Data := '';
        if fClientName in SessionFields then
          Data := Data + ';' + WideCharToString(pIncSess^.ses_cname);
        if fUserName in SessionFields then
          Data := Data + ';' + WideCharToString(pIncSess^.ses_username);
        if fNumOpens in SessionFields then
          Data := Data + ';' + IntToStr(pIncSess^.ses_numopens);
        if fTimeActive in SessionFields then
          Data := Data + ';' + IntToStr(pIncSess^.ses_time);
        if fIdleTime in SessionFields then
          Data := Data + ';' + IntToStr(pIncSess^.ses_idletime);

        if fUserFlag in SessionFields then
        begin
          case pIncSess^.ses_userflags of
            SESS_GUEST: Data := Data + ';' + 'GUEST';
            SESS_NOENCRYPTION: Data := Data + ';' + 'NO ENCRYPTION';
          else
            Data := Data + ';' + 'NONE';
          end;
        end;

        if fClientType in SessionFields then
          Data := Data + ';' + WideCharToString(pIncSess^.ses_cltypename);
        if fTransport in SessionFields then
          Data := Data + ';' + WideCharToString(pIncSess^.ses_transport);

        delete(Data, 1, 1);
        StringList.Add(Data);
        inc(pIncSess);
      end;
    end;

    if pSessBuffer <> nil then
      FNetApiBufferFree(pSessBuffer);
  end;

  StringList.EndUpdate;
end;

// =============================================================================
// TNTServerSessions
// =============================================================================

constructor TNTServerOpenFiles.Create;
begin
  FLibHandle := LoadLibrary('NETAPI32.DLL');

  if FLibHandle <> 0 then
  begin
    @FNetFileEnum := GetProcAddress(FLibHandle, 'NetFileEnum');
    @FNetApiBufferFree := GetProcAddress(FLibHandle, 'NetApiBufferFree');
  end;

end;

destructor TNTServerOpenFiles.Destroy;
begin
  if FLibHandle <> 0 then
  try
    FreeLibrary(FLibHandle);
  except
  end;

  inherited Destroy;
end;

procedure TNTServerOpenFiles.OpenFiles(const Machinename: string;
  StringList: TStrings;
  OpenFileFields: TNTServerOpenFileFieldSet = [fPathName]);
var
  i, E, ResumeHandle,
    TotalEntries, EntriesRead: DWORD;
  pFileBuffer: pointer;
  pIncBuff: PFileInfoStruc;
  pszServer: array[0..128] of WideChar;
  Perm, Data: string;
begin
  StringList.Clear;
  StringList.BeginUpdate;

  if FLibHandle <> 0 then
  begin
    pFileBuffer := nil;
    if OpenFileFields = [] then
      OpenFileFields := [fPathName];
    ResumeHandle := 0;
    E := FNetFileEnum(StringToWideChar(MachineName, pszServer, 129), nil,
      nil, 3, pFileBuffer, -1, EntriesRead, TotalEntries,
      Resumehandle);
    if E = 0 then
    begin
      pIncBuff := pFileBuffer;

      for i := 1 to EntriesRead do
      begin
        Data := '';

        if fPathName in OpenFileFields then
          Data := Data + ';' + WideCharToString(pIncBuff^.f_pathname);
        if fUser in OpenFileFields then
          Data := Data + ';' + WideCharToString(pIncBuff^.f_username);
        if fFileID in OpenFileFields then
          Data := Data + ';' + IntToStr(pIncBuff^.f_id);

        if fPermissions in OpenFileFields then
        begin
          Perm := '';
          if (PERM_FILE_READ and pIncBuff^.f_permissions) = PERM_FILE_READ then
            Perm := 'R'
          else
            Perm := '-';

          if (PERM_FILE_WRITE and pIncBuff^.f_permissions) = PERM_FILE_WRITE then
            Perm := Perm + 'W'
          else
            Perm := Perm + '-';

          if (PERM_FILE_CREATE and pIncBuff^.f_permissions) = PERM_FILE_CREATE then
            Perm := Perm + 'C'
          else
            Perm := Perm + '-';

          Data := Data + ';' + Perm;
        end;

        if fNumLocks in OpenFileFields then
          Data := Data + ';' + IntToStr(pIncBuff^.f_NumLocks);

        delete(Data, 1, 1);
        StringList.Add(Data);
        inc(pIncBuff);
      end;
    end;

    if pFileBuffer <> nil then
      FNetApiBufferFree(pFileBuffer);
  end;

  StringList.EndUpdate;
end;

// =============================================================================
// TNTServerGroups
// =============================================================================

constructor TNTServerGroups.Create;
begin
  FLibHandle := LoadLibrary('NETAPI32.DLL');

  if FLibHandle <> 0 then
  begin
    @FNetGroupEnum := GetProcAddress(FLibHandle, 'NetGroupEnum');
    @FNetApiBufferFree := GetProcAddress(FLibHandle, 'NetApiBufferFree');
  end;

end;

destructor TNTServerGroups.Destroy;
begin
  if FLibHandle <> 0 then
  try
    FreeLibrary(FLibHandle);
  except
  end;

  inherited Destroy;
end;

procedure TNTServerGroups.GroupNames(const Machinename: string;
  StringList: TStrings;
  GroupFields: TNTServerGroupsFieldSet = [fGroupName]);
var
  i, E, ResumeHandle,
    TotalEntries, EntriesRead: DWORD;
  pGroupBuffer: pointer;
  pIncBuff: PGroupInfoStruc;
  pszServer: array[0..128] of WideChar;
  Data: string;
begin
  StringList.Clear;
  StringList.BeginUpdate;

  if FLibHandle <> 0 then
  begin
    pGroupBuffer := nil;
    if GroupFields = [] then
      GroupFields := [fGroupName];
    ResumeHandle := 0;
    E := FNetGroupEnum(StringToWideChar(MachineName, pszServer, 129),
      2, pGroupBuffer, -1, EntriesRead, TotalEntries,
      Resumehandle);
    if E = 0 then
    begin
      pIncBuff := pGroupBuffer;

      for i := 1 to EntriesRead do
      begin
        Data := '';

        if fGroupName in GroupFields then
          Data := Data + ';' + WideCharToString(pIncBuff^.g_name);
        if fComment in GroupFields then
          Data := Data + ';' + WideCharToString(pIncBuff^.g_comment);
        if fGroupID in GroupFields then
          Data := Data + ';' + IntToStr(pIncBuff^.g_id);
        if fAttributeFlag in GroupFields then
          Data := Data + ';' + IntToStr(pIncBuff^.g_attributes);

        delete(Data, 1, 1);
        StringList.Add(Data);
        inc(pIncBuff);
      end;
    end;

    if pGroupBuffer <> nil then
      FNetApiBufferFree(pGroupBuffer);
  end;

  StringList.EndUpdate;
end;

// =============================================================================
// TNTServerDisks
// =============================================================================

constructor TNTServerDisks.Create;
begin
  FLibHandle := LoadLibrary('NETAPI32.DLL');

  if FLibHandle <> 0 then
  begin
    @FNetServerDiskEnum := GetProcAddress(FLibHandle, 'NetServerDiskEnum');
    @FNetApiBufferFree := GetProcAddress(FLibHandle, 'NetApiBufferFree');
  end;

end;

destructor TNTServerDisks.Destroy;
begin
  if FLibHandle <> 0 then
  try
    FreeLibrary(FLibHandle);
  except
  end;

  inherited Destroy;
end;

procedure TNTServerDisks.DiskNames(const Machinename: string;
  StringList: TStrings);
var
  i, E, ResumeHandle,
    TotalEntries, EntriesRead: DWORD;
  pDiskBuffer: pointer;
  pIncBuff: PDiskInfoStruc;
  pszServer: array[0..128] of WideChar;
begin
  StringList.Clear;
  StringList.BeginUpdate;

  if FLibHandle <> 0 then
  begin
    pDiskBuffer := nil;
    ResumeHandle := 0;
    E := FNetServerDiskEnum(StringToWideChar(MachineName, pszServer, 129),
      0, pDiskBuffer, -1, EntriesRead, TotalEntries,
      Resumehandle);
    if E = 0 then
    begin
      pIncBuff := pDiskBuffer;

      for i := 1 to EntriesRead do
      begin
        StringList.Add(WideCharToString(@pIncBuff^.d_name));
        inc(pIncBuff);
      end;
    end;

    if pDiskBuffer <> nil then
      FNetApiBufferFree(pDiskBuffer);
  end;

  StringList.EndUpdate;
end;

// =============================================================================
// GetServerResources()
//
// Return ';' delimted list of Resources from
// a given starting point '' enums from ROOT
// Return String Format
// 'Name;Object;Type;Status;Provider;Comment'
// =============================================================================

procedure GetServerResources(const RootObject: string;
  StringList: TStrings;
  RecursiveEnum: boolean;
  ResourceTypes: TNTServerResSet = [resAny]);
var
  NetResource: TNetResource;
  SaveRecurse: boolean;
  RootName: string;

  procedure RecurseResources(Pnr: PNetResource);
  var
    Buffer: pointer;
    FHandle: THandle;
    i, E, NumEntries, BuffSize: DWORD;
    Data: string;
    Ok: boolean;
    IsRoot: boolean;
  begin
    IsRoot := (Pnr.lpLocalName = nil);
    BuffSize := $4000;
    E := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, 0, Pnr, FHandle);

    if E = NO_ERROR then
    begin
      // Get required size - force errors and value => BuffSize
      GetMem(Buffer, BuffSize);
      while true do
      begin
        NumEntries := $FFFFFFFF;
        E := WNetEnumResource(FHandle, NumEntries, Buffer, BuffSize);
        if (E <> NO_ERROR) then
          break; // No more items or error
        Pnr := Buffer;

        for i := 1 to NumEntries do
        begin
          Ok := false;
          if IsRoot then
            Ok := true;

          if resAny in ResourceTypes then
            Ok := true
          else
          begin
            if (resPrinter in ResourceTypes) and
              (Pnr.dwType = RESOURCETYPE_PRINT) then
              Ok := true;
            if (resDisk in ResourceTypes) and
              (Pnr.dwType = RESOURCETYPE_DISK) then
              Ok := true;
            if (resServer in ResourceTypes) and
              (Pnr.dwDisplayType = RESOURCEDISPLAYTYPE_SERVER) and
              ((Pnr.dwType <> RESOURCETYPE_DISK) and
              (Pnr.dwType <> RESOURCETYPE_PRINT)) then
              Ok := true;
            if (resDomain in ResourceTypes) and
              (Pnr.dwDisplayType = RESOURCEDISPLAYTYPE_DOMAIN) and
              ((Pnr.dwType <> RESOURCETYPE_DISK) and
              (Pnr.dwType <> RESOURCETYPE_PRINT)) then
              Ok := true;
          end;

          if Ok then
          begin
            Data := Pnr.lpRemoteName + ';';

            case Pnr.dwDisplayType of
              RESOURCEDISPLAYTYPE_DOMAIN: Data := Data + 'DOMAIN;';
              RESOURCEDISPLAYTYPE_GENERIC: Data := Data + 'OTHER;';
              RESOURCEDISPLAYTYPE_SERVER: Data := Data + 'SERVER;';
              RESOURCEDISPLAYTYPE_SHARE: Data := Data + 'SHARE;';
              RESOURCEDISPLAYTYPE_FILE: Data := Data + 'FILE;';
              RESOURCEDISPLAYTYPE_GROUP: Data := Data + 'GROUP;';
              RESOURCEDISPLAYTYPE_NETWORK: Data := Data + 'NETWORK;';
              RESOURCEDISPLAYTYPE_SHAREADMIN: Data := Data + 'SHAREADMIN;';
              RESOURCEDISPLAYTYPE_DIRECTORY: Data := Data + 'DIRECTORY;';
              RESOURCEDISPLAYTYPE_TREE: Data := Data + 'TREE;';
              RESOURCEDISPLAYTYPE_NDSCONTAINER: Data := Data + 'NDSCONTAINER;';
            else
              Data := Data + 'UNKNOWN;';
            end;

            case Pnr.dwType of
              RESOURCETYPE_ANY: Data := Data + 'OTHER;';
              RESOURCETYPE_DISK: Data := Data + 'DISK;';
              RESOURCETYPE_PRINT: Data := Data + 'PRINTER;';
            else
              Data := Data + 'UNKNOWN;';
            end;

            case Pnr.dwUsage of
              RESOURCEUSAGE_CONNECTABLE: Data := Data + 'CONNECTABLE;';
              RESOURCEUSAGE_CONTAINER: Data := Data + 'CONTAINER;';
              RESOURCEUSAGE_NOLOCALDEVICE: Data := Data + 'NOLOCALDEVICE;';
              RESOURCEUSAGE_SIBLING: Data := Data + 'SIBLING;';
              RESOURCEUSAGE_ATTACHED: Data := Data + 'ATTACHED;';
            else
              Data := Data + 'UNKNOWN;';
            end;

            Data := Data + Pnr.lpProvider + ';';
            Data := Data + Pnr.lpComment;
            StringList.Add(Data);
          end;

          if RecursiveEnum and
            ((Pnr.dwUsage and RESOURCEUSAGE_CONTAINER) > 0) then
            RecurseResources(Pnr);

          inc(Longint(Pnr), SizeOf(TNetResource));
        end;
      end;

      FreeMem(Buffer);
      WNetCloseEnum(FHandle);
    end;
  end;

begin
  StringList.Clear;
  Screen.Cursor := crHourGlass;
  Application.ProcessMessages;
  Fillchar(NetResource, SizeOf(TNetResource), 0);
  NetResource.dwScope := RESOURCE_GLOBALNET;
  NetResource.dwUsage := RESOURCEUSAGE_CONTAINER;
  NetResource.lpRemoteName := PChar(RootObject);
  SaveRecurse := RecursiveEnum;
  StringList.BeginUpdate;

  // if RootObject is '' then getfirst entry
  if RootObject = '' then
  begin
    RecursiveEnum := false;
    RecurseResources(@NetResource);
    if (StringList.Count > 0) then
    begin
      RootName := copy(StringList[0], 1, pos(';', StringList[0]) - 1);
      Fillchar(NetResource, SizeOf(TNetResource), 0);
      NetResource.dwScope := RESOURCE_GLOBALNET;
      NetResource.dwUsage := RESOURCEUSAGE_RESERVED;
      NetResource.dwDisplayType := RESOURCEDISPLAYTYPE_NETWORK;
      NetResource.lpRemoteName := PChar(RootName);
    end;
    RecursiveEnum := SaveRecurse;
    StringList.Clear;
  end;

  RecurseResources(@NetResource);
  StringList.EndUpdate;
  Screen.Cursor := crDefault;
end;

// ================================================
// Validate Username,Domain and Password logon
// ================================================

function ValidateUserLogon(const UserName: string;
  const Domain: string;
  const PassWord: string): boolean;
var
  Retvar: boolean;
  LHandle: THandle;
begin

  Retvar := LogonUser(PChar(UserName), PChar(Domain), PChar(PassWord),
    LOGON32_LOGON_NETWORK, LOGON32_PROVIDER_DEFAULT,
    LHandle);
  if Retvar then
    CloseHandle(LHandle);
  Result := Retvar;
end;

end.