Reconnecting to Network Shares with the use of a component

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.

 

Share this article!

Follow us!

Find more helpful articles: