W
wonder365
Unregistered / Unconfirmed
GUEST, unregistred user!
program TransServer;{$APPTYPE CONSOLE}uses SysUtils, Winsock, Windows, IdHTTP, Classes;type TParam=record TrdId:integer;
Sckt:TSocket;
end;
function UserAuth(cMobileNumberChar;cPwd Char ):integer;cdecl;
external 'Auth.dll';{按照ch分割字符串Source,并存储在arstr中}function SplitString(var arstr: array of string;
const Source: string;
ch: Char): integer;var i, head: Integer;
begin
result := 0;
if Source = '' then
begin
arstr[1] := '';
inc(result);
exit;
end;
head := 1;
for i := 1 to length(Source)do
begin
if Source = ch then
begin
arstr[result] := copy(Source, head, i - head);
head := i + 1;
inc(result);
end;
end;
arstr[result] := copy(Source, head, length(Source) - head + 1);
inc(result);
end;
///////////////////////////////////////////////////////////////////////////////子线程函数function ChildThrd(pointer):LongInt;stdcall;Const RecvSize=1024000;var PkLen:integer;
ThreadId:integer;
ASocket:TSocket;
buf:array[0..1024] of char;
//StrArrRe:Array [0..19] of String;
IntRe:integer;
a,bChar;
IdHTTP: TIdHTTP;
StrTest:string;
BufRecvchar;
StrList:TStringList;//测试 StrArrRe:Array [0..19] of String;
StrMobileNumber,StrPwd:String;
begin
Result:=-1;
ThreadId:=TParam(p^).TrdId;
ASocket:=TParam(p^).Sckt;
Writeln('Thread '+IntToStr(ThreadId)+' Create');
FillChar(buf,SizeOf(buf),0);
PkLen:=Recv(ASocket,buf,SizeOf(buf),0);
//接收数据 //拆分客户端传来的(日志、登录验证请求)信息A|B|C SplitString(StrArrRe,buf,'|');
[red]GetMem(BufRecv,RecvSize);
//分配发送空间[/red] [red]ZeroMemory(bufRecv,RecvSize);
//初始化空间[/red] if(SameText(StrArrRe[0],'authme')) then
begin
StrMobileNumber:=StrArrRe[1];
StrPwd:=StrArrRe[2];
IntRe:=-9999;
IntRe:=UserAuth(pChar(StrMobileNumber),pChar(StrPwd));
Writeln('result is :' +StrMobileNumber+'::'+inttostr(IntRe));
StrPCopy(bufRecv,inttostr(IntRe));
Send(ASocket,bufRecv^,Length(bufRecv),0);//发送数据 end else
begin
//------------------------------------------------- IdHTTP:= TIdHTTP.Create(nil);
[red]StrPCopy(bufRecv,IdHTTP.Get(buf));[/red] IdHTTP.Free;
if PkLen>0 then
begin
Send(ASocket,bufRecv^,Length(bufRecv),0);//发送数据 end;
end;
Writeln(buf);
CloseSocket(ASocket);
//关闭socket Dispose(p);
FreeMem(BufRecv);
Writeln('Thread '+IntToStr(ThreadId)+' End');
Writeln('Socket '+IntToStr(ASocket)+' DisConnect');
end;
//主程序var MyWSA: WSAData;
Svr,Clt: TSockAddr;
NameLen:Integer;
hSocket,s: TSocket;
TimeOut:integer;
ThreadCount:integer;
hThread:Thandle;
ThreadIDWord;
Param:^TParam;
begin
If WSAStartup(MAKEWORD(2,2), MyWSA) <> 0 then
//初始化 begin
WSACleanup;
Writeln('WSAStartup() Fail');
Exit;
end;
hSocket := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
//创建socket If hSocket = INVALID_SOCKET then
begin
WSACleanup;
Writeln('Socket() Fail');
Exit;
end;
Svr.sin_family := AF_INET;
Svr.sin_port := htons(9999);
//server端口号为9999 Svr.sin_addr.S_addr := inet_addr(PChar('10.12.252.251'));//server的ip地址为127.0.0.1 If Bind(hSocket, Svr, SizeOf(Svr)) = SOCKET_ERROR then
//绑定socket begin
CloseSocket(hSocket);
WSACleanup;
Writeln('Bind() Fail');
Exit;
end;
if Listen(hSocket,256) = SOCKET_ERROR then
//socket开始侦听,最大同时连接数为256个 begin
CloseSocket(hSocket);
WSACleanup;
Writeln('Listen() Fail');
Exit;
end;
TimeOut:=3000;
ThreadCount:=0;
Writeln('Listening......');
while truedo
begin
NameLen:=SizeOf(Clt);
s:=Accept(hSocket,@Clt,@NameLen);//接受一个连接 if s = SOCKET_ERROR then
begin
CloseSocket(hSocket);
WSACleanup;
Writeln('Accept() Fail');
Exit;
end else
begin
Writeln('Socket '+IntToStr(s)+' Connect');
if SetSockOpt(s,SOL_SOCKET,SO_RCVTIMEO,PChar(@TimeOut),SizeOf(TimeOut))=SOCKET_ERROR then
//设置接收超时为3秒 begin
CloseSocket(s);
CloseSocket(hSocket);
WSACleanup;
Writeln('SetSockOpt() Fail');
Exit;
end;
if SetSockOpt(s,SOL_SOCKET,SO_SNDTIMEO,PChar(@TimeOut),SizeOf(TimeOut))=SOCKET_ERROR then
//设置发送超时为3秒 begin
CloseSocket(s);
CloseSocket(hSocket);
WSACleanup;
Writeln('SetSockOpt() Fail');
Exit;
end;
new(Param);
Param^.TrdId:=ThreadCount;
Param^.Sckt:=s;
hThread:=CreateThread(nil,0,@ChildThrd,Param,0,ThreadID);
//创建childthrd子线程 if hThread=0 then
begin
Writeln('CreateThread() Fail');
end else
begin
Inc(ThreadCount);
end;
end;
end;
CloseSocket(hSocket);
//关闭socket WSACleanup;
end.
使用专业软件测试工具进行多客户并发(同一时间点并发)压力测试时发现这段服务程序很容易就出现内存冲突了(比较汗的是,4个客户的压力就没办法支持了),目前主要发现是红色字体部分有问题。
Sckt:TSocket;
end;
function UserAuth(cMobileNumberChar;cPwd Char ):integer;cdecl;
external 'Auth.dll';{按照ch分割字符串Source,并存储在arstr中}function SplitString(var arstr: array of string;
const Source: string;
ch: Char): integer;var i, head: Integer;
begin
result := 0;
if Source = '' then
begin
arstr[1] := '';
inc(result);
exit;
end;
head := 1;
for i := 1 to length(Source)do
begin
if Source = ch then
begin
arstr[result] := copy(Source, head, i - head);
head := i + 1;
inc(result);
end;
end;
arstr[result] := copy(Source, head, length(Source) - head + 1);
inc(result);
end;
///////////////////////////////////////////////////////////////////////////////子线程函数function ChildThrd(pointer):LongInt;stdcall;Const RecvSize=1024000;var PkLen:integer;
ThreadId:integer;
ASocket:TSocket;
buf:array[0..1024] of char;
//StrArrRe:Array [0..19] of String;
IntRe:integer;
a,bChar;
IdHTTP: TIdHTTP;
StrTest:string;
BufRecvchar;
StrList:TStringList;//测试 StrArrRe:Array [0..19] of String;
StrMobileNumber,StrPwd:String;
begin
Result:=-1;
ThreadId:=TParam(p^).TrdId;
ASocket:=TParam(p^).Sckt;
Writeln('Thread '+IntToStr(ThreadId)+' Create');
FillChar(buf,SizeOf(buf),0);
PkLen:=Recv(ASocket,buf,SizeOf(buf),0);
//接收数据 //拆分客户端传来的(日志、登录验证请求)信息A|B|C SplitString(StrArrRe,buf,'|');
[red]GetMem(BufRecv,RecvSize);
//分配发送空间[/red] [red]ZeroMemory(bufRecv,RecvSize);
//初始化空间[/red] if(SameText(StrArrRe[0],'authme')) then
begin
StrMobileNumber:=StrArrRe[1];
StrPwd:=StrArrRe[2];
IntRe:=-9999;
IntRe:=UserAuth(pChar(StrMobileNumber),pChar(StrPwd));
Writeln('result is :' +StrMobileNumber+'::'+inttostr(IntRe));
StrPCopy(bufRecv,inttostr(IntRe));
Send(ASocket,bufRecv^,Length(bufRecv),0);//发送数据 end else
begin
//------------------------------------------------- IdHTTP:= TIdHTTP.Create(nil);
[red]StrPCopy(bufRecv,IdHTTP.Get(buf));[/red] IdHTTP.Free;
if PkLen>0 then
begin
Send(ASocket,bufRecv^,Length(bufRecv),0);//发送数据 end;
end;
Writeln(buf);
CloseSocket(ASocket);
//关闭socket Dispose(p);
FreeMem(BufRecv);
Writeln('Thread '+IntToStr(ThreadId)+' End');
Writeln('Socket '+IntToStr(ASocket)+' DisConnect');
end;
//主程序var MyWSA: WSAData;
Svr,Clt: TSockAddr;
NameLen:Integer;
hSocket,s: TSocket;
TimeOut:integer;
ThreadCount:integer;
hThread:Thandle;
ThreadIDWord;
Param:^TParam;
begin
If WSAStartup(MAKEWORD(2,2), MyWSA) <> 0 then
//初始化 begin
WSACleanup;
Writeln('WSAStartup() Fail');
Exit;
end;
hSocket := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
//创建socket If hSocket = INVALID_SOCKET then
begin
WSACleanup;
Writeln('Socket() Fail');
Exit;
end;
Svr.sin_family := AF_INET;
Svr.sin_port := htons(9999);
//server端口号为9999 Svr.sin_addr.S_addr := inet_addr(PChar('10.12.252.251'));//server的ip地址为127.0.0.1 If Bind(hSocket, Svr, SizeOf(Svr)) = SOCKET_ERROR then
//绑定socket begin
CloseSocket(hSocket);
WSACleanup;
Writeln('Bind() Fail');
Exit;
end;
if Listen(hSocket,256) = SOCKET_ERROR then
//socket开始侦听,最大同时连接数为256个 begin
CloseSocket(hSocket);
WSACleanup;
Writeln('Listen() Fail');
Exit;
end;
TimeOut:=3000;
ThreadCount:=0;
Writeln('Listening......');
while truedo
begin
NameLen:=SizeOf(Clt);
s:=Accept(hSocket,@Clt,@NameLen);//接受一个连接 if s = SOCKET_ERROR then
begin
CloseSocket(hSocket);
WSACleanup;
Writeln('Accept() Fail');
Exit;
end else
begin
Writeln('Socket '+IntToStr(s)+' Connect');
if SetSockOpt(s,SOL_SOCKET,SO_RCVTIMEO,PChar(@TimeOut),SizeOf(TimeOut))=SOCKET_ERROR then
//设置接收超时为3秒 begin
CloseSocket(s);
CloseSocket(hSocket);
WSACleanup;
Writeln('SetSockOpt() Fail');
Exit;
end;
if SetSockOpt(s,SOL_SOCKET,SO_SNDTIMEO,PChar(@TimeOut),SizeOf(TimeOut))=SOCKET_ERROR then
//设置发送超时为3秒 begin
CloseSocket(s);
CloseSocket(hSocket);
WSACleanup;
Writeln('SetSockOpt() Fail');
Exit;
end;
new(Param);
Param^.TrdId:=ThreadCount;
Param^.Sckt:=s;
hThread:=CreateThread(nil,0,@ChildThrd,Param,0,ThreadID);
//创建childthrd子线程 if hThread=0 then
begin
Writeln('CreateThread() Fail');
end else
begin
Inc(ThreadCount);
end;
end;
end;
CloseSocket(hSocket);
//关闭socket WSACleanup;
end.
使用专业软件测试工具进行多客户并发(同一时间点并发)压力测试时发现这段服务程序很容易就出现内存冲突了(比较汗的是,4个客户的压力就没办法支持了),目前主要发现是红色字体部分有问题。