Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > API de Windows
Actualizar esta página Compartir directorio ( InstallShield )
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 18-01-2007
Aldo Aldo is offline
Miembro
  
Registrado: ene 2004
Posts: 46
Poder: 0
Aldo Va por buen camino
Compartir directorio ( InstallShield )
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 :

Código Delphi [-]
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:

Código Delphi [-]
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
Responder Con Cita
  #2  
Antiguo 07-05-2007
Avatar de MaMu
MaMu MaMu is offline
Miembro
  
Registrado: abr 2006
Ubicación: Argentina
Posts: 863
Poder: 19
MaMu Va por buen camino
Me interesaria poder probarlo, me podrias pasar el archivo que falta?

ShareConst.dcu

Gracias de todas maneras, me parece muy bueno.

Saldudos
__________________
Código Delphi [-]
 
try 
ProgramarMicro(80C52,'Intel',MnHex,True);
except
On Exception do
MicroChip.IsPresent(True);
end;
Responder Con Cita
Respuesta

« Tema Anterior | Próximo Tema »


Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes
El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Compartir Internet brandolin Redes 3 05-07-2006 08:46:00
Compartir BD en red karymas Firebird e Interbase 9 20-06-2005 12:57:57
Compartir directorio D@byt Varios 7 13-06-2005 19:02:49
Compartir una carpeta D@byt Varios 2 30-05-2005 19:03:29
Compartir memoria en DLL William Diaz Varios 2 26-07-2003 03:08:56


La franja horaria es GMT +2. Ahora son las 18:52:04.

Club Delphi - Archivo - Top

Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi