Sharing and Unsharing a folder with Delphi

Navegando por internet no he encontrado una buena unit con toda la informaciĆ³n necesaria para compartir y descompartir carpetas utilizando la librerĆ­a netapi32.dll del SO. Recopilando informaciĆ³n de varias webs, he conseguido crear una pequeƱa librerĆ­a bastante Ćŗtil que nos permitirĆ” compartir y descompartir las carpetas que queramos a partir de unas funciones muy sencillas sin tener que manejar las complicadas NetShareAdd y NetShareDel.
A partir de aquƭ, podremos crear pequeƱas aplicaciones para que manipulen los diferentes directorios que queremos compartir. No he probado las funciones para unidades asƭ que no se si funcionarƭa, pero si que lo hace con las carpetas. AdemƔs del conocimiento de las diferentes funciones que dispone netapi32.dll, hay que crear la estructura SHARE_INFO_2 con la que hay que trabajar para poder compartir una carpeta.


unit uNetShare;

interface

uses
SysUtils, Windows;

type
SHARE_INFO_2 = record
shi2_netname: LPWSTR;
shi2_type: DWORD;
shi2_remark: LPWSTR;
shi2_permissions: DWORD;
shi2_max_uses: DWORD;
shi2_current_uses: DWORD;
shi2_path: LPWSTR;
shi2_passwd: LPWSTR;
end;
PSHARE_INFO_2 = ^SHARE_INFO_2;

const
STYPE_DISKTREE = 0;
STYPE_PRINTQ = 1;
STYPE_DEVICE = 2;
STYPE_IPC = 3;
STYPE_DFS = 100;
STYPE_SPECIAL = $80000000;

ACCESS_NONE = 0;
ACCESS_READ = 1;
ACCESS_WRITE = 2;
ACCESS_CREATE = 4;
ACCESS_EXEC = 8;
ACCESS_DELETE = 16;
ACCESS_ATRIB = 32;
ACCESS_PERM = 64;
ACCESS_ALL = (ACCESS_READ + ACCESS_WRITE + ACCESS_CREATE + ACCESS_EXEC + ACCESS_DELETE + ACCESS_ATRIB + ACCESS_PERM);

function UnshareFolder(sName: string): boolean;
procedure ShareFolder(StrName: string);
function getNetName(sFolder: string): string;

implementation

uses
StrUtils;

function NetShareAdd(servername: LPWSTR; level: DWORD; buf: pSHARE_INFO_2; parm_err: LPDWORD): LongWord; stdcall; external 'netapi32.dll';
function NetShareDel(ServerName, ShareName: pwChar; level: DWord): DWord; stdcall; external 'NETAPI32.DLL';

function UnshareFolder(sName: string): boolean;
var
Size: Integer;
rep: LongInt;
NameNT: PWChar;
ret : Boolean;
begin
ret := false;
if DirectoryExists(sName) then
begin
Size := SizeOf(WideChar) * 256;
GetMem(NameNT, Size);
StringToWideChar(getNetName(sName), NameNT, Size);
rep := NetShareDel(nil, NameNT, 0);
if rep = 0 then
ret := True
else
ret := false;
end;
Result := ret;
end;

procedure ShareFolder(StrName: string);
var
buf: Pointer;
UserInf: Share_INFO_2;
err: lpdword;
F: integer;
begin
err := nil;
if DirectoryExists(strName) then
begin
UserInf.shi2_netname := StringToOleStr(getNetName(strName));
UserInf.shi2_type := STYPE_DISKTREE;
UserInf.shi2_remark := '';
UserInf.shi2_permissions := ACCESS_ALL;
//UserInf.shi2_max_uses := -1;
UserInf.shi2_current_uses := 0;
UserInf.shi2_path := StringToOleStr(StrName);
UserInf.shi2_passwd := nil;
GetMem(Buf, sizeof(UserInf));
F := NetSHAREAdd(nil, 2, @UserInf, err);
FreeMem(Buf);
end;
end;

function getNetName(sFolder: string): string;
var
ipos, i: integer;
sTemp: string;
begin
ipos := 0;
for i := 1 to Length(sFolder) do
if sFolder[Length(sFolder)-i] = '\' then
begin
iPos := Length(sFolder)-i;
break;
end;
stemp := AnsiRightStr(sFolder, Length(sFolder) - ipos);
result := sTemp;
end;

end.



La utilizaciĆ³n de las funciones es muy simple:


ShareFolder('C:\temp');
UnshareFolder('C:\temp');


Ɖstos mĆ©todos funcionaran en versiones superiores de windows NT, pero no lo he probado en windows Vista, solo en windows Xp.
  • Enlaces y fuentes de interĆ©s:
is Folder shared?.
Compartir carpetas en windows.
Network share problem.
Using NetShareDel.
Using NetShareAdd.
Window Share functions.

Comments

Popular Posts