G
glcsgf
Unregistered / Unconfirmed
GUEST, unregistred user!
端口影射的原代码:
unit UMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ScktComp, StdCtrls, TypInfo, AppEvnts;
type
TChState = (csReady,
csInUse,
csShutDown, csError);
TSktState = (ssReady,
ssStart, ssInit, ssWork,
ssFinish, ssError);
TSrvSkt = class
protected
FChId: Integer;
FActive: Boolean;
FConnected: Boolean;
FClient: TClientSocket;
procedure SetChId(const Value: Integer);
procedure SetActive(const Value: Boolean);
procedure SetConnected(const Value: Boolean);
procedure SetClient(const Value: TClientSocket);
public
State: TSktState;
Skt2: TSrvSkt;
BuffSize: Integer;
RecvBuff: String;
SendBuff: String;
LastTick: Integer;
RecvBytes: Integer;
SendBytes: Integer;
Socket: TCustomWinSocket;
Params: TStringList;
function Elapsed: Integer;
function Receive(var Buff: String): Integer; virtual;
function InitSkt: Boolean; virtual;
procedure CleanUp; virtual;
procedure Timer; virtual;
procedure Event(SocketEvent: TSocketEvent); virtual;
procedure Error(ErrorEvent: TErrorEvent;
var ErrorCode: Integer); virtual;
function Transfer: Integer; virtual;
property ChId: Integer read FChId write SetChId;
property Active: Boolean read FActive write SetActive;
property Client: TClientSocket read FClient write SetClient;
property Connected: Boolean read FConnected write SetConnected;
constructor Create; virtual;
destructor Destroy; override;
end;
TClientSkt = class(TSrvSkt)
public
function InitSkt: Boolean; override;
procedure CleanUp; override;
procedure Event(SocketEvent: TSocketEvent); override;
end;
TChanel = record
Skt1: TSrvSkt;
Skt2: TSrvSkt;
State: TChState;
SessId: String;
end;
TMainFrm = class(TForm)
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
ListBox1: TListBox;
Button3: TButton;
Button4: TButton;
Server1: TServerSocket;
Client1: TClientSocket;
Timer1: TTimer;
ApplicationEvents1: TApplicationEvents;
Button5: TButton;
Label3: TLabel;
Label4: TLabel;
CheckBox1: TCheckBox;
Label5: TLabel;
Label6: TLabel;
Edit3: TEdit;
Label7: TLabel;
procedure Server1Listen(Sender: TObject; Socket: TCustomWinSocket);
procedure Button1Click(Sender: TObject);
procedure Server1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Server1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Server1ClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Server1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure Server1ClientWrite(Sender: TObject;
Socket: TCustomWinSocket);
procedure Client1Connect(Sender: TObject; Socket: TCustomWinSocket);
procedure Client1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure Client1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Client1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Client1Write(Sender: TObject; Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
procedure Button5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Label5DblClick(Sender: TObject);
procedure Label4DblClick(Sender: TObject);
private
{ Private declarations }
public
MaxDelayCt: Integer;
LastChId: Integer;
RemoteAddr: String;
RemotePort: Integer;
Chns: array of TChanel;
{ Public declarations }
procedure LogMsg(S: String);
function InitChanels(AMaxs: Integer): Integer;
function NewChanel(var LastId: Integer): Integer;
function FreeChanel(ChnId: Integer): Integer;
function CheckChanel(ChnId: Integer): Integer;
function ScanDelays(AMaxWait: Integer): Integer;
end;
var
MainFrm: TMainFrm;
implementation
{$R *.dfm}
{ TSrvSkt }
procedure TSrvSkt.CleanUp;
begin
if Assigned(Socket) and
(Socket is TServerClientWinSocket) then
begin
if Socket.Connected then
Socket.Close;
Socket := nil;
end;
RecvBuff := '';
SendBuff := '';
State := ssReady;
end;
constructor TSrvSkt.Create;
begin
Params := TStringList.Create;
BuffSize := 10*1024;
LastTick := GetTickCount;
end;
destructor TSrvSkt.Destroy;
begin
Active := False;
Params.Free;
inherited;
end;
function TSrvSkt.Elapsed: Integer;
begin
Result := Integer(GetTickCount) - LastTick;
end;
procedure TSrvSkt.Error(ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
State := ssError;
if Assigned(Socket) and
Socket.Connected then
begin
Socket.Close;
end;
Socket := nil;
LastTick := GetTickCount;
end;
procedure TSrvSkt.Event(SocketEvent: TSocketEvent);
begin
case SocketEvent of
seConnect:
begin
State := ssWork;
Skt2.Connected := True;
LastTick := GetTickCount;
end;
seDisconnect:
begin
if State = ssWork then
State := ssFinish;
Socket := nil;
LastTick := GetTickCount;
end;
seRead:
begin
Skt2.Transfer;
LastTick := GetTickCount;
end;
seWrite:
begin
if Transfer > 0 then
LastTick := GetTickCount;
end;
end;
end;
function TSrvSkt.InitSkt: Boolean;
begin
State := ssStart;
RecvBuff := '';
SendBuff := '';
RecvBytes := 0;
SendBytes := 0;
LastTick := GetTickCount;
Params.Clear;
Result := True;
end;
function TSrvSkt.Receive(var Buff: String): Integer;
var
s: String;
begin
Result := 0;
if Assigned(Socket) and
(State <> ssError) and
(Socket.ReceiveLength > 0) then
begin
if (Length(Buff) < BuffSize) or
(State = ssFinish) then
begin
s := Socket.ReceiveText;
Result := Length(s);
if Result > 0 then
begin
Buff := Buff + s;
Inc(RecvBytes, Result);
end;
end;
end;
end;
procedure TSrvSkt.SetActive(const Value: Boolean);
begin
if FActive <> Value then
begin
if Value then
begin
FActive := InitSkt;
SetChId(FChId);
end
else
begin
CleanUp;
FActive := Value;
end;
end;
end;
procedure TSrvSkt.SetChId(const Value: Integer);
begin
FChId := Value;
if Assigned(Socket) then
begin
Socket.Data := Pointer(Value);
end;
end;
procedure TSrvSkt.SetClient(const Value: TClientSocket);
begin
if Assigned(FClient) then
begin
FClient.OnConnect := Value.OnConnect;
FClient.OnDisconnect := Value.OnDisconnect;
FClient.OnError := Value.OnError;
FClient.OnRead := Value.OnRead;
FClient.OnWrite := Value.OnWrite;
end;
end;
procedure TSrvSkt.SetConnected(const Value: Boolean);
begin
if Assigned(Client) then
begin
Client.Active := Value;
end;
end;
procedure TSrvSkt.Timer;
begin
if State = ssWork then
begin
Transfer;
if Skt2.State in [ssFinish, ssError] then
begin
if not Assigned(Socket) then
State := ssFinish
else if Socket.Connected and
(Length(SendBuff) <= 0) then
begin
State := ssFinish;
end;
end;
end;
end;
function TSrvSkt.Transfer: Integer;
begin
Result := 0;
if Assigned(Socket) and
(State = ssWork) and
Socket.Connected then
begin
Skt2.Receive(SendBuff);
Result := Socket.SendText(SendBuff);
if Result > 0 then
begin
Delete(SendBuff, 1, Result);
Inc(SendBytes, Result);
LastTick := GetTickCount;
end;
end;
end;
{ TMainFrm }
function TMainFrm.InitChanels(AMaxs: Integer): Integer;
var
i, m, n: Integer;
begin
m := AMaxs;
if m <= -1 then m := -1;
n := Length(Chns);
for i := m + 1 to n - 1 do
begin
Chns.Skt1.Free;
Chns.Skt2.Free;
end;
SetLength(Chns, m + 1);
for i := n to m do
begin
Chns.Skt1 := TSrvSkt.Create;
Chns.Skt2 := TClientSkt.Create;
Chns.Skt1.Skt2 := Chns.Skt2;
Chns.Skt2.Skt2 := Chns.Skt1;
Chns.State := csReady;
Chns.SessId := '';
end;
Result := Length(Chns) - 1;
end;
procedure TMainFrm.LogMsg(S: String);
var
t: String;
begin
if CheckBox1.Checked then
begin
t := FormatDateTime('hh:nn:ss.zzz', Now) + ' ' + s;
ListBox1.ItemIndex := ListBox1.Items.Add(t);
end;
end;
procedure TMainFrm.Server1Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
LogMsg('开始运行 ...');
end;
procedure TMainFrm.Button1Click(Sender: TObject);
var
Len: Integer;
begin
RemoteAddr := Edit1.Text;
RemotePort := StrToIntDef(Edit2.Text, 19999);
Timer1.Enabled := True;
Len := InitChanels(100);
MaxDelayCt := Len * 5;
server1.Port := StrToIntDef(Edit3.Text, 20000);
Server1.Active := True;
end;
function TMainFrm.FreeChanel(ChnId: Integer): Integer;
var
i: Integer;
begin
i := ChnId;
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Active := False;
Chns.Skt2.Active := False;
Chns.State := csReady;
end;
LogMsg(Format('[%d,0]FreeChanel', ));
Result := ChnId;
end;
function TMainFrm.NewChanel(var LastId: Integer): Integer;
var
i: Integer;
begin
Result := 0;
if LastId < 1 then LastId := 1;
if LastId >= Length(Chns) then
LastId := 1;
for i := LastId to Length(Chns) - 1 do
begin
if Chns.State = csReady then
begin
Result := i;
Break;
end;
end;
if Result <= 0 then
begin
for i := 1 to LastId - 1 do
begin
if Chns.State = csReady then
begin
Result := i;
Break;
end;
end;
end;
LastId := Result;
end;
procedure TMainFrm.Server1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i, t: Integer;
begin
Timer1Timer(Sender);
t := Integer(Socket.Data);
i := NewChanel(LastChId);
if (t < 0) and (i <= 0) then
begin
Socket.Data := Pointer(t);
end
else
if (i > 0) and (i < Length(Chns)) then
begin
Socket.Data := Pointer(i);
Chns.State := csInUse;
Chns.Skt1.Active := True;
Chns.Skt1.Socket := Socket;
Chns.Skt1.ChId := i;
Chns.Skt2.Active := True;
Chns.Skt2.ChId := i;
Chns.Skt2.Client.Host := RemoteAddr;
Chns.Skt2.Client.Port := RemotePort;
Chns.Skt2.Client := Client1;
Chns.Skt1.Event(seConnect);
LogMsg(Format('[%d,1]Connect %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end
else if Server1.Socket.ActiveConnections < MaxDelayCt then
begin
// 如果连接总数没有超过延迟总数,
// 进行延迟处理
LogMsg(Format('[%d,1]Delay %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
Socket.Data := Pointer(-1);
end
else
begin
// 如果没有空闲通道,
// 并且如果连接总数超过延迟限额
// 立即断开此连接
LogMsg(Format('[%d,1]Refused %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
Socket.Data := nil;
if Socket.Connected then
Socket.Close;
end;
end;
procedure TMainFrm.Server1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i: Integer;
begin
i := Integer(Socket.Data);
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Event(seDisconnect);
end;
LogMsg(Format('[%d,1]Disconnect %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end;
procedure TMainFrm.Server1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var
i, m: Integer;
t: String;
begin
i := Integer(Socket.Data);
m := ErrorCode;
t := GetEnumName(TypeInfo(TErrorEvent), Ord(ErrorEvent));
LogMsg(Format('[%d,1]Error %s:%d Err: %s, Code: %d',
[i, Socket.RemoteAddress,
Socket.RemotePort, t, m]));
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Error(ErrorEvent, ErrorCode);
end;
ErrorCode := 0;
end;
procedure TMainFrm.Server1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
i, m: Integer;
begin
i := Integer(Socket.Data);
m := Socket.ReceiveLength;
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Event(seRead);
end;
LogMsg(Format('[%d,1]OnRead %s:%d R: %5d B',
[i, Socket.RemoteAddress,
Socket.RemotePort, m]));
end;
procedure TMainFrm.Server1ClientWrite(Sender: TObject;
Socket: TCustomWinSocket);
var
i: Integer;
begin
i := Integer(Socket.Data);
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Event(seWrite);
end;
LogMsg(Format('[%d,1]OnWrite %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end;
procedure TMainFrm.Client1Connect(Sender: TObject;
Socket: TCustomWinSocket);
var
i: Integer;
begin
i := Integer(Socket.Data);
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt2.Event(seConnect);
end;
LogMsg(Format('[%d,2]Connect %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end;
procedure TMainFrm.Client1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i: Integer;
begin
i := Integer(Socket.Data);
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt2.Event(seDisconnect);
end;
LogMsg(Format('[%d,2]Disconnect %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end;
procedure TMainFrm.Client1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
i, m: Integer;
t: String;
begin
i := Integer(Socket.Data);
m := ErrorCode;
t := GetEnumName(TypeInfo(TErrorEvent), Ord(ErrorEvent));
LogMsg(Format('[%d,2]Error %s:%d Err: %s, Code: %d',
[i, Socket.RemoteAddress,
Socket.RemotePort, t, m]));
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt2.Error(ErrorEvent, ErrorCode);
end;
ErrorCode := 0;
end;
procedure TMainFrm.Client1Read(Sender: TObject; Socket: TCustomWinSocket);
var
i, m: Integer;
begin
i := Integer(Socket.Data);
m := Socket.ReceiveLength;
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt2.Event(seRead);
end;
LogMsg(Format('[%d,2]OnRead %s:%d R: %5d B',
[i, Socket.RemoteAddress,
Socket.RemotePort, m]));
end;
procedure TMainFrm.Client1Write(Sender: TObject; Socket: TCustomWinSocket);
var
i: Integer;
begin
i := Integer(Socket.Data);
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt2.Event(seWrite);
end;
LogMsg(Format('[%d,2]OnWrite %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end;
function TMainFrm.CheckChanel(ChnId: Integer): Integer;
var
i, m: Integer;
begin
i := ChnId;
Result := 0;
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Timer;
Chns.Skt2.Timer;
if Chns.State = csInUse then
begin
if (Chns.Skt1.State = ssFinish) or
(Chns.Skt1.State = ssFinish) then
begin
Chns.State := csShutDown;
end;
if (Chns.Skt1.State = ssError) or
(Chns.Skt1.State = ssError) then
begin
Chns.State := csError;
end;
end;
m := 0;
if (Chns.Skt1.State in [ssFinish, ssError]) and
(Chns.Skt2.State in [ssFinish, ssError]) and
((Chns.Skt1.Elapsed > 100) or
(Chns.Skt2.Elapsed > 100)) then
begin
m := m + 1;
end
else
if (Chns.State in [csShutDown, csError]) and
((Chns.Skt1.Elapsed > 1000) or
(Chns.Skt2.Elapsed > 1000)) then
begin
m := m + 1;
end;
if m > 0 then
begin
FreeChanel(i);
end;
end;
end;
function TMainFrm.ScanDelays(AMaxWait: Integer): Integer;
var
i, m, n, t: Integer;
Socket: TCustomWinSocket;
begin
m := Server1.Socket.ActiveConnections;
Result := 0;
// 处理延迟的连接
for i := 0 to m - 1 do
begin
Socket := Server1.Socket.Connections;
n := Integer(Socket.Data);
if n < 0 then
begin
Socket.Data := Pointer;
t := NewChanel(LastChId);
if t > 0 then
begin
Server1ClientConnect(Self, Socket);
end
else
begin
// 如果发生无空闲会话通道,
// 则等待一个周期
Break;
end;
end;
end;
// 处理延迟超时的连接
for i := m - 1 downto 0 do
begin
Socket := Server1.Socket.Connections;
n := Integer(Socket.Data);
if n < 0 then
begin
// 对延迟的连接进行计数
Result := Result + 1;
n := -n;
n := n + 1;
if n >= AMaxWait then
begin
// 发生延迟超时
LogMsg(Format('[%d,1]Delay timeout %s:%d',
[-n, Socket.RemoteAddress,
Socket.RemotePort]));
if Socket.Connected then
begin
Socket.Close;
end;
end;
end;
end;
end;
{ TClientSkt }
procedure TClientSkt.CleanUp;
begin
inherited;
if Assigned(FClient) then
FreeAndNil(FClient);
Socket := nil;
end;
procedure TClientSkt.Event(SocketEvent: TSocketEvent);
begin
case SocketEvent of
seConnect:
begin
State := ssWork;
if Skt2.State = ssWork then
begin
Transfer;
end;
end;
seDisconnect:
begin
if State = ssWork then
begin
State := ssFinish;
Skt2.Transfer;
end;
end;
else
begin
inherited;
end;
end;
end;
function TClientSkt.InitSkt: Boolean;
begin
Result := inherited InitSkt;
FClient := TClientSocket.Create(nil);
Socket := FClient.Socket;
end;
procedure TMainFrm.Button2Click(Sender: TObject);
begin
InitChanels(-1);
Server1.Active := False;
end;
procedure TMainFrm.Timer1Timer(Sender: TObject);
var
i, ct, st: Integer;
begin
ct := Server1.Socket.ActiveConnections;
st := 0;
for i := 1 to Length(Chns) - 1 do
begin
if Chns.State <> csReady then
begin
CheckChanel(i);
st := st + 1;
end;
end;
if Assigned(Sender) and
(Sender is TTimer) then
begin
// 如果等待15秒钟都没有进行处理,则认为延迟超时
i := ScanDelays(15*1000 div Timer1.Interval);
if i > Label6.Tag then Label6.Tag := i;
Label6.Caption := IntToStr(Label6.Tag);
Caption := Format('Connections: %d,' +
' Sessions: %d, Delays: %d', [ct, st, i]);
Application.Title := Format('C: %d (S: %d, D: %d)', [ct, st, i]);
end;
end;
procedure TMainFrm.Button4Click(Sender: TObject);
begin
ListBox1.Clear;
end;
procedure TMainFrm.Button3Click(Sender: TObject);
var
i, m: Integer;
s, t, t1, t2: String;
begin
for i := 1 to Length(Chns) - 1 do
begin
if Chns.State <> csReady then
begin
m := GetTickCount;
t1 := GetEnumName(TypeInfo(TSktState), Ord(Chns.Skt1.State));
t2 := GetEnumName(TypeInfo(TSktState), Ord(Chns.Skt2.State));
s := Format('[%d,S], Sock1: $%s, Sock2: $%s, S: %d, R: %d',
[
i,
IntToHex(Integer(Chns.Skt1.Socket), 8),
IntToHex(Integer(Chns.Skt2.Socket), 8),
Chns.Skt2.SendBytes,
Chns.Skt1.SendBytes
]);
LogMsg(s);
t := GetEnumName(TypeInfo(TChState), Ord(Chns.State));
s := Format(
' %s, S1: %s, S2: %s, SdBf: %d, RvBf: %d',
[
t, t1, t2,
Length(Chns.Skt2.SendBuff),
Length(Chns.Skt1.SendBuff)
]);
LogMsg(s);
s := Format(' Tick1: %d, Tick2: %d, Now: %d',
[Chns.Skt1.Elapsed, Chns.Skt2.Elapsed, m]);
LogMsg(s);
end;
end;
end;
procedure TMainFrm.ApplicationEvents1Exception(Sender: TObject;
E: Exception);
begin
LogMsg('Error: ' + E.Message);
Label3.Tag := Label3.Tag + 1;
Label3.Caption := IntToStr(Label3.Tag);
LogMsg('Track:');
Button3Click(Sender);
end;
procedure TMainFrm.Button5Click(Sender: TObject);
begin
ListBox1.Items.SaveToFile('no169kls.log');
end;
procedure TMainFrm.FormCreate(Sender: TObject);
begin
Button4Click(Sender);
end;
procedure TMainFrm.Label5DblClick(Sender: TObject);
begin
Label6.Tag := 0;
Label6.Caption := '';
end;
procedure TMainFrm.Label4DblClick(Sender: TObject);
begin
Label3.Tag := 0;
Label3.Caption := '';
end;
end.
怎么在以上端口影射程序中实现:比如当一个客户端连接映射程序的指定端口,发送一个010B9D0000数据包,我要在他发送的出去前,将其过滤为022BC40000,在发送到映射程序映射的程序端口上。
unit UMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ScktComp, StdCtrls, TypInfo, AppEvnts;
type
TChState = (csReady,
csInUse,
csShutDown, csError);
TSktState = (ssReady,
ssStart, ssInit, ssWork,
ssFinish, ssError);
TSrvSkt = class
protected
FChId: Integer;
FActive: Boolean;
FConnected: Boolean;
FClient: TClientSocket;
procedure SetChId(const Value: Integer);
procedure SetActive(const Value: Boolean);
procedure SetConnected(const Value: Boolean);
procedure SetClient(const Value: TClientSocket);
public
State: TSktState;
Skt2: TSrvSkt;
BuffSize: Integer;
RecvBuff: String;
SendBuff: String;
LastTick: Integer;
RecvBytes: Integer;
SendBytes: Integer;
Socket: TCustomWinSocket;
Params: TStringList;
function Elapsed: Integer;
function Receive(var Buff: String): Integer; virtual;
function InitSkt: Boolean; virtual;
procedure CleanUp; virtual;
procedure Timer; virtual;
procedure Event(SocketEvent: TSocketEvent); virtual;
procedure Error(ErrorEvent: TErrorEvent;
var ErrorCode: Integer); virtual;
function Transfer: Integer; virtual;
property ChId: Integer read FChId write SetChId;
property Active: Boolean read FActive write SetActive;
property Client: TClientSocket read FClient write SetClient;
property Connected: Boolean read FConnected write SetConnected;
constructor Create; virtual;
destructor Destroy; override;
end;
TClientSkt = class(TSrvSkt)
public
function InitSkt: Boolean; override;
procedure CleanUp; override;
procedure Event(SocketEvent: TSocketEvent); override;
end;
TChanel = record
Skt1: TSrvSkt;
Skt2: TSrvSkt;
State: TChState;
SessId: String;
end;
TMainFrm = class(TForm)
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
ListBox1: TListBox;
Button3: TButton;
Button4: TButton;
Server1: TServerSocket;
Client1: TClientSocket;
Timer1: TTimer;
ApplicationEvents1: TApplicationEvents;
Button5: TButton;
Label3: TLabel;
Label4: TLabel;
CheckBox1: TCheckBox;
Label5: TLabel;
Label6: TLabel;
Edit3: TEdit;
Label7: TLabel;
procedure Server1Listen(Sender: TObject; Socket: TCustomWinSocket);
procedure Button1Click(Sender: TObject);
procedure Server1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Server1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Server1ClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Server1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure Server1ClientWrite(Sender: TObject;
Socket: TCustomWinSocket);
procedure Client1Connect(Sender: TObject; Socket: TCustomWinSocket);
procedure Client1Disconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure Client1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Client1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure Client1Write(Sender: TObject; Socket: TCustomWinSocket);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
procedure Button5Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Label5DblClick(Sender: TObject);
procedure Label4DblClick(Sender: TObject);
private
{ Private declarations }
public
MaxDelayCt: Integer;
LastChId: Integer;
RemoteAddr: String;
RemotePort: Integer;
Chns: array of TChanel;
{ Public declarations }
procedure LogMsg(S: String);
function InitChanels(AMaxs: Integer): Integer;
function NewChanel(var LastId: Integer): Integer;
function FreeChanel(ChnId: Integer): Integer;
function CheckChanel(ChnId: Integer): Integer;
function ScanDelays(AMaxWait: Integer): Integer;
end;
var
MainFrm: TMainFrm;
implementation
{$R *.dfm}
{ TSrvSkt }
procedure TSrvSkt.CleanUp;
begin
if Assigned(Socket) and
(Socket is TServerClientWinSocket) then
begin
if Socket.Connected then
Socket.Close;
Socket := nil;
end;
RecvBuff := '';
SendBuff := '';
State := ssReady;
end;
constructor TSrvSkt.Create;
begin
Params := TStringList.Create;
BuffSize := 10*1024;
LastTick := GetTickCount;
end;
destructor TSrvSkt.Destroy;
begin
Active := False;
Params.Free;
inherited;
end;
function TSrvSkt.Elapsed: Integer;
begin
Result := Integer(GetTickCount) - LastTick;
end;
procedure TSrvSkt.Error(ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
State := ssError;
if Assigned(Socket) and
Socket.Connected then
begin
Socket.Close;
end;
Socket := nil;
LastTick := GetTickCount;
end;
procedure TSrvSkt.Event(SocketEvent: TSocketEvent);
begin
case SocketEvent of
seConnect:
begin
State := ssWork;
Skt2.Connected := True;
LastTick := GetTickCount;
end;
seDisconnect:
begin
if State = ssWork then
State := ssFinish;
Socket := nil;
LastTick := GetTickCount;
end;
seRead:
begin
Skt2.Transfer;
LastTick := GetTickCount;
end;
seWrite:
begin
if Transfer > 0 then
LastTick := GetTickCount;
end;
end;
end;
function TSrvSkt.InitSkt: Boolean;
begin
State := ssStart;
RecvBuff := '';
SendBuff := '';
RecvBytes := 0;
SendBytes := 0;
LastTick := GetTickCount;
Params.Clear;
Result := True;
end;
function TSrvSkt.Receive(var Buff: String): Integer;
var
s: String;
begin
Result := 0;
if Assigned(Socket) and
(State <> ssError) and
(Socket.ReceiveLength > 0) then
begin
if (Length(Buff) < BuffSize) or
(State = ssFinish) then
begin
s := Socket.ReceiveText;
Result := Length(s);
if Result > 0 then
begin
Buff := Buff + s;
Inc(RecvBytes, Result);
end;
end;
end;
end;
procedure TSrvSkt.SetActive(const Value: Boolean);
begin
if FActive <> Value then
begin
if Value then
begin
FActive := InitSkt;
SetChId(FChId);
end
else
begin
CleanUp;
FActive := Value;
end;
end;
end;
procedure TSrvSkt.SetChId(const Value: Integer);
begin
FChId := Value;
if Assigned(Socket) then
begin
Socket.Data := Pointer(Value);
end;
end;
procedure TSrvSkt.SetClient(const Value: TClientSocket);
begin
if Assigned(FClient) then
begin
FClient.OnConnect := Value.OnConnect;
FClient.OnDisconnect := Value.OnDisconnect;
FClient.OnError := Value.OnError;
FClient.OnRead := Value.OnRead;
FClient.OnWrite := Value.OnWrite;
end;
end;
procedure TSrvSkt.SetConnected(const Value: Boolean);
begin
if Assigned(Client) then
begin
Client.Active := Value;
end;
end;
procedure TSrvSkt.Timer;
begin
if State = ssWork then
begin
Transfer;
if Skt2.State in [ssFinish, ssError] then
begin
if not Assigned(Socket) then
State := ssFinish
else if Socket.Connected and
(Length(SendBuff) <= 0) then
begin
State := ssFinish;
end;
end;
end;
end;
function TSrvSkt.Transfer: Integer;
begin
Result := 0;
if Assigned(Socket) and
(State = ssWork) and
Socket.Connected then
begin
Skt2.Receive(SendBuff);
Result := Socket.SendText(SendBuff);
if Result > 0 then
begin
Delete(SendBuff, 1, Result);
Inc(SendBytes, Result);
LastTick := GetTickCount;
end;
end;
end;
{ TMainFrm }
function TMainFrm.InitChanels(AMaxs: Integer): Integer;
var
i, m, n: Integer;
begin
m := AMaxs;
if m <= -1 then m := -1;
n := Length(Chns);
for i := m + 1 to n - 1 do
begin
Chns.Skt1.Free;
Chns.Skt2.Free;
end;
SetLength(Chns, m + 1);
for i := n to m do
begin
Chns.Skt1 := TSrvSkt.Create;
Chns.Skt2 := TClientSkt.Create;
Chns.Skt1.Skt2 := Chns.Skt2;
Chns.Skt2.Skt2 := Chns.Skt1;
Chns.State := csReady;
Chns.SessId := '';
end;
Result := Length(Chns) - 1;
end;
procedure TMainFrm.LogMsg(S: String);
var
t: String;
begin
if CheckBox1.Checked then
begin
t := FormatDateTime('hh:nn:ss.zzz', Now) + ' ' + s;
ListBox1.ItemIndex := ListBox1.Items.Add(t);
end;
end;
procedure TMainFrm.Server1Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
LogMsg('开始运行 ...');
end;
procedure TMainFrm.Button1Click(Sender: TObject);
var
Len: Integer;
begin
RemoteAddr := Edit1.Text;
RemotePort := StrToIntDef(Edit2.Text, 19999);
Timer1.Enabled := True;
Len := InitChanels(100);
MaxDelayCt := Len * 5;
server1.Port := StrToIntDef(Edit3.Text, 20000);
Server1.Active := True;
end;
function TMainFrm.FreeChanel(ChnId: Integer): Integer;
var
i: Integer;
begin
i := ChnId;
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Active := False;
Chns.Skt2.Active := False;
Chns.State := csReady;
end;
LogMsg(Format('[%d,0]FreeChanel', ));
Result := ChnId;
end;
function TMainFrm.NewChanel(var LastId: Integer): Integer;
var
i: Integer;
begin
Result := 0;
if LastId < 1 then LastId := 1;
if LastId >= Length(Chns) then
LastId := 1;
for i := LastId to Length(Chns) - 1 do
begin
if Chns.State = csReady then
begin
Result := i;
Break;
end;
end;
if Result <= 0 then
begin
for i := 1 to LastId - 1 do
begin
if Chns.State = csReady then
begin
Result := i;
Break;
end;
end;
end;
LastId := Result;
end;
procedure TMainFrm.Server1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i, t: Integer;
begin
Timer1Timer(Sender);
t := Integer(Socket.Data);
i := NewChanel(LastChId);
if (t < 0) and (i <= 0) then
begin
Socket.Data := Pointer(t);
end
else
if (i > 0) and (i < Length(Chns)) then
begin
Socket.Data := Pointer(i);
Chns.State := csInUse;
Chns.Skt1.Active := True;
Chns.Skt1.Socket := Socket;
Chns.Skt1.ChId := i;
Chns.Skt2.Active := True;
Chns.Skt2.ChId := i;
Chns.Skt2.Client.Host := RemoteAddr;
Chns.Skt2.Client.Port := RemotePort;
Chns.Skt2.Client := Client1;
Chns.Skt1.Event(seConnect);
LogMsg(Format('[%d,1]Connect %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end
else if Server1.Socket.ActiveConnections < MaxDelayCt then
begin
// 如果连接总数没有超过延迟总数,
// 进行延迟处理
LogMsg(Format('[%d,1]Delay %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
Socket.Data := Pointer(-1);
end
else
begin
// 如果没有空闲通道,
// 并且如果连接总数超过延迟限额
// 立即断开此连接
LogMsg(Format('[%d,1]Refused %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
Socket.Data := nil;
if Socket.Connected then
Socket.Close;
end;
end;
procedure TMainFrm.Server1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i: Integer;
begin
i := Integer(Socket.Data);
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Event(seDisconnect);
end;
LogMsg(Format('[%d,1]Disconnect %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end;
procedure TMainFrm.Server1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
var
i, m: Integer;
t: String;
begin
i := Integer(Socket.Data);
m := ErrorCode;
t := GetEnumName(TypeInfo(TErrorEvent), Ord(ErrorEvent));
LogMsg(Format('[%d,1]Error %s:%d Err: %s, Code: %d',
[i, Socket.RemoteAddress,
Socket.RemotePort, t, m]));
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Error(ErrorEvent, ErrorCode);
end;
ErrorCode := 0;
end;
procedure TMainFrm.Server1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
i, m: Integer;
begin
i := Integer(Socket.Data);
m := Socket.ReceiveLength;
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Event(seRead);
end;
LogMsg(Format('[%d,1]OnRead %s:%d R: %5d B',
[i, Socket.RemoteAddress,
Socket.RemotePort, m]));
end;
procedure TMainFrm.Server1ClientWrite(Sender: TObject;
Socket: TCustomWinSocket);
var
i: Integer;
begin
i := Integer(Socket.Data);
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Event(seWrite);
end;
LogMsg(Format('[%d,1]OnWrite %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end;
procedure TMainFrm.Client1Connect(Sender: TObject;
Socket: TCustomWinSocket);
var
i: Integer;
begin
i := Integer(Socket.Data);
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt2.Event(seConnect);
end;
LogMsg(Format('[%d,2]Connect %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end;
procedure TMainFrm.Client1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
i: Integer;
begin
i := Integer(Socket.Data);
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt2.Event(seDisconnect);
end;
LogMsg(Format('[%d,2]Disconnect %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end;
procedure TMainFrm.Client1Error(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
i, m: Integer;
t: String;
begin
i := Integer(Socket.Data);
m := ErrorCode;
t := GetEnumName(TypeInfo(TErrorEvent), Ord(ErrorEvent));
LogMsg(Format('[%d,2]Error %s:%d Err: %s, Code: %d',
[i, Socket.RemoteAddress,
Socket.RemotePort, t, m]));
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt2.Error(ErrorEvent, ErrorCode);
end;
ErrorCode := 0;
end;
procedure TMainFrm.Client1Read(Sender: TObject; Socket: TCustomWinSocket);
var
i, m: Integer;
begin
i := Integer(Socket.Data);
m := Socket.ReceiveLength;
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt2.Event(seRead);
end;
LogMsg(Format('[%d,2]OnRead %s:%d R: %5d B',
[i, Socket.RemoteAddress,
Socket.RemotePort, m]));
end;
procedure TMainFrm.Client1Write(Sender: TObject; Socket: TCustomWinSocket);
var
i: Integer;
begin
i := Integer(Socket.Data);
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt2.Event(seWrite);
end;
LogMsg(Format('[%d,2]OnWrite %s:%d',
[i, Socket.RemoteAddress,
Socket.RemotePort]));
end;
function TMainFrm.CheckChanel(ChnId: Integer): Integer;
var
i, m: Integer;
begin
i := ChnId;
Result := 0;
if (i > 0) and (i < Length(Chns)) then
begin
Chns.Skt1.Timer;
Chns.Skt2.Timer;
if Chns.State = csInUse then
begin
if (Chns.Skt1.State = ssFinish) or
(Chns.Skt1.State = ssFinish) then
begin
Chns.State := csShutDown;
end;
if (Chns.Skt1.State = ssError) or
(Chns.Skt1.State = ssError) then
begin
Chns.State := csError;
end;
end;
m := 0;
if (Chns.Skt1.State in [ssFinish, ssError]) and
(Chns.Skt2.State in [ssFinish, ssError]) and
((Chns.Skt1.Elapsed > 100) or
(Chns.Skt2.Elapsed > 100)) then
begin
m := m + 1;
end
else
if (Chns.State in [csShutDown, csError]) and
((Chns.Skt1.Elapsed > 1000) or
(Chns.Skt2.Elapsed > 1000)) then
begin
m := m + 1;
end;
if m > 0 then
begin
FreeChanel(i);
end;
end;
end;
function TMainFrm.ScanDelays(AMaxWait: Integer): Integer;
var
i, m, n, t: Integer;
Socket: TCustomWinSocket;
begin
m := Server1.Socket.ActiveConnections;
Result := 0;
// 处理延迟的连接
for i := 0 to m - 1 do
begin
Socket := Server1.Socket.Connections;
n := Integer(Socket.Data);
if n < 0 then
begin
Socket.Data := Pointer;
t := NewChanel(LastChId);
if t > 0 then
begin
Server1ClientConnect(Self, Socket);
end
else
begin
// 如果发生无空闲会话通道,
// 则等待一个周期
Break;
end;
end;
end;
// 处理延迟超时的连接
for i := m - 1 downto 0 do
begin
Socket := Server1.Socket.Connections;
n := Integer(Socket.Data);
if n < 0 then
begin
// 对延迟的连接进行计数
Result := Result + 1;
n := -n;
n := n + 1;
if n >= AMaxWait then
begin
// 发生延迟超时
LogMsg(Format('[%d,1]Delay timeout %s:%d',
[-n, Socket.RemoteAddress,
Socket.RemotePort]));
if Socket.Connected then
begin
Socket.Close;
end;
end;
end;
end;
end;
{ TClientSkt }
procedure TClientSkt.CleanUp;
begin
inherited;
if Assigned(FClient) then
FreeAndNil(FClient);
Socket := nil;
end;
procedure TClientSkt.Event(SocketEvent: TSocketEvent);
begin
case SocketEvent of
seConnect:
begin
State := ssWork;
if Skt2.State = ssWork then
begin
Transfer;
end;
end;
seDisconnect:
begin
if State = ssWork then
begin
State := ssFinish;
Skt2.Transfer;
end;
end;
else
begin
inherited;
end;
end;
end;
function TClientSkt.InitSkt: Boolean;
begin
Result := inherited InitSkt;
FClient := TClientSocket.Create(nil);
Socket := FClient.Socket;
end;
procedure TMainFrm.Button2Click(Sender: TObject);
begin
InitChanels(-1);
Server1.Active := False;
end;
procedure TMainFrm.Timer1Timer(Sender: TObject);
var
i, ct, st: Integer;
begin
ct := Server1.Socket.ActiveConnections;
st := 0;
for i := 1 to Length(Chns) - 1 do
begin
if Chns.State <> csReady then
begin
CheckChanel(i);
st := st + 1;
end;
end;
if Assigned(Sender) and
(Sender is TTimer) then
begin
// 如果等待15秒钟都没有进行处理,则认为延迟超时
i := ScanDelays(15*1000 div Timer1.Interval);
if i > Label6.Tag then Label6.Tag := i;
Label6.Caption := IntToStr(Label6.Tag);
Caption := Format('Connections: %d,' +
' Sessions: %d, Delays: %d', [ct, st, i]);
Application.Title := Format('C: %d (S: %d, D: %d)', [ct, st, i]);
end;
end;
procedure TMainFrm.Button4Click(Sender: TObject);
begin
ListBox1.Clear;
end;
procedure TMainFrm.Button3Click(Sender: TObject);
var
i, m: Integer;
s, t, t1, t2: String;
begin
for i := 1 to Length(Chns) - 1 do
begin
if Chns.State <> csReady then
begin
m := GetTickCount;
t1 := GetEnumName(TypeInfo(TSktState), Ord(Chns.Skt1.State));
t2 := GetEnumName(TypeInfo(TSktState), Ord(Chns.Skt2.State));
s := Format('[%d,S], Sock1: $%s, Sock2: $%s, S: %d, R: %d',
[
i,
IntToHex(Integer(Chns.Skt1.Socket), 8),
IntToHex(Integer(Chns.Skt2.Socket), 8),
Chns.Skt2.SendBytes,
Chns.Skt1.SendBytes
]);
LogMsg(s);
t := GetEnumName(TypeInfo(TChState), Ord(Chns.State));
s := Format(
' %s, S1: %s, S2: %s, SdBf: %d, RvBf: %d',
[
t, t1, t2,
Length(Chns.Skt2.SendBuff),
Length(Chns.Skt1.SendBuff)
]);
LogMsg(s);
s := Format(' Tick1: %d, Tick2: %d, Now: %d',
[Chns.Skt1.Elapsed, Chns.Skt2.Elapsed, m]);
LogMsg(s);
end;
end;
end;
procedure TMainFrm.ApplicationEvents1Exception(Sender: TObject;
E: Exception);
begin
LogMsg('Error: ' + E.Message);
Label3.Tag := Label3.Tag + 1;
Label3.Caption := IntToStr(Label3.Tag);
LogMsg('Track:');
Button3Click(Sender);
end;
procedure TMainFrm.Button5Click(Sender: TObject);
begin
ListBox1.Items.SaveToFile('no169kls.log');
end;
procedure TMainFrm.FormCreate(Sender: TObject);
begin
Button4Click(Sender);
end;
procedure TMainFrm.Label5DblClick(Sender: TObject);
begin
Label6.Tag := 0;
Label6.Caption := '';
end;
procedure TMainFrm.Label4DblClick(Sender: TObject);
begin
Label3.Tag := 0;
Label3.Caption := '';
end;
end.
怎么在以上端口影射程序中实现:比如当一个客户端连接映射程序的指定端口,发送一个010B9D0000数据包,我要在他发送的出去前,将其过滤为022BC40000,在发送到映射程序映射的程序端口上。