Mega Code Archive
Reconnecting to network shares with the use of a component
<![CDATA[
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.
]]>