common.pas

仙境传说(RO)私人服务器端源代码。第一次上传。

	EnableMonsterKnockBack :boolean;
	DisableEquipLimit      :boolean;
  DropMultiplier         :cardinal;
	DisableFleeDown        :boolean;
	DisableSkillLimit      :boolean;

	FormLeft:integer;
	FormTop:integer;
	FormWidth:integer;
	FormHeight:integer;

	ScriptList :TStringList;

{傾僀僥儉惢憿捛壛}
	MaterialDB :TIntList32;
{傾僀僥儉惢憿捛壛僐僐傑偱}
{僷乕僥傿乕婡擻捛壛}
	PartyNameList	:TStringList;
  CastleList    :TStringList;
  EmpList       :TStringList;
{僷乕僥傿乕婡擻捛壛僐僐傑偱}
{僉儏乕儁僢僩}
	PetDB      :TIntList32;
  PetList    :TIntList32;
{僉儏乕儁僢僩偙偙傑偱}
{僠儍僢僩儖乕儉婡擻捛壛}
	ChatRoomList :TIntList32;
	ChatMaxID  : cardinal;
{僠儍僢僩儖乕儉婡擻捛壛僐僐傑偱}
{業揦僗僉儖捛壛}
	VenderList :TIntList32;
{業揦僗僉儖捛壛僐僐傑偱}
{庢堷婡擻捛壛}
	DealingList :TIntList32;
	DealMaxID  :cardinal;
{庢堷婡擻捛壛僐僐傑偱}
{巵{敔捛壛}
	SummonMobList :TIntList32;
	SummonIOBList :TIntList32;
	SummonIOVList :TIntList32;
	SummonICAList :TIntList32;
	SummonIGBList :TIntList32;
{巵{敔捛壛僐僐傑偱}
{NPC僀儀儞僩捛壛}
	ServerFlag :TStringList;
	MapInfo    :TStringList;
{NPC僀儀儞僩捛壛僐僐傑偱}
{僊儖僪婡擻捛壛}
	GuildList     :TIntList32;
	NowGuildID    :cardinal;
	GSkillDB      :TIntList32;
	GExpTable     :array[0..50] of cardinal;
{僊儖僪婡擻捛壛僐僐傑偱}
	//Item     :TStringList;
	ItemDB     :TIntList32;
	ItemDBName :TStringList;
	MobDB      :TIntList32;
	MobDBName  :TStringList;
  SlaveDBName:TStringList;
  MArrowDB   :TIntList32;
  KafraDB    :TIntList32;
  BannedDB   :TStringList;
  IDTableDB  :TIntList32;
	SkillDB    :TIntList32;
	Player     :TIntList32;
	PlayerName :TStringList;
	Chara      :TIntList32;
	CharaName  :TStringList;
	CharaPID   :TIntList32;
	Map        :TStringList;
	MapList    :TStringList;

	//NowAccountID :cardinal;
	NowUsers      :word;
	NowLoginID    :cardinal;
	NowCharaID    :cardinal;
	NowNPCID      :cardinal;
	NowItemID     :cardinal;
	NowMobID      :cardinal;
{僉儏乕儁僢僩}
	NowPetID      :cardinal;
{僉儏乕儁僢僩偙偙傑偱}

  Seconds       :cardinal;
  Minutes       :cardinal;
  Hours         :cardinal;
  Days          :cardinal;

	DebugCnt      :word;
	id1           :cardinal;
	id2           :cardinal;
	CancelFlag    :boolean;
	ServerRunning :boolean;

	DebugOut      :TMemo;


	//exp_db
	ExpTable        :array[0..3] of array[0..255] of cardinal;
	//job_db1
	WeightTable     :array[0..20] of word;
	HPTable         :array[0..20] of word;
	SPTable         :array[0..20] of word;
	WeaponASPDTable :array[0..20] of array[0..16] of word;
	//job_db2
	JobBonusTable   :array[0..20] of array[1..255] of byte;
	//wp_db
	WeaponTypeTable :array[0..2] of array[0..16] of word;
	//ele_db
	ElementTable    :array[0..9] of array[0..99] of integer;

	mm              :array[0..30] of array[0..30] of rSearchMap;

	buf             :array[0..32767] of byte;
  buf2            :array[0..32767] of byte;
	stra            :array[0..32767] of char;
{僆僾僔儑儞娭楢}
	DefaultZeny     :cardinal;
        //僉儍儔僋僞乕弶婜僨乕僞娭楢
	DefaultMap      :string;
        DefaultPoint_X  :cardinal;
        DefaultPoint_Y  :cardinal;

        GMCheck         :cardinal; // GM僐儅儞僪傪GM埲奜傕巊偊傞偐
        DebugCMD        :cardinal; // 僨僶僢僌僐儅儞僪偑巊偊傞偐
DeathBaseLoss     :integer;
DeathJobLoss      :integer;
MonsterMob        :boolean;
SummonMonsterExp  :boolean;
SummonMonsterAgo  :boolean;
SummonMonsterName :boolean;
SummonMonsterMob  :boolean;
UseDatabase          :boolean;
GlobalGMsg        :string;
MapGMsg           :string;
{僆僾僔儑儞娭楢偙偙傑偱}
//------------------------------------------------------------------------------
// 娭悢掕媊
		procedure MapLoad(MapName:string);  //edited by The Harbinger -- darkWeiss version
		procedure MapMove(Socket:TCustomWinSocket; MapName:string; Point:TPoint); //edited by The Harbinger -- darkWeiss version
//------------------------------------------------------------------------------
		procedure RFIFOB(index:word; var b:byte);
		procedure RFIFOW(index:word; var w:word);
		procedure RFIFOL(index:word; var l:cardinal);
		function  RFIFOS(index:word; cnt:word):string;
		procedure RFIFOM1(index:word; var xy:TPoint);
		procedure RFIFOM2(index:word; var xy1:TPoint; var xy2:TPoint);
		procedure WFIFOB(index:word; b:byte);
		procedure WFIFOW(index:word; w:word);
		procedure WFIFOL(index:word; l:cardinal);
		procedure WFIFOS(index:word; str:string; cnt:word);
		procedure WFIFOM1(index:word; xy:TPoint; Dir:byte = 0);
		procedure WFIFOM2(index:word; xy1:TPoint; xy2:TPoint);
//------------------------------------------------------------------------------
		procedure PickUpItem(tc:TChara; l:Cardinal);

		procedure CalcAbility(tc:TChara; td:TItemDB; o:Integer = 0); //edited by The Harbinger -- darkWeiss version
		procedure CalcEquip(tc:TChara);
		procedure CalcSkill(tc:TChara; Tick:cardinal); //edited by The Harbinger -- darkWeiss version
		procedure CalcStat(tc:TChara; Tick:cardinal = 0); //edited by The Harbinger -- darkWeiss version

		procedure CalcLvUP(tc1:TChara; EXP:cardinal; JEXP:cardinal); //edited by The Harbinger -- darkWeiss version

		procedure SendCGetItem(tc:TChara; Index:word; Amount:word);
		procedure SendCStat(tc:TChara; View:boolean = false);
		procedure SendCStat1(tc:TChara; Mode:word; DType:word; Value:cardinal);
		procedure SendCStoreList(tc:TChara);
		procedure SendCSkillList(tc:TChara);
		procedure SendCData(Socket:TCustomWinSocket; tc:TChara; Use0079:boolean = false);
		procedure SendCMove(Socket: TCustomWinSocket; tc:TChara; before, after:TPoint);
		procedure SendCLeave(tc:TChara; mode:byte);
		procedure SendBCmd(tm:TMap; Point:TPoint; PacketLen:word; tc:TChara = nil; tail:boolean = False);

		procedure SendItemSkill(tc:TChara; s:Cardinal; L:Cardinal = 1);
		procedure SendSkillError(tc:TChara; Code:Cardinal);
		function  UseFieldSkill(tc:TChara; Tick:Cardinal) : Integer;
		function  UseTargetSkill(tc:TChara; Tick:Cardinal) : Integer;

		procedure SendCSkillAtk1(tm:TMap; tc:TChara; ts:TMob; Tick:cardinal; dmg:Word; k:byte; PType:byte = 0);  //edited by The Harbinger -- darkWeiss version
    procedure SendCSkillAtk2(tm:TMap; tc:TChara; tc1:TChara; Tick:cardinal; dmg:Word; k:byte; PType:byte = 0);  //added by The Harbinger -- darkWeiss version

		procedure CalcSkillTick(tm:TMap; tc:TChara; Tick:cardinal = 0);
		function  DecSP(tc:TChara; SkillID:word; LV:byte) :boolean;

		function  SearchCInventory(tc:TChara; ItemID:word; IEquip:boolean):word;
		function  SearchPInventory(tc:TChara; ItemID:word; IEquip:boolean):word;
//------------------------------------------------------------------------------
		//儌儞僗丒NPC
		procedure SendMData(Socket:TCustomWinSocket; ts:TMob; Use0079:boolean = false);
		procedure SendMMove(Socket: TCustomWinSocket; ts:TMob; before, after:TPoint; ver2:Word);
    procedure SendNData(Socket:TCustomWinSocket; tn:TNPC; ver2:Word; Use0079:boolean = false);
		procedure SendPMove(Socket: TCustomWinSocket; te:TeNPC; before, after:TPoint; ver2:Word);
{僉儏乕儁僢僩}
    procedure SendPetMove(Socket: TCustomWinSocket; tc:TChara; target:TPoint);
{僉儏乕儁僢僩偙偙傑偱}
//------------------------------------------------------------------------------
    //抧揰僗僉儖
		function  SetSkillUnit(tm:TMap; ID:cardinal; xy:TPoint; Tick:cardinal; SType:word; SCount:word; STime:cardinal; tc:TChara = nil):TNPC;
		procedure DelSkillUnit(tm:TMap; tn:TNPC);
//------------------------------------------------------------------------------
    //強帩傾僀僥儉
		function  MoveItem(ti1:TItemList; ti2:TitemList; Index:Word; cnt:Word) : Integer;

		function  GetItemStore(ti:TItemList; td:TItem; cnt:Word; IsEquip:Boolean = False) : Integer;
		function  DeleteItem(ti:TItemList; index:Word; cnt:Word) : Integer;
		function  SearchInventory(ti:TItemList; ItemID:word; IEquip:boolean) : word;//SearchCInventory()摍偲巊偄曽偼摨偠
		procedure CalcInventory(ti:TItemList);
		procedure SendCart(tc:TChara);
//------------------------------------------------------------------------------
{僷乕僥傿乕婡擻捛壛}
    //僷乕僥傿乕
		procedure PartyDistribution(Map:string; tpa:TParty; EXP:Cardinal = 0; JEXP:Cardinal = 0);
		procedure SendPartyList(tc:TChara);
		procedure SendPCmd(tc:TChara; PacketLen:word; InMap:boolean = false; AvoidSelf:boolean = false);
{僷乕僥傿乕婡擻捛壛僐僐傑偱}
//------------------------------------------------------------------------------
{僠儍僢僩儖乕儉婡擻捛壛}
		procedure ChatRoomExit(tc:TChara; AvoidSelf:boolean = false);
		procedure ChatRoomDisp(Socket: TCustomWinSocket; tc1:TChara);
		procedure SendCrCmd(tc:TChara; PacketLen:word; AvoidSelf:boolean = false);
		procedure SendNCrCmd(tm:TMap; Point:TPoint; PacketLen:word; tc:TChara = nil; AvoidSelf:boolean = false; AvoidChat:boolean = false);
{僠儍僢僩儖乕儉婡擻捛壛僐僐傑偱}
//------------------------------------------------------------------------------
{業揦僗僉儖捛壛}
		procedure VenderExit(tc:TChara; AvoidSelf:boolean = false);
		procedure VenderDisp(Socket: TCustomWinSocket; tc1:TChara);
{業揦僗僉儖捛壛僐僐傑偱}
//------------------------------------------------------------------------------
{庢堷婡擻捛壛}
		procedure CancelDealings(tc:TChara; AvoidSelf:boolean = false);
{庢堷婡擻捛壛僐僐傑偱}
//------------------------------------------------------------------------------
{NPC僀儀儞僩捛壛}
		function ConvFlagValue(tc:TChara; str:string; mode:boolean = false) : Integer;
{NPC僀儀儞僩捛壛僐僐傑偱}
//------------------------------------------------------------------------------
{僊儖僪婡擻捛壛}
		procedure SendGuildInfo(tc:TChara; Tab:Byte; GuildM:boolean = false; AvoidSelf:boolean = false);
		procedure SendGuildMCmd(tc:TChara; PacketLen:word; AvoidSelf:boolean = false);
		procedure CalcGuildLvUP(tg:TGuild; tc:TChara; GEXP:cardinal);
		procedure SendGLoginInfo(tg:TGuild; tc:TChara);   //edited by The Harbinger -- darkWeiss version
		function  GetGuildConUsers(tg:TGuild) : word;
    procedure GuildDInvest(tn:TNPC); //added by The Harbinger -- darkWeiss version
    procedure SpawnNPCMob(tn:TNPC;MobName:string;X:integer;Y:integer;SpawnDelay1:cardinal;SpawnDelay2:cardinal); //added by The Harbinger -- darkWeiss version
    procedure CallGuildGuard(tn:TNPC;guard:integer); //added by The Harbinger -- darkWeiss version
    procedure SetGuildKafra(tn:TNPC;mode:integer);  //added by The Harbinger -- darkWeiss version
    procedure EnableGuildKafra(MapName:string;KafraName:string;Mode:integer); //added by The Harbinger -- darkWeiss version
    procedure ClaimGuildCastle(ID:cardinal;MapName:string); //added by The Harbinger -- darkWeiss version
    function  GetGuildKafra(tn:TNPC) : integer;  //added by The Harbinger -- darkWeiss version
    function  GetGuildID(tn:TNPC) : word; //added by The Harbinger -- darkWeiss version
    function  GetGuildEDegree(tn:TNPC) : cardinal; //added by The Harbinger -- darkWeiss version
    function  GetGuildETrigger(tn:TNPC) : word; //added by The Harbinger -- darkWeiss version
    function  GetGuildDDegree(tn:TNPC) : cardinal; //added by The Harbinger -- darkWeiss version
    function  GetGuildDTrigger(tn:TNPC) : word; //added by The Harbinger -- darkWeiss version
    function  CheckGuildID(tn:TNPC; tc:TChara) : word; //added by The Harbinger -- darkWeiss version
    function  CheckGuildMaster(tn:TNPC; tc:TChara) : word; //added by The Harbinger -- darkWeiss version
    function  GetGuildName(tn:TNPC) : string;  //added by The Harbinger -- darkWeiss version
    function  GetGuildMName(tn:TNPC) : string; //added by The Harbinger -- darkWeiss version
		function  GetGuildRelation(tg:TGuild; tc:TChara) : integer;
		procedure KillGuildRelation(tg:TGuild; tg1:TGuild; tc:TChara; tc1:TChara; RelType:byte);
		function  LoadEmblem(tg:TGuild) : word;
		procedure SaveEmblem(tg:TGuild; size:cardinal);
{僊儖僪婡擻捛壛僐僐傑偱}
//==============================================================================










implementation

//==============================================================================
{捛壛}
procedure PickUpItem(tc:TChara; l:Cardinal);
var
	tm:TMap;
	tn:TNPC;
	j:Integer;
begin
	with tc do begin
		tm := tc.MData;
		if tm.NPC.IndexOf(l) <> -1 then begin
			tn := tm.NPC.IndexOfObject(l) as TNPC;
			if tc.MaxWeight >= tc.Weight + tn.Item.Data.Weight * tn.Item.Amount then begin
				j := SearchCInventory(tc, tn.Item.ID, tn.Item.Data.IEquip);
				if j <> 0 then begin
					//廍偆儌乕僔儑儞
					WFIFOW( 0, $008a);
					WFIFOL( 2, tc.ID);
					WFIFOL( 6, tn.ID);
					WFIFOB(26, 1);
					SendBCmd(tm, tc.Point, 29);
					//傾僀僥儉揚嫀
					WFIFOW(0, $00a1);
					WFIFOL(2, tn.ID);
					SendBCmd(tm, tn.Point, 6);
					//傾僀僥儉捛壛
					tc.Item[j].ID := tn.Item.ID;
					tc.Item[j].Amount := tc.Item[j].Amount + tn.Item.Amount;
					tc.Item[j].Equip := 0;
					tc.Item[j].Identify := tn.Item.Identify;
					tc.Item[j].Refine := tn.Item.Refine;
					tc.Item[j].Attr := tn.Item.Attr;
					tc.Item[j].Card[0] := tn.Item.Card[0];
					tc.Item[j].Card[1] := tn.Item.Card[1];
					tc.Item[j].Card[2] := tn.Item.Card[2];
					tc.Item[j].Card[3] := tn.Item.Card[3];
					tc.Item[j].Data := tn.Item.Data;
					//廳検捛壛
					tc.Weight := tc.Weight + tn.Item.Data.Weight * tn.Item.Amount;
					WFIFOW( 0, $00b0);
					WFIFOW( 2, $0018);
					WFIFOL( 4, tc.Weight);
					Socket.SendBuf(buf, 8);
					//傾僀僥儉僎僢僩捠抦
					SendCGetItem(tc, j, tn.Item.Amount);
					//傾僀僥儉嶍彍
					tm.NPC.Delete(tm.NPC.IndexOf(tn.ID));
					with tm.Block[tn.Point.X div 8][tn.Point.Y div 8].NPC do
						Delete(IndexOf(tn.ID));
					tn.Free;
				end else begin
					//偙傟埲忋傕偰側偄
					WFIFOW( 0, $00a0);
					WFIFOB(22, 1);
					Socket.SendBuf(buf, 23);
				end;
			end else begin
				//廳検僆乕僶乕
				WFIFOW( 0, $00a0);
				WFIFOB(22, 2);
				Socket.SendBuf(buf, 23);
			end;
		end else begin
			//廍偆傾僀僥儉偑偡偱偵側偔側偭偰傞
			WFIFOW( 0, $00a0);
			WFIFOB(22, 1);
			Socket.SendBuf(buf, 23);
		end;
	end;
end;
//------------------------------------------------------------------------------
procedure CalcAbility(tc:TChara; td:TItemDB; o:Integer = 0);
var
	j :Integer;
begin
	with tc do begin
		if td.IType = 6 then begin
			Inc(ATTPOWER, td.ATK);
		end;
		if td.IType <> 10 then begin
			Inc(ATK[0][0], td.ATK);
		end;
		MATKFix := MATKFix + td.MATK; //忨梡
		DEF1 := DEF1 + td.DEF;
		MDEF1 := td.MDEF;
		HIT := HIT + td.HIT; //柦拞
		FLEE1 := FLEE1 + td.FLEE; //夞旔
		Critical := Critical + td.Crit; //僋儕僥傿僇儖
		Lucky := Lucky + td.Avoid; //姰慡夞旔
		for j := 0 to 5 do begin
			Bonus[j] := Bonus[j] + td.Param[j];
		end;
		for j:=0 to 9 do begin