Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Как расшарить диск

Delphi , Файловая система , Диски

Как расшарить диск

Автор: Repairman

Программист, глядя на только что отформатированный вирусом винчестер: "Хмм... кажется здесь кто-то поработал зубной щеткой Reach Interdental от Johnson&Johnson..."

Это модуль для Share любого диска или папки как на локальном, так и на удаленном компьютере (если, конечно у Вас права администратора и на компе разрешено удаленное администрирование, для локальной машины это не обязательно... ;-))

Следует отметить, что под NT некоторые процедуры находятся в других DLL...

Функция SetShareOnDisk - ставит шару, RemoveShareFromDisk - снимает ее.


//(c)2002  repairman@uzel.ru
unit Share;

interface

type
  TPassw = string[8];
  TNetName = string[12];

  function SetShareOnDisk(HostName: string; { имя компьютера }
  LocalPath: string; { папка которую надо открыть для доступа }
  NetName: TNetName; { имя расшаренной папки в сети }
  Remark: string;    { комментарий, видимый в сети }
  Access: word;      { доступ }
  RO_Passw: TPassw;  { пароль на чтение }
  RW_Passw: TPassw   { пароль на полный доступ }
  ): boolean;

  function RemoveShareFromDisk(HostName: string; { имя компьютера }
  NetName: string;  { сетевое имя папки которую надо закрыть }
  LocalPath: string { локальный путь папки }
  ): boolean;

var
  ShareResult: word;

implementation

uses
  SysUtils, Windows, ShlObj;

{ указатель на имя компьютера,
например '\\Server'#0, если свой, то можно nil }
function NetShareAdd(ServerName: PChar;
Level: Word;       { уровень структуры Share_info, здесь 50 }
PShareInfo: PChar; { указатель на структуру Share_Info }
ParmErr: DWord)    { указатель на ??? }
{ svrapi для Win9X, NetApi32 для NT }
: dword; stdcall; external 'svrapi.dll';

function NetShareDel(ServerName: PChar; NetName: PChar;
Reserved: DWord): dword; stdcall; external 'svrapi.dll';

type
  _share_info_50 = record { структура Share уровня 50 }
  NetName: array[1..13] of char; { Как будет называться диск в сети }
  SType: byte;   { тип =0 (STYPE_DISKTREE) - шарить диски }
  Flags: word;   { флаги $0191,$0192,$0193....(доступ из сети) }
  Remark: PChar; { указатель на комментарий, видимый из сети }
  Path: PChar;   { указатель на имя ресурса, например 'c:\'#0 }
  { пароль для полного доступа, если не нужен =#0 }
  RW_Password: array [1..9] of char;
  { пароль для доступа на чтение, если не нужен =#0 }
  RO_Password: array [1..9] of char;
end;

function SetShareOnDisk(HostName, LocalPath: string; NetName: TNetName;
Remark: string; Access: word; RO_Passw, RW_Passw: TPassw): boolean;
var
  ShareInfo: _Share_Info_50;
begin
  Result:=false;
  StrPCopy(@ShareInfo.NetName, NetName);
  ShareInfo.SType:=0;
  ShareInfo.Flags:=Access;
  ShareInfo.Remark:=PChar(Remark);
  ShareInfo.Path:=PChar(LocalPath);
  StrPCopy(@ShareInfo.RO_Password, RO_Passw);
  StrPCopy(@ShareInfo.RW_Password, RW_Passw);
  { вызываем Share }
  ShareResult:=NetShareAdd(PChar(HostName), 50,@ShareInfo,$0000002a);
  if ShareResult<>0 then { расшарить неудалось }
    Exit;
    { сказать шеллу об изменениях }
  SHChangeNotify(SHCNE_NETSHARE, SHCNF_PATH, PChar(LocalPath), nil);
  Result:=true;
end;

function RemoveShareFromDisk(HostName, NetName, LocalPath: string): boolean;
begin
  Result:=false;
  { удалить шару }
  ShareResult:=NetShareDel(PChar(HostName), PChar(NetName), 0);
  if ShareResult<>0 then
    Exit;
    { сказать шеллу об изменениях }
  SHChangeNotify(SHCNE_NETUNSHARE, SHCNF_PATH,PChar(LocalPath),nil);
  Result:=true;
end;

end.

Это модуль Delphi, который предоставляет функции для деления и удаления дисковых устройств на локальном или удаленном компьютере. Функции:

  • SetShareOnDisk: делит директорию на указанном хост-компьютере с заданным сетевым именем, комментарием, правами доступа, паролем для чтения и паролем для записи.
  • RemoveShareFromDisk: удаляет деленную директорию с указанного хост-компьютера.

Модуль использует Windows API для взаимодействия с операционной системой. Функции:

  • NetShareAdd: добавляет новый раздел на указанном хост-компьютере.
  • NetShareDel: удаляет существующий раздел на указанном хост-компьютере.

Модуль также включает в себя определение типа _share_info_50, которое представляет структуру деленного ресурса в Windows.

Обзор использования модуля:

  1. Создайте экземпляр класса TShare.
  2. Вызовите функцию SetShareOnDisk для деления директории на удаленном компьютере. Функция принимает несколько параметров, включая имя хост-компьютера, локальный путь, сетевое имя, комментарий, права доступа, пароль для чтения и пароль для записи.
  3. Вызовите функцию RemoveShareFromDisk для удаления директории на удаленном компьютере.

Обратите внимание, что этот модуль написан для Delphi 5 или более поздних версий, так как он использует функции интерфейсов и вариативных типов данных, которые не доступны в ранних версиях Delphi.

Пример использования:

program ShareDemo;
uses
  Share,
  Windows;

var
  share: TShare;
  hostName: string;
  localPath: string;
  netName: string;
  remark: string;
  access: word;
  roPassw, rwPassw: string;

begin
   // Создайте экземпляр класса TShare
  share := TShare.Create;

   // Установите параметры для деления директории
  hostName := 'server';
  localPath := 'c:\shared\dir';
  netName := 'shared_dir';
  remark := 'This is a shared directory';
  access := $0191; // Чтение-only доступ
  roPassw := 'readonly';
  rwPassw := 'writeonly';

   // Делите директорию
  if share.SetShareOnDisk(hostName, localPath, netName, remark, access, roPassw, rwPassw) then
    WriteLn('Shared successfully')
  else
    WriteLn('Sharing failed');

   // Удалите директорию
  if share.RemoveShareFromDisk(hostName, netName, localPath) then
    WriteLn('Unshared successfully')
  else
    WriteLn('Unsharing failed');
end.

В этом коде делится директория на удаленном компьютере с именем server, сетевым именем shared_dir, чтение-only доступом и паролями для чтения и записи. Затем директория удаляется.

Как расшарить диск - модуль для шарирования любого диска или папки на локальном компьютере или удаленном компьютере с правами администратора.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Диски ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-06-16 03:33:52/0.0061781406402588/0