unit1.~pas

网络编程十个重要的实例

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.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.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.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.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.btnExitClick(Sender: TObject);
begin
  frmMain.Close;
end;

end.