udp 服务器
----
unit PTNS956;
{
设计:张世平
时间:2005-6-24
注意:需要Config956.ini文件配合
}
interface
uses
StrUtils,
Classes,
windows,
Dialogs,
WinSock,
ScktComp,
IniFiles,
SysUtils,
ExtCtrls,
NMUDP,
GlobalDefine,
activex;
resourcestring
StatusDateTimeFormat = 'yyyy/mm/dd" - "hh:nn:ss:zzz AM/PM';
type
TCFG = record
LOCALPORT: integer;
REMOTEHOST: string;
REMOTEPORT: integer;
RepeatTime: integer;
NeedWriteLog: integer;
tcpport: integer;
end;
PMyPobject = ^MyPobject;
MyPobject = record
Msg: PByte;
Len: Integer
end;
TNS956 = class
private
NMUDP1: TNMUDP;
Timer1: TTimer; //计划15秒通过udp向通讯机广播信号
ServerSocket1: TServerSocket;
TimerSend: TTimer; //如果winsock 通,并且发送队列有数据,则发送
procedure WriteLog(ErrStr: string);
procedure Timer1Timer(Sender: tobject);
procedure TimerSendTimer(Sender: tobject);
procedure NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: string; Port: Integer);
procedure ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
public
constructor Create();
function LoadUDPParameter(): BOOLEAN;
function SetUDPParameter(): BOOLEAN;
destructor DESTROY; override;
function Execute(): BOOLEAN;
end;
function FreeBuf(Buffer: PTThreadList): Boolean;
function ReadFromBuf(var MyObject: PMyPobject; var Buffer: PTThreadList): Boolean;
function HaveData(Buffer: PTThreadList): Boolean;
function WriteToBuf(var MyObject: PMyPobject; var Buffer: PTThreadList; Capacity: Integer): Boolean;
procedure Log(LogFilename: string; ErrStr: string);
procedure SendLog(ErrStr: string);
procedure RecLog(ErrStr: string);
function MyPbyteTOStr(MsgOfRead: PByte; NumOfRead: Integer): string;
procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer);
procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength: WORD);
const
iCapacity = 1024;
SelfLog = 'log_956.Log';
SendDataQueue_log = 'log_956_send.log';
ReceiveDataQueue_Log = 'log_956_Rec.log';
var SendDataQueue: PTThreadList; //待发送数据队列
ReceiveDataQueue: PTThreadList; //接收数据
CurPath: string;
CFG: TCFG;
implementation
procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer);
{pbyteArray must point to enough memory to hold the output}
var
i, j: WORD;
tempPtr: PChar;
twoDigits: string[2];
begin
tempPtr := pbyteArray;
j := 1;
for i := 1 to (Length(hHexStr) div 2) do begin
twoDigits := Copy(hHexStr, j, 2);
Inc(j, 2);
PByte(tempPtr)^ := StrToInt('$' + twoDigits);
Inc(tempPtr);
end; {for}
if ((Length(hHexStr) mod 2) = 1) then
begin
twoDigits := '0' + RightStr(hHexStr, 1);
Inc(j, 2);
PByte(tempPtr)^ := StrToInt('$' + twoDigits);
end;
end;
procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength: WORD);
const
HexChars: array[0..15] of Char = '0123456789ABCDEF';
var
i, j: WORD;
begin
hHexStr := '';
j := 1;
for i := 1 to InputLength do begin
hHexStr := hHexStr + Char(HexChars[pbyteArray^ shr 4]);
inc(j);
hHexStr := hHexStr + Char(HexChars[pbyteArray^ and 15]);
inc(j);
inc(pbyteArray);
end;
end;
function MyPbyteTOStr(MsgOfRead: PByte; NumOfRead: Integer): string;
var p: pchar;
begin
p := pchar(MsgOfRead);
result := copy(p, 1, NumOfRead);
end;
procedure Log(LogFilename: string; ErrStr: string);
var
LogFile: TextFile;
begin
if CFG.NeedWriteLog <> 1 then exit;
AssignFile(LogFile, LogFilename);
if FileExists(LogFilename) then Append(LogFile)
else Rewrite(LogFile);
Writeln(LogFile, ErrStr);
CloseFile(LogFile);
end;
procedure TNS956.WriteLog(ErrStr: string);
begin
LOG(CurPath + selflog, DateTimeToStr(now) + ': ' + ErrStr);
end;
procedure SendLog(ErrStr: string);
begin
LOG(CurPath + SendDataQueue_log, ErrStr);
end;
procedure RecLog(ErrStr: string);
begin
LOG(CurPath + ReceiveDataQueue_Log, ErrStr);
end;
function GETINIkey(IniFile: pchar; MAINKEY: pchar; SUBKEY: pchar): pchar; stdcall; //export;
var
myini: Tinifile;
s: string;
begin
myini := Tinifile.Create(IniFile);
s := myini.readString(MAINKEY, SUBKEY, '');
getmem(result, length(s) + 1);
strcopy(result, pchar(s));
myini.Free;
end;
constructor TNS956.Create();
begin
CoInitialize(nil);
NMUDP1 := TNMUDP.Create(nil);
NMUDP1.OnDataReceived := NMUDP1DataReceived;
Timer1 := TTimer.Create(nil);
Timer1.Enabled := false;
timer1.OnTimer := Timer1Timer;
TimerSend := TTimer.Create(nil); //如果winsock 通,并且发送队列有数据,则发送
TimerSend.Enabled := false;
TimerSend.Interval := 1; //时间可以自己定义
TimerSend.OnTimer := TimerSendtimer;
if not LoadUDPParameter() then
begin
writelog('装载config956.ini出错误...');
exit;
end;
ServerSocket1 := tServerSocket.Create(nil);
ServerSocket1.OnClientError := ServerSocket1ClientError;
ServerSocket1.OnClientConnect := ServerSocket1ClientConnect;
ServerSocket1.OnClientDisconnect := ServerSocket1ClientDisconnect;
ServerSocket1.OnClientRead := ServerSocket1ClientRead;
ServerSocket1.OnListen := ServerSocket1Listen;
if not SetUDPParameter() then exit;
ServerSocket1.Active := true;
ServerSocket1.Active := false;
New(SendDataQueue);
SendDataQueue^ := TThreadList.Create;
New(ReceiveDataQueue);
ReceiveDataQueue^ := TThreadList.create;
end;
destructor TNS956.DESTROY;
begin
TIMER1.Enabled := FALSE;
TimerSend.Enabled := FALSE;
ServerSocket1.Active := FALSE;
Timer1.FREE;
TimerSend.Free;
NMUDP1.FREE;
ServerSocket1.Free;
WRITELOG('NS956 服务关闭正常...');
end;
function TNS956.Execute: BOOLEAN;
begin
result := true;
timer1.Enabled := true;
timerSend.Enabled := true;
end;
function TNS956.LoadUDPParameter(): BOOLEAN;
var P: PCHAR;
inifile: pchar;
begin
RESULT := FALSE;
inifile := Pchar(CurPath + 'CONFIG956.INI');
try
P := GETINIkey(inifile, 'UDP', 'LOCALPORT');
CFG.LocalPort := STRTOINT(P);
P := GETINIkey(inifile, 'UDP', 'REMOTEHOST');
CFG.REMOTEHOST := p;
P := GETINIkey(inifile, 'UDP', 'REMOTEport');
CFG.REMOTEPORT := strtoint(p);
P := GETINIkey(inifile, 'UDP', 'RepeatTime');
CFG.RepeatTime := strtoint(p);
P := GETINIkey(inifile, 'UDP', 'NeedWriteLog');
CFG.NeedWriteLog := strtoint(p);
P := GETINIkey(inifile, 'winsock', 'tcpport');
CFG.TCPPort := strtoint(p);
RESULT := TRUE;
except
RESULT := FALSE;
end;
end;
function TNS956.SetUDPParameter(): BOOLEAN;
begin
RESULT := FALSE;
try
WriteLog('UDP服务正在加载...');
NMUDP1.LocalPort := CFG.LocalPort;
WriteLog('UDP开始监视端口:' + inttostr(CFG.LocalPort));
NMUDP1.RemoteHost := CFG.REMOTEHOST;
WriteLog('UDP发送到目标计算机:' + CFG.REMOTEHOST);
NMUDP1.Remoteport := CFG.REMOTEPORT;
NMUDP1.ReportLevel := 2;
WriteLog('UDP发送到目标计算机端口:' + inttostr(CFG.REMOTEPORT));
timer1.Interval := CFG.RepeatTime * 1000;
ServerSocket1.Port := CFG.TCPPort;
// ServerSocket1.ServerType := stNonBlocking;
writelog('winsock server port:' + inttostr(CFG.tcpport));
RESULT := TRUE;
except
RESULT := FALSE;
end;
end;
procedure TNS956.Timer1Timer(Sender: tobject);
var
MyStream: TMemoryStream;
TmpStr: string;
begin
TmpStr := formatdatetime(StatusDateTimeFormat, now());
MyStream := TMemoryStream.Create;
try
MyStream.Write(TmpStr[1], Length(tmpstr));
NMUDP1.SendStream(MyStream);
finally
MyStream.Free;
end;
writelog('send:' + tmpstr);
end;
procedure TNS956.TimerSendTimer(Sender: tobject);
var
wmsg: PMyPobject;
i, ii: integer;
FoundSockConnecte: boolean;
TmpStr:string;
begin
ServerSocket1.Active := true; //确使ServerSocket1不要停止
if not HaveData(SendDataQueue) then exit;
FoundSockConnecte := false;
with ServerSocket1.Socket do
begin
for i := 0 to activeconnections - 1 do
if connections.Connected then FoundSockConnecte := true;
end;
if not FoundSockConnecte then exit;
//---上面有点粗造:应该考虑是我们指定/认可的sock连接,才发数据
//而且发指定/属于它的数据
//但实际上 目前我们认为只有一台client sock 和它连接
try
wmsg := nil;
if not ReadFromBuf(wmsg, SendDataQueue) then exit;
if wmsg = nil then exit;
with ServerSocket1.Socket do
begin
for i := 0 to activeconnections - 1 do
if connections.Connected then
connections.SendBuf(wmsg.msg^, wmsg.Len); // .SendText(inttostr(ii));
BytesToHexStr(TmpStr, wmsg.Msg, wmsg.Len);
// SendLog(MyPbyteTOStr(wmsg.Msg, wmsg.Len));
SendLog(TmpStr);
end;
finally
if wmsg <> nil then
begin
if wmsg^.Msg <> nil then
FreeMem(wmsg.Msg, wmsg.Len);
Dispose(wmsg);
end;
end;
end;
procedure TNS956.NMUDP1DataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: string; Port: Integer);
var
MyStream: TMemoryStream;
TmpStr: string;
begin
MyStream := TMemoryStream.Create;
if NumberBytes < 1 then exit;
try
NMUDP1.ReadStream(MyStream);
SetLength(TmpStr, NumberBytes);
MyStream.Read(TmpStr[1], NumberBytes);
writelog('Receive:' + FromIP + ': ' + TmpStr);
finally
MyStream.Free;
end;
end;
procedure TNS956.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ErrorCode := 0;
end;
procedure TNS956.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
writelog('winsock found a user connect...');
end;
procedure TNS956.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
writelog('winsock found a user disconnect...');
end;
procedure TNS956.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
bufRecv: PByte;
iLength: Integer;
wmsg: PMyPobject;
TmpStr: string;
begin
iLength := Socket.ReceiveLength;
GetMem(bufRecv, iLength);
Socket.ReceiveBuf(bufRecv^, iLength); //// // p := pchar(bufRecv); //bufRecv^错误 zsp
new(wmsg);
GetMem(wmsg.Msg, iLength);
CopyMemory(wmsg.Msg, bufRecv, iLength); // wmsg.Msg^ := MsgOfWrite^; //正确,但不能指向 wmsg.Msg := bufRecv; //zsp测试通过
wmsg.Len := iLength;
WriteToBuf(wmsg, ReceiveDataQueue, iCapacity);
freeMem(bufRecv, iLength);
BytesToHexStr(TmpStr, wmsg.msg, iLength);
// RecLog(MyPbyteTOStr(wmsg.Msg, wmsg.Len));
RecLog(TmpStr);
end;
procedure TNS956.ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
WRITELOG('Winsock Listening...');
end;
function ReadFromBuf(var MyObject: PMyPobject; var
Buffer: PTThreadList): Boolean;
var
tmpList: TList;
begin
result := true;
tmpList := Buffer^.LockList;
try
if tmpList.Count > 0 then
begin
MyObject := tmpList.First;
tmpList.Delete(0);
tmpList.Pack;
end
else
begin
MyObject := nil;
result := false;
end;
finally
begin
Buffer^.UnlockList;
end;
end;
end;
function FreeBuf(Buffer: PTThreadList): Boolean;
var
tmpList: TList;
wmsg: pMyPobject;
begin
result := true;
tmpList := Buffer^.LockList;
while tmpList.Count > 0 do
begin
wmsg := PMyPobject(tmpList.Last);
tmpList.Delete(tmplist.Count - 1);
tmplist.Pack;
if wmsg <> nil then
begin
if wmsg^.Msg <> nil then
FreeMem(wmsg.Msg, wmsg.Len);
Dispose(wmsg);
end;
end
end;
function HaveData(Buffer: PTThreadList): Boolean;
var
tmpList: TList;
begin
tmpList := Buffer^.LockList;
if tmpList.Count > 0 then
result := true
else
result := false;
Buffer^.UnlockList;
end;
function WriteToBuf(var MyObject: PMyPobject; var
Buffer: PTThreadList; Capacity: Integer): Boolean;
var
tmpList: TList;
wmsg: PMyPobject;
begin
tmpList := Buffer^.LockList;
try
while tmpList.Count >= Capacity do
begin
wmsg := tmpList.First;
tmpList.Delete(0);
tmpList.Pack;
if wmsg <> nil then
begin
if wmsg^.Msg <> nil then
FreeMem(wmsg.Msg, wmsg.Len);
Dispose(wmsg);
end;
end;
tmpList.Add(MyObject);
tmpList.Pack;
finally
begin
Buffer^.UnlockList;
end;
end;
result := true;
end;
end.