Aldo
18-01-2007, 13:15:36
Hola a todos:
Estoy trabajando en Delphi 5 y tengo una DLL que entre otras cosas tiene una función que se encarga de Compartir directorios de Windows. El problema es que esta dll lleva escrita aproximadamente unos 3 o 4 años y siempre funcionó correctamente cuando era llamada desde el InstallShield para compartir unos determinados directorios durante la instalación de una aplicación y a partir de un tiempo a esta parte no está funcionando ( solamente que se haya confirmado en los Windows XP ). En Windows ( 2000 y 2003 ) "funciona correctamente".
El entrecomillado está porque no es del todo cierto. Os Explico. Cuando utilizo la función de compartir directorio ( de la misma dll ) desde un programa de testeo, se comparte correctamente el directorio, de hecho, pone correctamente el nombre del recurso compartido, así como su comentario y después cuando se está en MiPC ojeando las carpetas, se aprecia la manito sobre la carpeta como señal de que la misma está compartida ( esto en todos los Sistemas Operativos de Windows, incluyendo XP ) .
Si la misma función de la misma DLL la llamo desde el InstallShield ( ahora viene lo sorprendente ). No comparte la carpeta como antes he explicado, la mano no está visible sobre la carpeta, y si se presiona el botón derecho del ratón sobre la carpeta y se va a la opción Compartir del menú emergente, la carpeta tampoco aparece compartida. PERO si se trata de ojear la red desde otro ordenador la carpeta compartida aparece como un recurso de red compartido y se puede acceder a esa carpeta inclusive copiando ficheros en ella o eliminando alguno de los que allí hayan. IMPORTANTE Esto no lo hace en Windows XP y es el motivo de pediros vuestra ayuda, si me podeís recomendar algo para saber como afrontar el problema.
El código fuente es el siguiente :
function CompartirDirectorio(Dir,Nombre,Comentario:PChar):Integer;
var
Flags : Word;
Err : Integer;
SR : TSharedResource;
begin
Result:=-1;
SR:=TSharedResource.Create(nil);
try
SR.ServerName:='';
SR.ShareName := string(Nombre);
SR.ResourcePath := string(Dir);
SR.Comment := string(Comentario);
SR.ReadOnlyPassword := '';
SR.ReadWritePassword := '';
SR.MaxConnections := SHI_USES_UNLIMITED;
SR.PersistShare := True;
SR.SystemShare := True;
SR.ResourceType := RTFolder;
SR.AccessType:=ATFull;
SR.NTAccessPermissions:=[NT_Read, NT_Write, NT_Create, NT_Execute, NT_Delete,
NT_Attrib, NT_Permissions, NT_All];
SR.UnShare; // Por si ya existía
SR.Share;
Result:=0;
finally
SR.Free;
end;
end;
Donde:
unit SharedResource;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShareConst;
type
TResType = (RTFolder, RTPrinter, RTDevice, RTIPC);
TAccessType = (ATReadOnly, ATFull, ATDepends);
TErrorEvent = Procedure(ErrorCode : Integer; ErrorString : String) of object;
TNTAccessType = (NT_Read, NT_Write, NT_Create, NT_Execute, NT_Delete,
NT_Attrib, NT_Permissions, NT_All);
TNTAccessOptions = set of TNTAccessType;
TSharedResource = class(TComponent)
private
_AccessType : Word;
_Comment : String;
_CurrentConnections : Integer;
_MaxConnections : Integer;
_NTAccessPermissions : TNTAccessOptions;
_NTPermissions : Integer;
_PersistShare : Boolean;
_ReadOnlyPassword : String;
_ReadWritePassword : String;
_ResourcePath : String;
_ResourceType : Byte;
_ServerName : String;
_ShareName : String;
_SystemShare : Boolean;
ErrorEvent : TErrorEvent;
DLLHandle : THandle;
IsNT : Boolean; {Are we in Win9x, or NT? Set by constructor.}
NTNetShareAdd : function(ServerName : PChar; ShareLevel : Integer; Buffer : Pointer; Error : PLongword) : Integer; StdCall;
NTNetShareDel : function(ServerName : PChar; NetName : PChar; Reserved : Integer) : Integer; StdCall;
NTNetShareGetInfo : function(ServerName : PChar; NetName : PChar; ShareLevel : SmallInt; Buffer : Pointer) : Integer; StdCall;
NetShareAdd : function(ServerName : PChar; ShareLevel : SmallInt; Buffer : Pointer; Size : Word) : Integer; StdCall;
NetShareDel : function(ServerName : PChar; NetName : PChar; Reserved : Word) : Integer; StdCall;
NetShareGetInfo : function(ServerName : PChar; NetName : PChar; ShareLevel : SmallInt; Buffer : Pointer; Size : Word; Var Used : Word) : Integer; StdCall;
NTNetApiBufferFree : function(Buffer : Pointer) : Integer; StdCall;
function GetAccessType : TAccessType;
function GetResourceType : TResType;
procedure SetAccessType(ToWhat : TAccessType);
procedure SetComment(ToWhat : String);
procedure SetNTAccessPermissions(ToWhat : TNTAccessOptions);
procedure SetReadOnlyPassword(ToWhat : String);
procedure SetReadWritePassword(ToWhat : String);
procedure SetResourceType(ToWhat : TResType);
procedure SetResPath(ToWhat : String);
procedure SetServerName(ToWhat : String);
procedure SetShareName(ToWhat : String);
protected
public
constructor Create(Owner : TComponent); override;
destructor Destroy; override;
function IsShared : Boolean;
function LoadShareInfo(ServerName : String; NetName : String) : Integer;
function Share : Integer;
function Unshare : Integer;
function Update : Integer;
published
property AccessType : TAccessType read GetAccessType write SetAccessType default ATReadOnly;
property Comment : String read _Comment write SetComment;
property CurrentConnections : Integer read _CurrentConnections;
property MaxConnections : Integer read _MaxConnections write _MaxConnections;
property NTAccessPermissions : TNTAccessOptions read _NTAccessPermissions write SetNTAccessPermissions;
property PersistShare : Boolean read _PersistShare write _PersistShare default false;
property ReadOnlyPassword : String read _ReadOnlyPassword write SetReadOnlyPassword;
property ReadWritePassword : String read _ReadWritePassword write SetReadWritePassword;
property ResourcePath : String read _ResourcePath write SetResPath;
property ResourceType : TResType read GetResourceType write SetResourceType default RTFolder;
property ServerName : String read _ServerName write SetServerName;
property ShareName : String read _ShareName write SetShareName;
property SystemShare : Boolean read _SystemShare write _SystemShare default false;
property OnError : TErrorEvent read ErrorEvent write ErrorEvent;
end;
procedure Register;
implementation
constructor TSharedResource.Create(Owner : TComponent);
var verInfo : _OSVERSIONINFOA;
begin
inherited;
{Initialize Stuff!}
DLLHandle := 0;
IsNT := False;
_AccessType := SHI50F_RDONLY;
_Comment := '';
_CurrentConnections := 0;
_MaxConnections := -1;
_NTAccessPermissions := [NT_Read];
_NTPermissions := ACCESS_READ;
_PersistShare := True;
_ReadOnlyPassword := '';
_ReadWritePassword := '';
_ResourcePath := '';
_ResourceType := STYPE_DISKTREE;
_ServerName := '';
_ShareName := '';
_SystemShare := False;
{Make sure we only load the libaries on runtime.}
{Here we dynamically load the networking functions we need.
The Library handle will be freed in the destructor.}
if not(csDesigning in ComponentState) then
begin
verInfo.dwOSVersionInfoSize := sizeOf(_OSVERSIONINFOA);
{See if we're running 9x or NT}
GetVersionEx(verInfo);
If (verInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) then
IsNT := True;
If IsNT then
begin
DLLHandle := LoadLibrary(PChar('NETAPI32.DLL')); {Try Loading the WinNT library}
If (DLLHandle > 0) then
begin
{Aaugh! NT takes different paramters than 9x! :) }
@NTNetShareAdd := GetProcAddress(DLLHandle, PChar('NetShareAdd'));
@NTNetShareDel := GetProcAddress(DLLHandle, PChar('NetShareDel'));
@NTNetShareGetInfo := GetProcAddress(DLLHandle, PChar('NetShareGetInfo'));
@NTNetApiBufferFree := GetProcAddress(DLLHandle, PChar('NetApiBufferFree'));
end;
end
else
begin
DLLHandle := LoadLibrary(PChar('SVRAPI.DLL'));{Try Loading the Win9x library}
If (DLLHandle > 0) then
begin
@NetShareAdd := GetProcAddress(DLLHandle, PChar('NetShareAdd'));
@NetShareDel := GetProcAddress(DLLHandle, PChar('NetShareDel'));
@NetShareGetInfo := GetProcAddress(DLLHandle, PChar('NetShareGetInfo'));
end;
end;
end;
end;
destructor TSharedResource.Destroy;
begin
{Make sure we only unload the libaries on runtime.}
if not(csDesigning in ComponentState) then
If (DLLHandle > 0) then
FreeLibrary(DLLHandle);
inherited;
end;
function TSharedResource.IsShared : Boolean;
var PMyNTShare : ^Share_Info2;
PMyShare : ^Share_Info50;
AmountUsed : Word;
Err : Integer;
begin
Result := False;
If (DLLHandle <= 0) Then
begin
If Assigned(OnError) then OnError(NERR_DLLNotLoaded,GetNetErrorString(NERR_DLLNotLoaded))
end
else if IsNT then
begin
PMyNTShare := Nil;
Err := NTNetShareGetInfo(PChar(WideString(_ServerName)),PChar(WideString(_ShareName)),2,@PMyNTShare);
If Err = 0 Then Result := True;
If (PMyNTShare <> nil) then NTNetApiBufferFree(PMyNTShare);
end
else
begin
PMyShare := AllocMem(512);
Err := NetShareGetInfo(PChar(_ServerName),PChar(_ShareName),50,PMyShare,512,AmountUsed);
If Err = 0 Then Result := True;
FreeMem(PMyShare);
end;
end;
function TSharedResource.LoadShareInfo(ServerName : String; NetName : String) : Integer;
var PMyNTShare : ^Share_Info2;
PMyShare : ^Share_Info50;
AmountUsed : Word;
Err : Integer;
begin
If (DLLHandle <= 0) Then
begin
If Assigned(OnError) then OnError(NERR_DLLNotLoaded,GetNetErrorString(NERR_DLLNotLoaded));
Result := NERR_DLLNotLoaded;
end
else if IsNT then
begin
PMyNTShare := Nil;
Err := NTNetShareGetInfo(PChar(WideString(UpperCase(ServerName))),PChar(WideString(UpperCase(NetName))),2,@ PMyNTShare);
If Err = 0 Then
Begin
_ServerName := ServerName;
_ShareName := PMyNTShare.shi2_netname;
_ResourceType := PMyNTShare.shi2_type;
If (PMyNTShare.shi2_permissions and ACCESS_ALL) = ACCESS_ALL then
_NTAccessPermissions := _NTAccessPermissions + [NT_All];
If (PMyNTShare.shi2_permissions and ACCESS_READ) = ACCESS_READ then
_NTAccessPermissions := _NTAccessPermissions + [NT_Read];
If (PMyNTShare.shi2_permissions and ACCESS_WRITE) = ACCESS_WRITE then
_NTAccessPermissions := _NTAccessPermissions + [NT_Write];
If (PMyNTShare.shi2_permissions and ACCESS_CREATE) = ACCESS_CREATE then
_NTAccessPermissions := _NTAccessPermissions + [NT_Create];
If (PMyNTShare.shi2_permissions and ACCESS_EXEC) = ACCESS_EXEC then
_NTAccessPermissions := _NTAccessPermissions + [NT_Execute];
If (PMyNTShare.shi2_permissions and ACCESS_DELETE) = ACCESS_DELETE then
_NTAccessPermissions := _NTAccessPermissions + [NT_Delete];
If (PMyNTShare.shi2_permissions and ACCESS_ATRIB) = ACCESS_ATRIB then
_NTAccessPermissions := _NTAccessPermissions + [NT_Attrib];
If (PMyNTShare.shi2_permissions and ACCESS_PERM) = ACCESS_PERM then
_NTAccessPermissions := _NTAccessPermissions + [NT_Permissions];
_CurrentConnections := PMyNTShare.shi2_current_uses;
_MaxConnections := PMyNTShare.shi2_max_uses;
_Comment := PMyNTShare.shi2_remark;
_ResourcePath := PMyNTShare.shi2_path;
_ReadOnlyPassword := PMyNTShare.shi2_passwd;
_ReadWritePassword := PMyNTShare.shi2_passwd;
End
else
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
If (PMyNTShare <> nil) then NTNetApiBufferFree(PMyNTShare);
Result := Err;
end
else
begin
PMyShare := AllocMem(512);
Err := NetShareGetInfo(PChar(UpperCase(ServerName)),PChar(UpperCase(NetName)),50,PMyShare,512,AmountUsed);
If Err = 0 Then
Begin
_ServerName := ServerName;
_ShareName := PMyShare.shi50_netname;
_ResourceType := PMyShare.shi50_type;
If (PMyShare.shi50_flags and SHI50F_DEPENDSON) = SHI50F_DEPENDSON then _AccessType := SHI50F_DEPENDSON
Else If (PMyShare.shi50_flags and SHI50F_RDONLY) = SHI50F_RDONLY then _AccessType := SHI50F_RDONLY
Else If (PMyShare.shi50_flags and SHI50F_FULL) = SHI50F_FULL then _AccessType := SHI50F_FULL;
_PersistShare := ((PMyShare.shi50_flags and SHI50F_PERSIST) = SHI50F_PERSIST);
_SystemShare := ((PMyShare.shi50_flags and SHI50F_SYSTEM) = SHI50F_SYSTEM);
_Comment := PMyShare.shi50_remark;
_ResourcePath := PMyShare.shi50_path;
_ReadOnlyPassword := PMyShare.shi50_ro_password;
_ReadWritePassword := PMyShare.shi50_rw_password;
End
else
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
FreeMem(PMyShare);
Result := Err;
end;
end;
function TSharedResource.Share : Integer;
var MyShare : Share_Info50;
PMyShare : ^Share_Info50;
MyNTShare : Share_Info2;
PMyNTShare : ^Share_Info2;
Err : Integer;
ErrNum : Integer;
MyFlags : Word;
MyName, MyComment, MyPath, MyPW : WideString;
begin
Err := NERR_Success;
If (DLLHandle <= 0) Then
begin
If Assigned(OnError) then OnError(NERR_DLLNotLoaded,GetNetErrorString(NERR_DLLNotLoaded))
end
else if IsNT then
begin
MYName := _ShareName;
MYComment := _Comment;
MyPath := _ResourcePath;
MyPW := _ReadOnlyPassword;
MyNTShare.shi2_netname := PWideChar(MYName);
MyNTShare.shi2_type := _ResourceType;
MyNTShare.shi2_remark := PWideChar(MYComment);
MyNTShare.shi2_permissions := _NTPermissions;
MyNTShare.shi2_max_uses := _MaxConnections;
MyNTShare.shi2_current_uses := 0;
MyNTShare.shi2_path := PWideChar(MyPath);
MyNTShare.shi2_passwd := PWideChar(MyPW);
PMyNTShare := @MyNTShare;
Err := NTNetShareAdd(PChar(WideString(_ServerName)),2,PMyNTShare,@ErrNum);
If (Err <> NERR_Success) then
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
end
else
begin
strLcopy(MyShare.shi50_netname,PChar(_ShareName),13);
MyShare.shi50_type := _ResourceType;
MyFlags := 0;
If _PersistShare then MyFlags := MyFlags or SHI50F_PERSIST;
If _SystemShare then MyFlags := MyFlags or SHI50F_SYSTEM;
MyFlags := MyFlags or _AccessType;
MyShare.shi50_flags := MyFlags;
MyShare.shi50_remark := PChar(_Comment);
MyShare.shi50_path := PChar(_ResourcePath);
strLcopy(MyShare.shi50_rw_password,PChar(_ReadWritePassword),9);
strLcopy(MyShare.shi50_ro_password,PChar(_ReadOnlyPassword),9);
PMyShare := @MyShare;
Err := NetShareAdd(PChar(_ServerName),50,PMyShare,SizeOf(MyShare));
If (Err <> NERR_Success) then
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
end;
result := Err;
end;
function TSharedResource.Unshare : Integer;
var Err : Integer;
begin
If IsNT Then
Err := NTNetShareDel(PChar(WideString(_ServerName)),PChar(WideString(_ShareName)),0)
Else Err := NetShareDel(PChar(_ServerName),PChar(_ShareName),0);
If (Err <> 0 ) then
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
Result := Err;
end;
function TSharedResource.Update : Integer;
var Err : Integer;
begin
Err := NERR_Success;
If IsShared Then
Begin
Err := UnShare;
If Err = NERR_Success Then Err := Share;
End
Else Err := NERR_NetNameNotFound;
If (Err <> NERR_Success) then
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
Result := Err;
end;
function TSharedResource.GetAccessType : TAccessType;
begin
if _AccessType = SHI50F_RDONLY then Result := ATReadOnly
else if _AccessType = SHI50F_FULL then Result := ATFull
else Result := ATDepends;
end;
function TSharedResource.GetResourceType : TResType;
begin
if _ResourceType = STYPE_PRINTQ then result := RTPrinter
else result := RTFolder;
end;
procedure TSharedResource.SetAccessType(ToWhat : TAccessType);
begin
if ToWhat = ATReadOnly then _AccessType := SHI50F_RDONLY
else if ToWhat = ATFull then _AccessType := SHI50F_FULL
else _AccessType := SHI50F_DEPENDSON;
end;
procedure TSharedResource.SetComment(ToWhat : String);
begin
If Length(ToWhat) > 255 then
ToWhat := Copy(ToWhat,1,255);
_Comment := ToWhat;
end;
procedure TSharedResource.SetNTAccessPermissions(ToWhat : TNTAccessOptions);
begin
_NTAccessPermissions := ToWhat;
_NTPermissions := 0;
If NT_Read in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_READ;
If NT_Write in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_WRITE;
If NT_Execute in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_EXEC;
If NT_Create in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_CREATE;
If NT_Delete in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_DELETE;
If NT_Attrib in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_ATRIB;
If NT_Permissions in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_PERM;
If NT_All in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_ALL;
end;
procedure TSharedResource.SetReadOnlyPassword(ToWhat : String);
begin
if Length(ToWhat) > 9 then
ToWhat := Copy(ToWhat,1,9);
_ReadOnlyPassword := ToWhat;
if isNT then
_ReadWritePassword := ToWhat;
end;
procedure TSharedResource.SetReadWritePassword(ToWhat : String);
begin
if Length(ToWhat) > 9 then
ToWhat := Copy(ToWhat,1,9);
_ReadWritePassword := ToWhat;
if isNT then
_ReadOnlyPassword := ToWhat;
end;
procedure TSharedResource.SetResourceType(ToWhat : TResType);
begin
if ToWhat = RTPrinter then _ResourceType := STYPE_PRINTQ
else if ((ToWhat = RTDevice) and isNT) then _ResourceType := STYPE_DEVICE
else if ((ToWhat = RTIPC) and isNT) then _ResourceType := STYPE_IPC
else _ResourceType := STYPE_DISKTREE;
end;
procedure TSharedResource.SetResPath(ToWhat : String);
begin
_ResourcePath := UpperCase(ToWhat);
end;
procedure TSharedResource.SetServerName(ToWhat : String);
begin
if (isShared and not(csDesigning in ComponentState)) then
begin
Unshare;
_ServerName := UpperCase(ToWhat);
Share;
end
else
_ServerName := UpperCase(ToWhat);
end;
procedure TSharedResource.SetShareName(ToWhat : String);
begin
if (Length(ToWhat) > 13) and Not IsNT then
ToWhat := Copy(ToWhat,1,13);
if (Length(ToWhat) > 81) then
ToWhat := Copy(ToWhat,1,81);
if (isShared and not(csDesigning in ComponentState)) then
begin
Unshare;
_ShareName := UpperCase(ToWhat);
Share;
end
else
_ShareName := UpperCase(ToWhat);
end;
procedure Register;
begin
RegisterComponents('Custom', [TSharedResource]);
end;
end.
Gracias por el tiempo que me han dedicado. Un saludo
Estoy trabajando en Delphi 5 y tengo una DLL que entre otras cosas tiene una función que se encarga de Compartir directorios de Windows. El problema es que esta dll lleva escrita aproximadamente unos 3 o 4 años y siempre funcionó correctamente cuando era llamada desde el InstallShield para compartir unos determinados directorios durante la instalación de una aplicación y a partir de un tiempo a esta parte no está funcionando ( solamente que se haya confirmado en los Windows XP ). En Windows ( 2000 y 2003 ) "funciona correctamente".
El entrecomillado está porque no es del todo cierto. Os Explico. Cuando utilizo la función de compartir directorio ( de la misma dll ) desde un programa de testeo, se comparte correctamente el directorio, de hecho, pone correctamente el nombre del recurso compartido, así como su comentario y después cuando se está en MiPC ojeando las carpetas, se aprecia la manito sobre la carpeta como señal de que la misma está compartida ( esto en todos los Sistemas Operativos de Windows, incluyendo XP ) .
Si la misma función de la misma DLL la llamo desde el InstallShield ( ahora viene lo sorprendente ). No comparte la carpeta como antes he explicado, la mano no está visible sobre la carpeta, y si se presiona el botón derecho del ratón sobre la carpeta y se va a la opción Compartir del menú emergente, la carpeta tampoco aparece compartida. PERO si se trata de ojear la red desde otro ordenador la carpeta compartida aparece como un recurso de red compartido y se puede acceder a esa carpeta inclusive copiando ficheros en ella o eliminando alguno de los que allí hayan. IMPORTANTE Esto no lo hace en Windows XP y es el motivo de pediros vuestra ayuda, si me podeís recomendar algo para saber como afrontar el problema.
El código fuente es el siguiente :
function CompartirDirectorio(Dir,Nombre,Comentario:PChar):Integer;
var
Flags : Word;
Err : Integer;
SR : TSharedResource;
begin
Result:=-1;
SR:=TSharedResource.Create(nil);
try
SR.ServerName:='';
SR.ShareName := string(Nombre);
SR.ResourcePath := string(Dir);
SR.Comment := string(Comentario);
SR.ReadOnlyPassword := '';
SR.ReadWritePassword := '';
SR.MaxConnections := SHI_USES_UNLIMITED;
SR.PersistShare := True;
SR.SystemShare := True;
SR.ResourceType := RTFolder;
SR.AccessType:=ATFull;
SR.NTAccessPermissions:=[NT_Read, NT_Write, NT_Create, NT_Execute, NT_Delete,
NT_Attrib, NT_Permissions, NT_All];
SR.UnShare; // Por si ya existía
SR.Share;
Result:=0;
finally
SR.Free;
end;
end;
Donde:
unit SharedResource;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ShareConst;
type
TResType = (RTFolder, RTPrinter, RTDevice, RTIPC);
TAccessType = (ATReadOnly, ATFull, ATDepends);
TErrorEvent = Procedure(ErrorCode : Integer; ErrorString : String) of object;
TNTAccessType = (NT_Read, NT_Write, NT_Create, NT_Execute, NT_Delete,
NT_Attrib, NT_Permissions, NT_All);
TNTAccessOptions = set of TNTAccessType;
TSharedResource = class(TComponent)
private
_AccessType : Word;
_Comment : String;
_CurrentConnections : Integer;
_MaxConnections : Integer;
_NTAccessPermissions : TNTAccessOptions;
_NTPermissions : Integer;
_PersistShare : Boolean;
_ReadOnlyPassword : String;
_ReadWritePassword : String;
_ResourcePath : String;
_ResourceType : Byte;
_ServerName : String;
_ShareName : String;
_SystemShare : Boolean;
ErrorEvent : TErrorEvent;
DLLHandle : THandle;
IsNT : Boolean; {Are we in Win9x, or NT? Set by constructor.}
NTNetShareAdd : function(ServerName : PChar; ShareLevel : Integer; Buffer : Pointer; Error : PLongword) : Integer; StdCall;
NTNetShareDel : function(ServerName : PChar; NetName : PChar; Reserved : Integer) : Integer; StdCall;
NTNetShareGetInfo : function(ServerName : PChar; NetName : PChar; ShareLevel : SmallInt; Buffer : Pointer) : Integer; StdCall;
NetShareAdd : function(ServerName : PChar; ShareLevel : SmallInt; Buffer : Pointer; Size : Word) : Integer; StdCall;
NetShareDel : function(ServerName : PChar; NetName : PChar; Reserved : Word) : Integer; StdCall;
NetShareGetInfo : function(ServerName : PChar; NetName : PChar; ShareLevel : SmallInt; Buffer : Pointer; Size : Word; Var Used : Word) : Integer; StdCall;
NTNetApiBufferFree : function(Buffer : Pointer) : Integer; StdCall;
function GetAccessType : TAccessType;
function GetResourceType : TResType;
procedure SetAccessType(ToWhat : TAccessType);
procedure SetComment(ToWhat : String);
procedure SetNTAccessPermissions(ToWhat : TNTAccessOptions);
procedure SetReadOnlyPassword(ToWhat : String);
procedure SetReadWritePassword(ToWhat : String);
procedure SetResourceType(ToWhat : TResType);
procedure SetResPath(ToWhat : String);
procedure SetServerName(ToWhat : String);
procedure SetShareName(ToWhat : String);
protected
public
constructor Create(Owner : TComponent); override;
destructor Destroy; override;
function IsShared : Boolean;
function LoadShareInfo(ServerName : String; NetName : String) : Integer;
function Share : Integer;
function Unshare : Integer;
function Update : Integer;
published
property AccessType : TAccessType read GetAccessType write SetAccessType default ATReadOnly;
property Comment : String read _Comment write SetComment;
property CurrentConnections : Integer read _CurrentConnections;
property MaxConnections : Integer read _MaxConnections write _MaxConnections;
property NTAccessPermissions : TNTAccessOptions read _NTAccessPermissions write SetNTAccessPermissions;
property PersistShare : Boolean read _PersistShare write _PersistShare default false;
property ReadOnlyPassword : String read _ReadOnlyPassword write SetReadOnlyPassword;
property ReadWritePassword : String read _ReadWritePassword write SetReadWritePassword;
property ResourcePath : String read _ResourcePath write SetResPath;
property ResourceType : TResType read GetResourceType write SetResourceType default RTFolder;
property ServerName : String read _ServerName write SetServerName;
property ShareName : String read _ShareName write SetShareName;
property SystemShare : Boolean read _SystemShare write _SystemShare default false;
property OnError : TErrorEvent read ErrorEvent write ErrorEvent;
end;
procedure Register;
implementation
constructor TSharedResource.Create(Owner : TComponent);
var verInfo : _OSVERSIONINFOA;
begin
inherited;
{Initialize Stuff!}
DLLHandle := 0;
IsNT := False;
_AccessType := SHI50F_RDONLY;
_Comment := '';
_CurrentConnections := 0;
_MaxConnections := -1;
_NTAccessPermissions := [NT_Read];
_NTPermissions := ACCESS_READ;
_PersistShare := True;
_ReadOnlyPassword := '';
_ReadWritePassword := '';
_ResourcePath := '';
_ResourceType := STYPE_DISKTREE;
_ServerName := '';
_ShareName := '';
_SystemShare := False;
{Make sure we only load the libaries on runtime.}
{Here we dynamically load the networking functions we need.
The Library handle will be freed in the destructor.}
if not(csDesigning in ComponentState) then
begin
verInfo.dwOSVersionInfoSize := sizeOf(_OSVERSIONINFOA);
{See if we're running 9x or NT}
GetVersionEx(verInfo);
If (verInfo.dwPlatformId = VER_PLATFORM_WIN32_NT) then
IsNT := True;
If IsNT then
begin
DLLHandle := LoadLibrary(PChar('NETAPI32.DLL')); {Try Loading the WinNT library}
If (DLLHandle > 0) then
begin
{Aaugh! NT takes different paramters than 9x! :) }
@NTNetShareAdd := GetProcAddress(DLLHandle, PChar('NetShareAdd'));
@NTNetShareDel := GetProcAddress(DLLHandle, PChar('NetShareDel'));
@NTNetShareGetInfo := GetProcAddress(DLLHandle, PChar('NetShareGetInfo'));
@NTNetApiBufferFree := GetProcAddress(DLLHandle, PChar('NetApiBufferFree'));
end;
end
else
begin
DLLHandle := LoadLibrary(PChar('SVRAPI.DLL'));{Try Loading the Win9x library}
If (DLLHandle > 0) then
begin
@NetShareAdd := GetProcAddress(DLLHandle, PChar('NetShareAdd'));
@NetShareDel := GetProcAddress(DLLHandle, PChar('NetShareDel'));
@NetShareGetInfo := GetProcAddress(DLLHandle, PChar('NetShareGetInfo'));
end;
end;
end;
end;
destructor TSharedResource.Destroy;
begin
{Make sure we only unload the libaries on runtime.}
if not(csDesigning in ComponentState) then
If (DLLHandle > 0) then
FreeLibrary(DLLHandle);
inherited;
end;
function TSharedResource.IsShared : Boolean;
var PMyNTShare : ^Share_Info2;
PMyShare : ^Share_Info50;
AmountUsed : Word;
Err : Integer;
begin
Result := False;
If (DLLHandle <= 0) Then
begin
If Assigned(OnError) then OnError(NERR_DLLNotLoaded,GetNetErrorString(NERR_DLLNotLoaded))
end
else if IsNT then
begin
PMyNTShare := Nil;
Err := NTNetShareGetInfo(PChar(WideString(_ServerName)),PChar(WideString(_ShareName)),2,@PMyNTShare);
If Err = 0 Then Result := True;
If (PMyNTShare <> nil) then NTNetApiBufferFree(PMyNTShare);
end
else
begin
PMyShare := AllocMem(512);
Err := NetShareGetInfo(PChar(_ServerName),PChar(_ShareName),50,PMyShare,512,AmountUsed);
If Err = 0 Then Result := True;
FreeMem(PMyShare);
end;
end;
function TSharedResource.LoadShareInfo(ServerName : String; NetName : String) : Integer;
var PMyNTShare : ^Share_Info2;
PMyShare : ^Share_Info50;
AmountUsed : Word;
Err : Integer;
begin
If (DLLHandle <= 0) Then
begin
If Assigned(OnError) then OnError(NERR_DLLNotLoaded,GetNetErrorString(NERR_DLLNotLoaded));
Result := NERR_DLLNotLoaded;
end
else if IsNT then
begin
PMyNTShare := Nil;
Err := NTNetShareGetInfo(PChar(WideString(UpperCase(ServerName))),PChar(WideString(UpperCase(NetName))),2,@ PMyNTShare);
If Err = 0 Then
Begin
_ServerName := ServerName;
_ShareName := PMyNTShare.shi2_netname;
_ResourceType := PMyNTShare.shi2_type;
If (PMyNTShare.shi2_permissions and ACCESS_ALL) = ACCESS_ALL then
_NTAccessPermissions := _NTAccessPermissions + [NT_All];
If (PMyNTShare.shi2_permissions and ACCESS_READ) = ACCESS_READ then
_NTAccessPermissions := _NTAccessPermissions + [NT_Read];
If (PMyNTShare.shi2_permissions and ACCESS_WRITE) = ACCESS_WRITE then
_NTAccessPermissions := _NTAccessPermissions + [NT_Write];
If (PMyNTShare.shi2_permissions and ACCESS_CREATE) = ACCESS_CREATE then
_NTAccessPermissions := _NTAccessPermissions + [NT_Create];
If (PMyNTShare.shi2_permissions and ACCESS_EXEC) = ACCESS_EXEC then
_NTAccessPermissions := _NTAccessPermissions + [NT_Execute];
If (PMyNTShare.shi2_permissions and ACCESS_DELETE) = ACCESS_DELETE then
_NTAccessPermissions := _NTAccessPermissions + [NT_Delete];
If (PMyNTShare.shi2_permissions and ACCESS_ATRIB) = ACCESS_ATRIB then
_NTAccessPermissions := _NTAccessPermissions + [NT_Attrib];
If (PMyNTShare.shi2_permissions and ACCESS_PERM) = ACCESS_PERM then
_NTAccessPermissions := _NTAccessPermissions + [NT_Permissions];
_CurrentConnections := PMyNTShare.shi2_current_uses;
_MaxConnections := PMyNTShare.shi2_max_uses;
_Comment := PMyNTShare.shi2_remark;
_ResourcePath := PMyNTShare.shi2_path;
_ReadOnlyPassword := PMyNTShare.shi2_passwd;
_ReadWritePassword := PMyNTShare.shi2_passwd;
End
else
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
If (PMyNTShare <> nil) then NTNetApiBufferFree(PMyNTShare);
Result := Err;
end
else
begin
PMyShare := AllocMem(512);
Err := NetShareGetInfo(PChar(UpperCase(ServerName)),PChar(UpperCase(NetName)),50,PMyShare,512,AmountUsed);
If Err = 0 Then
Begin
_ServerName := ServerName;
_ShareName := PMyShare.shi50_netname;
_ResourceType := PMyShare.shi50_type;
If (PMyShare.shi50_flags and SHI50F_DEPENDSON) = SHI50F_DEPENDSON then _AccessType := SHI50F_DEPENDSON
Else If (PMyShare.shi50_flags and SHI50F_RDONLY) = SHI50F_RDONLY then _AccessType := SHI50F_RDONLY
Else If (PMyShare.shi50_flags and SHI50F_FULL) = SHI50F_FULL then _AccessType := SHI50F_FULL;
_PersistShare := ((PMyShare.shi50_flags and SHI50F_PERSIST) = SHI50F_PERSIST);
_SystemShare := ((PMyShare.shi50_flags and SHI50F_SYSTEM) = SHI50F_SYSTEM);
_Comment := PMyShare.shi50_remark;
_ResourcePath := PMyShare.shi50_path;
_ReadOnlyPassword := PMyShare.shi50_ro_password;
_ReadWritePassword := PMyShare.shi50_rw_password;
End
else
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
FreeMem(PMyShare);
Result := Err;
end;
end;
function TSharedResource.Share : Integer;
var MyShare : Share_Info50;
PMyShare : ^Share_Info50;
MyNTShare : Share_Info2;
PMyNTShare : ^Share_Info2;
Err : Integer;
ErrNum : Integer;
MyFlags : Word;
MyName, MyComment, MyPath, MyPW : WideString;
begin
Err := NERR_Success;
If (DLLHandle <= 0) Then
begin
If Assigned(OnError) then OnError(NERR_DLLNotLoaded,GetNetErrorString(NERR_DLLNotLoaded))
end
else if IsNT then
begin
MYName := _ShareName;
MYComment := _Comment;
MyPath := _ResourcePath;
MyPW := _ReadOnlyPassword;
MyNTShare.shi2_netname := PWideChar(MYName);
MyNTShare.shi2_type := _ResourceType;
MyNTShare.shi2_remark := PWideChar(MYComment);
MyNTShare.shi2_permissions := _NTPermissions;
MyNTShare.shi2_max_uses := _MaxConnections;
MyNTShare.shi2_current_uses := 0;
MyNTShare.shi2_path := PWideChar(MyPath);
MyNTShare.shi2_passwd := PWideChar(MyPW);
PMyNTShare := @MyNTShare;
Err := NTNetShareAdd(PChar(WideString(_ServerName)),2,PMyNTShare,@ErrNum);
If (Err <> NERR_Success) then
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
end
else
begin
strLcopy(MyShare.shi50_netname,PChar(_ShareName),13);
MyShare.shi50_type := _ResourceType;
MyFlags := 0;
If _PersistShare then MyFlags := MyFlags or SHI50F_PERSIST;
If _SystemShare then MyFlags := MyFlags or SHI50F_SYSTEM;
MyFlags := MyFlags or _AccessType;
MyShare.shi50_flags := MyFlags;
MyShare.shi50_remark := PChar(_Comment);
MyShare.shi50_path := PChar(_ResourcePath);
strLcopy(MyShare.shi50_rw_password,PChar(_ReadWritePassword),9);
strLcopy(MyShare.shi50_ro_password,PChar(_ReadOnlyPassword),9);
PMyShare := @MyShare;
Err := NetShareAdd(PChar(_ServerName),50,PMyShare,SizeOf(MyShare));
If (Err <> NERR_Success) then
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
end;
result := Err;
end;
function TSharedResource.Unshare : Integer;
var Err : Integer;
begin
If IsNT Then
Err := NTNetShareDel(PChar(WideString(_ServerName)),PChar(WideString(_ShareName)),0)
Else Err := NetShareDel(PChar(_ServerName),PChar(_ShareName),0);
If (Err <> 0 ) then
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
Result := Err;
end;
function TSharedResource.Update : Integer;
var Err : Integer;
begin
Err := NERR_Success;
If IsShared Then
Begin
Err := UnShare;
If Err = NERR_Success Then Err := Share;
End
Else Err := NERR_NetNameNotFound;
If (Err <> NERR_Success) then
If Assigned(OnError) then OnError(Err,GetNetErrorString(Err));
Result := Err;
end;
function TSharedResource.GetAccessType : TAccessType;
begin
if _AccessType = SHI50F_RDONLY then Result := ATReadOnly
else if _AccessType = SHI50F_FULL then Result := ATFull
else Result := ATDepends;
end;
function TSharedResource.GetResourceType : TResType;
begin
if _ResourceType = STYPE_PRINTQ then result := RTPrinter
else result := RTFolder;
end;
procedure TSharedResource.SetAccessType(ToWhat : TAccessType);
begin
if ToWhat = ATReadOnly then _AccessType := SHI50F_RDONLY
else if ToWhat = ATFull then _AccessType := SHI50F_FULL
else _AccessType := SHI50F_DEPENDSON;
end;
procedure TSharedResource.SetComment(ToWhat : String);
begin
If Length(ToWhat) > 255 then
ToWhat := Copy(ToWhat,1,255);
_Comment := ToWhat;
end;
procedure TSharedResource.SetNTAccessPermissions(ToWhat : TNTAccessOptions);
begin
_NTAccessPermissions := ToWhat;
_NTPermissions := 0;
If NT_Read in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_READ;
If NT_Write in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_WRITE;
If NT_Execute in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_EXEC;
If NT_Create in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_CREATE;
If NT_Delete in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_DELETE;
If NT_Attrib in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_ATRIB;
If NT_Permissions in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_PERM;
If NT_All in _NTAccessPermissions then _NTPermissions := _NTPermissions or ACCESS_ALL;
end;
procedure TSharedResource.SetReadOnlyPassword(ToWhat : String);
begin
if Length(ToWhat) > 9 then
ToWhat := Copy(ToWhat,1,9);
_ReadOnlyPassword := ToWhat;
if isNT then
_ReadWritePassword := ToWhat;
end;
procedure TSharedResource.SetReadWritePassword(ToWhat : String);
begin
if Length(ToWhat) > 9 then
ToWhat := Copy(ToWhat,1,9);
_ReadWritePassword := ToWhat;
if isNT then
_ReadOnlyPassword := ToWhat;
end;
procedure TSharedResource.SetResourceType(ToWhat : TResType);
begin
if ToWhat = RTPrinter then _ResourceType := STYPE_PRINTQ
else if ((ToWhat = RTDevice) and isNT) then _ResourceType := STYPE_DEVICE
else if ((ToWhat = RTIPC) and isNT) then _ResourceType := STYPE_IPC
else _ResourceType := STYPE_DISKTREE;
end;
procedure TSharedResource.SetResPath(ToWhat : String);
begin
_ResourcePath := UpperCase(ToWhat);
end;
procedure TSharedResource.SetServerName(ToWhat : String);
begin
if (isShared and not(csDesigning in ComponentState)) then
begin
Unshare;
_ServerName := UpperCase(ToWhat);
Share;
end
else
_ServerName := UpperCase(ToWhat);
end;
procedure TSharedResource.SetShareName(ToWhat : String);
begin
if (Length(ToWhat) > 13) and Not IsNT then
ToWhat := Copy(ToWhat,1,13);
if (Length(ToWhat) > 81) then
ToWhat := Copy(ToWhat,1,81);
if (isShared and not(csDesigning in ComponentState)) then
begin
Unshare;
_ShareName := UpperCase(ToWhat);
Share;
end
else
_ShareName := UpperCase(ToWhat);
end;
procedure Register;
begin
RegisterComponents('Custom', [TSharedResource]);
end;
end.
Gracias por el tiempo que me han dedicado. Un saludo