umain.pas

一个实现端口映射的例子

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls, ExtCtrls, TypInfo;

type
  TChState = (csReady,
    csInUse,
    csShutDown, csError);

  TChanel = record
    Tick: Integer;
    State: TChState;
    SessId: String;
    RecvBuff: String;
    SendBuff: String;
    RecvBytes: Integer;
    SendBytes: Integer;
    Client1: TClientSocket;
    Client2: TClientSocket;
    Socket1: TCustomWinSocket;
    Socket2: TCustomWinSocket;
  end;

  TMainFrm = class(TForm)
    Server1: TServerSocket;
    Client1: TClientSocket;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    ListBox1: TListBox;
    Timer1: TTimer;
    Button3: TButton;
    CheckBox1: TCheckBox;
    Button4: TButton;
    CheckBox2: TCheckBox;
    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 Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Server1Listen(Sender: TObject; Socket: TCustomWinSocket);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    LastChn: Integer;
    Chns: array of TChanel;
    RemoteAddr: String;
    RemotePort: Integer;

    function InitChanels(AMaxs: Integer): Integer;
    function FindConn(Socket: TCustomWinSocket): Boolean;
    function NewChanel(var LastChId: Integer): Integer;
    function FreeChanel(ChnId: Integer): Integer;
    function CheckChanel(ChnId: Integer): Integer;
    function DoTransfer1(ChnId: Integer;
      Finish: Boolean = False): Integer;
    function DoTransfer2(ChnId: Integer;
      Finish: Boolean = False): Integer;

    procedure LogMsg(S: String);
    procedure CheckChns;
  end;

var
  MainFrm: TMainFrm;

implementation

{$R *.dfm}

function PickPkg(var Data: String): String;
var
  i, m, n: Integer;
  d1, d2: Integer;
  c: Char;
begin
  // 查找起始标志
  m := 0;
  c := '?';
  for i := 1 to Length(Data) - 2 do
  begin
    if Data[i] = #$FE then
    begin
      m := i;
      Break;
    end;
  end;
  // 取得后面两字节数据
  n := -1;
  if m > 0 then
  begin
    c := Data[m + 1];
    d1 := Ord(Data[m + 2]) -128;
    d2 := Ord(Data[m + 3]) -128;
    if (d1 >= 0) and (d1 < 100) and
      (d2 <= 0) and (d2 < 100) then
    begin
      n := d2 * 100 + d1;
    end
  end;
  // 提取数据包
  Result := '';
  if n >= 0 then
  begin
    if m + n + 3 <= Length(Data) then
    begin
      Result := c + Copy(Data, m + 4, n);
      Delete(Data, 1, m + n + 3);
    end
    else if m > 1 then
    begin
      Delete(Data, 1, m - 1);
    end;
  end
  else
    Data := '';
end;

{ TMainFrm }

function TMainFrm.FindConn(Socket: TCustomWinSocket): Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to Server1.Socket.ActiveConnections - 1 do
  begin
    if Server1.Socket.Connections[i] = Socket then
    begin
      Result := True;
      Break;
    end;
  end;
end;

function TMainFrm.InitChanels(AMaxs: Integer): Integer;
var
  i, Len1: Integer;
  Maxs: Integer;
begin
  Maxs := AMaxs;
  if Maxs <= -1 then Maxs := -1;
  Len1 := Length(Chns);
  for i := Maxs + 1 to Len1 - 1 do
  begin
    Chns[i].State := csReady;
    if Assigned(Chns[i].Socket1) then
    begin
      if FindConn(Chns[i].Socket1) and
        Chns[i].Socket1.Connected then
      begin
        Chns[i].Socket1.Close;
      end;
      Chns[i].Socket1 := nil;
    end;
    if Assigned(Chns[i].Socket2) then
    begin
      if Chns[i].Socket2.Connected then
      begin
        Chns[i].Socket2.Close;
      end;
      Chns[i].Socket2 := nil;
    end;
    if Assigned(Chns[i].Client1) then
    begin
      Chns[i].Client1.Free;
      Chns[i].Client1 := nil;
    end;
    if Assigned(Chns[i].Client2) then
    begin
      Chns[i].Client2.Free;
      Chns[i].Client2 := nil;
    end;
    Chns[i].SessId := '';
    Chns[i].State := csReady;
  end;
  SetLength(Chns, Maxs + 1);
  for i := Len1 to Maxs do
  begin
    Chns[i].Client1 := nil;
    Chns[i].Client2 := nil;
    Chns[i].Socket1 := nil;
    Chns[i].Socket2 := nil;
    Chns[i].State := csReady;
    Chns[i].SessId := '';
    Chns[i].RecvBuff := '';
    Chns[i].SendBuff := '';
    Chns[i].RecvBytes := 0;
    Chns[i].SendBytes := 0;
  end;
  Result := Length(Chns) - 1;
end;

function TMainFrm.NewChanel(var LastChId: Integer): Integer;
var
  i: Integer;
begin
  Result := -1;
  if LastChId <= 0 then LastChId := 0;
  if LastChId >= Length(Chns) then LastChId := 0;
  for i := LastChId + 1 to Length(Chns) - 1 do
  begin
    if Chns[i].State = csReady then
    begin
      Result := i;
      Break;
    end;
  end;
  if Result < 0 then
  begin
    for i := 1 to LastChId do
    begin
      if Chns[i].State = csReady then
      begin
        Result := i;
        Break;
      end;
    end;
  end;
  LastChId := 0;
  if Result > 0 then
  begin
    i := Result;
    if not Assigned(Chns[i].Client2) then
      Chns[i].Client2 := TClientSocket.Create(Self);
    Chns[i].Client2.OnConnect := Client1.OnConnect;
    Chns[i].Client2.OnDisconnect := Client1.OnDisconnect;
    Chns[i].Client2.OnError := Client1.OnError;
    Chns[i].Client2.OnRead := Client1.OnRead;
    Chns[i].Client2.OnWrite := Client1.OnWrite;
    Chns[i].Client2.Tag := i;
    Chns[i].Socket1 := nil;
    Chns[i].Socket2 := Chns[i].Client2.Socket;
    Chns[i].SessId := '';
    Chns[i].SendBuff := '';
    Chns[i].RecvBuff := '';
    Chns[i].RecvBytes := 0;
    Chns[i].SendBytes := 0;
    LastChId := i;
  end;
end;

function TMainFrm.FreeChanel(ChnId: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  i := ChnId;
  LogMsg(Format('Free chanel Chn[%d]', [i]));
  if (i > 0) and (i < Length(Chns)) then
  begin
    if FindConn(Chns[i].Socket1) and
      Chns[i].Socket1.Connected then
    begin
      Chns[i].Socket1.Close;
    end;
    Chns[i].Socket1 := nil;
    Chns[i].Socket2 := nil;
    if Assigned(Chns[i].Client1) then
      Chns[i].Client1.Free;
    Chns[i].Client1 := nil;
    if Assigned(Chns[i].Client2) then
      Chns[i].Client2.Free;
    Chns[i].Client2 := nil;
    Chns[i].SessId := '';
    Chns[i].RecvBuff := '';
    Chns[i].SendBuff := '';
    Chns[i].State := csReady;
    Result := 1;
  end;
end;

function TMainFrm.CheckChanel(ChnId: Integer): Integer;
var
  i, t: Integer;
  b1, b2: Boolean;
  a1, a2: Boolean;
begin
  Result := 0;
  i := ChnId;
  if (i > 0) and (i < Length(Chns)) then
  begin
    Result := 1;
    if DoTransfer1(i) > 0 then
      Chns[i].Tick := GetTickCount;
    if DoTransfer2(i) > 0 then
      Chns[i].Tick := GetTickCount;
    t := GetTickCount;
    if Chns[i].State = csShutDown then
    begin
      a1 := Assigned(Chns[i].Socket1);
      a2 := Assigned(Chns[i].Socket2);
      b1 := False;
      b2 := False;
      if a1 and Chns[i].Socket1.Connected then
        b1 := (Length(Chns[i].RecvBuff) <= 0) and
          (t - Chns[i].Tick >= 100);
      if a2 and Chns[i].Socket2.Connected then
        b2 := (Length(Chns[i].SendBuff) <= 0) and
          (t - Chns[i].Tick >= 100);
      if (not a1 and b2) or (not a2 and b1) or
        (not a1 and not a2) or
        (a1 and a2 and b1 and b2) then
      begin
        FreeChanel(i);
        Result := -1;
      end;
      
      if CheckBox1.Checked then
      begin
        LogMsg(BoolToStr(a1, True) + ',' +
          BoolToStr(a2, True) + ',' +
          BoolToStr(b1, True) + ',' +
          BoolToStr(b2, True) );
      end;
    end;
    // Clear terminated chanel
    if ((Chns[i].State = csError) and
      (t - Chns[i].Tick >= 3000)) then
    begin
      FreeChanel(i);
      Result := -2;
    end;
  end;
end;

function TMainFrm.DoTransfer1(ChnId: Integer; 
  Finish: Boolean): Integer;
var
  i, Len: Integer;
  s: String;