unit UnitTCPUDP;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,WinSock, ExtCtrls, ComCtrls,inif iles,StrUtils;
const
WM_SOCK = WM_USER + 82; {自定义windows消息}
//在tcp 服务器方式下,WM_SOCK为监听消息
// WM_SOCK+1到 WM_SOCK+MAX_ACCEPT 为与连接客户端进行通讯时的消息
MAX_ACCEPT=100;
FD_SET= MAX_ACCEPT;
type
TFormTCPUDP = class(TForm)
BtnSend: TButton;
MemoReceive: TMemo;
EditSend: TEdit;
Label2: TLabel;
Label3: TLabel;
Bevel2: TBevel;
STOpCode: TStaticText;
STIndex: TStatic Text;
STCommand: TStatic Text;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
GroupBox3: TGroupBox;
RBTCP: TRadioButton;
RBUDP: TRadioButton;
Panel1: TPanel;
RBClient: TRadioButton;
RBServer: TRadioButton;
GroupBox4: TGroupBox;
BtnConnect: TButton;
BtnClose: TButton;
Bevel1: TBevel;
StatusBar1: TStatusBar;
PanelDest: TPanel;
Label4: TLabel;
EditRemoteHost: TEdit;
Label5: TLabel;
EditRemotePort: TEdit;
Label6: TLabel;
CmbSendTo: TComboBox;
Label7: TLabel;
PanelLocal: TPanel;
ChkBind: TCheckBox;
EditHostPort: TEdit;
Label1: TLabel;
procedure BtnSendClick(Sender: TObject);
procedure BtnConnectClick(Sender: TObject);
procedure RBTCPClick(Sender: TObject);
procedure RBUDPClick(Sender: TObject);
procedure BtnCloseClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure RBClientClick(Sender: TObject);
procedure RBServerClick(Sender: TObject);
procedure ChkBindClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure EditHostPortChange(Sender: TObject);
procedure EditRemoteHostChange(Sender: TObject);
procedure EditRemotePortChange(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure CmbSendToKeyPress(Sender: TObject; var Key: Char); {消息接送}
private
{ Private declarations }
FirstFlag:Boolean;
INIPath:String;
procedure R eadData(var Message: TMessage);
function ReadTCPUDPIni():boolean; //读取配置信息
procedure Wri t eIniStr(FileName:String;section:string;Ident:string;StringValue:string);//写系统信息 procedure Wri t eIniBool(FileName:String;section:string;Ident:string;BoolValue:Boolean);//写系统信息 protected
{ Protected declarations }
{ other fields and methods}
procedure wndproc(var message:Tmessage);override;
public
{ Public declarations }
end;
const
DATA_LENGTH =120; //数据长度
type
TUDPaction = packed record
opcode:byte; //操作码
index:word; //序列号
Command:byte; //命令字
data:array[0..(DATA_LENGTH-1)] of char; //数据
end;
var
FormTCPUDP: TFormTCPUDP;
AcceptSock:Array[0..MAX_ACCEPT] OF Tsocket;
FSockAccept : Array[0..MAX_ACCEPT] OF TSockAddrIn;
AcceptSockFlag: Array[0..MAX_ACCEPT] OF boolean;
AcceptNum:integer=0;
socket通信在哪一层FSockLocal : TSockAddrIn;
PackageID:integer=0; //包序号
BindFlag:Boolean=true;
TcpFlag:Boolean=false;
ServerFlag:Boolean=false;
function WinSockInital(Handle: HWnd):bool;
Procedure WinSockClose();
implementation
{$R *.dfm}
{始化SOCKET}
function WinSockInital(Handle: HWnd):bool;
var TempWSAData: TWSAData;
i:integer;
begin
result := false;
{ 1 初始化SOCKET}
if WSAStartup(2, TempWSAData)=1 then //2表示启用winsock2
exi t;
{若是用UDP通信，则用}
if TcpFlag then
AcceptSock[0]:=Socket(AF_INET,SOCK_STREAM,0)
else
AcceptSock[0]:=Socket(AF_INET,SOCK_DGRAM,0);
if AcceptSock[0]=SOCKET_ERROR then
exi t;
if (BindFlag and not tcpflag) or (Serverflag and tcpflag) then
if bind(AcceptSock[0],FSockLocal,sizeof(FSockLocal))<>0 then
begin
WinSockClose();
exit;
end;
if Tcpflag then
if Serverflag then
begin
if Listen(AcceptSock[0],1)<>0 then //等待连接队列的最大长度为1
begin
&
nbsp;WinSockClose();
exi t;
end;
end
else
if connect(AcceptSock[0],FSockAccept[0],sizeof(FSockAccept[0]))<>0 then
begin
WinSockClose();
exi t;
end;
{FD_READ 在读就绪的时候, 产生WM_SOCK 自定义消息号}
if not TcpFlag then
WSAAsyncSelect(AcceptSock[0], Handle , WM_SOCK, FD_READ)
else if Serverflag then
WSAAsyncSelect(AcceptSock[0], Handle , WM_SOCK, FD_READ or FD_ACCEPT or FD_CLOSE) else
WSAAsyncSelect(AcceptSock[0], Handle , WM_SOCK, FD_READ or FD_CLOSE);
R esult:=true;
end;
{关闭SOCKET}
Procedure WinSockClose();
var i:integer;
begin
for i:=1 to MAX_ACCEPT DO
if AcceptSockFlag[i] then
begin
CloseSocket(AcceptSock[i]);
AcceptSockFlag[i]:=false;
end;
CloseSocket(AcceptSock[0]); {closesocket函数用来关闭一个描述符为AcceptSock[0]套接字}
WSACleanup;
end;
function TFormTCPUDP.ReadTCPUDPIni():boolean;
var ti:TiniFile;
begin
ti:=TIniFile.Create(INIPath+'TCPUDP.ini');
<:=ti.ReadString('Setting','LocalPort','');
ChkBind.Checked:=ti.ReadBool('Setting','BindStatus',false);
:=ti.ReadString('Setting','RemotePort','');
:=ti.ReadString('Setting','R emoteHost','');
RBTCP.Checked:=ti.ReadBool('Setting','TCPStatus',false);
RBUDP.Checked:=not RBTCP.Checked;
RBServer.Checked:=ti.R eadBool('Setting','ServerStatus',false);
RBClient.Checked:=not RBServer.Checked;
end;
procedure TFormTCPUDP.WriteIniStr(FileName:String;Section:string;Ident:string;StringValue:string); var ti:TiniFile;
begin
ti:=TIniFile.Create(FileName);
ti.writestring(section,Ident,StringValue);
ti.Free;
end;
procedure TFormTCPUDP.WriteIniBool(FileName:String;Section:string;Ident:string;BoolValue:Boolean); var ti:TiniFile;
begin
ti:=TIniFile.Create(FileName);
ti.writebool(section,Ident,BoolValue);
ti.Free;
end;
procedure TFormTCPUDP.BtnSendClick(Sender: TObject);
var SEND_PACKAGE : TUDPaction; //数据发送
i:integer;
s:String;
begin
Fillchar(SEND_PACKAGE.data,Data_Length,chr(0));
SEND_PACKAGE.data[0]:='1';
SEND_PACKAGE.data[1]:='2';
SEND_PACKAGE.data[2]:='3';
SEND_PACKAGE.opcode:=2;
SEND_PACKAGE.index:=PackageID;
SEND_PACKAGE.Command:=3;
s:=editsend.Text;
for i:=0 to length(EditSend.Text)-1 do
SEND_PACKAGE.data[i]:=s[i+1];
PackageID:=PackageID+1;
if not (Tcpflag and Serverflag) then
sendto(AcceptSock[0], SEND_PACKAGE,sizeof(SEND_PACKAGE), 0, FSockAccept[0], sizeof(FSockAcce pt[0]))
else if AcceptNum=0 then
Application.MessageBox('没有一个客户端和您建立连接','信息提示',MB_OK)
else
begin
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论