delphi共享文件夹

方法一：

unit   Unit1;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Classes,   Graphics,   Controls,   Forms,   Dialogs,  
      ExtCtrls,   StdCtrls,FileCtrl,Shellapi;  
      //directoryExists,SelectDirectory两函数要用到   FileCtrl单元，WinExec要用到ShellApi单元  
   
  type  
      TfrmMain   =   class(TForm)  
          GroupBox1:   TGroupBox;  
          Bevel1:   TBevel;  
          memResult:   TMemo;  
          GroupBox2:   TGroupBox;  
          StaticText1:   TStaticText;  
          edtShareDirectory:   TEdit;  
          btnSelect:   TButton;  
          StaticText2:   TStaticText;  
          edtShareName:   TEdit;  
          edtUserNum:   TEdit;  
          StaticText4:   TStaticText;  
          StaticText3:   TStaticText;  
          edtDescription:   TEdit;  
          CheckBox1:   TCheckBox;  
          RadioGroup1:   TRadioGroup;  
          GroupBox3:   TGroupBox;  
          btnShare:   TButton;  
          btnCancelShare:   TButton;  
          btnExit:   TButton;  
          procedure   btnSelectClick(Sender:   TObject);  
          procedure   btnShareClick(Sender:   TObject);  
          procedure   edtShareDirectoryChange(Sender:   TObject);  
          procedure   FormCreate(Sender:   TObject);  
          procedure   edtUserNumChange(Sender:   TObject);  
          procedure   CheckBox1Enter(Sender:   TObject);  
          procedure   CheckBox1Click(Sender:   TObject);  
          procedure   btnCancelShareClick(Sender:   TObject);  
          procedure   btnExitClick(Sender:   TObject);  
      private  
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      frmMain:   TfrmMain;  
   
  implementation  
   
  {$R   *.DFM}  
  procedure   TfrmMain.btnShareClick(Sender:   TObject);  
  var  
    str:string;  
  begin  
  if   DirectoryExists(edtShareDirectory.text)   then  
      begin  
          if   edtShareName.text=''   then  
              begin  
                showmessage('请指定共享名！');  
                    //提示指定要删除的共享名  
                exit;  
                    //退出Button2Click函数  
              end;  
        str:='command.com   /C   net   share   '+edtShareName.text+'='+edtShareDirectory.text;  
        if   CheckBox1.Checked   then  
            str:=str+'   /UNLIMITED'  
                  //同时访问人数无限制  
            else  
                  str:=str+'   /USERS:'+edtUserNum.text;  
                  //指定可同时访问人数  
                  str:=str+'   /REMARK:'+edtDescription.text;  
          case   RadioGroup1.ItemIndex   of  
              0:str:=str+'   /CACHE:Manual';  
                //手动配置缓存  
              1:str:=str+'   /CACHE:Automatic';  
                //自动配置缓存  
              2:str:=str+'   /CACHE:No';  
                //不需要缓存  
            end;  
   
        if   winexec(pchar(str),sw_hide)>31   then  
          memResult.lines.add(edtShareDirectory.text+'共享成功！')  
          else  
            memResult.lines.add(edtShareDirectory.text+'共享失败！');  
      end;  
  end;  
  procedure   TfrmMain.btnCancelShareClick(Sender:   TObject);  
  var  
    str:string;  
  begin  
  if   DirectoryExists(edtShareDirectory.text)   then  
      begin  
          if   edtShareName.text=''   then  
              begin  
                showmessage('请指定要取消的共享名！');  
                exit;  
              end;  
            str:='command.com   /C   net   share   '+edtShareName.text+'   /delete';  
        if   winexec(pchar(str),sw_hide)>31   then  
          memResult.lines.add(edtShareDirectory.text+'共享取消！')  
          else  
            memResult.lines.add(edtShareDirectory.text+'取消共享失败！');  
      end;  
  end;  
  procedure   TfrmMain.edtShareDirectoryChange(Sender:   TObject);  
  begin  
      edtShareName.text:=ExtractfileName(edtShareDirectory.text);  
  end;  
  procedure   TfrmMain.FormCreate(Sender:   TObject);  
  begin  
      memResult.Lines.Clear;  
  end;  
   
  procedure   TfrmMain.edtUserNumChange(Sender:   TObject);  
  begin  
      try  
          strtoint(edtUserNum.text);  
      except  
          showmessage('请输入整数！');  
      end;  
  end;  
   
  procedure   TfrmMain.CheckBox1Enter(Sender:   TObject);  
  begin  
  CheckBox1.Checked:=not   CheckBox1.Checked;  
      //点击CheckBox1后选择状态反转  
  end;  
   
   
  procedure   TfrmMain.CheckBox1Click(Sender:   TObject);  
  begin  
    if   CheckBox1.Checked   then  
          edtUserNum.Enabled:=false  
          //不限制用户数则使edtUserNum失效  
          else  
                edtUserNum.Enabled:=true;  
  end;  
   
  procedure   TfrmMain.btnSelectClick(Sender:   TObject);  
  var  
      Dir:   string;  
  begin  
  try  
      Dir   :=   'C:/book';  
      if   SelectDirectory(Dir,   [sdAllowCreate,   sdPerformCreate,   sdPrompt],0)   then  
          edtShareDirectory.text:=   Dir;  
          //选择要共享的目录  
  except  
  end;  
  end;  
   
  procedure   TfrmMain.btnExitClick(Sender:   TObject);  
  begin  
      frmMain.Close;  
  end;  
   
  end.

 

=====================================================================

方法二：

unit Share;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

  StdCtrls,FileCtrl,My_Share;

 

type

  TFormShare = class(TForm)

    Label1: TLabel;

    Label2: TLabel;

    Label3: TLabel;

    BtSelect: TButton;

    EditDir: TEdit;// 文件共享目录

    EditSharename: TEdit; // 共享名称

    EditInfo: TEdit;// 备注

    Button1: TButton;

    Button2: TButton;

    procedure BtSelectClick(Sender: TObject);

    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  FormShare: TFormShare;

 

implementation

 

{$R *.DFM}

 

procedure TFormShare.BtSelectClick(Sender: TObject);

var

  directory: string;

begin

  if SelectDirectory(' 选择一个目录 ','', directory) then

    EditDir.Text := directory;

end;

 

procedure TFormShare.Button1Click(Sender: TObject);

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;

  ShareResource('genispan',EditDir.Text,EditSharename.Text,EditInfo.Text);

  { 注意：如果在共享目录名称后面添加 $ 符号，共享后在网络邻居里看不到此文件夹

   但实际上已经共享了，你可以在本地看到 }

end;

 

procedure TFormShare.Button_DelClick(Sender: TObject);// 删除共享文件夹
begin
  NetShareDel('genispan',EditSharename.Text,0);
end;

 

end.

 

以下是单元文件：

 

unit My_Share;

 

interface

uses

   Windows,Sysutils ;

type

  // 纪录类型声明，注意参数类型的正确对应，最好别看 delphi 的帮助，引起误导

  TSHARE_INFO_502 = record

    shi502_netname: PWideChar;

    shi502_type: DWORD;

    shi502_remark: PWideChar;

    shi502_permissions: DWORD;

    shi502_max_uses: DWORD;

    shi502_current_uses: DWORD;

    shi502_path: PWideChar;

    shi502_passwd: PWideChar;

    shi502_reserved: DWORD;

    shi502_security_descriptor: PSECURITY_DESCRIPTOR;

  end;

// 添加共享

function NetShareAdd(servername:Widestring; level: DWORD; Buf: PBYTE;

         var parm_err: PDWORD ): DWORD; stdcall;

// 删除共享

function NetShareDel(ServerName:Widestring; NetName: Widestring;

         Reserved: DWord): Integer; StdCall;

const

  { 共享类型 }

  STYPE_DISKTREE = 0 ;

  STYPE_PRINTQ   = 1 ;

  STYPE_DEVICE   = 2 ;

  STYPE_IPC      = 3 ;

  { 访问权限 }

  ACCESS_READ    = 0 ;

  ACCESS_WRITE   = 1 ;

  ACCESS_CREATE  = 2 ;

  ACCESS_EXEC    = 3 ;

  ACCESS_DELETE  = 4 ;

  ACCESS_ALL     = 7 ;

// 自己声明的函数，为了调用方便，参数就不用说明了吧！

function ShareResource(ServerName,FilePath,NetName, Remark : string): Integer;

//function DeleteShare(ServerName: string; NetName: string): Integer;

implementation

// 注意在 windows95/98/me 下面 dll 库是 SVRAPI.DLL ，而且参数类型也要随之改变的吆！

function NetShareAdd; external 'netapi32.DLL' name 'NetShareAdd';

function NetShareDel; external 'netapi32.DLL' name 'NetShareDel';

 

function ShareResource(ServerName,FilePath,NetName, Remark : string): Integer;

var

  ShInfo: TSHARE_INFO_502;

  parm_err:PDWORD;

  _FilePath,_NetName, _Remark : PWideChar ;

  _ServerName : Pchar ;

begin

  GetMem(_ServerName,255) ; // 分配内存

  GetMem(_FilePath,255);

  GetMem(_NetName,255);

  GetMem(_Remark,255);

  StringToWideChar(FilePath,_FilePath,255); // 字符串转换 , 一定要转换正确

  StringToWideChar(NetName,_NetName,255);

  StringToWideChar(Remark,_Remark,255);

  strpcopy(_ServerName,ServerName);

  // 开始创建结构

  with ShInfo do

  begin

    shi502_netname := _NetName;

    shi502_type := STYPE_DISKTREE ;

    shi502_remark := _Remark ;

    shi502_max_uses := $FFFFFFFF;

    shi502_current_uses := 10;

    shi502_path := _FilePath;

     shi502_passwd := nil;

    shi502_reserved := 0;

    shi502_security_descriptor := nil;

    shi502_permissions := ACCESS_ALL;

  end;

  try

    Result := NetShareAdd(_ServerName, 502, @ShInfo, parm_err);

  Finally // 别忘了释放内存

    FreeMem(_ServerName,255);

    FreeMem(_FilePath,255);

    FreeMem(_NetName,255);

    FreeMem(_Remark,255);

  end;

end;

 

end.

=============================================================

第二种方法在WINXP SP3下测试通过  由于时间关系 第一种方案没有测试