umain.pas

一个实现端口映射的例子

begin
  i := ChnId;
  Result := -1;
  if (i > 0) and (i < Length(Chns)) then
  begin
    Len := 0;
    if (Length(Chns[i].SendBuff) < 10*1024) or Finish then
    begin
      if Assigned(Chns[i].Socket1) then
      begin
        s := Chns[i].Socket1.ReceiveText;
        Chns[i].SendBuff := Chns[i].SendBuff + s;
      end;
    end;
    if Assigned(Chns[i].Socket2) and
      Chns[i].Socket2.Connected then
    begin
      Len := Chns[i].Socket2.SendText(Chns[i].SendBuff);
      if Len > 0 then Delete(Chns[i].SendBuff, 1, Len);
    end;
    Chns[i].SendBytes := Len;
    Result := Len;
  end;
end;

function TMainFrm.DoTransfer2(ChnId: Integer; Finish: Boolean): Integer;
var
  i, Len: Integer;
  s: String;
begin
  i := ChnId;
  Result := -1;
  if (i > 0) and (i < Length(Chns)) then
  begin
    Len := 0;
    if (Length(Chns[i].RecvBuff) < 10*1024) or Finish then
    begin
      if Assigned(Chns[i].Socket2) then
      begin
        s := Chns[i].Socket2.ReceiveText;
        Len := Length(s);
        Chns[i].RecvBuff := Chns[i].RecvBuff + s;
      end;
    end;
    if Assigned(Chns[i].Socket1) and
      Chns[i].Socket1.Connected then
    begin
      Len := Chns[i].Socket1.SendText(Chns[i].RecvBuff);
      if Len > 0 then Delete(Chns[i].RecvBuff, 1, Len);
    end;
    Chns[i].RecvBytes := Len;
    Result := Len;
  end;
end;

procedure TMainFrm.LogMsg(S: String);
var
  t: String;
begin         
  t := FormatDateTime('hh:nn:ss.zzz', Now) + ' ' + s;
  ListBox1.ItemIndex := ListBox1.Items.Add(t);
end;

procedure TMainFrm.CheckChns;
var
  i: Integer;
begin
  for i := 0 to Length(Chns) - 1 do
  begin
    if Chns[i].State <> csReady then
      CheckChanel(i);
  end;
end;

procedure TMainFrm.Server1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: Integer;
begin
  Socket.Data := nil;
  LastChn := 0;
  i := NewChanel(LastChn);
  if i > 0 then
  begin
    Chns[i].State := csInUse;
    Chns[i].Socket1 := Socket;
    Chns[i].Socket1.Data := Pointer(i);
    Chns[i].Socket2.Data := Pointer(i);
    Chns[i].Tick := GetTickCount;
    Chns[i].Client2.Host := RemoteAddr;
    Chns[i].Client2.Port := RemotePort;
    Chns[i].Client2.Active := True;
    LogMsg(Format('Come in Chn[%d]: %s:%d',
      [i, Socket.RemoteAddress,
      Socket.RemotePort]));
  end
  else
  begin
    LogMsg(Format('Refuse Chn[%d]: %s:%d',
      [i, Socket.RemoteAddress,
      Socket.RemotePort]));
    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
    if Chns[i].State = csInUse then
      DoTransfer1(i, True);
    Chns[i].State := csShutDown;
    Chns[i].Socket1 := nil;
    Chns[i].Tick := GetTickCount;
    LogMsg(Format('Disconnect Chn[%d]: %s:%d',
      [i, Socket.RemoteAddress,
      Socket.RemotePort]));
  end;
end;

procedure TMainFrm.Server1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
var
  i: Integer;
begin
  i := Integer(Socket.Data);
  if (i > 0) and (i < Length(Chns)) then
  begin
    Chns[i].State := csError;
    Chns[i].Tick := GetTickCount;
    Chns[i].Socket1 := nil;
    if Socket.Connected then Socket.Close;
  end;
  LogMsg(Format('SrvError Chn[%d]: %s:%d ErrCode: %d',
    [i, Socket.RemoteAddress,
    Socket.RemotePort, ErrorCode]));
  ErrorCode := 0;
end;

procedure TMainFrm.Server1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: Integer;
begin
  i := Integer(Socket.Data);
  LogMsg(Format('SrvRead Chn[%d]: %s:%d %d Bytes',
    [i, Socket.RemoteAddress,
    Socket.RemotePort, Socket.ReceiveLength]));
  if (i > 0) and (i < Length(Chns)) then
  begin
    if DoTransfer1(i) > 0 then
    begin
      Chns[i].Tick := GetTickCount;
    end;
  end;
end;

procedure TMainFrm.Server1ClientWrite(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i: Integer;
begin
  i := Integer(Socket.Data);
  LogMsg(Format('SrvWrite Chn[%d]: %s:%d',
    [i, Socket.RemoteAddress,
    Socket.RemotePort]));
  if (i > 0) and (i < Length(Chns)) then
  begin
    if DoTransfer2(i) > 0 then
    begin
      Chns[i].Tick := GetTickCount;
    end;
  end;
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
    if DoTransfer1(i) > 0 then
      Chns[i].Tick := GetTickCount;
  end;
  LogMsg(Format('Connect remote Chn[%d]: %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
    if Chns[i].State = csInUse then
      DoTransfer2(i, True);
    Chns[i].State := csShutDown;
    Chns[i].Socket2 := nil;
    Chns[i].Tick := GetTickCount;
  end;
  LogMsg(Format('Disconnect remote Chn[%d]: %s:%d',
    [i, Socket.RemoteAddress,
    Socket.RemotePort]));
end;

procedure TMainFrm.Client1Error(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
  i: Integer;
begin
  i := Integer(Socket.Data);
  if (i > 0) and (i < Length(Chns)) then
  begin
    Chns[i].State := csError;
    Chns[i].Tick := GetTickCount;
    Chns[i].Socket2 := nil;
    if Socket.Connected then Socket.Close;
  end;
  LogMsg(Format('CliError Chn[%d]: %s:%d ErrCode: %d',
    [i, Socket.RemoteAddress,
    Socket.RemotePort, ErrorCode]));
  ErrorCode := 0;
end;

procedure TMainFrm.Client1Read(Sender: TObject; Socket: TCustomWinSocket);
var
  i: Integer;
begin
  i := Integer(Socket.Data);
  LogMsg(Format('CliRead Chn[%d]: %s:%d %d Bytes',
    [i, Socket.RemoteAddress,
    Socket.RemotePort, Socket.ReceiveLength]));
  if (i > 0) and (i < Length(Chns)) then
  begin
    if DoTransfer2(i) > 0 then
    begin
      Chns[i].Tick := GetTickCount;
    end;
  end;
end;

procedure TMainFrm.Client1Write(Sender: TObject; Socket: TCustomWinSocket);
var
  i: Integer;
begin
  i := Integer(Socket.Data);
  LogMsg(Format('CliWrite Chn[%d]: %s:%d',
    [i, Socket.RemoteAddress,
    Socket.RemotePort]));
  if (i > 0) and (i < Length(Chns)) then
  begin
    if DoTransfer1(i) > 0 then
    begin
      Chns[i].Tick := GetTickCount;
    end;
  end;
end;

procedure TMainFrm.Button1Click(Sender: TObject);
begin
  Server1.Active := False;
  RemoteAddr := Edit1.Text;
  RemotePort := StrToIntDef(Edit2.Text, 1009);
  Server1.Active := True;
  InitChanels(20);
  Timer1.Enabled := True;
end;

procedure TMainFrm.Button2Click(Sender: TObject);
begin
  InitChanels(-1);
  Server1.Active := False;
  Timer1.Enabled := False;
end;

procedure TMainFrm.Server1Listen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  LogMsg('Start listen ...');
end;

procedure TMainFrm.Timer1Timer(Sender: TObject);
var
  i, ct, st: Integer;
begin
  CheckChns;
  
  ct := Server1.Socket.ActiveConnections;
  st := 0;
  for i := 1 to Length(Chns) - 1 do
  begin
    if Chns[i].State <> csReady then
    begin
      st := st + 1;
    end;
  end;

  Caption := Format('Connections: %d, Sessions: %d',
    [ct, st]);
end;

procedure TMainFrm.Button3Click(Sender: TObject);
var
  i, m: Integer;
  s, t: String;
begin
  for i := 1 to Length(Chns) - 1 do
  begin
    if Chns[i].State <> csReady then
    begin
      t := GetEnumName(TypeInfo(TChState), Ord(Chns[i].State));
      m := GetTickCount;
      s := Format(
        '%s, SdBf: %d, RvBf: %d, Tick: %d, Now: %d',
        [
        t,
        Length(Chns[i].SendBuff),
        Length(Chns[i].RecvBuff),
        Chns[i].Tick, m
        ]);
      LogMsg(s);
      s := Format('Chanel: %d, Sock1: $%s, Sock2: $%s',
        [
        i,
        IntToHex(Integer(Chns[i].Socket1), 8),
        IntToHex(Integer(Chns[i].Socket2), 8)
        ]);
      LogMsg(s);
    end;
  end;
end;

procedure TMainFrm.Button4Click(Sender: TObject);
begin
  ListBox1.Clear;
end;

procedure TMainFrm.CheckBox2Click(Sender: TObject);
begin
  Timer1.Enabled := CheckBox2.Checked;
end;

end.