Ever lost a networked share and didn't know how to connect to it?
Well with this component you can search the network for a specific share containing a file or a directory and automatically reconnect to it.

NOTE: IF YOU ALLREADY KNOW THE LOCATION OF THE SHARE YOU SHOULDN'T USE THIS COMPONENT AS IN LARGE NETWORKS WILL BE SLOW. THIS IS ONLY IF YOU DON'T KNOW THE EXACT LOCATION BUT CAN LOCATE IT BY USING A MARKER SUCH AS A SPECIFIC FILE OR FOLDER.

TIP: Use the BeforeConnect Event to specify whether a connection should be made.

unit Reconnect;

interface

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

type
  TSIsType=(itDir,itIniFile,itApp,itOther);
  TBeforeConnectEvent=procedure(Owner:TObject;AssignPath:string;var Accept:boolean) of object;
  TAfterConnectEvent=procedure(Owner:TObject;AssignedPath:string) of object;
  TOnFail=procedure(Owner:TObject;FailMessage:string) of object;
  TReconnect = class(TComponent)
  private
    { Private declarations }
    DidAssign:boolean;
    FItemToLookFor:String;
    FUserName:String;
    FPassword:String;
    FLetterToAssign:Char;
    FIsType:TSIsType;
    FOutputLabel:TLabel;
    FFailMessage:String;
    FBeforeConnect:TBeforeConnectEvent;
    FAfterConnect:TAfterConnectEvent;
    FOnFail:TOnFail;
    function DoEnum(NetResT:PNetResourceA):integer;
    function addbs(g:string):string;OVERLOAD;
    function addbs(g:string;SLASH:CHAR):string;OVERLOAD;
    function SearchFor(NetResT:NETRESOURCE;Path,param:string):boolean;
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
    function SearchAndAssign:boolean;
    property ItemToLookFor:String read FItemToLookFor write FItemToLookFor;
    property LetterToAssign:Char read FLetterToAssign write FLetterToAssign;
    property IsType:TSIsType read FIsType write FIsType default itDir;
    property OutputLabel:TLabel read FOutputLabel write FOutputLabel;
    property UserName:String read FUserName write FUserName;
    property Password:String read FPassword write FPassword;
    property BeforeConnect:TBeforeConnectEvent read FBeforeConnect write FBeforeConnect;
    property AfterConnect:TAfterConnectEvent read FAfterConnect write FAfterConnect;
    property OnFail:TOnFail read FOnFail write FOnFail;
  end;


procedure Register;

implementation


Function TReconnect.addbs(g:string;SLASH:CHAR):string;
begin
  g:=trim(g);
  if g<>''
  then begin
    if g[length(g)]<>SLASH
    then result:=g+SLASH
    else result:=g;
  end
  else result:=g;
end;

function TReconnect.addbs(g:string):string;
begin
result:=addbs(g,'\');
end;

function TReconnect.SearchFor(NetResT:NETRESOURCE;Path,param:string):boolean;
var
  cont:boolean;
  Exists:boolean;
begin
  Exists:=false;
  path:=addbs(path);
  SearchFor:=false;
  if IsType=itDir then
    Exists:=directoryExists(path+param);
  if IsType=itIniFile then
    Exists:=FileExists(path+param);
  if IsType=itApp then
    Exists:=FileExists(path+param);
  if IsType=itOther then
    Exists:=FileExists(path+param);
  if Exists then
    begin
      cont:=true;
      try
      if assigned(FBeforeConnect) then
        BeforeConnect(self,path,cont);
      except
        showmessage('Failed to call BeforeConnect.');
      end;
      if cont then
        begin
          try
          NetResT.lpLocalName:=pchar(string(FLetterToAssign)+':');
          WNetAddConnection2A(NetResT,pchar(UserName),pchar(Password),CONNECT_UPDATE_PROFILE);
          DidAssign:=true;
            try
            if assigned(FAfterConnect) then
              AfterConnect(self,path);
            except
              showmessage('Failed to call AfterConnect.');
            end;
          except on E: Exception do
            Showmessage(E.Message);
          end;
          SearchFor:=true;
        end;
    end;
end;

function TReconnect.DoEnum(NetResT:PNetResourceA):integer;
var
  EnumH:THandle;
  cnt:cardinal;
  buffsize:cardinal;
  NetResBuf:array [0..200] of NETRESOURCE;
  res:word;
  i:integer;
begin
  if DidAssign then
    exit;
  try
  cnt:=255;
  WNetOpenEnum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,0,NetResT,EnumH);
  res:=0;
  while (res=NO_ERROR) do
    begin
      buffsize:=sizeof(NetResBuf);
      res:=WNetEnumResource(EnumH,cnt,@NetResBuf,buffsize);
      for i:=0 to cnt-1 do
         begin
           if Assigned(OutputLabel) then
             begin
               OutputLabel.Caption:=NetResBuf[i].lpRemoteName;
               OutputLabel.Refresh;
             end;
           if NetResBuf[i].dwDisplayType=RESOURCEDISPLAYTYPE_SHARE then
             begin
               if not DidAssign then
                 if SearchFor(NetResBuf[i],string(NetResBuf[i].lpRemoteName),ItemToLookFor) then
                   begin
                     result:=0;
                     exit;
                   end;
             end;
           if (NetResBuf[i].dwScope=RESOURCEUSAGE_CONTAINER) then
        doEnum(@NetResBuf[i]);
        end;
    end;
  WNetCloseEnum(EnumH);
  result:=1;
  except on E: Exception do
    begin
      FFailMessage:=E.Message;
      if Assigned(FOnFail) then
        OnFail(Owner,FFailMessage);
      result:=0;
    end;
  end;
end;

function TReconnect.SearchAndAssign:boolean;
begin
  DidAssign:=false;
  DoEnum(nil);
  result:=true;
end;

procedure Register;
begin
  RegisterComponents('VNPVcls', [TReconnect]);
end;

end.