main.~pas

RO模拟器!!适合玩仙境传说的玩家们呦~

		if Assigned(ItemDB.Objects[Idx]) then
			(ItemDB.Objects[Idx] AS TItemDB).Free;
	ItemDB.Free; //CR - Frees up 1.4Mb properly on close down that is leaked.
	ItemDBName.Free;

{傾僀僥儉惢憿捛壛}
	for Idx := MaterialDB.Count-1 downto 0 do
		if Assigned(MaterialDB.Objects[Idx]) then
			(MaterialDB.Objects[Idx] AS TMaterialDB).Free;
	MaterialDB.Free;
{傾僀僥儉惢憿捛壛僐僐傑偱}
	for Idx := MobDB.Count-1 downto 0 do
		if Assigned(MobDB.Objects[Idx]) then
			(MobDB.Objects[Idx] AS TMobDB).Free;
	MobDB.Free;
	MobDBName.Free;

	for Idx := MArrowDB.Count-1 downto 0 do
		if Assigned(MArrowDB.Objects[Idx]) then
			(MArrowDB.Objects[Idx] AS TMArrowDB).Free;
	MArrowDB.Free;

	for Idx := WarpDatabase.Count-1 downto 0 do
		if Assigned(WarpDatabase.Objects[Idx]) then
			(WarpDatabase.Objects[Idx] AS TWarpDatabase).Free;
	WarpDatabase.Free;

	MobAIDB.Free; //CR - Empty list.

	for Idx := MobAIDBFusion.Count-1 downto 0 do
		if Assigned(MobAIDBFusion.Objects[Idx]) then
			(MobAIDBFusion.Objects[Idx] AS TMobAIDBFusion).Free;
	MobAIDBFusion.Free;

	GlobalVars.Free;
	//PharmacyDB.Free;

	for Idx := IDTableDB.Count-1 downto 0 do
		if Assigned(IDTableDB.Objects[Idx]) then
			(IDTableDB.Objects[Idx] AS TIDTbl).Free;
	IDTableDB.Free;

	for Idx := SlaveDBName.Count-1 downto 0 do
		if Assigned(SlaveDBName.Objects[Idx]) then
			(SlaveDBName.Objects[Idx] AS TSlaveDB).Free;
	SlaveDBName.Free;

	//CR - both of these are the same count, same objects - free objects on one
	// and leave the other objects[] list alone - only free the object once!! :)
	for Idx := SkillDB.Count-1 downto 0 do
		if Assigned(SkillDB.Objects[Idx]) then
			(SkillDB.Objects[Idx] AS TSkillDB).Free;
	SkillDB.Free;
	SkillDBName.Free;

	for Idx := Player.Count-1 downto 0 do
		if Assigned(Player.Objects[Idx]) then
			(Player.Objects[Idx] AS TPlayer).Free;
	Player.Free;
	PlayerName.Free;

	for Idx := Chara.Count-1 downto 0 do
		if Assigned(Chara.Objects[Idx]) then
			(Chara.Objects[Idx] AS TChara).Free;
	Chara.Free;
	CharaName.Free;
	CharaPID.Free;
{僠儍僢僩儖乕儉婡擻捛壛}
	for Idx := ChatRoomList.Count-1 downto 0 do
		if Assigned(ChatRoomList.Objects[Idx]) then
			(ChatRoomList.Objects[Idx] AS TChatRoom).Free;
	ChatRoomList.Free;
{僠儍僢僩儖乕儉婡擻捛壛僐僐傑偱}
{僷乕僥傿乕婡擻捛壛}
	for Idx := PartyNameList.Count-1 downto 0 do
		if Assigned(PartyNameList.Objects[Idx]) then
			(PartyNameList.Objects[Idx] AS TParty).Free;
	PartyNameList.Free;

	for Idx := CastleList.Count-1 downto 0 do
		if Assigned(CastleList.Objects[Idx]) then
			(CastleList.Objects[Idx] AS TCastle).Free;
	CastleList.Free;

	for Idx := TerritoryList.Count-1 downto 0 do
		if Assigned(TerritoryList.Objects[Idx]) then
			(TerritoryList.Objects[Idx] AS TTerritoryDB).Free;
	TerritoryList.Free;

	for Idx := EmpList.Count-1 downto 0 do
		if Assigned(EmpList.Objects[Idx]) then
			(EmpList.Objects[Idx] AS TEmp).Free;
	EmpList.Free;
{僷乕僥傿乕婡擻捛壛僐僐傑偱}
{僉儏乕儁僢僩}
	for Idx := PetDB.Count-1 downto 0 do
		if Assigned(PetDB.Objects[Idx]) then
			(PetDB.Objects[Idx] AS TPetDB).Free;
	PetDB.Free;

	for Idx := PetList.Count-1 downto 0 do
		if Assigned(PetList.Objects[Idx]) then
			(PetList.Objects[Idx] AS TPet).Free;
	PetList.Free;
{僉儏乕儁僢僩偙偙傑偱}
{業揦僗僉儖捛壛}
	for Idx := VenderList.Count-1 downto 0 do
		if Assigned(VenderList.Objects[Idx]) then
			(VenderList.Objects[Idx] AS TVender).Free;
	VenderList.Free;
{業揦僗僉儖捛壛僐僐傑偱}
{庢堷婡擻捛壛}

	for Idx := DealingList.Count-1 downto 0 do
		if Assigned(DealingList.Objects[Idx]) then
			(DealingList.Objects[Idx] AS TDealings).Free;
	DealingList.Free;
{庢堷婡擻捛壛僐僐傑偱}
{巵{敔捛壛}
	SummonMobList.Free;  //ChrstphrR - 2004/04/19 - This list is now leak free.
	SummonMobListMVP.Free; {CR - empty list 2004/04/23 - leaving be}

	{ChrstphrR 2004/04/26 -- Summon???Lists cleaned up here by converting them to
	TStringLists -- now instead of using a TIntList32 that was:
	- storing an integer the same number as the index of the nodes in Integers[]
	- storing a string in a TObject (think, tossing a dime into a fridge)
	- failing to free the strings AND the Objects when cleaning up...
	Now we have a semi-inefficient StringLists that are used for random item
	generation when someone uses a Old Blue Box, etc.  This is a compromise data
	structure until I make them equivalent to the TRandList derived objects that
	TSummonMobList is.
	}
	SummonIOBList.Free; //Changed to TStringList
	SummonIOVList.Free; //" " "
	SummonICAList.Free; //" " "
	SummonIGBList.Free; //" " "
	SummonIOWBList.Free;//" " "
{巵{敔捛壛僐僐傑偱}
{NPC僀儀儞僩捛壛}
	ServerFlag.Free;//Strings Only List - safe as is.

{NPC僀儀儞僩捛壛僐僐傑偱}
{僊儖僪婡擻捛壛}
	for Idx := GuildList.Count-1 downto 0 do
		if Assigned(GuildList.Objects[Idx]) then
			(GuildList.Objects[Idx] AS TGuild).Free;
	GuildList.Free;

	//Static list loaded up at beginning, need to free properly at the end.
	for Idx := GSkillDB.Count-1 downto 0 do
		if Assigned(GSkillDB.Objects[Idx]) then
			(GSkillDB.Objects[Idx] AS TSkillDB).Free;
	GSkillDB.Free;
{僊儖僪婡擻捛壛僐僐傑偱}
	{ChrstphrR 2004/04/23 - Runtime list, Map list is filled up as characters
	move about in the game}
	for Idx := Map.Count-1 downto 0 do
		if Assigned(Map.Objects[Idx]) then
			(Map.Objects[Idx] AS TMap).Free;
	Map.Free;

	for Idx := MapInfo.Count-1 downto 0 do
		if Assigned(MapInfo.Objects[Idx]) then
			(MapInfo.Objects[Idx] AS MapTbl).Free;
	MapInfo.Free;

	for Idx := MapList.Count-1 downto 0 do
		if Assigned(MapList.Objects[Idx]) then
			(MapList.Objects[Idx] AS TMapList).Free;
	MapList.Free;
end;//proc TfrmMain.FormCloseQuery()
//------------------------------------------------------------------------------

procedure TfrmMain.FormResize(Sender: TObject);
begin
	Perform(WM_NCACTIVATE, Word(Active), 0);
	if WindowState = wsNormal then begin
		FormLeft := Left;
		FormTop := Top;
		FormWidth := Width;
		FormHeight := Height;
	end;
	StatusBar1.Panels[1].Width :=200;
	StatusBar1.Panels[0].Width := 100;
	// Keep the timer portion of the panels the same.
end;

//------------------------------------------------------------------------------
procedure TfrmMain.PriorityUpdate(prioramount : Integer);
var
	PriorityClass	:cardinal;
begin
	case prioramount of
	0: 		PriorityClass := REALTIME_PRIORITY_CLASS;
	1: 		PriorityClass := HIGH_PRIORITY_CLASS;
	2: 		PriorityClass := ABOVE_NORMAL_PRIORITY_CLASS;
	3: 		PriorityClass := NORMAL_PRIORITY_CLASS;
	4: 		PriorityClass := BELOW_NORMAL_PRIORITY_CLASS;
	5: 		PriorityClass := IDLE_PRIORITY_CLASS;
	else
		begin
			Priority := 3;
			PriorityClass := NORMAL_PRIORITY_CLASS;
		end;
	end;

	SetPriorityClass(GetCurrentProcess(), PriorityClass);
end;
//==============================================================================





//==============================================================================
// ****************************************************************************
// * SERVER 1 : LOGIN SERVER (Port 6900)                                      *
// ****************************************************************************
//==============================================================================
procedure TfrmMain.sv1ClientConnect(Sender: TObject;
	Socket: TCustomWinSocket);
begin
	//debugout.lines.add('[' + TimeToStr(Now) + '] ' + Socket.RemoteAddress + ': Login Server -> Connect');
end;
//------------------------------------------------------------------------------
procedure TfrmMain.sv1ClientDisconnect(Sender: TObject;
	Socket: TCustomWinSocket);
begin
	//debugout.lines.add('[' + TimeToStr(Now) + '] ' + Socket.RemoteAddress + ': Login Server -> Disconnect');
end;
//------------------------------------------------------------------------------
procedure TfrmMain.sv1ClientError(Sender: TObject;
	Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
	var ErrorCode: Integer);
begin
        debugout.lines.add('[' + TimeToStr(Now) + '] ' + Socket.RemoteAddress + ': Login Server -> Player has been disconnected from server. Player did not exit via Exit button');
	if ErrorCode = 10053 then Socket.Close;
	ErrorCode := 0;
end;
//------------------------------------------------------------------------------
procedure TfrmMain.sv1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
	try
	sv1PacketProcess(Socket);
  except
    exit;
  end;
end;
//==============================================================================










//==============================================================================
// ****************************************************************************
// * SERVER 2 : CHARA SERVER (Port 6121)                                      *
// ****************************************************************************
//==============================================================================
procedure TfrmMain.sv2ClientConnect(Sender: TObject;
	Socket: TCustomWinSocket);
begin
        //debugout.lines.add('[' + TimeToStr(Now) + '] ' + Socket.RemoteAddress + ': Character Server -> Connect');
end;
//------------------------------------------------------------------------------
procedure TfrmMain.sv2ClientDisconnect(Sender: TObject;
	Socket: TCustomWinSocket);
begin
        //debugout.lines.add('[' + TimeToStr(Now) + '] ' + Socket.RemoteAddress + ': Character Server -> Disconnect');
end;
//------------------------------------------------------------------------------
procedure TfrmMain.sv2ClientError(Sender: TObject;
	Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
	var ErrorCode: Integer);
begin
        debugout.lines.add('[' + TimeToStr(Now) + '] ' + Socket.RemoteAddress + ': Character Server -> Player has been disconnected from server. Player did not exit via Exit button');
	if ErrorCode = 10053 then Socket.Close;
	ErrorCode := 0;
end;
//------------------------------------------------------------------------------
procedure TfrmMain.sv2ClientRead(Sender: TObject;
	Socket: TCustomWinSocket);
begin
	try
	sv2PacketProcess(Socket);
	except
		exit;
	end;
end;
//==============================================================================




//==============================================================================
// ****************************************************************************
// * SERVER 3 : GAME SERVER (Port 5121)                                       *
// ****************************************************************************
//==============================================================================
procedure TfrmMain.sv3ClientConnect(Sender: TObject;
	Socket: TCustomWinSocket);
begin
	//debugout.lines.add('[' + TimeToStr(Now) + '] ' + Socket.RemoteAddress + ': Game Server -> Connect');
	NowUsers := sv3.Socket.ActiveConnections;
        statusbar1.Panels.Items[0].Text := ' 在线用户: ' +inttostr(NowUsers); // 显示在线用户
end;
//------------------------------------------------------------------------------
procedure TfrmMain.sv3ClientDisconnect(Sender: TObject;
	Socket: TCustomWinSocket);
var
	tc  :TChara;
	tp  :TPlayer;

	i,j :integer;
	mi  :MapTbl;

begin

        // AlexKreuz: Random 10053 Bug Fix
        if Assigned(Socket.Data) then begin
					tc := Socket.Data;
        	SendCLeave(tc, 2);
                {NPC僀儀儞僩捛壛}
         if MapInfo.IndexOf(tc.Map) <> -1 then begin
        	i := MapInfo.IndexOf(tc.Map);
        	j := -1;
        	if (i <> -1) then begin
        		mi := MapInfo.Objects[i] as MapTbl;
        		if (mi.noSave = true) then j := 0;
        	end;
        	if (tc.Sit = 1) or (j = 0) then begin
                        {NPC僀儀儞僩捛壛僐僐傑偱}
        		tc.Map := tc.SaveMap;
        		tc.Point.X := tc.SavePoint.X;
        		tc.Point.Y := tc.SavePoint.Y;
        	end;
        	tc.Login := 0;
        	tp := tc.PData;
        	tp.Login := 0;
                if UseSQL then SQLDataSave();
         end;
        end;

        // AlexKreuz: Random 10053 Bug Fix
        //debugout.lines.add('[' + TimeToStr(Now) + '] ' + Socket.RemoteAddress + ': Game Server -> Disconnect');
        NowUsers := sv3.Socket.ActiveConnections;
        if NowUsers > 0 then Dec(NowUsers);
        statusbar1.Panels.Items[0].Text := ' 在线用户: ' +inttostr(NowUsers); // 显示在线用户

end;
//------------------------------------------------------------------------------
procedure TfrmMain.sv3ClientError(Sender: TObject;
	Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
	var ErrorCode: Integer);
//var
//	tc  :TChara;
//	tp  :TPlayer;
begin
	if UseSQL then SQLDataSave();
	if ErrorCode = 10053 then begin
    	Socket.Close;
        debugout.lines.add('[' + TimeToStr(Now) + '] ' + Socket.RemoteAddress + ': Game Server -> Player has been disconnected from server. Player did not exit via Exit button');
    end;
	if ErrorCode = 10054 then begin
    	Socket.Close;
        debugout.lines.add('[' + TimeToStr(Now) + '] ' + Socket.RemoteAddress + ': Game Server -> Player has been disconnected from server. Player tried to log in twice with the same account');
    end;

	ErrorCode := 0;
	NowUsers := sv3.Socket.ActiveConnections;
end;
//------------------------------------------------------------------------------
procedure TfrmMain.sv3ClientRead(Sender: TObject;
	Socket: TCustomWinSocket);
begin
        try
	        sv3PacketProcess(Socket);
        except
                exit;
        end;
end;
//==============================================================================










//==============================================================================
{
ChrstphrR 2004/04/27
- unused var cleanup
- Checked for memory leaks - no obvious ones.
}
procedure TFrmMain.MonsterSpawn(tm:TMap; ts:TMob; Tick:cardinal);
var
	i, j, k : Integer;
	tc      : TChara;

begin