usrmain.pas

delphi中的SOCKET使用的简单程序

unit uSrMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, Buttons;

type
  TfmServer = class(TForm)
    ServerSocket1: TServerSocket;
    BitBtn1: TBitBtn;
    Memo1: TMemo;
    Label1: TLabel;
    Edit1: TEdit;
    edtMsg: TEdit;
    Button1: TButton;
    Edit3: TEdit;
    Button2: TButton;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button1Click(Sender: TObject);
    procedure ServerSocket1Accept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure Button2Click(Sender: TObject);
    procedure ServerSocket1ClientWrite(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    procedure GetShareFile(Socket: TCustomWinSocket; sRecText: string);
  end;

var
  fmServer: TfmServer;

implementation

uses StrUtils;

{$R *.dfm}

procedure TfmServer.BitBtn1Click(Sender: TObject);
begin
  if not Self.ServerSocket1.Active then
  begin
    Self.ServerSocket1.Port:=strtoint(Self.Edit1.Text);
    Self.ServerSocket1.Open;
    Self.BitBtn1.Caption:='Stop Server';
  end else
  begin
    Self.ServerSocket1.Close;
    Self.BitBtn1.Caption:='Start Server';
  end;
end;

procedure TfmServer.FormCreate(Sender: TObject);
begin
//
end;

procedure TfmServer.FormDestroy(Sender: TObject);
begin
  Self.ServerSocket1.Active:=False;
end;

procedure TfmServer.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Self.Memo1.Lines.Add(format('建立连接%s(%d)', [Socket.RemoteAddress, Socket.SocketHandle]));
end;

procedure TfmServer.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Self.Memo1.Lines.Add(format('断开连接%s(%d)', [Socket.RemoteAddress, Socket.SocketHandle]));
end;

procedure TfmServer.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  sRecText: string;
begin
  sRecText:= Socket.ReceiveText;

  Self.Memo1.Lines.Add(format('%s(%d):', [Socket.RemoteHost, Socket.SocketHandle]));
  Self.Memo1.Lines.Add(sRecText);
  //
  if LeftStr(sRecText, 11) = '#ShareFile#' then
  begin
    Delete(sRecText, 1, 11);
    Self.GetShareFile(Socket, sRecText);
  end;
end;

procedure TfmServer.ServerSocket1ClientWrite(Sender: TObject; Socket: TCustomWinSocket);
begin
  Self.Memo1.Lines.Add('OnClientWrite:'+Socket.RemoteAddress);
end;

procedure TfmServer.Button1Click(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to Self.ServerSocket1.Socket.ActiveConnections-1 do
    Self.ServerSocket1.Socket.Connections[i].SendText(Self.edtMsg.Text);
  Self.edtMsg.Text:='';
end;

procedure TfmServer.ServerSocket1Accept(Sender: TObject; Socket: TCustomWinSocket);
begin
  Self.Memo1.Lines.Add(format('接受连接%s(%d):', [Socket.RemoteHost, Socket.SocketHandle]));
  Socket.SendText('欢迎来到微积分的聊天室！');
end;

procedure TfmServer.Button2Click(Sender: TObject);
var
  Socket:TCustomWinSocket;
begin
  Socket:=TCustomWinSocket.Create(strtoint(Self.Edit3.Text));
  Socket.SendText(Self.edtMsg.Text);
end;

procedure TfmServer.GetShareFile(Socket: TCustomWinSocket; sRecText: string);
var
  sr: TSearchRec;
  sType, sName: string;
begin
  //Self.Memo1.Lines.Add('sRecText:'+sRecText);
  if sRecText = '' then
  begin
    Socket.SendText(Format('#ShareFile#目录#C:\;', [sType, sName]));
    Socket.SendText(Format('#ShareFile#目录#D:\;', [sType, sName]));
    Socket.SendText(Format('#ShareFile#目录#E:\;', [sType, sName]));
  end else
  begin
    if RightStr(sRecText, 1)<>'\' then
      sRecText:= sRecText + '\';
    //不管如何，子目录下增加一个可以返回上级
    if Length(sRecText)>3 then
      Socket.SendText(Format('#ShareFile#目录#..;', [sType, sName]));
    //  
    if FindFirst(sRecText+'*.*', faAnyFile, sr)=0 then
    begin
      repeat
        if (sr.Attr and faDirectory) = faDirectory then
        begin
          sType:= '目录';
          if (sr.Name = '.') or (sr.Name = '..') then sType:= '';
        end else
          sType:= '文件';
          
        if sType <> '' then
        begin
          sName:= sr.Name;
          Socket.SendText(Format('#ShareFile#%s#%s;', [sType, sName]));
        end;
      until FindNext(sr) <> 0;
      FindClose(sr);
    end;
  end;
end;

end.