How to obtain list of all computers/devices on the network? 1

[djjd47130]

I asked this a while back and never got a response, can't find the original post, so I'll ask it again.

I just want to be able to enumerate a list of all computers and devices on a network. I prefer to actually get the IP addresses, but I can live with the device names too, as long as I can easily do a DNS lookup. It's also important to be as quick as possible - I don't want the application hanging up while it's searching.

JD Solutions

 

[djjd47130]

I found it, here's the code...

http://www.delphitricks.com/source-code/internet/get_a_list_of_computers_in_a_network.html

Except, I've been trying to convert it into a thread, and since it's the first thread I've really attempted, it's miserably failing. My goal is to turn it into a class TNetList where I can call an Enumerate procedure which in turn performs the search - and then for each device it finds, not only adds it to the list, but triggers an event OnDeviceAdded which provides the new device's info. Any ideas of how to build this into a threaded class?

JD Solutions

 

[Glenn9999]

The first question to ask is if the calls you are making is thread-safe. This will probably be the biggest complication. This generally means that any resources are coordinated and don't require the main thread.

As for the thread itself, I've found you have to wrap its call in a TComponent if you want any direct VCL interaction (i.e. without synchronize, doing message handling procs in your form, etc - you still have to do the latter in a TComponent). This is how I'm doing the downloader component I made using that WinHTTP unit. If you just want a callable object with an event, you'll still have to make it into a wrapper.

Anyhow you get a basic outline by selecting New then Thread Object. The problem I have with that though is that separating a small amount of code is difficult to justify so I copy the structures into the unit with the associated form anyway.

A kinda stupid example (in functionality) follows. If you want a more real-world example (though it is basically the same idea), there should be a karaoke media player sample in this forum I did once upon a time:

unit Unit1;
// small thread-handling demo by Glenn9999 at tek-tips.com
interface

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

const
  WM_UPDATEFORM = WM_USER + $2000;
type
  TTCounter = class(TThread)
  private
    { Private declarations }
  public
    Counter: Integer;
    WinHandle: THandle; // the handle I'm supposed to notify.
  protected
    procedure Execute; override;
  end;
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  protected
     procedure UpdateStuff(var WinMsg: TMessage); message WM_UPDATEFORM;
  public
    { Public declarations }
    TCounter: TTCounter;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TTCounter.Execute;
begin
  while not Terminated do
    begin
      inc(Counter);
      PostMessage(WinHandle, WM_UPDATEFORM, Counter, 0);
     // you want to give the system a little breathing room so the other
     // thread can handle your messages
      sleep(10);
    end;
end;

procedure TForm1.UpdateStuff(var WinMsg: TMessage);
// where the main thread handles VCL stuff.  Equivalent to your OnDeviceAdded
// event if/when you make a wrapper object for the thread.
  begin
    Label1.Caption := IntToStr(WinMsg.WParam);
  end;

procedure TForm1.Button1Click(Sender: TObject);
// start counting thread.
begin
  // shut down original thread if we restart.
  if Assigned(TCounter) then
    TCounter.Terminate;
  TCounter := TTCounter.Create(true);  // create thread suspended, false makes it run immediately
  with TCounter do
    begin
      Counter := 0;
      WinHandle := Form1.Handle;
      FreeOnTerminate := true;
      Resume;
    end;
  Button2.Enabled := true;
  Button4.Enabled := true;
end;

procedure TForm1.Button2Click(Sender: TObject);
// pause counting thread, more to demo TThread.
begin
  Button2.Enabled := false;
  Button3.Enabled := true;
  TCounter.Suspend;
end;

procedure TForm1.Button3Click(Sender: TObject);
// resume counting thread, more to demo TThread.
begin
  Button2.Enabled := true;
  Button3.Enabled := false;
  TCounter.Resume;
end;

procedure TForm1.Button4Click(Sender: TObject);
// terminate counting thread, more to demo TThread.
begin
  Button2.Enabled := false;
  Button3.Enabled := false;
  Button4.Enabled := false;
  TCounter.Terminate;
end;

procedure TForm1.FormDestroy(Sender: TObject);
// you want to make sure your thread gets shut down before main program does.
begin
  TCounter.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button2.Enabled := false;
  Button3.Enabled := false;
  Button4.Enabled := false;
end;

end.

The big issue with threads is usually the communication aspect of it. While you could use Synchronize as the means to do it, it's a little messy and doesn't work too well in all cases. So I used messages above, which is more useful in more cases (interprocess communication, like a DLL proc sending notifications to a main form, or inter-thread communication like here).

Also make sure you don't do anything to hamper the thread from running through your main program as well. Basically running the thread makes it concurrent to whatever else you are doing, so keep design in mind in that regard.

There is much more to TThread and threads in general than what is in the code above, so be sure to research and ask questions if you have any.

Barring the experience of actually doing it, if all you are looking for is to select a computer on the network, you can look into using this component I put into the FAQs. faq102-7233 I don't have a network to test the browse machines part (or browse printer part), but the API that that component encapsulates lets you browse and select just about any resource you can see in Explorer.

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[Glenn9999]

Another example I felt like doing. YMMV on method and how well it works and lightly tested.

It's a component that shows the time on a VCL TButton

unit tclockunit;
  { Clock button demo written by Glenn9999 of tek-tips.com }
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, stdctrls;

const
  WM_UPDATEBTN = WM_USER + $500;
  TimeStrDefault = 'h:mm:ss AM/PM';
type
  TClockUpdate = class(TThread)
  public
    ButtonHandle: THandle;
  protected
    procedure Execute; override;
  end;
  TClockButton = class(TButton)
  private
   { Private declarations }
    FClockUpdate: TClockUpdate;
    FTimeFormat: String;
    MainHandle: THandle;

    procedure SetTimeFormat(Value: String);
  protected { Protected declarations }
    procedure UpdateStuff(var WinMsg: TMessage); message WM_UPDATEBTN;
    procedure Loaded; override;
  public    { Public declarations }
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
  published { Published declarations }
    property TimeFormat: string read FTimeFormat write SetTimeFormat;
  end;

procedure Register;

implementation

procedure TClockUpdate.Execute;
begin
  while not Terminated do
    begin
      PostMessage(ButtonHandle, WM_UPDATEBTN, 0, 0);
      sleep(1000);
    end;
end;

procedure TClockButton.UpdateStuff(var WinMsg: TMessage);
// where the main thread handles VCL stuff.  Equivalent to your OnDeviceAdded
// event if/when you make a wrapper object for the thread.
  begin
    Caption := FormatDateTime(FTimeFormat, Now);
  end;

procedure TClockButton.SetTimeFormat(Value: String);
  var
    Test: string;
  begin
    Test := FormatDateTime(Value, Now);
    if Test = Value then
      ShowMessage('"' + Value + '" is not a valid date time string.  Please correct.')
    else
      FTimeFormat := Value;
  end;

Constructor TClockButton.Create(AOwner: TComponent);
  begin
    Inherited Create(AOwner);
    MainHandle := AllocateHWnd(UpdateStuff);
    FClockUpdate := TClockUpdate.Create(true);
    with FClockUpdate do
      begin
        FreeOnTerminate := true;
        ButtonHandle := MainHandle;
        Resume;
      end;
  end;

procedure TClockButton.Loaded;
  { initializations of the control }
  begin
    inherited loaded;
    if FTimeFormat = '' then
      FTimeFormat := TimeStrDefault;
  end;

Destructor TClockButton.Destroy;
  begin
    FClockUpdate.Terminate;
    sleep(20);
    DeAllocateHWnd(MainHandle);
    Inherited;
  end;

procedure Register;
begin
  RegisterComponents('Samples', [TClockButton]);
end;

end.

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[djjd47130]

Thanks, I shall play around with that code tonight and see what I come up with... This will be used in the NetSpeed testing system so that each service on each computer can look for other computers which are running the same service, obviously on the same port. I'm building the raw packets myself, coming up I'll probably be asking how to measure meaningful packet size by the size of a string, but I'm sure that's a simple calculation.

JD Solutions

 

[djjd47130]

After closer evaluation of the method(s) I found, it looks like A) Whoever wrote that likes to make things complex, and B) To implement this in a thread, it looks like I need to strip it down and build all that directly into the thread, rather than relying on calling a single method. The main issue is I don't want to wait for every device to be enumerated before further reading, etc. Hence the reason for the thread, so it can do all the scanning in the background, and save its results to a list. I'm also trying to put events on this thread for when new devices are added to the list (and eventually when it recognizes something changed).

In other words, I need to use the concept of the code I found, but completely re-do it working within the thread its self. I see it's using an array, and that the API function which obtains this info requires this list as a parameter. What I don't understand is why it expects me to keep calling the function over and over for each resource, when I provided the array which it needs to save to?

Anyway, here's what I have so far below. The main class to look at is the TNetResourceScanner which is the TThread. Also, Glenn, thanks for the samples, except my project won't necessarily need to keep going in a loop, it should only execute on demand, and shall disable its self when it's done finding all resources. The main problem I'm having is that the thread won't stop because the method it calls doesn't stop.

Unless, I could make it always executing and checking for any changes, thus refreshing the list...

I'm sure there's tons possible, and that's exactly where I start getting confused, is which path to take. I just hate going too far with one way to find out I should have done it completely different.

I'm starting to want to get rid of the TNetResourceList and replace with just a TNetResourceArray. If I go the route of always scanning, then there would be two of these arrays (TNetResourceArray) - one for the thread to work with and the other to hold the info available to the user, and synchronize those two. This way, I can search for changes between each list and trigger events when there's changes (such as resource added/removed, or info of a resource is different). My main goal in the first place is to get the thread to stop properly, as it works, but never stops.

unit uTestMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, dmNetSpeed, ComCtrls, ExtCtrls, ImgList,
  JDNeedleGauge, JDNet;

const
  SVR_MSG_CONNECTED = 'Server Connected Successfully';
  SVR_MSG_DISCONNECTED = 'Server Disconnected Successfully';
  SVR_MSG_ERROR = 'Unexpected Server Error';



type
  TfrmMain = class(TForm)
    lstClients: TListView;
    pTop: TPanel;
    cmdStart: TBitBtn;
    cmdStop: TBitBtn;
    cmdPause: TBitBtn;
    cmdResume: TBitBtn;
    Splitter1: TSplitter;
    imgClients: TImageList;
    pBottom: TPanel;
    chkPostLog: TCheckBox;
    tmrLog: TTimer;
    pLog: TPanel;
    Log: TMemo;
    Gauge: TJDNeedleGauge;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Net: TNetList;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tmrLogTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure cmdStartClick(Sender: TObject);
    procedure cmdStopClick(Sender: TObject);
    procedure NetAdd(Resource: PNetResourceA);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure NetBegin(Sender: TNetList);
    procedure NetEnd(Sender: TNetList);
  private
    fSvc: TNetSpeed;
    fLog: TStringList;
    //Child Events
    procedure SvcConnect(Sender: TNetSpeed);
    procedure SvcDisconnect(Sender: TNetSpeed);
    procedure SvcLog(Sender: TNetSpeed;
      LogText: String);
    procedure SvcError(Sender: TNetSpeed;
      var ErrCode: Integer; var ErrMsg: String);
    function GetPingNeedle: TNeedle;
    function GetUploadNeedle: TNeedle;
    function GetDownloadNeedle: TNeedle;
  public
    procedure PostLog(const S: String);

    property PingNeedle: TNeedle read GetPingNeedle;
    property UploadNeedle: TNeedle read GetUploadNeedle;
    property DownloadNeedle: TNeedle read GetDownloadNeedle;
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
var
  X: Integer;
begin
  fLog:= TStringList.Create;
  fSvc:= TNetSpeed.Create(nil);
    fSvc.OnConnect:= SvcConnect;
    fSvc.OnDisconnect:= SvcDisconnect;
    fSvc.OnLog:= SvcLog;
    fSvc.OnError:= SvcError;
  PingNeedle.Position:= 0;
  UploadNeedle.Position:= 0;
  DownloadNeedle.Position:= 0;

  if Net.Refresh then begin

  end;

end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  if assigned(fSvc) then fSvc.Free;
  if assigned(fLog) then fLog.Free;
end;

procedure TfrmMain.PostLog(const S: String);
begin
  if assigned(fLog) then begin
    fLog.Append(S);
  end;
end;

procedure TfrmMain.tmrLogTimer(Sender: TObject);
var
  X: Integer;
begin       
  if assigned(fLog) then begin
    if chkPostLog.Checked then begin
      while fLog.Count > 0 do begin
        Log.Lines.Append(fLog[0]);
        fLog.Delete(0);
        Log.SelStart:= Length(Log.Text) - 1;
        Log.SelLength:= 1;
        Log.SelStart:= Length(Log.Text);
        Application.ProcessMessages;
      end;
    end;
  end;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  pLog.Align:= alClient;
  
end;

procedure TfrmMain.cmdStartClick(Sender: TObject);
begin
  fSvc.Active:= True;
  
end;

procedure TfrmMain.cmdStopClick(Sender: TObject);
begin   
  fSvc.Active:= False;

end;

procedure TfrmMain.SvcConnect(Sender: TNetSpeed);
begin
  PostLog(SVR_MSG_CONNECTED);
  cmdStart.Enabled:= False;
  cmdStop.Enabled:= True;
end;

procedure TfrmMain.SvcDisconnect(Sender: TNetSpeed);
begin
  PostLog(SVR_MSG_DISCONNECTED);
  cmdStart.Enabled:= True;
  cmdStop.Enabled:= False;
end;

procedure TfrmMain.SvcError(Sender: TNetSpeed; var ErrCode: Integer;
  var ErrMsg: String);
begin
  PostLog(SVR_MSG_ERROR);
  PostLog('Error Code: '+IntToStr(ErrCode));
  PostLog(ErrMsg);
  ErrCode:= 0;
end;

procedure TfrmMain.SvcLog(Sender: TNetSpeed; LogText: String);
begin
  PostLog(LogText);
end;

function TfrmMain.GetDownloadNeedle: TNeedle;
begin
  Result:= Gauge.Needles[1] as TNeedle;
end;

function TfrmMain.GetPingNeedle: TNeedle;
begin
  Result:= Gauge.Needles[0] as TNeedle;
end;

function TfrmMain.GetUploadNeedle: TNeedle;
begin
  Result:= Gauge.Needles[2] as TNeedle;
end;

procedure TfrmMain.NetAdd(Resource: PNetResourceA);
begin
  PostLog('  '+Resource.lpLocalName+' - '+Resource.lpRemoteName+' - '+
    Resource.lpProvider+' - '+Resource.lpComment);
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  TmrLog.Enabled:= False;
end;

procedure TfrmMain.NetBegin(Sender: TNetList);
begin
  PostLog('Beginning scan...');
end;

procedure TfrmMain.NetEnd(Sender: TNetList);
begin
  PostLog('Scan Ended.');
end;

end.

JD Solutions

 

[djjd47130]

PS - You won't have the component resource file it refers to. It's an installable drop-in component.

JD Solutions

 

[djjd47130]

***********NOTE***********

I have changed my mind on how I want to structure this. You're still more than welcome to give any input, but I'm going in a far different direction than I had above.

With the network scanner system which I'm building this component for, I've decided to add in a central server which all clients will connect to. This server will have a database of what computers are available to connect to, providing their IP addresses and such.

This eliminates the purpose for the above component which I'm trying to build, but I'd still like to get it working anyway.

JD Solutions

 

[Glenn9999]

Also, Glenn, thanks for the samples, except my project won't necessarily need to keep going in a loop, it should only execute on demand, and shall disable its self when it's done finding all resources. The main problem I'm having is that the thread won't stop because the method it calls doesn't stop.

I'm not sure I understand what the issue is. The idea is that you put your long running process into a thread, wrap your thread calls in another regular object which controls the object. The wrapper object then has some form of execute method (like "ScanNetworkInfo"). Then have the thread send the wrapper object messages indicating what it needs to indicate.

The downloader object I keep referencing (and am still working on, which is why I just don't share that as an example) is a good example. It won't be running all the time, just long enough to download the file. I plug in the file URL, call "DownloadFile", that handles the thread calls and sets everything up.

I have messages from the thread which ties back to the main object, which is a VCL component. There I have the component trigger "OnFilePrompt" when I find out the remote file name, "OnProgress" about every second to be able to update the form (progress bar, etc), and then "OnCompleted" to signal that the download is done.

The idea is to let the worker thread you create do its job and let the main VCL thread do its job and not to impede either of them from doing it (like with a wait loop & application.processmessages, etc).

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[djjd47130]

I mentioned that because my original plan was to run the scan on demand, and the samples you posted were executing in a loop *until terminated*. I just wasn't sure of how to implement your examples at that moment, but came a long way since then also. I still have the problem of the procedure never ending (recursively calls its self).

After careful consideration, I decided that the best way to do this is maintain both a list of records in the thread its self, and a master list within the component, and synchronizing between them. When the scan starts, it will save the found records into the array (as the method I found online does) directly in the thread.

Then I will trigger events (not necessarily messages) for when either A) new record is on scanned list that isn't yet on master list, B) scanned record details differ from corresponding record in master list, or C) Scan completed and there is a record (or more) in master list which are no longer in scanned list (thus removed).

The key issue as I highlighted above is that the main method used to perform the actual scan never ends, it continually calls its self over and over (as it was designed by its writer). I'm finding it hard to get a hold of any other sample source which does this task, so I'm trying to re-code it, but miserably failing.

The final fix will have to be writing the code which is in these methods I found directly into the thread, so I can keep control over it. That's the point where I got stuck. I have the thread concept down, I just guess I'm trying to be too careful, because I know threads are very sensitive.

JD Solutions

 

[Glenn9999]

I mentioned that because my original plan was to run the scan on demand, and the samples you posted were executing in a loop *until terminated*.

Actually all that does is enable your main thread to control what the other thread does. Your design may not dictate the process being cancelled (in other words the thread being forcibly terminated), but it is generally good practice to enable this to be done within the thread, even if the intention is to not enable it. This is because your program can be terminated (usually) while the thread is doing its work.

Like with the downloader, if I want a "cancel download" button on my main VCL form, all I need to do is call the terminate method of the thread and then the logic is planned so it gracefully exits as soon as possible. Otherwise if I let the thread run, it just runs until the file is downloaded successfully and then terminates.

TThread.Terminated is a signal variable for your thread code to accomplish this.

Thread coding is a big topic with a learning curve (which I'm still trying to get over to be honest, since I'm finding it is taking some practice), which is why I mentioned to feel free to research and ask questions.

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[Glenn9999]

but it is generally good practice to enable this to be done within the thread, even if the intention is to not enable it. This is because your program can be terminated (usually) while the thread is doing its work.

To clarify as to the main reason for doing this, your thread might be using resources which need closed or freed (like other objects, dynamically allocated memory, file handles, etc) in the course of termination. Even if you don't intend on the thread to be terminated at-will, it is still good to make provision to give back resources instead of just cutting it off.

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[Glenn9999]

Just thought to post this: It's a very good read to work through on the topic of threads.

http://www.eonclash.com/Tutorials/Multithreading/MartinHarvey1.1/ToC.html

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

 

[djjd47130]

The important issue which I need resolved here is not necessarily the thread, I'm getting the hang of that. The problem is that these API calls have virtually no documentation, at least not helpful enough for Delphi. I can find all the constants and everything which represent each property, and the API functions, it's just really hard to figure out how Windows expects me to be calling them. I've done quite some work trying to implement the code directly in the thread, and somehow failed along the line and am getting access violations, coming from the line after the API call when it tries to read what it acquired...

Here's my latest code, it's a little all over, but I commented where the errors are happening.

{--------------------------------------------------------------}
{  JDNet                                                       }
{  Collection of classes for interacting with the network      }
{  TNetList: TComponent - Provides list of devices on network  }
{  TNetResourceScanner: TThread - Performs scanning of network }
{  TNetResourceList: TList - Hold list of PNetResource         }
{--------------------------------------------------------------}

unit JDNet;

interface

uses
  Classes, Windows, SysUtils, ShellAPI;

type
  TNetList = class;
  TNetResourceScanner = class;
       
  TNetListEvent = procedure(Sender: TNetList) of object;
  TNetResourceEvent = procedure(Resource: PNetResource) of object;
  TNetCountChange = procedure(Sender: TNetList; OldCount, NewCount: Integer) of object;
               
  TNetScope = (nsConnected, nsGlobalNet, nsRemembered, nsRecent, nsContext);

  TNetResourceType = (nrAny, nrDisk, nrPrint, nrReserved);
  TNetResourceTypes = set of TNetResourceType;

  TNetUsage = (ruConnectable, ruContainer, ruNoLocalDevice, ruSibling,
    ruAttached, ruAll, ruReserved);
  TNetUsages = set of TNetUsage;
       
  TNetDisplayType = (ndGeneric, ndDomain, ndServer, ndShare, ndFile, ndGroup,
    ndNetwork, ndRoot, ndShareAdmin, ndDirectory, ndTree, ndNDSContainer);
  TNetDisplayTypes = set of TNetDisplayType;


  //As found in original source...
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;


  TNetResourceScanner = class(TThread)
  private
    //Creating Objects
    fFound: PNetResourceArray;
    fItems: PNetResourceArray;
    //Variables
    fBusy: Bool;
    fStop: Bool;
    fItemsCount: DWORD;
    fFoundCount: DWORD;
    fHandle: THandle;
    //Events
    fOnAdd: TNetResourceEvent;
    fOnBegin: TNotifyEvent;
    fOnEnd: TNotifyEvent;
    fOnCountChange: TNetCountChange;
    //Property Control
    function GetResource(Index: Integer): PNetResource;
    function GetCount: Integer;
    //Other Methods
    procedure Added(Resource: PNetResource); 
    procedure BeginScan;
    procedure ScanEnded;            
    function CreateNetResourceList(NetResource: PNetResource): Boolean;
    procedure ScanLevel(NetResource: PNetResource);
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy;
    procedure Refresh;
    procedure StopScan;
    property Busy: Bool read fBusy;  
    property Resources[Index: Integer]: PNetResource read GetResource;
    property Count: Integer read GetCount;
    property OnAdd: TNetResourceEvent read fOnAdd write fOnAdd;
    property OnBegin: TNotifyEvent read fOnBegin write fOnBegin;
    property OnEnd: TNotifyEvent read fOnEnd write fOnEnd;
    property OnCountChange: TNetCountChange
      read fOnCountChange write fOnCountChange;
  end;
        
  TNetList = class(TComponent)
  private
    //Creating Objects
    fThread: TNetResourceScanner;
    //Events
    fOnAdd: TNetResourceEvent;
    fOnBegin: TNetListEvent;
    fOnEnd: TNetListEvent;
    //Property Control
    function GetResource(Index: Integer): TNetResource;
    function GetCount: Integer;
    //Child Event Procedures
    procedure Added(Resource: PNetResource);
    procedure Begun(Sender: TObject);
    procedure Ended(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Refresh: Bool;
    property Resource[Index: Integer]: TNetResource read GetResource;
    property Count: Integer read GetCount;
  published
    property OnAdd: TNetResourceEvent read fOnAdd write fOnAdd;
    property OnBegin: TNetListEvent read fOnBegin write fOnBegin;
    property OnEnd: TNetListEvent read fOnEnd write fOnEnd;
  end;


 {
function NetResourceTypesToDWord(Types: TNetResourceTypes): DWORD;
function NetDisplayTypesToDWord(Types: TNetDisplayTypes): DWORD;
function NetUsagesToDWord(Usages: TNetUsages): DWORD;
function NetScopeToDWord(Scope: TNetScope);
 }


procedure Register;

implementation

{$R JDNet.dcr}

procedure Register;
begin
  RegisterComponents('JD Custom', [TNetList]);
end;



{ TNetList }

constructor TNetList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fThread:= TNetResourceScanner.Create;
    fThread.OnAdd:= Added;
    fThread.OnBegin:= Begun;
    fThread.OnEnd:= Ended;
end;

destructor TNetList.Destroy;
const
  CMax = 5;
var
  C: Integer;
begin
  if assigned(fThread) then begin
    if fThread.Busy then fThread.StopScan;
    C:= 0;
    while (fThread.Busy) or (C <= CMax) do begin
      Sleep(1000);
      Inc(C);
    end;
    fThread.Terminate;
    C:= 0;
    while (not fThread.Terminated) or (C <= CMax) do begin
      Sleep(1000);
      Inc(C);
    end;
  end;
  if assigned(fThread) then fThread.Free;
  inherited Destroy;
end;

function TNetList.Refresh: Bool;
begin
  Result:= True;
  try
    fThread.Refresh;
  except
    on e: exception do begin
      Result:= False;
    end;
  end;
end;

function TNetList.GetCount: Integer;
begin
  Result:= fThread.Count;
end;

function TNetList.GetResource(Index: Integer): TNetResource;
begin
  if (Index >= 0) and (Index < fThread.Count) then begin
    Result:= fThread.Resources[Index]^;
  end else begin
    raise Exception.Create('List index out of bounds ('+IntToStr(Index)+')');
  end;
end;

procedure TNetList.Added(Resource: PNetResource);
begin
  if assigned(fOnAdd) then fOnAdd(Resource);
end;

procedure TNetList.Begun(Sender: TObject);
begin
  if assigned(fOnBegin) then fOnBegin(Self);
end;

procedure TNetList.Ended(Sender: TObject);
begin
  if assigned(fOnEnd) then fOnEnd(Self);
end;

{ TNetResourceScanner }

constructor TNetResourceScanner.Create;
begin
  fBusy:= True;
  try
    inherited Create(True);
    fStop:= True;
  finally
    fBusy:= False;
  end;
end;

destructor TNetResourceScanner.Destroy;
begin
  fStop:= True;
  fBusy:= True;
  FreeMem(fFound);
end;
    
function TNetResourceScanner.CreateNetResourceList(NetResource: PNetResource): Boolean;
var
  Res: DWord;
  Sz: DWord;
  I: Integer;
  //R: PNetResource;
begin
  Result:= False;
  fFound:= Nil;
  fFoundCount:= 0;
  if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0,
    NetResource, fHandle) = NO_ERROR then
  begin
    try
      Sz:= $4000;
      GetMem(fFound, Sz);
      try
        I:= 0;
        repeat
          fFoundCount:= DWord(-1);
          FillChar(fFound^, Sz, 0);
          /////////////////////////////////////////////////
          //Raising error result 487: ERROR_INVALID_ADDRESS
          Res:= WNetEnumResource(fHandle, fFoundCount, fFound, Sz);
          //Res:= WNetEnumResource(fHandle, fFoundCount, R, Sz);
          //if assigned(fOnAdd) then fOnAdd(R);   
          if Res = ERROR_MORE_DATA then ReAllocMem(fFound, Sz);
          if assigned(fOnAdd) then fOnAdd(@fFound[I]);
          Inc(I);
        until (Res <> ERROR_MORE_DATA) or (fStop) or (Terminated);
        Result:= Res = NO_ERROR;
        if Result then begin

        end else begin
          fFound:= Nil;
          fFoundCount:= 0;
        end;
      except
        FreeMem(fFound);
        raise;
      end;
    finally
      WNetCloseEnum(fHandle);
    end;
  end;
end;

procedure TNetResourceScanner.ScanLevel(NetResource: PNetResource);
var
  i: Integer;
begin
  if CreateNetResourceList(NetResource) then try
    for i:= 0 to Integer(fFoundCount) - 1 do begin
      //////////////////////////////////////////////////////////////////
      //Crashing here when trying to read TNetResource from fFound array
      //if fFound[i].dwDisplayType = RESOURCEDISPLAYTYPE_SERVER then begin
        //if assigned(fOnAdd) then fOnAdd(@fFound[i]);
      //end;

      if (fFound[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
        ScanLevel(@fFound[i]);
    end;
  finally

  end;
end;

{ Notes:
  - Cannot wait for ScanNetworkResources method to end
    - ScanNetworkResources doesn't stop executing
  - Make sure thread execution successfully terminates on demand
    - Requires tapping into the ScanNetworkResources code
  - Possibly multiple thread executions at once???
}

procedure TNetResourceScanner.Execute;
const
  DelaySeconds = 60;
var
  X: Integer;
  R: PNetResource;
begin
  inherited;
  while (not Terminated) and (not fStop) do begin
    try

      ScanLevel(nil);

      //Loop through resources found
      for X:= 0 to fFoundCount - 1 do begin
        if (fStop) or (Terminated) then break;
        R:= @fFound[X];
        //Add Check if already exists... etc...
      end;
    finally
      ScanEnded;
      for X:= 0 to DelaySeconds do Sleep(1000);
    end;
  end;
end;

procedure TNetResourceScanner.BeginScan;
begin
  fBusy:= True;
  if assigned(fOnBegin) then fOnBegin(Self);
  try
    fStop:= False;
    Resume;
  except
    on e: exception do begin

    end;
  end;
end;
    
procedure TNetResourceScanner.ScanEnded;
begin
  fStop:= True; 
  fBusy:= False; 
  Suspend;
  if assigned(fOnEnd) then fOnEnd(Self);
end;

procedure TNetResourceScanner.Added(Resource: PNetResource);
begin
  if assigned(fOnAdd) then fOnAdd(Resource);
end;

function TNetResourceScanner.GetCount: Integer;
begin
  Result:= fItemsCount;
end;

function TNetResourceScanner.GetResource(Index: Integer): PNetResource;
begin
  Result:= @fItems[Index];
end;

procedure TNetResourceScanner.Refresh;
begin
  BeginScan;
end;

procedure TNetResourceScanner.StopScan;
begin
  fStop:= True;
end;

end.

JD Solutions

 

[djjd47130]

I got it working now with the code built into the thread, but I'm back to square one with the problem that the procedure doesn't stop in due time. I thought for a minute that it never stops, but waited a bit and finally it stopped. That makes me think it's the API function(s) which take the actual time.

In other words, I can't stop the thread from going on and on until that API call finally finishes. Unless there's a way to forcefully stop that API call? I have an enum handle, so maybe there's a way to stop any current (time consuming) queries associated with that handle?



JD Solutions

 

[djjd47130]

So, to wrap things up on this thread (and this thread), I have learned...

A) Basics of building a TThread descendent
- Any variables which will be accessed from thread shall be declared in the execution of the thread
- Any external variables which the thread should access shall be synchronized, either...
> by sending messages
> by triggering events
- Thread is expected to complete its full execution

B) Basics of acquiring list of network resources from Windows API
- Creating/freeing API enum handle
- Using handle to query individual resources for details
- Storing resources in an Array

C) Using record pointers
- using PNetResource and PNetResourceArray instead of TNetResource and TNetResourceArray
- using ^ and @

All of the above I am still very sketchy with, and need to learn a lot more.

I'm cleaning up the code right now and will post the final thing soon, except, one little issue - During debug, I get an error when the thread terminates: EPrivilege: "Privileged Instruction"

???


JD Solutions

 

[djjd47130]

As I mentioned, here's the **somewhat** cleaned up code...

{--------------------------------------------------------------}
{ JDNet                                                        }
{ Collection of classes for interacting with the network       }
{  TNetList: TComponent - Provides list of devices on network  }
{  TNetResourceScanner: TThread - Performs scanning of network }
{--------------------------------------------------------------}

unit JDNet;

interface

uses
  Classes, Windows, SysUtils, ShellAPI;

type
  TNetList = class;
  TNetResourceScanner = class;

  TNetScope = (nsConnected, nsGlobalNet, nsRemembered, nsRecent, nsContext);
  TNetResourceType = (nrAny, nrDisk, nrPrint, nrReserved);
  TNetResourceTypes = set of TNetResourceType;
  TNetUsage = (ruConnectable, ruContainer, ruNoLocalDevice, ruSibling,
    ruAttached, ruAll, ruReserved);
  TNetUsages = set of TNetUsage;
  TNetDisplayType = (ndGeneric, ndDomain, ndServer, ndShare, ndFile, ndGroup,
    ndNetwork, ndRoot, ndShareAdmin, ndDirectory, ndTree, ndNDSContainer);
  TNetDisplayTypes = set of TNetDisplayType;
          
  PNetResourceArray = ^TNetResourceArray;
  TNetResourceArray = array[0..100] of TNetResource;

  TNetListEvent = procedure(Sender: TNetList) of object;
  TNetResourceEvent = procedure(Resource: PNetResource) of object;
  TNetCountChange = procedure(Sender: TNetList; OldCount, NewCount: Integer) of object;

  TNetList = class(TComponent)
  private
    //Creating Objects
    fThread: TNetResourceScanner;
    //Variables
    fScope: TNetScope;
    fResourceTypes: TNetResourceTypes;
    fUsages: TNetUsages;
    fDisplayTypes: TNetDisplayTypes;
    //Events
    fOnAdd: TNetResourceEvent;
    fOnBegin: TNetListEvent;
    fOnEnd: TNetListEvent;
    //Property Control
    function GetResource(Index: Integer): TNetResource;
    function GetCount: Integer;
    procedure SetScope(Value: TNetScope);
    procedure SetResourceTypes(Value: TNetResourceTypes);
    procedure SetUsages(Value: TNetUsages);
    procedure SetDisplayTypes(Value: TNetDisplayTypes);
    //Child Event Procedures
    procedure Added(Resource: PNetResource);
    procedure Begun(Sender: TObject);
    procedure Ended(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Refresh: Bool;
    property Resource[Index: Integer]: TNetResource read GetResource;
    property Count: Integer read GetCount;
  published
    property Scope: TNetScope read fScope write SetScope;
    property ResourceTypes: TNetResourceTypes
      read fResourceTypes write SetResourceTypes;
    property Usages: TNetUsages read fUsages write SetUsages;
    property DisplayTypes: TNetDisplayTypes
      read fDisplayTypes write SetDisplayTypes;
    property OnAdd: TNetResourceEvent read fOnAdd write fOnAdd;
    property OnBegin: TNetListEvent read fOnBegin write fOnBegin;
    property OnEnd: TNetListEvent read fOnEnd write fOnEnd;
  end;

  TNetResourceScanner = class(TThread)
  private               
    //Variables
    fItems: PNetResourceArray;
    fBusy: Bool;
    fStop: Bool;
    fItemsCount: DWORD;
    fScope: DWORD;
    fTypes: DWORD;
    fUsages: DWORD;
    fDisplays: DWORD;
    //Events
    fOnAdd: TNetResourceEvent;
    fOnBegin: TNotifyEvent;
    fOnEnd: TNotifyEvent;
    fOnCountChange: TNetCountChange;
    //Property Control
    function GetResource(Index: Integer): PNetResource;
    function GetCount: Integer;
    //Other Methods
    procedure Added(Resource: PNetResource); 
    procedure BeginScan;
    procedure ScanEnded;            
    function CreateNetResourceList(NetResource: PNetResource;
      out List: PNetResourceArray; out Count: DWord): Boolean;
    procedure ScanLevel(NetResource: PNetResource);
  protected
    procedure Execute; override;
  public
    constructor Create;
    destructor Destroy;
    procedure Refresh(Sco, Typ, Usg, Dsp: DWORD);
    procedure StopScan;
    property Busy: Bool read fBusy;  
    property Resources[Index: Integer]: PNetResource read GetResource;
    property Count: Integer read GetCount;
    property OnAdd: TNetResourceEvent read fOnAdd write fOnAdd;
    property OnBegin: TNotifyEvent read fOnBegin write fOnBegin;
    property OnEnd: TNotifyEvent read fOnEnd write fOnEnd;
    property OnCountChange: TNetCountChange
      read fOnCountChange write fOnCountChange;
  end;



  
    
{ Misc. Methods }

function NetResourceTypesToDWord(Types: TNetResourceTypes): DWORD;
function NetDisplayTypesToDWord(Types: TNetDisplayTypes): DWORD;
function NetUsagesToDWord(Usages: TNetUsages): DWORD;
function NetScopeToDWord(Scope: TNetScope): DWORD;




procedure Register;

implementation

{$R JDNet.dcr}

procedure Register;
begin
  RegisterComponents('JD Custom', [TNetList]);
end;





{ Misc. Methods }

function NetScopeToDWord(Scope: TNetScope): DWORD;
begin
  case Scope of
    nsConnected:  Result:= RESOURCE_CONNECTED;
    nsGlobalNet:  Result:= RESOURCE_GLOBALNET;
    nsRemembered: Result:= RESOURCE_REMEMBERED;
    nsRecent:     Result:= RESOURCE_RECENT;
    nsContext:    Result:= RESOURCE_CONTEXT;
  end;
end;

function NetResourceTypesToDWord(Types: TNetResourceTypes): DWORD;
begin
  Result:= DWord(-1);
  if nrAny in Types then begin
    if Result = -1 then
      Result:= RESOURCETYPE_ANY
    else
      Result:= Result or RESOURCETYPE_ANY;
  end;
  if nrDisk in Types then begin   
    if Result = -1 then
      Result:= RESOURCETYPE_DISK
    else
      Result:= Result or RESOURCETYPE_DISK;
  end;
  if nrPrint in Types then begin  
    if Result = -1 then
      Result:= RESOURCETYPE_PRINT
    else
      Result:= Result or RESOURCETYPE_PRINT;
  end;
  if nrReserved in Types then begin   
    if Result = -1 then
      Result:= RESOURCETYPE_RESERVED
    else
      Result:= Result or RESOURCETYPE_RESERVED;
  end;
  if Result = DWord(-1) then Result:= RESOURCETYPE_ANY;
end;

function NetUsagesToDWord(Usages: TNetUsages): DWORD;
begin
  Result:= DWord(-1);
  if ruConnectable in Usages then begin
    if Result = -1 then
      Result:= RESOURCEUSAGE_CONNECTABLE
    else
      Result:= Result or RESOURCEUSAGE_CONNECTABLE;
  end;
  if ruContainer in Usages then begin   
    if Result = -1 then
      Result:= RESOURCEUSAGE_CONTAINER
    else
      Result:= Result or RESOURCEUSAGE_CONTAINER;
  end;
  if ruNoLocalDevice in Usages then begin    
    if Result = -1 then
      Result:= RESOURCEUSAGE_NOLOCALDEVICE
    else
      Result:= Result or RESOURCEUSAGE_NOLOCALDEVICE;
  end;
  if ruSibling in Usages then begin    
    if Result = -1 then
      Result:= RESOURCEUSAGE_SIBLING
    else
      Result:= Result or RESOURCEUSAGE_SIBLING;
  end;
  if ruAttached in Usages then begin   
    if Result = -1 then
      Result:= RESOURCEUSAGE_ATTACHED
    else
      Result:= Result or RESOURCEUSAGE_ATTACHED;
  end;
  if ruAll in Usages then begin     
    if Result = -1 then
      Result:= RESOURCEUSAGE_ALL
    else
      Result:= Result or RESOURCEUSAGE_ALL;
  end;
  if ruReserved in Usages then begin
    if Result = -1 then
      Result:= RESOURCEUSAGE_RESERVED
    else
      Result:= Result or RESOURCEUSAGE_RESERVED;
  end;
  if Result = DWord(-1) then Result:= RESOURCEUSAGE_ALL;
end;

function NetDisplayTypesToDWord(Types: TNetDisplayTypes): DWORD;   
begin
  Result:= DWord(-1);
  if ndGeneric in Types then begin
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_GENERIC
    else
      Result:= Result or RESOURCEDISPLAYTYPE_GENERIC;
  end;
  if ndDomain in Types then begin  
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_DOMAIN
    else
      Result:= Result or RESOURCEDISPLAYTYPE_DOMAIN;
  end;
  if ndServer in Types then begin    
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_SERVER
    else
      Result:= Result or RESOURCEDISPLAYTYPE_SERVER;
  end;
  if ndShare in Types then begin   
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_SHARE
    else
      Result:= Result or RESOURCEDISPLAYTYPE_SHARE;
  end;
  if ndFile in Types then begin    
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_FILE
    else
      Result:= Result or RESOURCEDISPLAYTYPE_FILE;
  end;
  if ndGroup in Types then begin   
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_GROUP
    else
      Result:= Result or RESOURCEDISPLAYTYPE_GROUP;
  end;
  if ndNetwork in Types then begin   
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_NETWORK
    else
      Result:= Result or RESOURCEDISPLAYTYPE_NETWORK;
  end;
  if ndRoot in Types then begin   
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_ROOT
    else
      Result:= Result or RESOURCEDISPLAYTYPE_ROOT;
  end;
  if ndShareAdmin in Types then begin   
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_SHAREADMIN
    else
      Result:= Result or RESOURCEDISPLAYTYPE_SHAREADMIN;
  end;
  if ndDirectory in Types then begin   
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_DIRECTORY
    else
      Result:= Result or RESOURCEDISPLAYTYPE_DIRECTORY;
  end;
  if ndTree in Types then begin   
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_TREE
    else
      Result:= Result or RESOURCEDISPLAYTYPE_TREE;
  end;
  if ndNDSContainer in Types then begin  
    if Result = -1 then
      Result:= RESOURCEDISPLAYTYPE_NDSCONTAINER
    else
      Result:= Result or RESOURCEDISPLAYTYPE_NDSCONTAINER;
  end;
  if Result = DWord(-1) then Result:= RESOURCEDISPLAYTYPE_GENERIC;
end;






{ TNetList }

constructor TNetList.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fThread:= TNetResourceScanner.Create;
    fThread.OnAdd:= Added;
    fThread.OnBegin:= Begun;
    fThread.OnEnd:= Ended;
  fScope:= nsGlobalNet;
  fResourceTypes:= [nrDisk];
  fUsages:= [ruAll];
  fDisplayTypes:= [ndGeneric, ndServer];
end;

destructor TNetList.Destroy;
const
  CMax = 1;
var
  C: Integer;
begin
  if assigned(fThread) then begin
    if fThread.Busy then fThread.StopScan;
    C:= 0;
    while (fThread.Busy) or (C <= CMax) do begin
      Sleep(1000);
      Inc(C);
    end;

    fThread.Terminate;
    C:= 0;
    while (not fThread.Terminated) or (C <= CMax) do begin
      Sleep(1000);
      Inc(C);
    end;
  end;
  if assigned(fThread) then fThread.Free;
  inherited Destroy;
end;

function TNetList.Refresh: Bool;
begin
  Result:= True;
  try

    fThread.Refresh(
      NetScopeToDWord(fScope),
      NetResourceTypesToDWord(fResourceTypes),
      NetUsagesToDWord(fUsages),
      NetDisplayTypesToDWord(fDisplayTypes)
    );
  except
    on e: exception do begin
      Result:= False;
    end;
  end;
end;

function TNetList.GetCount: Integer;
begin
  Result:= fThread.Count;
end;

function TNetList.GetResource(Index: Integer): TNetResource;
begin
  if (Index >= 0) and (Index < fThread.Count) then begin
    Result:= fThread.Resources[Index]^;
  end else begin
    raise Exception.Create('List index out of bounds ('+IntToStr(Index)+')');
  end;
end;

procedure TNetList.Added(Resource: PNetResource);
begin
  if assigned(fOnAdd) then fOnAdd(Resource);
end;

procedure TNetList.Begun(Sender: TObject);
begin
  if assigned(fOnBegin) then fOnBegin(Self);
end;

procedure TNetList.Ended(Sender: TObject);
begin
  if assigned(fOnEnd) then fOnEnd(Self);
end;

procedure TNetList.SetDisplayTypes(Value: TNetDisplayTypes);
begin
  fDisplayTypes:= Value;
end;

procedure TNetList.SetResourceTypes(Value: TNetResourceTypes);
begin
  fResourceTypes:= Value;
end;

procedure TNetList.SetScope(Value: TNetScope);
begin
  fScope:= Value;
end;

procedure TNetList.SetUsages(Value: TNetUsages);
begin
  fUsages:= Value;
end;

{ TNetResourceScanner }

constructor TNetResourceScanner.Create;
begin
  fBusy:= True;
  try
    inherited Create(True);
    FreeOnTerminate:= True;
    Priority:= tpHigher;
    fStop:= True;
  finally
    fBusy:= False;
  end;
end;

destructor TNetResourceScanner.Destroy;
begin
  fStop:= True;
  fBusy:= True;
end;

//The next 2 methods are the 2 found in the original post
//  which I based this off of
function TNetResourceScanner.CreateNetResourceList(NetResource: PNetResource;
  out List: PNetResourceArray; out Count: DWord): Boolean;
var
  Res: DWord;
  Sz: DWord;
  H: THandle;
begin
  Result:= False;
  List:= Nil;
  Count:= 0;
  //Open enum and get handle
  if WNetOpenEnum(fScope, fTypes, fUsages, NetResource, H) = NO_ERROR then
  //if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0,
    //NetResource, H) = NO_ERROR then
  begin
    try
      Sz:= $4000;
      GetMem(List, Sz);
      try
        repeat
          if (fStop) or (Terminated) then begin
            Break;
          end else begin
            Count:= DWord(-1);
            FillChar(List^, Sz, 0);
            //Enum individual resource
            Res:= WNetEnumResource(H, Count, List, Sz);
            if Res = ERROR_MORE_DATA then ReAllocMem(List, Sz);
          end;
        until (Res <> ERROR_MORE_DATA) or (fStop) or (Terminated);
        Result:= Res = NO_ERROR;
        if not Result then begin
          FreeMem(List);
          List:= Nil;
          Count:= 0;
        end;
      except
        raise;
      end;
    finally
      if H > 0 then
        //Close enum by handle
        WNetCloseEnum(H);
      H:= 0;
    end;
  end;
end;

procedure TNetResourceScanner.ScanLevel(NetResource: PNetResource);
var     
  Ent: DWord;
  Lst: PNetResourceArray;
  i: Integer;
begin
  if CreateNetResourceList(NetResource, Lst, Ent) then try
    for i:= 0 to Integer(Ent) - 1 do begin
      if (fStop) or (Terminated) then begin
        Break;
      end else begin
        if Lst[i].dwDisplayType = RESOURCEDISPLAYTYPE_SERVER then
          if assigned(fOnAdd) then fOnAdd(@Lst[i]);
      end;
      if (fStop) or (Terminated) then begin
        Break;
      end else begin
        if (Lst[i].dwUsage and RESOURCEUSAGE_CONTAINER) <> 0 then
          ScanLevel(@Lst[i]);
      end;
    end;
  finally
    FreeMem(Lst);
  end;
end;

procedure TNetResourceScanner.Execute;
const
  DelaySeconds = 60;
var
  X: Integer;
  R: PNetResource;
begin
  inherited;
  while (not Terminated) and (not fStop) do begin
    try

      ScanLevel(nil);

    finally
      ScanEnded;
      for X:= 0 to DelaySeconds do Sleep(1000);
    end;
  end;
end;

procedure TNetResourceScanner.BeginScan;
begin
  fBusy:= True;
  if assigned(fOnBegin) then fOnBegin(Self);
  try
    fStop:= False;
    Resume;
  except
    on e: exception do begin

    end;
  end;
end;
    
procedure TNetResourceScanner.ScanEnded;
begin
  fStop:= True; 
  fBusy:= False; 
  Suspend;
  if assigned(fOnEnd) then fOnEnd(Self);
end;

procedure TNetResourceScanner.Added(Resource: PNetResource);
begin
  if assigned(fOnAdd) then fOnAdd(Resource);
end;

function TNetResourceScanner.GetCount: Integer;
begin
  Result:= fItemsCount;
end;

function TNetResourceScanner.GetResource(Index: Integer): PNetResource;
begin
  Result:= @fItems[Index];
end;

procedure TNetResourceScanner.Refresh(Sco, Typ, Usg, Dsp: DWORD);
begin
  fScope:= Sco;
  fTypes:= Typ;
  fUsages:= Usg;
  fDisplays:= Dsp;
  BeginScan;
end;

procedure TNetResourceScanner.StopScan;
begin
  fStop:= True;
end;

end.

JD Solutions