iggstreamserver.pas

通信控件

    FreeSlot(PRemove);
    Dec(FCount);
  end;
end;

function TIRegisterPool.Heart(dwID: DWORD; SessionID: WORD; wPort: WORD; Heart: WORD): Boolean;
var
  PIReg: PIRegister;
begin
  FLock.Enter;
  try
    PIReg := Find(dwID);
    Result := (PIReg <> nil) and (PIReg.SessionID = SessionID);
    if Result then
    begin
      PIReg.RegRoute.wLoginPort := wPort;
      PIReg.Heart := Heart;
    end;
  finally
    FLock.Leave;
  end;
end;

function TIRegisterPool.Update(var Describe: TIDescribe): Boolean;
var
  PIReg: PIRegister;
begin
  FLock.Enter;
  try
    PIReg := Find(Describe.ID);
    Result := PIReg <> nil;
    if Result then
    begin
      //clear PIReg.Describe
      if (Describe.InfoSize <> PIReg.Describe.InfoSize) then begin
        FreeMem(PIReg.Describe.Info);
        PIReg.Describe.Info := AllocMem(Describe.InfoSize);
      end;
      PIReg.Describe.InfoSize := Describe.InfoSize;
      Move(Describe.Info^, PIReg.Describe.Info^, Describe.InfoSize);
    end;
  finally
    FLock.Leave;
  end;
end;

function TIRegisterPool.Get(var Describe: TIDescribe; const dwID: DWORD): Boolean;
var
  PIReg: PIRegister;
begin
  FLock.Enter;
  try
    PIReg := Find(dwID);
    Result := PIReg <> nil;
    if Result then
      Describe := PIReg.Describe;
  finally
    FLock.Leave;
  end;
end;

function TIRegisterPool.Get(var RegRoute: TIRegRoute; const dwID: DWORD): Boolean;
var
  PIReg: PIRegister;
begin
  FLock.Enter;
  try
    PIReg := Find(dwID);
    Result := PIReg <> nil;
    if Result then
      RegRoute := PIReg.RegRoute;
  finally
    FLock.Leave;
  end;
end;

function TIRegisterPool.IsExist(const dwID: DWORD; const SessionID: WORD): Boolean;
var
  PIReg: PIRegister;
begin
  FLock.Enter;
  try
    PIReg := Find(dwID);
    Result := (PIReg <> nil) and (PIReg.SessionID = SessionID);
  finally  FLock.Leave; end;
end;

function TIRegisterPool.IsValid(const dwID: DWORD): Boolean;
var
  PIReg: PIRegister;
begin
  FLock.Enter;
  try
    PIReg := Find(dwID);
    Result := (PIReg <> nil) and (PIReg.Heart > 0);
  finally  FLock.Leave; end;
end;

procedure TIRegisterPool.CheckHeart();
var
  I: Integer;
  PIReg: PIRegister;
begin
  I := 0;
  try
    PIReg := nil;
    while(TRUE) do
    begin
      SearchIn(I, PIReg);
      if (PIReg = nil) then Break;
      if (PIReg.Heart > 0) then
        Dec(PIReg.Heart);
    end;
  except end;
end;

  { TIServer }

constructor TIServer.Create();
begin
  inherited Create();
  Init;
end;

destructor TIServer.Destroy();
begin
  Clear;
  inherited Destroy;
end;

procedure TIServer.Init;
begin
  FUDPServer := nil;
  FTCPServer := nil;
  FRegPool   := nil;
  FActive	   := FALSE;
  SetNative;
  FThdBuffer := AllocMem(2048);
  try
    FRegPool := TIRegisterPool.Create;
    FTime := TTimer.Create(nil);
    FTime.Interval := 50000;
    FTime.OnTimer := ThreadProc;
    FTime.Enabled := FALSE;
  except  Exit;  end;
end;

procedure TIServer.Clear;
begin
  SetActive(FALSE);
  FreeMem(FThdBuffer);
  try
    if Assigned(FRegPool) then
      FRegPool.Free;
    FTime.Free;
  except end;
  FRegPool := nil;
  FTime := nil;
end;

procedure TIServer.SetNative;
begin
  SetBindAddress('');
  SetBindPort(DEF_SERVER_PORT);
end;

function TIServer.GetBindAddress: string;
begin
  Result := IPToString(FBindIP);
end;

procedure TIServer.SetBindAddress(const Value: string);
begin
  FBindIP := GetHostIP(Value);
end;

function TIServer.GetBindPort: Integer;
begin
  Result := WinSock.ntohs(FBindPort);
end;

procedure TIServer.SetBindPort(const Value: Integer);
begin
  if (Value > 2048) and (Value < 65535) then
  begin
    FBindPort := WinSock.htons(Value);
  end;
end;

function TIServer.CheckValidValue: Boolean;
begin
  Result := (FBindIP <> 0) and (FBindPort <> 0);
end;

procedure TIServer.SetActive(V: Boolean);
begin
  if V <> FActive then
  begin
    if V then begin
      FActive := (CreateNetService = 0);
      DoStartupNotify();
    end else begin
      FActive := not (FreeNetService = 0);
      DoStopNotify();
    end;
  end;
end;

function TIServer.CreateNetService: Integer;
var
  Thread: TINetThread;
begin
  Result := -1;
  if not CheckValidValue then Exit;
  
  try
    FUDPServer := TIUDP.Create(FBindIP, FBindPort);
    if (FUDPServer.Enable) then
    begin
      Thread := TINetThread.Create(FUDPServer, TRUE);
      Put(FUDPServer);
      FUDPServer.Thread := Thread;
      Thread.RunProc := FUDPServer.DoReceiveProc;
      FUDPServer.OnUDPMsgNotify := OnUDPProc;
      Thread.FreeOnTerminate := TRUE;
      Thread.Resume;
    end;
  except  Exit;  end;

  try
    FTCPServer := TITCP.Create(FBindIP, FBindPort);
    if (FTCPServer.IsOpen) then
    begin
      Thread := TINetThread.Create(FTCPServer, TRUE);
      Put(FTCPServer);
      FTCPServer.Thread := Thread;
      //FTCPServer.OnTCPPeerNotify := OnTCPPeerProc;
      FTCPServer.OnTCPAcceptNotify := OnTCPProc;
      Thread.RunProc := FTCPServer.DoAcceptProc;

      Thread.FreeOnTerminate := TRUE;
      Thread.Resume;
    end;
  except  Exit;  end;
  FTime.Enabled := TRUE;
  //CreateThread;
  Result := 0;
end;

function TIServer.FreeNetService: Integer;
begin
  Result := -1;
  try
    {try
      if Assigned(FTCPServer) then
        FTCPServer.Free;
    except end;
    try
      if Assigned(FUDPServer) then
        FUDPServer.Free;
    except end;}
    //StopThread;
    QuitAll();
    FTime.Enabled := FALSE;
    Result := 0;
  finally
    FTCPServer := nil;
    FUDPServer := nil;
  end;
end;

procedure TIServer.DoStartupNotify;
begin
  try
    if Assigned(FOnStartupNotify) then
      FOnStartupNotify(Self);
  except end;
end;
procedure TIServer.DoStopNotify;
begin
  try
    if Assigned(FOnStartupNotify) then
      FOnStartupNotify(Self);
  except end;
end;

procedure TIServer.OnTCPProc(var TCPPeer: TITCPPeer);
var
  Thread: TINetThread;
begin
  try
    if Assigned(TCPPeer) and TCPPeer.IsPeer then
    begin
      Thread := TINetThread.Create(TCPPeer, TRUE);
      if Put(TCPPeer) then begin
        TCPPeer.OnTCPPeerNotify := OnTCPPeerProc;
        TCPPeer.Thread := Thread;
        Thread.RunProc := TCPPeer.DoPeerProc;
        Thread.FreeOnTerminate := TRUE;
        Thread.Resume;
      end;
    end;
  except end;
end;

procedure TIServer.ThreadProc(Sender: TObject);
begin
  try
    //Sleep(1000);
    //Exit;
    while(FActive and Assigned(FThread) and (not FThread.Exit)) do
    begin
      CheckRegisterPool();
      //Sleep(1000*50);
    end;
  except
  end;;
end;

procedure TIServer.CreateThread;
begin
  try
    FThread := TIWorkThread.Create(TRUE);
    //FThread.RunProc         := ThreadProc;
    FThread.FreeOnTerminate := TRUE;
    FThread.Resume;
  except end;  
end;

procedure TIServer.StopThread;
begin
  try
    if Assigned(FThread) then
    begin
      FThread.Stop;
    end;
    Sleep(100);
  except end;
  //FThread := nil;
end;

procedure TIServer.CheckRegisterPool;
var
  I: Integer;
  PIReg: PIRegister;
begin
  I := 0;
  PIReg := nil;
  try
    while(True) do
    begin
      PIReg := FRegPool.SearchIn(I, PIReg);
      if (PIReg = nil) then Break;
      if (PIReg.Heart > 0) then
        Dec(PIReg.Heart);
    end;
  except end;
end;

function TIServer.SetUserInfo(NameID: string; Info: Pointer; InfoSize: Integer): Integer;
var
  Des: TIDescribe;
  RegRoute: TIRegRoute;
begin
  FillChar(Des, SizeOf(Des), 0);
  FillChar(RegRoute, SizeOf(RegRoute), 0);
  Result := -1;

  try
    if (NameID <> '') and (Length(NameID) < MAX_I_NAMEID) then
    begin
      Des.ID := CalculateID(NameID);
      StrLCopy(Des.NameID, PChar(NameID), Length(NameID));
      Des.Info := Info;
      Des.InfoSize := InfoSize;
      if FRegPool.Put(Des, RegRoute) <> nil then
      begin
        Result := 0;
      end;
    end;
  except end;
end;

function TIServer.GetUserInfo(NameID: string; var Info: Pointer): Integer;
var
  Describe: TIDescribe;
  ID: DWORD;
begin
  Result := 0;
  if NameID <> '' then
  begin
    ID := CalculateID(NameID);
    if FRegPool.Get(Describe, ID) then
    begin
      if (Describe.InfoSize > 0) then
        Info := AllocMem(Describe.InfoSize);
      Move(Describe.Info^, Info^, Describe.InfoSize);
      Result := Describe.InfoSize;
    end;
  end;
end;

function TIServer.GetUsersInfo(var Infos: Pointer; Status: Integer=0): Integer;
var
  Users, Temp: PIUsersLink;
  I: Integer; PIReg: PIRegister; IsOK: Boolean;
begin
  Users := nil; Temp := nil;  IsOK := FALSE;
  I := 0; PIReg := nil; result := 0;

  try
    while(TRUE)do
    begin
      PIReg := FRegPool.SearchIn(I, PIReg);
      if (PIReg = nil) then Break;
      IsOK := FALSE;
      case Status of
        1: if PIReg.Heart > 0 then IsOK := TRUE;
        2: if PIReg.Heart = 0 then IsOK := TRUE;
      else
        IsOK := TRUE;
      end;

      if IsOK then
      begin
        if (Temp = nil) then begin
          New(Temp);
        end else begin
          New(Temp.Link); Temp := Temp.Link;
        end;
        FillChar(Temp^, SizeOf(TIUsersLink), 0);
        
        if (Users = nil) then Users := Temp;

        Temp.NameID := PIReg.Describe.NameID;
        Temp.Status := Ord(PIReg.Heart > 0);
        Temp.IPStr  := IPToString(PIReg.RegRoute.dwLoginIP);
        Temp.InfoSize := PIReg.Describe.InfoSize;