Rede - reconectar drives desconectados pelo windows

Top  Previous  Next

// reconectar drives de redes perdidos

 

{

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. 

Answer:

 

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..200of 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