iggstreamserver.pas

通信控件

        if (Temp.InfoSize > 0) then
          Temp.Info := AllocMem(Temp.InfoSize);
        Move(PIReg.Describe.Info^, Temp.Info^, Temp.InfoSize);
        Inc(Result);
      end;
    end;
    Infos := Users;
  except Result := -1; end;
end;

procedure TIServer.FreeUsersInfo(Infos: Pointer);
var
  Users, Temp: PIUsersLink;
begin
  try
    if Assigned(Infos) then
    Users := PIUsersLink(Infos);
    while(Users <> nil) do
    begin
      Temp := Users;
      Users := Users.Link;
      try
        if Assigned(Temp.Info) then
          FreeMem(Temp.Info);
        Dispose(Temp);
      except end;
    end;
  except end;
end;

procedure TIServer.DeleteUser(Status: Integer);
var
  I: Integer; PIReg, PTemp: PIRegister; IsOK: Boolean;
begin
  I := 0; PIReg := nil; IsOK := FALSE;

  try
    while(TRUE) do
    begin
      PIReg := FRegPool.SearchIn(I, PIReg);
      if PIReg = nil then Break;
      while(PIReg <> nil) do
      begin
        PTemp := PIReg; PIReg := PIReg.PNext;

        IsOK := FALSE;
        case Status of
          1: if PTemp.Heart > 0 then IsOK := TRUE;
          2: if PTemp.Heart = 0 then IsOK := TRUE;
        else
          IsOK := TRUE;
        end;

        if (IsOK) then
        begin
          FRegPool.Remove(PTemp.Describe.ID);
        end;
      end;
    end;
  except end;
end;

function TIServer.DeleteUser(NameID: string): Boolean;
var
  ID: DWORD;
begin
  Result := TRUE;
  try
    if (NameID <> '') then
    begin
      ID := CalculateID(NameID);
      FRegPool.Remove(ID);
    end;
  except end;  
end;

procedure TIServer.OnRegister(PHeader: PSPKHeader; dwIP: DWORD; wPort: WORD);
var
  Des: TIDescribe;
  PData: PRegisterData;
  ReData: TRsRegisterData;
begin
  FillChar(Des, SizeOf(Des), 0);
  FillChar(ReData, SizeOf(ReData), 0);

  try
    PData := Data(PHeader);

    Des.ID := PData.dwID;
    Move(PData.szNameID, Des.NameID, MAX_I_NAMEID-1);
    PData.RegRoute.dwLoginIP  := dwIP;
    PData.RegRoute.wLoginPort := wPort;
    ReData.dwResult := Ord(FRegPool.Put(Des, PData.RegRoute, PHeader.wReserved[1]) <> nil);
    ReData.dwID     := PData.dwID;
    ReData.dwIP     := dwIP;
    ReData.dwPort   := wPort;
    FUDPServer.QuerySend(PHeader, ReData, SizeOf(ReData), dwIP, wPort);
    if ReData.dwResult = Ord(TRUE) then
    begin
      FRegPool.Heart(PData.dwID, PHeader.wReserved[1], wPort);
      //do Notffy Register to all user....
      SendStatus(PData.dwID, 0, 1);
    end;
  except end;  
end;

procedure TIServer.OnUnRegister(PHeader: PSPKHeader; dwIP: DWORD; wPort: WORD);
var
  PData: PUnRegisterData;
  RsData: TRsUnRegisterData;
begin
  try
    FillChar(RsData, SizeOf(RsData), 0);
    PData := Data(PHeader);
    if FRegPool.Remove(PData.dwID, PHeader.wReserved[1]) then
    begin
      RsData.dwResult := 1;
      //do Notify UnRegister to all user....
      //SendStatus(PData.dwID, 0, 0);
    end;
    RsData.dwID := PData.dwID;
    FUDPServer.QuerySend(PHeader, RsData, SizeOf(RsData), dwIP, wPort);
  except end;
end;

procedure TIServer.OnHeart(PHeader: PSPKHeader; dwIP: DWORD; wPort: WORD);
var
  Res   : Boolean;
  PData : PToServer;
  RsData: TFromServer;
begin
  FillChar(RsData, SizeOf(RsData), 0);
  PData := Data(PHeader);

  Res   := FRegPool.Heart(PHeader.dwSendID, PHeader.wReserved[1], wPort);
  RsData.AttachID   := PHeader.dwSendID;
  RsData.LoginIP    := dwIP;
  RsData.LoginPort  := wPort;
  RsData.SubmitV    := Integer(Sth);
  if (Res) then  RsData.Para := 1;
  FUDPServer.QuerySend(PHeader, RsData, SizeOf(RsData), dwIP, wPort);
end;

procedure TIServer.OnToServer(PHeader: PSPKHeader; dwIP: DWORD; wPort: WORD);
var
  PData	  : PToServer;
  RsData  : TFromServer;
  RegRoute: TIRegRoute;
begin
  PData   := Data(PHeader);

  if (PData.SubmitV = Integer(Hts)) then
  begin
    OnHeart(PHeader, dwIP, wPort);
    Exit;
  end;

  if (PData.SubmitV and Integer(Agb) = Integer(Agb)) then
  begin
    FillChar(RsData, SizeOf(RsData), 0);
    RsData.AttachID    := PData.Para1;
    RsData.SubmitV		 := Integer(Agb);
    if FRegPool.Get(RegRoute, PData.Para1) then
    begin
      RsData.Para 		 := 1;
      RsData.LoginIP 	 := RegRoute.dwLoginIP;
      RsData.LoginPort := RegRoute.wLoginPort;
      RsData.LocalIP	 := RegRoute.dwLocalIP;
      RsData.LocalPort := RegRoute.wLocalPort;
    end;

    FUDPServer.QuerySend(PHeader, RsData, SizeOf(RsData), dwIP, wPort);
    dwIP  := RsData.LoginIP;
    wPort := RsData.LoginPort;
  end;

  if ((PData.SubmitV and Integer(Ssa)) = Integer(Ssa)) and (dwIP <> 0) then
  begin
    FillChar(RsData, SizeOf(RsData), 0);
    RsData.AttachID    := PData.SelfID;
    RsData.SubmitV		 := Integer(Ssa);
    if FRegPool.Get(RegRoute, PData.SelfID) then
    begin
      RsData.Para 		 := 1;
      RsData.LoginIP 	 := RegRoute.dwLoginIP;
      RsData.LoginPort := RegRoute.wLoginPort;
      RsData.LocalIP	 := RegRoute.dwLocalIP;
      RsData.LocalPort := RegRoute.wLocalPort;
    end;

    FUDPServer.QuerySend(PHeader, RsData, SizeOf(RsData), dwIP, wPort);
  end;
end;

procedure TIServer.OnToClient(PHeader: PSPKHeader; dwIP: DWORD; wPort: WORD);
var
  RegRoute: TIRegRoute;
  PData: PToClient;
begin
  PData := PToClient(Data(PHeader));
  if FRegPool.Get(RegRoute, PData.AttachID) then
  begin
    PData.Para1 := dwIP;
    PData.Para2 := wPort;
    FUDPServer.SendTo(PHeader, PHeader.wpkSize, RegRoute.dwLoginIP, RegRoute.wLoginPort);
  end else begin
    //Notify AttachID Unregister....
    SendStatus(PData.AttachID, PData.SelfID, 0);
  end;
end;

procedure TIServer.SendStatus(FromID: DWORD; ToID: DWORD; Status: Integer);
var
  PIReg: PIRegister;
  RegRoute: TIRegRoute;
  PHeader: PSPKHeader;
  PData: PFromServer;
  I: Integer;
begin
  I := 0;  PIReg := nil;
  PHeader  := PSPKHeader(FThdBuffer);
  PHeader^ := SPKHeader(RS_SOCK_FROMS, SizeOf(TFromServer));
  PHeader.bpkType := pkRPKH;
  PData := Data(PHeader);

  PData.Para    := Status;
  PData.SubmitV := Integer(Stus);

  if (ToID <> 0) then  begin
    if FRegPool.Get(RegRoute, ToID) then
    begin
      PData.AttachID   := FromID;
      FUDPServer.SendTo(PHeader, PHeader.wpkSize, RegRoute.dwLoginIP, RegRoute.wLoginPort);
    end;
  end else begin
    PIReg := FRegPool.SearchIn(I, PIReg);
    while(PIReg <> nil) do
    begin
      PData.AttachID   := FromID;
      FUDPServer.SendTo(PHeader, PHeader.wpkSize, PIReg.RegRoute.dwLoginIP, PIReg.RegRoute.wLoginPort);
      PIReg := FRegPool.SearchIn(I, PIReg);
    end;
  end;
end;

procedure TIServer.FwrWidePacket(PWPKH: PWPKHeader; IP: DWORD; Port: WORD);
var
  RegRoute: TIRegRoute;
  WPKH: TWPKHeader;
  label _FWR_;
begin
  if (PWPKH.dwIP = 0) or (PWPKH.wPort = 0) then begin
    FillChar(RegRoute, SizeOf(RegRoute), 0);
    if FRegPool.Get(RegRoute, PWPKH.dwRecvID) then
      goto _FWR_;
  end else begin
    RegRoute.dwLoginIP := PWPKH.dwIP;
    RegRoute.wLoginPort := PWPKH.wPort;
_FWR_:
    PWPKH.dwIP := IP;
    PWPKH.wPort := Port;
    FUDPServer.SendTo(PWPKH, PWPKH.SPK.wpkSize, RegRoute.dwLoginIP, RegRoute.wLoginPort);
  end;
  WPKH := SetSEQU(PWPKH, RegRoute.dwLoginIP, RegRoute.wLoginPort);
  FUDPServer.SendTo(@WPKH, WPKH.SPK.wpkSize, IP, Port);
end;

procedure TIServer.OnUDPProc(var PktTag: TPacketTag);
var
  PWPKH: PWPKHeader;
  PData: PChar;
  IP, Port: Integer;
begin
  try
    PWPKH := PWPKHeader(PktTag.Data);
    //if check packet invalid then exit;
    IP := PktTag.SockAddr.sin_addr.S_addr;  Port := PktTag.SockAddr.sin_port;
    if PWPKH.SPK.bpkType = pkBPKH then
    begin
      FUDPServer.SendTo(PWPKH, PWPKH.SPK.wpkSize, PWPKH.dwIP, PWPKH.wPort);
    end else if (PWPKH.SPK.bpkType = pkMPKH) then
    begin
      FUDPServer.SendTo(PWPKH, PWPKH.SPK.wpkSize, PWPKH.dwIP, PWPKH.wPort);
    end else if (PWPKH.SPK.bpkType = pkWPKH) then begin
      FwrWidePacket(PWPKH, IP, Port);
    end else begin
    case PWPKH.SPK.wCommand of
      SB_USER_REGISTER:
        OnRegister(PSPKHeader(PWPKH), IP, Port);
      SB_USER_UNREGIST:
        OnUnRegister(PSPKHeader(PWPKH), IP, Port);
      SB_SOCK_TOS:
        OnToServer(PSPKHeader(PWPKH), IP, Port);
      SB_SOCK_TOC:
        OnToClient(PSPKHeader(PWPKH), IP, Port);
    end;
    end;
  except end;
end;

procedure TIServer.OnSetUserInfo(PData: Pointer; Pack: PTCPPack; var PackR: TTCPPackR);
var
  PDesH: PIDescribeH;
  Describe: TIDescribe;
  Res: Boolean; P: PChar;
begin
  PDesH := PIDescribeH(Pack.Pack);
  //check PDesH vaild ....

  Res := FRegPool.Get(Describe, PDesH.ID);
  if (Res) then
  begin
    Describe.InfoSize := PDesH.InfoSize;
    P := PChar(PChar(Pack.Pack)+SizeOf(TIDescribeH));
    Describe.Info := P;
    FRegPool.Update(Describe);
  end;

  PackR.Operate := Pack.Operate;
  if Res then  PackR.Result := 1  else  PackR.Result := 2;
end;

procedure TIServer.OnGetUserInfo(PData: Pointer; Pack: PTCPPack; var PackR: TTCPPackR);
var
  PDesH: PIDescribeH;
  Describe: TIDescribe;
  Res: Boolean;
begin
  PDesH := PIDescribeH(Pack.Pack);
  //check PDesH vaild ...

  Res := FRegPool.Get(Describe, PDesH.ID);
  if (Res) then
  begin
    PackR.PackSize := Describe.InfoSize;

    if (PackR.PackSize > 0) then
      PackR.Pack := AllocMem(PackR.PackSize);
    if (PackR.Pack <> nil) then
    begin
      Move(Describe.Info^, PackR.Pack^, PackR.PackSize);
      PackR.PackSour := 1;
    end;
  end;

  PackR.Operate := Pack.Operate;
  if Res then PackR.Result := 1 else PackR.Result := 2;
end;

procedure TIServer.OnCheckConnectSyn(PData: Pointer; Pack: PTCPPack; var PackR: TTCPPackR);
var
  PSyn: PConnectSyn;
  RsSyn: TConnectSyn;
begin
  try
    FillChar(RsSyn, SizeOf(RsSyn), 0);

    PSyn := PConnectSyn(Pack.Pack);
    RsSyn.SelfID := PSyn.SelfID;
    RsSyn.AttachID := PSyn.AttachID;
    Inc(FUniqueID);
    RsSyn.Para3 := FUniqueID;
    if FRegPool.IsValid(PSyn.SelfID) then
      RsSyn.Para1 := 1;
    if (FRegPool.IsValid(PSyn.AttachID)) then
      RsSyn.Para2 := 1;

    PackR.PackSize := SizeOf(RsSyn);
    if (PackR.PackSize > 0) then
      PackR.Pack := AllocMem(PackR.PackSize);
    if (PackR.Pack <> nil) then
    begin
      Move(RsSyn, PackR.Pack^, PackR.PackSize);
      PackR.PackSour := 1;
    end;
  except end;
end;

procedure TIServer.OnTCPPeerProc(Owner: TITCPPeer);
var
  Buffer: array[0..1023] of Char;
  SPKH: PSPKHeader;
  Ptr: Pointer;
  Pack: PTCPPack;
  PackR: TTCPPackR;
  Res: Integer;
begin
  FillChar(Buffer, 1024, 0);
  SPKH := PSPKHeader(@Buffer);

  try
    try
      Res := Owner.ReadBuffer(Pointer(SPKH), SizeOf(TSPKHeader));
      if (Res <= 0) then Exit;

      Ptr := Data(SPKH);
      if (SPKH.wpkSize - SPKH.wDataOffset > 0) then
        Res := Owner.ReadBuffer(Ptr, SPKH.wpkSize - SPKH.wDataOffset);
      if (Res <= 0) then Exit;

      Pack := PTCPPack(Ptr);
      //Res := Owner.ReadBuffer(Pointer(Pack), SizeOf(TTCPPack));
      //if (Res <= 0) then Exit;

      if (Pack.PackSize > 0) then
        Res := Owner.ReadBuffer(Pack.Pack, Pack.PackSize);
      if (Res <= 0) then  Exit;
      Pack.PackSour := 1;

      //check SPKH  vaild....
      FillChar(PackR, SizeOf(PackR), 0);
      case SPKH.wCommand of
        SB_SET_USER_INFO: OnSetUserInfo(Ptr, Pack, PackR);
        SB_GET_USER_INFO: OnGetUserInfo(Ptr, Pack, PackR);
        SB_GET_UNIQUE_ID: OnCheckConnectSyn(Ptr, Pack, PackR);
      end;
      
      //if PackR.Operate <> 0 then
      begin
        Ptr := Pointer(@PackR);
        Owner.WriteBuffer(Ptr, SizeOf(PackR)-SizeOf(Pointer));

        if (PackR.Pack <> nil) then
          Owner.WriteBuffer(PackR.Pack, PackR.PackSize);
      end;
    except end;
  finally
    try
      if (PackR.PackSour = 1) then  FreeMem(PackR.Pack);
      if (Pack.PackSour = 1)  then  FreeMem(Pack.Pack);
      Quit(Owner);
    except end;  
  end;
end;

end.