設置共享

[99j1]

請問在程序中如何設置能使文件夾或磁盤共享?(調用註冊表設置也行)請問如何實現?

[大地精灵]

可以用楼上的，c:\temp，就是你要设置的文件夹，如果是磁盘的话就写根目录就行了，删除的话用下一句就行了
WinExec('net.exe share MyShare=/delete', SW_HIDE)

[大地精灵]

不好意思，写错了语句是这样的，删除语句是这样的
WinExec('net.exe share MyShare/delete', SW_HIDE)

[王集鹄]

WinExec('net.exe share MyShare=c:\temp', SW_HIDE)

[99j1]

目前共享可以,但刪除共享還不行,何故?另外這樣設置的共享為完全共享,能否控制它的權限呢?(如只設置它為只讀)

[99j1]

up

[webnetmax]

下加如下面这个单元
unit My_Share;

interface
uses
SysUtils;
type
Share_Info50 = packed record
shi50_netname: array[0..12] of Char; {13}
shi50_type: Byte;
shi50_flags: Word;
shi50_remark: PChar;
shi50_path: PChar;
shi50_rw_password: array[0..8] of Char; {9}
shi50_ro_password: array[0..8] of Char;
end;
const
STYPE_DISKTREE = 0; {磁盘共享}
STYPE_PRINTQ = 1; {打印机共享}


SHI50F_RDONLY = 1; { 只读共享}
SHI50F_FULL = 2; { 完全共享}
SHI50F_DEPENDSON = (SHI50F_RDONLY or SHI50F_FULL); {进入需要口令}

SHI50F_PERSIST = 256; {此选项：计算机重新启动后才生效}
SHI50F_SYSTEM = 512; {此选项：即时生效，且击右键无法看到共享}
function ShareResource(ServerName: PChar; FilePath: PChar;
NetName: PChar; Remark: PChar;
ShareType: Byte; Flags: Word;
RWPass: PChar; ROPass: PChar): Integer;
function DeleteShare(ServerName: PChar; NetName: PChar): Integer;
function NetShareAdd(ServerName: PChar; ShareLevel: SmallInt; Buffer: Pointer; Size: Word): Integer; StdCall;
function NetShareDel(ServerName: PChar; NetName: PChar; Reserved: Word): Integer; StdCall;

implementation

function ShareResource(ServerName: PChar; FilePath: PChar;
NetName: PChar; Remark: PChar;
ShareType: Byte; Flags: Word;
RWPass: PChar; ROPass: PChar): Integer; {目录共享}
var
MyShare: Share_Info50;
PMyShare: ^Share_Info50;
begin
strLcopy(MyShare.shi50_netname, NetName, 13);
MyShare.shi50_type := ShareType;
MyShare.shi50_flags := Flags;
MyShare.shi50_remark := Remark;
MyShare.shi50_path := FilePath;
strLcopy(MyShare.shi50_rw_password, RWPass, 9);
strLcopy(MyShare.shi50_ro_password, ROPass, 9);
PMyShare := @MyShare;
Result := NetShareAdd(ServerName, 50, PMyShare, SizeOf(MyShare));
end;

function DeleteShare(ServerName: PChar; NetName: PChar): Integer; {撤消共享目录}
begin
Result := NetShareDel(ServerName, NetName, 0);
end;

function NetShareAdd; external 'SVRAPI.DLL';
function NetShareDel; external 'SVRAPI.DLL';{注意：NT/2000下要改为NETAPI32.DLL，可以在程序中判断系统来加载不同的DLL }
end.
//////////////////////////////////////////////////////////////////////////////////
然后在在Unit1中调用：
unit Unit1;

interface

uses
Windows, FileCtrl, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
BtSelect: TButton;
EditDir: TEdit;
Label1: TLabel;
EditSharename: TEdit;
Label2: TLabel;
Label3: TLabel;
EditInfo: TEdit;
Button2: TButton;
CheckBox1: TCheckBox;
Label4: TLabel;
Label5: TLabel;
procedure Button1Click(Sender: TObject);
procedure BtSelectClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
haha: Boolean;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation
uses My_Share;
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
S1, S2: string;
begin
if EditDir.Text = '' then
begin

Application.MessageBox('请先选择一个目录！', '黑洞', MB_ICONINFORMATION + MB_OK);
BtSelect.Click;
Exit;
end;
if EditSharename.Text = '' then
begin
Application.MessageBox('请先输入共享名称！', '黑洞', MB_ICONINFORMATION + MB_OK);
EditSharename.SetFocus;
Exit;
end;

S1 := UpperCase(EditDir.Text);
S2 := UpperCase(EditSharename.Text);
DeleteShare(nil, Pchar(S2));
sleep(500);
if CheckBox1.Checked then
ShareResource(nil, pchar(S1), Pchar(S2), Pchar(EditInfo.Text), STYPE_DISKTREE, SHI50F_FULL { or SHI50F_SYSTEM}, '', '')
else
ShareResource(nil, pchar(S1), Pchar(S2), Pchar(EditInfo.Text), STYPE_DISKTREE, SHI50F_RDONLY { or SHI50F_SYSTEM}, '', '')
{注意：改为ShareResource(nil, pchar(S1), Pchar(S2), Pchar(EditInfo.Text), STYPE_DISKTREE, SHI50F_FULL or SHI50F_SYSTEM, '', '')
击右键将看不见共享，但实际上已经共享了！
还有一个小技巧：共享名后面叫一个$号则共享后别人打开网上邻居看不到却可以访问.
}
end;

procedure TForm1.BtSelectClick(Sender: TObject);
var
directory: string;
begin
if SelectDirectory('选择一个目录', '', directory) then EditDir.Text := directory;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
S: string;
begin
S := UpperCase(EditSharename.Text);
if S <> '' then
DeleteShare(nil, Pchar(S))
else
Application.MessageBox('请先输入共享名称！', '黑洞', MB_ICONINFORMATION + MB_OK);

end;

procedure TForm1.FormPaint(Sender: TObject);
begin
if haha then
begin
haha := False;
Self.Left := 0;
while Self.Left < ((screen.width div 2) - (Self.Width div 2)) do
begin
Self.Left := self.Left + 2;
end; //窗口从左向右出现
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
while Self.Left < screen.Width do
begin //窗口向右消失
Self.Left := Self.Left + 10;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
haha := True;
end;

end.

[webnetmax]

对。我给的代码中其实就是用的function NetUserAdd

[wlw88]

老大还是用
function NetUserAdd(Server:PWideChar;Level:DWORD;Buf:pointer;ParmError:dword):LongInt;
stdcall; external 'netapi32.dll';
这个函数吧