Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Расшаривание папки! [D6, XP]

serko © (2005-11-09 23:28:00)
Нашел вот такую статью, с помощью которой можна расшарить папку в сети:
unit Share; //(c)2002 <Repairman> repairman@uzel.ru 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; function NetShareAdd(ServerName: PChar; //указатель на имя компьютера, например '\\Server'#0, если свой, то можно nil Level: Word; //уровень структуры Share_info, здесь 50 PShareInfo: PChar; //указатель на структуру Share_Info ParmErr: DWord) //указатель на ??? : dword; stdcall; external 'svrapi.dll'; //svrapi для Win9X, NetApi32 для NT 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 RW_Password: array[1..9] of char; //пароль для полного доступа, если не нужен =#0 RO_Password: array[1..9] of char; //пароль для доступа на чтение, если не нужен =#0 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); ShareResult := NetShareAdd(PChar(HostName), 50, @ShareInfo, $0000002A); //вызываем Share 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. <\code> Так вот пишу так SetShareOnDisk('\\Serega'#0, 'C:\Temp', 'Temp', 'Шара', 1, #0,#0) Может я не так пишу? Подправьте меня!

serko (2005-11-17 13:22:00) [1]
Ув. модератор переместите мою тему в раздел Media, ато в Начинающих я немогу дождаться ответа казалось бы на простенький вопрос!

serko (2005-11-16 22:23:00) [2]
Ну как сделать доступ токо на чтение?

serko (2005-11-15 17:53:00) [3]

> > Если ничего не пишет, то зайди через сетевое окружение
> на
> > свой компьютер и посмотри. Должна быть там.
>
>
> Так есть, но полного доступа нет, хотя ставил уже ACCESS_ALL

Сорри! Все работает, токо на расшариваемой папке сразу не появляется своеобразная "рука" и почему то всегда (при разных shi2_permissions) делается полный доступ!
А как сделать чтобы можна было токо считывать и запретить изменение папки.

Пожалуйста помогите!

serko (2005-11-11 20:13:00) [4]

> Блин, действительно партизан.

Почему?
> Если ничего не пишет, то зайди через сетевое окружение на
> свой компьютер и посмотри. Должна быть там.

Так есть, но полного доступа нет, хотя ставил уже ACCESS_ALL

> Похоже придется определять под какой ОС запущена программа
> и открывать шару в зависимости от этого.

А как это сделать?

CHES (2005-11-11 15:47:00) [5]
>> Так не прикол! А как сделать шоб заработал на >> любой ОС?

Похоже придется определять под какой ОС запущена программа и открывать шару в зависимости от этого.

>> Он тоже на ХР не работает!

Проверено под Win 2000 SP4.
Блин, действительно партизан.
Какую ошибку выдает?
Если ничего не пишет, то зайди через сетевое окружение на свой компьютер и посмотри. Должна быть там.

serko (2005-11-11 15:11:00) [6]

> Не будет твой модуль работать в XP

Так не прикол! А как сделать шоб заработал на любой ОС?

> След. пример добавит шару 'D:\Temp' на локальном компьютере.

Он тоже на ХР не работает!

CHES (2005-11-11 11:37:00) [7]
А ссылку которую дал Плохиш © читал ?
Не будет твой модуль работать в XP

След. пример добавит шару 'D:\Temp' на локальном компьютере.

...
implementation
...

function NetShareAdd(ServerName: PChar;
Level: Word;
PShareInfo: PChar;
ParmErr: DWord): dword; stdcall; external
'NetApi32.dll';

...

procedure TForm1.Button1Click(Sender: TObject);
const
STYPE_DISKTREE = $0;
STYPE_PRINTQ = $1;
STYPE_DEVICE = $2;
STYPE_IPC = $3;

ACCESS_NONE = $0;
ACCESS_READ = $1;
ACCESS_WRITE = $2;
ACCESS_CREATE = $4;
ACCESS_EXEC = $8;
ACCESS_DELETE = $10;
ACCESS_ATRIB = $20;
ACCESS_PERM = $40;
ACCESS_FINDFIRST = $80;
ACCESS_GROUP = $8000;
ACCESS_ALL = (ACCESS_READ or ACCESS_WRITE or ACCESS_CREATE or ACCESS_EXEC or
ACCESS_DELETE or ACCESS_ATRIB or ACCESS_PERM or ACCESS_FINDFIRST);
type
_SHARE_INFO_2 = record
shi2_netname: LPWSTR;
shi2_type: DWORD;
shi2_remark: LPWSTR;
shi2_permissions: DWORD;
shi2_max_uses: DWORD;
shi2_current_uses: DWORD;
shi2_path: LPWSTR;
shi2_passwd: LPWSTR;
end;
var
shi: _SHARE_INFO_2;
res: DWORD;
err: Cardinal;
begin
err := 0;
with shi do
begin
shi2_netname := 'TestShare';
shi2_type := STYPE_DISKTREE;
shi2_remark := 'My Test Share';
shi2_permissions := ACCESS_READ;
shi2_max_uses := 10;
shi2_current_uses := 0;
shi2_path := 'D:\Temp';
shi2_passwd := nil;
end;
res := NetShareAdd(nil, 2, @shi, err);
if res <> 0 then
ShowMessage(SysErrorMessage(GetLastError))
else SHChangeNotify(SHCNE_NETSHARE, SHCNF_PATH, PChar(shi.shi2_path), nil);
end;

serko (2005-11-10 22:42:00) [8]

> ShareInfo.SType := 0;

Какой надо тип поставить чтобы шарить папки (0 это шара на диски)?

Если не сложно напишите заполненную функцию SetShareOnDisk() для любой папки! Плиииизззззз

Плохиш (2005-11-10 01:21:00) [9]
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/stgmgmt/fs/netshareadd.asp

ERROR_INVALID_LEVEL

serko (2005-11-10 01:08:00) [10]
ShareResult равно 124!

Плохиш (2005-11-10 00:54:00) [11]
И чему равно ShareResult, партизан фигов?

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »