unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, WinSock, StdCtrls, ExtCtrls;
type
TfrmMainSocket = class(TForm)
mmoInfo: TMemo;
btnSend: TButton;
edtMsg: TEdit;
grp1: TGroupBox;
edtIP: TEdit;
lbl1: TLabel;
lbl2: TLabel;
edtPort: TEdit;
btnSet: TButton;
procedure btnSendClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnSetClick(Sender: TObject);
private
FStrIp: string;
FPort: Integer;
FSendbuff: array[0..1023] of Char;
FRevbuff: array[0..1023] of Char;
function InitWinSocket: Boolean;
procedure ClearnWinSocket;
procedure SendMessageToServer;
public
{ Public declarations }
end;
var
frmMainSocket: TfrmMainSocket;
implementation
uses
usocketThread;
{$R *.dfm}
procedure TfrmMainSocket.btnSendClick(Sender: TObject);
begin
with TSocketThread.Create do
begin
BeginStart(SendMessageToServer, nil, btnSend);
end;
end;
procedure TfrmMainSocket.btnSetClick(Sender: TObject);
begin
if (edtIP.Text <> '') and (edtPort.Text <> '') then
begin
FStrIp := edtIP.Text;
FPort := StrToInt(edtPort.Text);
btnSet.Enabled := False;
end;
end;
procedure TfrmMainSocket.ClearnWinSocket;
begin
WSACleanup;
end;
function TfrmMainSocket.InitWinSocket: Boolean;
var
wData: WSAData;
begin
Result := WSAStartup(MakeWord(2, 2), wData) = 0;
end;
procedure TfrmMainSocket.SendMessageToServer;
var
sock: TSocket;
SockAddr: TSockAddr;
begin
if (edtMsg.Text = '') or (edtIP.Text = '') or (edtPort.Text = '') then
Exit;
FillChar(SockAddr, sizeof(SockAddr), $0);
sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
try
SockAddr.sin_family := AF_INET;
SockAddr.sin_port := htons(FPort);
SockAddr.sin_addr.S_addr := inet_addr(PChar(FStrIp));
StrCopy(FSendbuff, PChar(edtMsg.Text));
if connect(sock, SockAddr, sizeof(SOCKADDR_IN)) = SOCKET_ERROR then
begin
ShowMessageFmt('connect socket error,[%d]', [WSAGetLastError]);
Exit;
end;
if send(sock, FSendbuff, SizeOf(FSendbuff), 0) > 0 then
begin
if recv(sock, FRevbuff, SizeOf(FRevbuff), 0) > 0 then
begin
mmoInfo.Lines.Add(StrPas(FRevbuff));
FillChar(FRevbuff, sizeof(FRevbuff), $0);
end;
end;
FillChar(FSendbuff, sizeof(FSendbuff), $0);
finally
closesocket(sock);
end;
end;
procedure TfrmMainSocket.FormCreate(Sender: TObject);
begin
InitWinSocket;
end;
procedure TfrmMainSocket.FormDestroy(Sender: TObject);
begin
ClearnWinSocket;
end;
end.
//线程单元
unit usocketThread;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls;
type
TOnSocketEvent = procedure of object;
TOnSocketEventFinally = procedure(const ExecuteInfo: string) of object;
TSocketThread = class(TThread)
private
FControl: TWinControl;
FOnSocketEvent: TOnSocketEvent;
FOnSocketEventFinally: TOnSocketEventFinally;
procedure _Finally(Sender: TObject);
protected
procedure Execute; override;
public
constructor Create;
function BeginStart(AOnSocketEvent: TOnSocketEvent;
AOnSocketEventFinally: TOnSocketEventFinally;
AControl: TWinControl): Boolean;
property OnSocketEvent: TOnSocketEvent read FOnSocketEvent write FOnSocketEvent;
property OnSocketEventFinally: TOnSocketEventFinally read FOnSocketEventFinally write FOnSocketEventFinally;
end;
implementation
{ TSocketThread }
function TSocketThread.BeginStart(AOnSocketEvent: TOnSocketEvent;
AOnSocketEventFinally: TOnSocketEventFinally; AControl: TWinControl): Boolean;
begin
FOnSocketEvent := AOnSocketEvent;
FOnSocketEventFinally := AOnSocketEventFinally;
FControl := AControl;
if Assigned(FControl) then
FControl.Enabled := False;
Self.Resume;
Result := True;
end;
constructor TSocketThread.Create;
begin
inherited Create(True);
FreeOnTerminate := True;
Priority := tpLowest;
OnTerminate := _Finally;
end;
procedure TSocketThread.Execute;
begin
inherited;
if Assigned(FOnSocketEvent) then
FOnSocketEvent;
end;
procedure TSocketThread._Finally(Sender: TObject);
begin
if Assigned(FControl) then
FControl.Enabled := True;
if Assigned(FOnSocketEventFinally) then
FOnSocketEventFinally('ok!');
end;
end.