CLIENT代码：
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, Winsock, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
const
WM_SOCKETEVENT = WM_USER + $1001; // Socket事件响应的消息
WM_SOCKCMEVENT = WM_USER + $1002; // 自定义消息
SCE_LISTENERORR = 1; // Accept发生错误
SCE_ACCEPT = 2; // 接收到一个客户端的请求]
SCE_DISCONNECT= 3; // 一个连接断开
type
TSocketMessage = record // Socket消息的结构定义
Msg: Cardinal;
Socket: TSocket;
SelectEvent: Word;
SelectError: Word;
Result: Longint;
end;
type
TFrmMain = class(TForm)
Memo1: TMemo;
StatusBar1: TStatusBar;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
FSock: TSocket;
WSAData: TWSAData;
function InitSock(): Boolean;
procedure CloseSockAndShowMsg(Sock: TSocket; Text: string);
procedure WMWinSockEvent(var Msg: TSocketMessage); message WM_SOCKETEVENT;
function Client(hWnd: THandle): Boolean;
function ReceivePacket(hWnd: THandle): Boolean;
function SetSelect(hWnd: THandle; lEvent: DWORD): Boolean;
function SendPacket(hWnd: THandle; Length: Integer): Boolean;
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
{$R *.dfm}
procedure TFrmMain.Button1Click(Sender: TObject);
begin
InitSock();
end;
function TFrmMain.Client(hWnd: THandle): Boolean;
begin
Result := True;
end;
function TFrmMain.InitSock: Boolean;
const
IP = '192.168.1.129';
var
FSockAddr_in: sockaddr_in;
begin
Result := True;
// WSAStartup
if WSAStartup($1010, WSAData) <> 0 then
begin
MessageBox(Handle, 'WSAStartup failed', 'Socket', MB_OK);
Exit;
end;
// 得到Socket
FSock := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if FSock = INVALID_SOCKET then
begin
MessageBox(Handle, PChar('Create socket error, errorno: ' + IntToStr(WSAGetLastError)),
'Socket', MB_OK);
WSACleanup();
end;
// Connect
with FSockAddr_in do
begin
sin_family := PF_INET;
sin_addr.S_addr := inet_addr(PChar(IP));
sin_port := htons(10059);
end;
WSAAsyncSelect(FSock, Handle, WM_SOCKETEVENT, FD_CONNECT);
connect(FSock, FSockAddr_in, SizeOf(sockaddr_in))
{ if connect(FSock, FSockAddr_in, SizeOf(sockaddr_in)) = SOCKET_ERROR then
begin
MessageBox(Handle, PChar('connect error, errorno: ' + IntToStr(WSAGetLastError)),
'Socket', MB_OK);
closesocket(FSock);
WSACleanup();
end;
}end;
function TFrmMain.ReceivePacket(hWnd: THandle): Boolean;
begin
Result := True;
end;
function TFrmMain.SendPacket(hWnd: THandle; Length: Integer): Boolean;
begin
Result := True;
end;
function TFrmMain.SetSelect(hWnd: THandle; lEvent: DWORD): Boolean;
begin
Result := True;
end;
procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
closesocket(FSock);
WSACleanup();
end;
procedure TFrmMain.WMWinSockEvent(var Msg: TSocketMessage);
var
Sock: TSocket;
begin
Sock := Msg.Socket;
case Msg.SelectEvent of
FD_CONNECT:
begin
if Msg.SelectError <> 0 then
CloseSockAndShowMsg(Sock, '服务器忙，请稍后再试！')
else
begin
if WSAAsyncSelect(Sock, Handle, Msg.SelectEvent, FD_READ or FD_WRITE or FD_CLOSE) =
SOCKET_ERROR then
CloseSockAndShowMsg(Sock, 'WSAAsyncSelect Failure');
end;
end;
FD_ACCEPT:
begin
end;
FD_READ:
begin
end;
FD_WRITE:
begin
end;
FD_OOB:
begin
end;
FD_CLOSE:
begin
end;
end;
end;
procedure TFrmMain.CloseSockAndShowMsg(Sock: TSocket; Text: string);
begin
if closesocket(Sock) = SOCKET_ERROR then
MessageBox(Handle, PChar('closesocket error, errno: ' + IntToStr(WSAGetLastError)),
'Socket', MB_OK);
if Trim(Text) <> '' then
MessageBox(Handle, PChar(Text), 'Socket', MB_OK);
end;
end.
界面：
object FrmMain: TFrmMain
Left = 319
Top = 103
BorderStyle = bsSingle
Caption = 'FrmMain'
ClientHeight = 453
ClientWidth = 625
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClose = FormClose
PixelsPerInch = 96
TextHeight = 13
object Memo1: TMemo
Left = 0
Top = 0
Width = 625
Height = 393
Align = alTop
ImeName = '智能狂拼3测试版'
Lines.Strings = (
'Memo1')
TabOrder = 0
end
object StatusBar1: TStatusBar
Left = 0
Top = 434
Width = 625
Height = 19
Panels = <>
SimplePanel = False
end
object Button1: TButton
Left = 8
Top = 403
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 2
OnClick = Button1Click
end
end
