unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, ExtCtrls;

type
 TService1 = class(TService)
   procedure ServiceStart(Sender: TService; var Started: Boolean);
   procedure ServiceStop(Sender: TService; var Stopped: Boolean);
 private
   { Private declarations }
 public
   function GetServiceController: TServiceController; override;
   { Public declarations }
 end;

 TShareMonThread = class(TThread)
 private
   Timer:TTimer;
 protected
   procedure Execute; override;
 public
   procedure OnTimer(Sender: TObject);
   procedure ShareMon;
 end;

 TFileInfo3 = packed record
  fi3_id          : DWORD;
  fi3_permissions : DWORD;
  fi3_num_locks   : DWORD;
  fi3_pathname    : PWChar;
  fi3_username    : PWChar;
 end;
 PFileInfo3 = ^TFileInfo3;
 TFileInfo3Array = array[0..512] of TFileInfo3;
 PFileInfo3Array = ^TFileInfo3Array;

var
 Service1: TService1;
 FLibHandle : THandle;
 ShareMonThread:TShareMonThread;
 NetFileEnumNT:function( servername, basepath, username : PWChar; level  : DWORD; bufptr  : Pointer; prefmaxlen : DWORD; entriesread, totalentries, resume_handle : LPDWORD):DWORD; stdcall;

implementation

{$R *.DFM}

procedure TShareMonThread.OnTimer(Sender: TObject);
begin
 if ShareMonThread<>nil then
   ShareMonThread.Execute;
end;

procedure TShareMonThread.Execute;
begin
 ShareMon;
end;

procedure TShareMonThread.ShareMon;
var
 fs:TFileStream;
 sl:TStringList;
 FileInfoNT: PFileInfo3Array;
 TotalEntries,EntriesReadNT: DWORD;
 i:integer;
begin
 FileInfoNT := nil;
 sl:=TStringList.Create;
 fs:=TFileStream.Create('D:\test.txt',fmOpenReadWrite);
 fs.Seek(0,soFromEnd);
 if NetFileEnumNT(nil,nil,nil,3,@FileInfoNT,DWORD(-1),@entriesreadNT, @totalentries, nil)=0 then
   for i:=0 to EntriesReadNT-1 do
     sl.Add(FileInfoNT^[i].fi3_username + #9#9 +FileInfoNT^[i].fi3_pathname);
 sl.SaveToStream(fs);
 fs.Free;
end;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
 Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
 Result := ServiceController;
end;

procedure TService1.ServiceStart(Sender: TService; var Started: Boolean);
begin
 FLibHandle := LoadLibrary('NETAPI32.DLL');
 if FLibHandle = 0 then
 begin
   Started:=false;
   Exit;
 end;
 @NetFileEnumNT := GetProcAddress(FLibHandle, 'NetFileEnum');
 if not Assigned(NetFileEnumNT) then
 begin
   FreeLibrary(FLibHandle);
   Started:=false;
   Exit;
 end;
 ShareMonThread:=TShareMonThread.Create(false);
 ShareMonThread.Timer:=TTimer.Create(self);
 ShareMonThread.Timer.OnTimer :=ShareMonThread.OnTimer;
end;

procedure TService1.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
 ShareMonThread.Timer.Enabled:=False;
 ShareMonThread.Timer.Free;
 ShareMonThread.Terminate;
 ShareMonThread.Free;
 FreeLibrary(FLibHandle);
end;

end.

procedure TForm1.Button1Click(Sender: TObject);
var
 FileInfoNT: PFileInfo3Array;
 TotalEntries,EntriesReadNT: DWORD;
 i:integer;
begin
for i:= 0 to 1000 do
 NetFileEnumNT(nil,nil,nil,3,@FileInfoNT,DWORD(-1),@entriesreadNT, @totalentries, nil)
end;