uconnect.pas

千年源代码,只缺少控件,可以做二次开发用,好不容易得来的

         else begin rFColor := WinRGB (22,22,22); rBColor := WinRGB (0, 0 ,0); end;
      end;

      SetWordString (rWordstring, aStr);
      ComData.Cnt := Sizeof(TSChatMessage) - Sizeof(TWordString) + sizeofwordstring(rWordString);
   end;
   AddSendData (@ComData, ComData.Cnt + SizeOf (Word));
end;

procedure TConnector.SendMap (var aSenderInfo: TBasicData; amap, aobj, arof, atil, aSoundBase: string);
var
   ComData : TWordComData;
   psNewMap : PTSNewMap;
begin
   psNewMap := @ComData.Data;
   FillChar (psNewMap^, SizeOf (TSNewMap), 0);
   with psNewMap^ do begin
      rmsg := SM_NEWMAP;
      StrPCopy (@rMapName, aMap);
      StrCopy (@rCharName, @aSenderInfo.Name);
      rId := aSenderInfo.id;
      rx := aSenderInfo.x;
      ry := aSenderInfo.y;
      StrPCopy (@rObjName, aobj);
      StrPCopy (@rRofName, arof);
      StrPCopy (@rTilName, atil);
      ComData.Cnt := SizeOf (TSNewMap);
   end;
   AddSendData (@ComData, ComData.Cnt + SizeOf (Word));
end;

procedure TConnector.SendShowCenterMessage (aStr : String; aColor : Word);
var
   ComData : TWordComData;
   psShowCenterMsg : PTSShowCenterMsg;
begin
   psShowCenterMsg := @ComData.Data;

   with psShowCenterMsg^ do begin
      rMsg := SM_SHOWCENTERMSG;
      rColor := aColor;
      SetWordString (rText, aStr);
      ComData.Cnt := SizeOf (TSShowCenterMsg) - SizeOf (TWordString) + SizeOfWordString (rText);
   end;
   AddSendData (@ComData, ComData.Cnt + SizeOf (Word));
end;

procedure TConnector.SendShow (var aSenderinfo: TBasicData);
var
   ComData : TWordComData;
   psShow : PTSShow;
   str : shortstring;
begin
   if (aSenderInfo.Feature.rrace = RACE_HUMAN) or (aSenderInfo.Feature.rRace = RACE_MONSTER)
      or (aSenderInfo.Feature.rRace = RACE_NPC) then begin
      psShow := @ComData.Data;
      with psShow^ do begin
         str := StrPas (@aSenderInfo.Name);

         if aSenderInfo.ServerName [0] <> 0 then
            str := str + ',' + StrPas (@aSenderInfo.ServerName);

         if Length (str) >= 18 then str := Copy (str, 1, 18);

         rmsg := SM_SHOW;
         rId := aSenderInfo.id;
         StrPCopy (@rNameString, str);
         rdir := aSenderInfo.dir;
         rx := aSenderInfo.x;
         ry := aSenderInfo.y;
         rFeature := aSenderInfo.Feature;
         if rFeature.rrace = RACE_NPC then rFeature.rrace := RACE_MONSTER;
         SetWordString (rWordString, '');

         ComData.Cnt := sizeof(TSShow)-sizeof(twordstring)+sizeofwordstring(rwordstring);
      end;
      AddSendData (@ComData, ComData.Cnt + SizeOf (Word));
      exit;
   end;
end;

function TConnector.GetToken (aStr : String; aDivStr : Char; aTime : Integer) : String;
var
   Strs : array [0..5] of string;
   Dest : String;
   i : Integer;
begin
   Dest := aStr;

   for i := 0 to 5 do begin
      Dest := GetValidStr3 (Dest, Strs[i], aDivStr);
      if Dest = '' then break;
   end;

   Result := Strs [aTime];   
end;

// TConnectorList
constructor TConnectorList.Create;
begin
   CurProcessPos := 0;
   ConnectorProcessCount := 0;

   CreateTick := 0;
   DeleteTick := 0;
   SaveTick := 0;

   UniqueKey := TIntegerKeyClass.Create;
   NameKey := TStringKeyClass.Create;

   DataList := TList.Create;

   SaveBuffer := TPacketBuffer.Create (1024 * 1024 * 4);
end;

destructor TConnectorList.Destroy;
begin
   Clear;
   UniqueKey.Free;
   NameKey.Free;
   DataList.Free;

   SaveBuffer.Free;

   inherited Destroy;
end;

procedure TConnectorList.Clear;
var
   i : Integer;
   Connector : TConnector;
begin
   UniqueKey.Clear;
   NameKey.Clear;

   for i := 0 to DataList.Count - 1 do begin
      Connector := DataList.Items [i];
      Connector.Free;
   end;
   DataList.Clear;

   SaveBuffer.Clear;
end;

procedure TConnectorList.Update (CurTick : Integer);
var
   i : Integer;
   Connector : TConnector;
begin
   for i := DataList.Count - 1 downto 0 do begin
      Connector := DataList.Items [i];
      if Connector.FboAllowDelete = true then begin
         UniqueKey.Delete (1000000000 * Connector.GateNo + Connector.ConnectID);
         NameKey.Delete (Connector.Name);
         Connector.Free;
         DataList.Delete (i);
         continue;
      end;
      Connector.Update (CurTick);
   end;

   {
   ConnectorProcessCount := (DataList.Count * 4 div 100);
   if ConnectorProcessCount = 0 then ConnectorProcessCount := DataList.Count;

   ConnectorProcessCount := ProcessListCount;

   if DataList.Count > 0 then begin
      StartPos := CurProcessPos;
      for i := 0 to ConnectorProcessCount - 1 do begin
         if CurProcessPos >= DataList.Count then CurProcessPos := 0;
         Connector := DataList.Items [CurProcessPos];
         Connector.Update (CurTick);
         Inc (CurProcessPos);
         if CurProcessPos = StartPos then break;
      end;
   end;
   }
end;

function TConnectorList.GetCount : Integer;
begin
   Result := DataList.Count;
end;

function TConnectorList.GetNameKeyCount : Integer;
begin
   Result := NameKey.Count;
end;

function TConnectorList.GetUniqueKeyCount : Integer;
begin
   Result := UniqueKey.Count;
end;

function TConnectorList.CreateConnect (aGateNo : Integer; aPacket : PTPacketData) : TConnector;
var
   Connector : TConnector;
   pcd : PTDBRecord;
   GateNo, ConnectID : Integer;
   ServerName : String;
begin
   Result := nil;

   GateNo := aGateNo;
   ConnectID := aPacket^.RequestID;

   pcd := @aPacket^.Data;

   ServerName := GameServerConnectorList.GetGameServerName (aGateNo);
   if ServerName = '' then begin
      GameServerConnectorList.AddSendServerData (aGateNo, aPacket^.RequestID, BG_USERCLOSE, nil, 0);
      exit;
   end;

   Connector := NameKey.Select (StrPas (@pcd^.PrimaryKey) + ' (' + ServerName + ')');
   if Connector <> nil then begin
      DeleteConnect (Connector.GateNo, Connector.ConnectID);
      GameServerConnectorList.AddSendServerData (aGateNo, aPacket^.RequestID, BG_USERCLOSE, nil, 0);
      exit;
   end;

   Connector := TConnector.Create (ServerName, GateNo, ConnectID);
   if Connector.StartLayer (@aPacket^.Data) = false then begin
      Connector.Free;
      GameServerConnectorList.AddSendServerData (aGateNo, aPacket^.RequestID, BG_USERCLOSE, nil, 0);
      exit;
   end;

   UniqueKey.Insert (1000000000 * GateNo + ConnectID, Connector);
   NameKey.Insert (Connector.Name, Connector);

   DataList.Add (Connector);

   frmMain.AddLog ('Start ' + Connector.Name); // for test;
   frmMain.AddUser (Connector.Name);

   Result := Connector;
end;

procedure TConnectorList.DeleteConnect (aGateNo, aConnectID : Integer);
var
   nPos : Integer;
   Connector : TConnector;
begin
   Connector := UniqueKey.Select (1000000000 * aGateNo + aConnectID);
   if Connector <> nil then begin
      nPos := DataList.IndexOf (Connector);
      UniqueKey.Delete (1000000000 * Connector.GateNo + Connector.ConnectID);
      NameKey.Delete (Connector.Name);
      Connector.Free;
      DataList.Delete (nPos);
   end;
end;

procedure TConnectorList.CloseAllConnect;
var
   i : Integer;
   Connector : TConnector;
begin
   for i := 0 to DataList.Count - 1 do begin
      Connector := DataList.Items [i];
      GameServerConnectorList.AddSendServerData (Connector.GateNo, Connector.ConnectID, GM_DISCONNECT, nil, 0);
   end;
end;
{
procedure TConnectorList.CloseConnectByCharName (aName : String);
var
   i : Integer;
   Connector : TConnector;
begin
   for i := DataList.Count - 1 downto 0 do begin
      Connector := DataList.Items [i];
      if Connector.Name = aName then begin
         GameServerConnectorList.AddSendServerData (Connector.GateNo, Connector.ConnectID, GM_DISCONNECT, nil, 0);
         exit;
      end;
   end;
end;

procedure TConnectorList.CloseConnectByGateNo (aGateNo : Integer);
var
   i : Integer;
   Connector : TConnector;
begin
   for i := DataList.Count - 1 downto 0 do begin
      Connector := DataList.Items [i];
      if Connector.GateNo = aGateNo then begin
         DeleteConnect (aGateNo, Connector.ConnectID);
      end;
   end;
end;
}
procedure TConnectorList.AddReceiveData (aGateNo : Integer; aPacket : PTPacketData);
var
   ComData : TWordComData;
   Connector : TConnector;
begin
   Connector := UniqueKey.Select (1000000000 * aGateNo + aPacket^.RequestID);
   if Connector <> nil then begin
      ComData.Cnt := aPacket^.PacketSize - (SizeOf (Word) + SizeOf (Integer) + SizeOf (Byte) * 2);
      Move (aPacket^.Data, ComData.Data, ComData.Cnt);
      Connector.AddReceiveData (@ComData, ComData.Cnt + SizeOf (Word));
      exit;
   end;
end;

{
procedure TConnectorList.AddSaveData (aData : PChar; aSize : Integer);
begin
   SaveBuffer.Put (aData, aSize);
end;
}

function TConnectorList.GetSaveListCount : Integer;
begin
   Result := SaveBuffer.Count;
end;

procedure TConnectorList.BattleDBMessageProcess (aPacket : PTPacketData);
var
   i : Integer;
   Connector : TConnector;
begin
   for i := 0 to DataList.Count - 1 do begin
      Connector := DataList.Items [i];
      if Connector.ConnectID = aPacket^.RequestID then begin
         Connector.BattleDBMessageProcess (aPacket);
         exit;
      end;
   end;
end;

procedure TConnectorList.SendLatestList (aWhereStatus : TWhereStatus; aData : PChar; aSize : Integer);
var
   i : Integer;
   Connector : TConnector;
begin
   for i := 0 to DataList.Count - 1 do begin
      Connector := DataList.Items [i];
      if Connector.WhereStatus = aWhereStatus then begin
         Connector.AddSendData (aData, aSize);
      end;
   end;
end;

procedure TConnectorList.SendLatestRoomList (aGroupTitle : String; aData : PChar; aSize : Integer);
var
   i : Integer;
   Connector : TConnector;
begin
   for i := 0 to DataList.Count - 1 do begin
      Connector := DataList.Items [i];
      if Connector.WhereStatus = ws_room then begin
         if Connector.GroupTitle = aGroupTitle then begin
            Connector.AddSendData (aData, aSize);
         end;
      end;
   end;
end;

procedure TConnectorList.WaitRoomMessage (aGroupTitle : String; aStr : String; aColor : Byte);
var
   i : Integer;
   Connector : TConnector;
begin
   for i := 0 to DataList.Count - 1 do begin
      Connector := DataList.Items [i];
      if Connector.GroupTitle = aGroupTitle then begin
         if Connector.WhereStatus = ws_room then begin
            Connector.SendChatMessage (aStr, aColor);
         end;
      end;
   end;
end;

procedure TConnectorList.ShoutMessage (aStr : String; aColor : Byte);
var
   i : Integer;
   Connector : TConnector;
begin
   for i := 0 to DataList.Count - 1 do begin
      Connector := DataList.Items [i];
      Connector.SendChatMessage (aStr, aColor);
   end;
end;

end.