Read-only шары

Так должно быть совсем нормально Никаких лишних юнитов и удобное использование. Можно наверно и в FAQ, раз вопрос повторяется.

{*******************************************************}
{                                                       }
{       Добавление и удаление общих сетевых ресурсов    }
{                                                       }
{ Copyright (c)                                         }
{    1998-2002 Rouse_                                   }
{              (базовый код, взят из примера NetMon)    }
{    2006 Smike                                         }
{              (- доработка для возможности создания    }
{                 ресурсов, открытых только для чтения  }
{                 под NT/2000/XP/2003,                  }
{               - небольшой рефакторинг ;) )            }
{                                                       }
{*******************************************************}
 
unit Shares;
 
interface
 
uses
  Windows, SysUtils, AclApi;
 
function ShareDirectory(const Directory: string): DWORD;
function UnShareDirectory(const Directory: string): DWORD;
 
implementation
 
const
  STYPE_DISKTREE = 0;
 
function ShareDirectoryNT(const Directory, ShareName: string): DWORD;
type
  TShareInfo502 = packed record
    shi502_netname : PWChar;
    shi502_type: DWORD;
    shi502_remark :PWChar;
    shi502_permissions: DWORD;
    shi502_max_uses : DWORD;
    shi502_current_uses : DWORD;
    shi502_path : PWChar;
    shi502_passwd : PWChar;
    shi502_reserved: DWORD;
    shi502_security_descriptor: PSECURITY_DESCRIPTOR;
  end;
const
  ACL_REVISION = 2;
  SECURITY_WORLD_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 1));
  SECURITY_WORLD_RID = ($00000000);
  SECURITY_NT_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
  SECURITY_BUILTIN_DOMAIN_RID = ($00000020);
  DOMAIN_ALIAS_RID_ADMINS = ($00000220);          
var
  NetShareAddNT: function(servername: PWideChar;
                          level: DWORD;
                          buf: Pointer;
                          parm_err: LPDWORD): DWORD; stdcall;
  ShareNT : TShareInfo502;
  FLibHandle: THandle;
  TmpDirNT, TmpNameNT: PWChar;
  TmpLength: Integer;
  pSd: PSECURITY_DESCRIPTOR;
  pDacl: PACL;
  EveryoneSid, AdminSid: Pointer;  
begin
  Result := DWORD(-1);
  FLibHandle := LoadLibrary('NETAPI32.DLL');
  if FLibHandle = 0 then Exit;
  try
    NetShareAddNT := GetProcAddress(FLibHandle,'NetShareAdd');
    if not Assigned(NetShareAddNT) then Exit;
    
    TmpLength := SizeOf(WideChar) * 256; //Определяем необходимый размер
 
    GetMem(TmpNameNT, TmpLength); //Конвертируем в PWChar
    StringToWideChar(ShareName, TmpNameNT, TmpLength);
    ShareNT.shi502_netname := TmpNameNT; //Имя
 
    ShareNT.shi502_type := STYPE_DISKTREE; //Тип ресурса
    ShareNT.shi502_remark := ''; //Комментарий
    // В NT, 2000, XP, 2003 разрешения на уровне расшаренной папки не поддерживается
    // Для этого задаем ниже атрибуты доступа на уровне групп
    ShareNT.shi502_permissions := 0;
    ShareNT.shi502_max_uses := DWORD(-1); //Кол-во максим. подключ.
    ShareNT.shi502_current_uses := 0; //Кол-во тек подкл.
 
    GetMem(TmpDirNT, TmpLength);
    StringToWideChar(Directory, TmpDirNT, TmpLength);
    ShareNT.shi502_path := TmpDirNT; //Путь к ресурсу
 
    ShareNT.shi502_passwd := ''; //Пароль
 
    ShareNT.shi502_reserved := 0;
 
    // Здесь начинается самое интересное - задаем разрешения :)
    GetMem(pDacl, 256);
    InitializeAcl(pDacl^, 256, ACL_REVISION);
    EveryoneSid := nil;
    AdminSid := nil;
    AllocateAndInitializeSid(SECURITY_WORLD_SID_AUTHORITY, 1, SECURITY_WORLD_RID, 0, 0, 0, 0, 0, 0, 0, EveryoneSid);
    AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, AdminSid);
    AddAccessAllowedAce(pDacl^, ACL_REVISION, GENERIC_ALL, AdminSid);
    AddAccessAllowedAce(pDacl^, ACL_REVISION, (GENERIC_READ or GENERIC_EXECUTE or READ_CONTROL or STANDARD_RIGHTS_READ), EveryoneSid);
    GetMem(pSd, SECURITY_DESCRIPTOR_MIN_LENGTH);
    InitializeSecurityDescriptor(pSd, SECURITY_DESCRIPTOR_REVISION);
    SetSecurityDescriptorDacl(pSd, TRUE, pDacl, FALSE);
    ShareNT.shi502_security_descriptor := pSd;
 
    Result := NetShareAddNT(nil, 502, @ShareNT, nil); //Добавляем ресурс
 
    if Assigned(EveryoneSid) then
      FreeSid(EveryoneSid);
 
    if Assigned(AdminSid) then
      FreeSid(AdminSid);
 
    //освобождаем память
    FreeMem(pDacl);
    FreeMem(pSd);
    FreeMem(TmpNameNT);
    FreeMem(TmpDirNT);
  finally
    FreeLibrary(FLibHandle);
  end;
end;
 
function ShareDirectory9x(const Directory, ShareName: string): DWORD;
type
  TShareInfo50 = packed record
    shi50_netname : array [0..12] of Char;
    shi50_type : Byte;
    shi50_flags : Word;
    shi50_remark : PChar;
    shi50_path : PChar;
    shi50_rw_password : array [0..8] of Char;
    shi50_ro_password : array [0..8] of Char;
  end;
const
  SHI50F_RDONLY  = $1;
var
  NetShareAdd: function(pszServer: PAnsiChar;
                        sLevel: Cardinal;
                        pbBuffer: PAnsiChar;
                        cbBuffer: Word):DWORD; stdcall;
  Share9x : TShareInfo50;
  FLibHandle : THandle;  
begin
  Result := DWORD(-1);
  FLibHandle := LoadLibrary('SVRAPI.DLL');
  if FLibHandle = 0 then Exit;
  try
    NetShareAdd := GetProcAddress(FLibHandle,'NetShareAdd');
    if not Assigned(NetShareAdd) then Exit;
 
    FillChar(Share9x.shi50_netname, SizeOf(Share9x.shi50_netname), #0);
    Move(ShareName[1], Share9x.shi50_netname[0], Length(ShareName)); //Имя
    Share9x.shi50_type := STYPE_DISKTREE; //Тип ресурса
    Share9x.shi50_flags := SHI50F_RDONLY; //Доступ
    FillChar(Share9x.shi50_remark,
      SizeOf(Share9x.shi50_remark), #0); //Комментарий
    FillChar(Share9x.shi50_path,
      SizeOf(Share9x.shi50_path), #0);
    Share9x.shi50_path := PAnsiChar(Directory); //Путь к ресурсу
    FillChar(Share9x.shi50_rw_password,
      SizeOf(Share9x.shi50_rw_password), #0); //Пароль полного доступа
    FillChar(Share9x.shi50_ro_password,
      SizeOf(Share9x.shi50_ro_password), #0); //Пароль для чтения
    Result := NetShareAdd(nil, 50, @Share9x, SizeOf(Share9x));
  finally
    FreeLibrary(FLibHandle);
  end;
end;
 
function ShareDirectory(const Directory: string): DWORD;
var
  ShareDir, ShareName: string;
begin
  ShareDir := ExcludeTrailingPathDelimiter(Directory);
  ShareName := ExtractFileName(ShareDir);
 
  if Win32Platform = VER_PLATFORM_WIN32_NT then
    Result := ShareDirectoryNT(ShareDir, ShareName)
  else
    Result := ShareDirectory9x(ShareDir, ShareName);
end;
 
function UnShareDirectoryNT(const ShareName: string): DWORD;
var
  FLibHandle : THandle;
  NameNT: PWChar;
  NetShareDelNT: function(servername: PWideChar;
                          netname: PWideChar;
                          reserved: DWORD): LongInt; stdcall;
  Size: Integer;
begin
  Result := DWORD(-1);
  FLibHandle := LoadLibrary('NETAPI32.DLL');
  if FLibHandle = 0 then Exit;
  try
    NetShareDelNT := GetProcAddress(FLibHandle, 'NetShareDel');
    if not Assigned(NetShareDelNT) then //Проверка
    begin
      FreeLibrary(FLibHandle);
      Exit;
    end;
    Size := SizeOf(WideChar) * 256;
    GetMem(NameNT, Size);  //Выделяем память под переменную
    StringToWideChar(ShareName, NameNT, Size); //Преобразуем в PWideChar
    NetShareDelNT(nil, NameNT, 0);   //Удаляем ресурс
    FreeMem(NameNT);  //Освобождаем память
  finally
    FreeLibrary(FLibHandle);
  end;
end;
 
function UnShareDirectory9x(const ShareName: string): DWORD;
var
  FLibHandle: THandle;
  Name9x: array [0..12] of Char;
  NetShareDel: function(pszServer,
                        pszNetName: PChar;
                        usReserved: Word): DWORD; stdcall;
begin
  Result := DWORD(-1);
  FLibHandle := LoadLibrary('SVRAPI.DLL');
  if FLibHandle = 0 then Exit;
  try
    NetShareDel := GetProcAddress(FLibHandle,'NetShareDel');
    if not Assigned(NetShareDel) then Exit;
    FillChar(Name9x, SizeOf(Name9x), #0); //Очищаем массив
    Move(ShareName[1], Name9x[0], Length(ShareName)); //Заполняем массив
    Result := NetShareDel(nil, @Name9x, 0); //Удаляем ресурс
  finally
    FreeLibrary(FLibHandle);
  end;
end;
 
function UnShareDirectory(const Directory: string): DWORD;
var
  ShareName: string;
begin
  ShareName := ExtractFileName(ExcludeTrailingPathDelimiter(Directory));
 
  if Win32Platform = VER_PLATFORM_WIN32_NT then       //Код для NT
    Result := UnShareDirectoryNT(ShareName)
  else                                                //Код для 9х-Ме
    Result := UnShareDirectory9x(ShareName);
end;
 
end.

Сообщение отредактировано: Smike - 20.07.06, 10:45

А с удаленного компа можно зашарить?
AclApi это стандартный модуль?

Цитата aster_x @ 04.09.06, 09:38

А с удаленного компа можно зашарить?

Теоретически - да. За это по идее отвечает первый параметр NetShareAdd.

Цитата aster_x @ 04.09.06, 09:38

AclApi это стандартный модуль?

У меня в D2006 - да. Как в старых - не знаю.

Обнаружил небольшие проблемы при работе в Windows 98, связанные с путями в нижнем/смешанном регистре и длинными именами шары. Чтобы все работало нормально, в код следует внести следующие исправления:
- в коде расшаривания папки для Windows 98 делаем путь к расшариваемой папке в верхнем регистре и копируем в имя самой шары первые 12 символов её имени, для Windows NT+ - без изменений:

function ShareDirectory(const Directory: string): DWORD;
var
  ShareDir, ShareName: string;
begin
  ShareDir := ExcludeTrailingPathDelimiter(Directory);
 
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    ShareName := ExtractFileName(ShareDir);
    Result := ShareDirectoryNT(ShareDir, ShareName);
  end else begin
    // В MSDN сказано, что путь должен быть в верхнем регистре
    ShareDir := AnsiUpperCase(ShareDir);
    ShareName := Copy(ExtractFileName(ShareDir), 1, 12);
 
    Result := ShareDirectory9x(ShareDir, ShareName);
  end;
end;

- в функции убирания шары для Windows 98 находим имя шары по тому же принципу (первые 12 символов от названия к директории в верхнем регистре):

function UnShareDirectory(const Directory: string): DWORD;
var
  ShareName: string;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    // Код для NT
    ShareName := ExtractFileName(ExcludeTrailingPathDelimiter(Directory));
    Result := UnShareDirectoryNT(ShareName);
  end else begin
    // Код для 9х-Ме
    ShareName := AnsiUpperCase(Copy(ExtractFileName(ExcludeTrailingPathDelimiter(Directory)), 1, 12));                                            
    Result := UnShareDirectory9x(ShareName);
  end;
end;

Проверял под виртуальной машиной, в "полевых" условиях не приходилось, поэтому буду благодарен, если кто-то и меня проверит