delphi 一个很有用的共享连接网络工具|笨鱼技术网

Problem/Question/Abstract:

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