Карта сайта 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 и FreePascal.


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


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




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



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


реклама



©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
23.04.2024 22:00:27/0.0013730525970459/0