serverform.pas

外国人写的各种类型的源代码,有兴趣的朋友看看吧！是学习的好东西哟

unit ServerForm;

interface

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

const
  wm_RefreshClients = wm_User;

type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    Label2: TLabel;
    lbLog: TListBox;
    Image1: TImage;
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ThreadEnd(Sender: TObject;
      Thread: TServerClientThread);
    procedure ServerSocket1ThreadStart(Sender: TObject;
      Thread: TServerClientThread);
    procedure ServerSocket1ClientWrite(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    strFile: string;
  public
    procedure SockEvt (Sender: TObject; Socket: TCustomWinSocket;
      SocketEvent: TSocketEvent);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  lbLog.Items.Add ('Connected: ' +
    Socket.RemoteHost + ' (' +
    Socket.RemoteAddress + ')' );
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  lbLog.Items.Add ('Disconnected: ' +
    Socket.RemoteHost + ' (' +
    Socket.RemoteAddress + ')' );
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  // receives the file
  lbLog.Items.Add ('File requested: ' + strFile);
  strFile := Socket.ReceiveText;
end;

procedure TForm1.ServerSocket1ThreadEnd(Sender: TObject;
  Thread: TServerClientThread);
begin
  lbLog.Items.Add ('Thread completed: ' + IntToStr (Thread.ThreadID));
end;

procedure TForm1.ServerSocket1ThreadStart(Sender: TObject;
  Thread: TServerClientThread);
begin
  lbLog.Items.Add ('Thread started: ' + IntToStr (Thread.ThreadID));
  Thread.ClientSocket.OnSocketEvent := SockEvt;
end;

procedure TForm1.ServerSocket1ClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
var
  MemStream: TMemoryStream;
begin
  // sends back a bitmap anyway
  if FileExists (strFile) then
  begin
    lbLog.Items.Add ('Sending file: ' + strFile);
    Socket.SendStream (TFileStream.Create (
      strFile, fmOpenRead or fmShareDenyWrite));
  end
  else
  begin
    lbLog.Items.Add ('Invalid Request: ' + strFile);
    MemStream := TMemoryStream.Create;
    Image1.Picture.Bitmap.SaveToStream (MemStream);
    MemStream.Position := 0;
    Socket.SendStream (MemStream);
  end;
end;

procedure TForm1.SockEvt(Sender: TObject; Socket: TCustomWinSocket;
  SocketEvent: TSocketEvent);
begin
  Beep;
end;

end.