mainfrm.~pas

这个 SOCKET 实现图片的传送和生成 在我所有的程序中都使用了这个程序

unit MainFrm;

interface

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

type
   TfrmMain = class(TForm)
      ssServer: TServerSocket;
      edtText: TEdit;
      Label1: TLabel;
      btnSend: TButton;
      btnSendFile: TButton;
      OpenDialog: TOpenDialog;
      mmLog: TMemo;
      procedure FormCreate(Sender: TObject);
      procedure ssServerClientError(Sender: TObject;
         Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
         var ErrorCode: Integer);
      procedure ssServerClientDisconnect(Sender: TObject;
         Socket: TCustomWinSocket);
      procedure ssServerClientConnect(Sender: TObject;
         Socket: TCustomWinSocket);
      procedure ssServerListen(Sender: TObject; Socket: TCustomWinSocket);
      procedure btnSendClick(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
      procedure btnSendFileClick(Sender: TObject);
   private
    { Private declarations }
      FStream: TMemoryStream;
      procedure WriteLog(Log: string);
      procedure SendText(txt: string);
   public
    { Public declarations }
   end;

var
   frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
   ssServer.Open;
   FStream := TMemoryStream.Create;
end;

procedure TfrmMain.ssServerClientError(Sender: TObject;
   Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
   var ErrorCode: Integer);
begin
   WriteLog(Format(Socket.RemoteAddress + '连接错误，错误代码：%d', [ErrorCode]));
   Socket.Close;
   ErrorCode := 0;
end;

procedure TfrmMain.WriteLog(Log: string);
begin
   mmLog.Lines.Add(FormatDateTime('>YYYY-MM-DD HH:NN:SS*> ', Now) + log);
end;

procedure TfrmMain.ssServerClientDisconnect(Sender: TObject;
   Socket: TCustomWinSocket);
begin
   WriteLog(Socket.RemoteAddress + '断开连接');
end;

procedure TfrmMain.ssServerClientConnect(Sender: TObject;
   Socket: TCustomWinSocket);
begin
   WriteLog(Socket.RemoteAddress + '连接成功');
end;

procedure TfrmMain.ssServerListen(Sender: TObject;
   Socket: TCustomWinSocket);
begin
   WriteLog(Format('服务器启动成功，服务端口:%d', [ssServer.Port]));
end;

procedure TfrmMain.SendText(txt: string);
var
   i: Integer;
   Size: Integer;
   Buffer: PChar;
begin
   txt := 'text' + txt;
   Size := Length(txt);
   GetMem(Buffer, Size + 1);
   Buffer[Size] := #0;
   StrPCopy(Buffer, txt);
   for i := 0 to ssServer.Socket.ActiveConnections - 1 do
   begin
      ssServer.Socket.Connections[i].SendBuf(Buffer^, Size);
   end;
   FreeMem(Buffer);
end;

procedure TfrmMain.btnSendClick(Sender: TObject);
begin
   SendText(edtText.Text);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
   FStream.Free;
end;

procedure TfrmMain.btnSendFileClick(Sender: TObject);
var
   Size: Integer;
   Buffer: PChar;
begin
   if Self.OpenDialog.Execute then
   begin
      FStream.LoadFromFile(OpenDialog.FileName);
      FStream.Position := 0;
      Size := FStream.Size;
      Inc(Size, 5);
      GetMem(Buffer, Size + 1);
      FStream.Read(Buffer[4], Size - 5);
      Buffer[0] := 'f';
      Buffer[1] := 'i';
      Buffer[2] := 'l';
      Buffer[3] := 'e';
      Buffer[Size - 1] := 'E';
      Buffer[Size] := #0;
      if ssServer.Socket.ActiveConnections > 0 then
      begin
         WriteLog('发送文件' + OpenDialog.FileName + '，大小：' + IntToStr(Size - 5));
         ssServer.Socket.Connections[0].SendBuf(Buffer^, Size);
      end;
      FreeMem(Buffer);
   end;
end;

end.