設置共享

Question

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

Answer 1

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

Answer 2

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

Answer 3

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

Answer 4

下加如下面这个单元
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_re: 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; Re: 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;implementationfunction ShareResource(ServerName: PChar; FilePath: PChar;
  NetName: PChar; Re: 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_re := Re;
  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;interfaceuses
  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.

Answer 5

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

Answer 6

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