Author: Vassilis Perantzakis
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.
1 unit Reconnect;
2
3 interface
4
5 uses
6 Windows, Messages, StdCtrls, SysUtils, Classes, Graphics, Controls, Forms,
7 Dialogs,
8 FileCtrl;
9
10 type
11 TSIsType = (itDir, itIniFile, itApp, itOther);
12 TBeforeConnectEvent = procedure(Owner: TObject; AssignPath: string; var Accept:
13 boolean) of object;
14 TAfterConnectEvent = procedure(Owner: TObject; AssignedPath: string) of object;
15 TOnFail = procedure(Owner: TObject; FailMessage: string) of object;
16 TReconnect = class(TComponent)
17 private
18 { Private declarations }
19 DidAssign: boolean;
20 FItemToLookFor: string;
21 FUserName: string;
22 FPassword: string;
23 FLetterToAssign: Char;
24 FIsType: TSIsType;
25 FOutputLabel: TLabel;
26 FFailMessage: string;
27 FBeforeConnect: TBeforeConnectEvent;
28 FAfterConnect: TAfterConnectEvent;
29 FOnFail: TOnFail;
30 function DoEnum(NetResT: PNetResourceA): integer;
31 function addbs(g: string): string; overload;
32 function addbs(g: string; SLASH: CHAR): string; overload;
33 function SearchFor(NetResT: NETRESOURCE; Path, param: string): boolean;
34 protected
35 { Protected declarations }
36 public
37 { Public declarations }
38 published
39 { Published declarations }
40 function SearchAndAssign: boolean;
41 property ItemToLookFor: string read FItemToLookFor write FItemToLookFor;
42 property LetterToAssign: Char read FLetterToAssign write FLetterToAssign;
43 property IsType: TSIsType read FIsType write FIsType default itDir;
44 property OutputLabel: TLabel read FOutputLabel write FOutputLabel;
45 property UserName: string read FUserName write FUserName;
46 property Password: string read FPassword write FPassword;
47 property BeforeConnect: TBeforeConnectEvent read FBeforeConnect write
48 FBeforeConnect;
49 property AfterConnect: TAfterConnectEvent read FAfterConnect write
50 FAfterConnect;
51 property OnFail: TOnFail read FOnFail write FOnFail;
52 end;
53
54 procedure register;
55
56 implementation
57
58 function TReconnect.addbs(g: string; SLASH: CHAR): string;
59 begin
60 g := trim(g);
61 if g <> '' then
62 begin
63 if g[length(g)] <> SLASH then
64 result := g + SLASH
65 else
66 result := g;
67 end
68 else
69 result := g;
70 end;
71
72 function TReconnect.addbs(g: string): string;
73 begin
74 result := addbs(g, '\');
75 end;
76
77 function TReconnect.SearchFor(NetResT: NETRESOURCE; Path, param: string): boolean;
78 var
79 cont: boolean;
80 Exists: boolean;
81 begin
82 Exists := false;
83 path := addbs(path);
84 SearchFor := false;
85 if IsType = itDir then
86 Exists := directoryExists(path + param);
87 if IsType = itIniFile then
88 Exists := FileExists(path + param);
89 if IsType = itApp then
90 Exists := FileExists(path + param);
91 if IsType = itOther then
92 Exists := FileExists(path + param);
93 if Exists then
94 begin
95 cont := true;
96 try
97 if assigned(FBeforeConnect) then
98 BeforeConnect(self, path, cont);
99 except
100 showmessage('Failed to call BeforeConnect.');
101 end;
102 if cont then
103 begin
104 try
105 NetResT.lpLocalName := pchar(string(FLetterToAssign) + ':');
106 WNetAddConnection2A(NetResT, pchar(UserName), pchar(Password),
107 CONNECT_UPDATE_PROFILE);
108 DidAssign := true;
109 try
110 if assigned(FAfterConnect) then
111 AfterConnect(self, path);
112 except
113 showmessage('Failed to call AfterConnect.');
114 end;
115 except on E: Exception do
116 Showmessage(E.message);
117 end;
118 SearchFor := true;
119 end;
120 end;
121 end;
122
123 function TReconnect.DoEnum(NetResT: PNetResourceA): integer;
124 var
125 EnumH: THandle;
126 cnt: cardinal;
127 buffsize: cardinal;
128 NetResBuf: array[0..200] of NETRESOURCE;
129 res: word;
130 i: integer;
131 begin
132 if DidAssign then
133 exit;
134 try
135 cnt := 255;
136 WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK, 0, NetResT, EnumH);
137 res := 0;
138 while (res = NO_ERROR) do
139 begin
140 buffsize := sizeof(NetResBuf);
141 res := WNetEnumResource(EnumH, cnt, @NetResBuf, buffsize);
142 for i := 0 to cnt - 1 do
143 begin
144 if Assigned(OutputLabel) then
145 begin
146 OutputLabel.Caption := NetResBuf[i].lpRemoteName;
147 OutputLabel.Refresh;
148 end;
149 if NetResBuf[i].dwDisplayType = RESOURCEDISPLAYTYPE_SHARE then
150 begin
151 if not DidAssign then
152 if SearchFor(NetResBuf[i], string(NetResBuf[i].lpRemoteName),
153 ItemToLookFor) then
154 begin
155 result := 0;
156 exit;
157 end;
158 end;
159 if (NetResBuf[i].dwScope = RESOURCEUSAGE_CONTAINER) then
160 doEnum(@NetResBuf[i]);
161 end;
162 end;
163 WNetCloseEnum(EnumH);
164 result := 1;
165 except on E: Exception do
166 begin
167 FFailMessage := E.message;
168 if Assigned(FOnFail) then
169 OnFail(Owner, FFailMessage);
170 result := 0;
171 end;
172 end;
173 end;
174
175 function TReconnect.SearchAndAssign: boolean;
176 begin
177 DidAssign := false;
178 DoEnum(nil);
179 result := true;
180 end;
181
182 procedure register;
183 begin
184 RegisterComponents('VNPVcls', [TReconnect]);
185 end;
186
187 end.
|
