database.pas

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

unit Database;



interface

uses
	Windows, MMSystem, Forms, Classes, SysUtils, IniFiles,MD5;

//==============================================================================
// 娭悢掕媊
		procedure DatabaseLoad(Handle:HWND);
		procedure DataLoad();
		procedure PlayerDataLoad();
		procedure DataSave(forced : Boolean = False);
//==============================================================================


	//Files partitioned out of DatabaseLoad
	Function  DataBaseFilesExist : Boolean;
	Procedure LoadSummonLists;
	Procedure LoadPetData;

implementation

uses
	Common, Game_Master, GlobalLists, Zip;


(*-----------------------------------------------------------------------------*
DataBaseFilesExist

Returns a True value if ALL files needed in the Database folder exist,
else returns false.
(Optional DB files are checked for individually)

Called by:
	DatabaseLoad

Pre:
	None.
Post:
	Returns a True or False value

Revisions:
--
2004/05/04 - ChrstphrR - Initial breakout from DatabaseLoad - 11 required files
2004/05/04 - " - Checked again, and Required Files checked now 21

Question:
The following files were not checked for here - are they really just optional?
	special_db.txt
	mapinfo_db.txt

2004/05/29 - AlexKreuz added gm_access.txt to the required list.
*-----------------------------------------------------------------------------*)
Function  DataBaseFilesExist : Boolean;
Begin
	Result := True; // Assume True.

	if NOT (
		FileExists(AppPath + 'database\item_db.txt') AND
		FileExists(AppPath + 'database\summon_item.txt') AND
		FileExists(AppPath + 'database\summon_mob.txt') AND
		FileExists(AppPath + 'database\summon_mobID.txt') AND
		FileExists(AppPath + 'database\metalprocess_db.txt') AND

		FileExists(AppPath + 'database\pet_db.txt' ) AND
		FileExists(AppPath + 'database\mob_db.txt') AND
		FileExists(AppPath + 'database\skill_db.txt') AND
		FileExists(AppPath + 'database\skill_guild_db.txt') AND
		FileExists(AppPath + 'database\exp_guild_db.txt') AND

		FileExists(AppPath + 'database\exp_db.txt') AND
		FileExists(AppPath + 'database\Monster_AI.txt') AND
		FileExists(AppPath + 'database\territory_db.txt') AND
		FileExists(AppPath + 'database\summon_slave.txt') AND
		FileExists(AppPath + 'database\make_arrow.txt') AND

		FileExists(AppPath + 'database\id_table.txt') AND
		FileExists(AppPath + 'database\gm_access.txt') AND

		FileExists(AppPath + 'database\job_db1.txt') AND
		FileExists(AppPath + 'database\job_db2.txt') AND
		FileExists(AppPath + 'database\wp_db.txt') AND
		FileExists(AppPath + 'database\warp_db.txt') AND

		FileExists(AppPath + 'database\ele_db.txt')
	) then begin
		Result := FALSE;
	end;
End;(* Func DataBaseFilesExist (LocalUnitProc)
*-----------------------------------------------------------------------------*)


(*-----------------------------------------------------------------------------*
LoadSummonLists

This is a Local Procedure to Database unit. Must be declared ahead of the
DatabaseLoad procedure.

Loads all Summon* Lists from the proper database files. Broken out to make the
original routine more readable -- each group of files loaded in it's own logical
section.

Called by:
	DatabaseLoad

Pre:
	DataBaseFilesExist returns True (summmon_*.txt files exist)
Post:
	The following lists will have Zero or more entries:
	SummonMobList    (summon_mobID.txt)
	SummonMobListMVP (summon_mob.txt -- currently empty for this list)
	SummonIOBList    (summon_item.txt)
	SummonIOVList    (summon_item.txt)
	SummonICAList    (summon_item.txt)
	SummonIGBList    (summon_item.txt)
	SummonIOWBList   (summon_item.txt)

Revisions:
--
2004/05/04 - ChrstphrR - Initial breakout from DatabaseLoad
2004/05/04 - ChrstphrR - Bug fix #827 - fixed for that, and ALL box summon lists
*-----------------------------------------------------------------------------*)
Procedure LoadSummonLists;
Var
	Idx     : Integer;
	Counter : Integer; //Tallies entries into a list for display when done
	Weight  : Integer; //Weighting number or "chance" item has to be chosen.

	Txt     : TextFile;
	Str     : string;      //Holds each line read
	SL      : TStringList; //Parses Str into text tokens.
Begin
	debugout.lines.add('[' + TimeToStr(Now) + '] ' + 'Summon Monster List loading...');
	{ChrstphrR 2004/04/19 - New SummonMobList code... created and loaded here}

	//Creates and loads data from the file all in one step
	SummonMobList := TSummonMobList.Create(AppPath + 'database\summon_mobID.txt');
	debugout.lines.add('[' + TimeToStr(Now) + '] ' + Format('-> Total %d Summon Monster List loaded.', [SummonMobList.Count]));
	{ChrstphrR 2004/04/19 - yes, that's all to see here - the rest is in the
	TSummonMobList code}

	{ChrstphrR 2004/05/23 - cleaned up last of the summon???lists here.
	}
	Application.ProcessMessages;
	AssignFile(Txt, AppPath + 'database\summon_mob.txt');
	Reset(Txt);
	SL := TStringList.Create;
	while not eof(Txt) do begin
		Readln(txt, str);
		SL.Delimiter     := ',';
		SL.DelimitedText := Str;
		if (SL[0] = 'MVP') AND (SL.Count >= 3) then begin
			if (MobDBName.IndexOf(SL[1]) = -1) then begin
				{Warn of invalid container in the line, handle gracefully}
				debugout.lines.add('[' + TimeToStr(Now) + '] ' + 
					'*** summon_item.txt Error handled (1). Please report this Item: ' + str
				);
			end else begin
				Weight := StrToIntDef(SL[2],1);
				for Idx := 1 to Weight do begin
					SummonMobListMVP.Add(SL[1]);
				end;
			end;
		end;
	end;
	CloseFile(txt);
	debugout.lines.add('[' + TimeToStr(Now) + '] ' + 
		Format( '-> Total %d Summon MVP Monster List loaded.',
		[SummonMobListMVP.Count] )
	);
	//-- End of SummonMobList / SummonMobListMVP Load


	//Summon Box Lists
	debugout.lines.add('[' + TimeToStr(Now) + '] ' + 'Summon Item List loading...');
	Application.ProcessMessages;
	AssignFile(Txt, AppPath + 'database\summon_item.txt');
	Reset(Txt);
	SL.Clear;
	while not eof(Txt) do begin
		Readln(txt, str);
		SL.DelimitedText := Str;
		if SL.Count < 3 then Continue; //safety check against bad line.

		{ChrstphrR 2004/05/04 - code-side fix for bug #827 -- Checking entries
		in summon_item.txt against ItemDB before adding to list.
		We know that ItemDB is populated about 400 lines ahead, so checking is safe,
		so we're checking the ItemDBName list to make sure the Box items ARE there.}

		{ChrstphrR 2004/05/04 - StrToIntDef ensures that at least, the
		weighting of this choice will be 1, if not defined, or 0 or less.}
		Weight := StrToIntDef(SL[2],1);

		if (ItemDBName.IndexOf(SL[0]) = -1) then begin
			{Warn of invalid container in the line, handle gracefully}
			debugout.lines.add('[' + TimeToStr(Now) + '] ' + 
				'*** summon_item.txt Error handled (1). Please report this Item: ' + str
			);
			Continue;
		end;
		if (ItemDBName.IndexOf(SL[1]) = -1) then begin
			{ChrstphrR - well, the item in the summon_item.txt doesn't exist if we
			branch here, output a message to let the user know, so they can post a
			bug report to get the DB file corrected.}
			debugout.lines.add('[' + TimeToStr(Now) + '] ' + 
				'*** summon_item.txt Error handled (2). Please report this Item: ' + Str
			);
			Continue;
		end;//if ItemDBName Check

		//ChrstphrR -- Poor algorithm choice, will convert "later" to
		//algorithm TSummonMobList uses.
		for Idx := 1 to Weight do begin
			if (SL[0] = 'Old_Blue_Box') then
				SummonIOBList.Add(SL[1])
			else if (SL[0] = 'Old_Violet_Box') then
				SummonIOVList.Add(SL[1])
			else if (SL[0] = 'Old_Card_Album') then
				SummonICAList.Add(SL[1])
			else if (SL[0] = 'Gift_Box') then
				SummonIGBList.Add(SL[1])
			else if (SL[0] = 'Old_Weapon_Box') then
				SummonIOWBList.Add(SL[1]);
		end;

	end;//while
	CloseFile(Txt);
	SL.Free;

	Counter := SummonIOBList.Count + SummonIOVList.Count + SummonICAList.Count +
		SummonIGBList.Count + SummonIOWBList.Count;

	debugout.lines.add('[' + TimeToStr(Now) + '] ' + Format('-> Total %d Summon Item List loaded.', [Counter]));
	Application.ProcessMessages;
End;(* Proc LoadSummonLists
*-----------------------------------------------------------------------------*)


(*-----------------------------------------------------------------------------*
LoadPetData

This is a Local Procedure to Database unit. Must be declared ahead of the
DatabaseLoad procedure.

Loads all Pet Lists from the proper database files. Broken out to make the
original routine more readable -- and to allow future work to safeguard against
bad data in the pet data files, before they're loaded into the internal lists.

Called by:
	DatabaseLoad

Pre:
	DataBaseFilesExist returns True (summmon_*.txt files exist)
Post:
	The following lists will have Zero or more entries:
//	SummonMobList    (summon_mobID.txt)

Revisions:
--
2004/05/26 - ChrstphrR - Initial breakout from DatabaseLoad
2004/05/26 - ChrstphrR - Variable renaming for clarity.
*-----------------------------------------------------------------------------*)
Procedure LoadPetData;
Var
	ID_Idx    : Integer;
	LineCount : Integer;
	PetErrors : Boolean;

	Str       : string; //temp storage for read line.
	Txt       : TextFile;
	PDB       : TPetDB;
	PetDBrow  : TStringList;

Begin
	debugout.lines.add('[' + TimeToStr(Now) + '] ' +  'Pet database loading...' );

	AssignFile(Txt, AppPath + 'database\pet_db.txt' );
	Reset(Txt);
	Readln(Txt, Str);//Read comment line at top of pet_db
	PetDBRow := TStringList.Create;

	PetErrors := FALSE;
	LineCount := 1;

	while NOT eof(Txt) do begin
		PetDBrow.Clear;
		Readln(txt, Str);
		Inc(LineCount);
		PetDBrow.DelimitedText := str;

		//Does the row have 14 entries?
		//Does the first field have an ID number in it? -1 = invalid ID
		if (PetDBrow.Count = 14) then
			ID_Idx := StrToIntDef( PetDBrow[ 0], -1)
		else
			ID_IDx := -2;

		//Look up ID found in PetDB - only procede if there's an entry.
		if MobDB.IndexOf(ID_Idx) > -1 then begin
		//ChrstphrR 2004/05/26 -- No typechecking done here - unsafe.
		// -- no dupe entry checks either - first entry in always used.
			PDB := TPetDB.Create;
			try
				with PDB do begin
					MobID       := StrToInt( PetDBrow[ 0] );
					ItemID      := StrToInt( PetDBrow[ 1] );
					EggID       := StrToInt( PetDBrow[ 2] );
					AcceID      := StrToInt( PetDBrow[ 3] );
					FoodID      := StrToInt( PetDBrow[ 4] );
					Fullness    := StrToInt( PetDBrow[ 5] );
					HungryDelay := StrToInt( PetDBrow[ 6] );
					Hungry      := StrToInt( PetDBrow[ 7] );
					Full        := StrToInt( PetDBrow[ 8] );
					Reserved    := StrToInt( PetDBrow[ 9] );
					Die         := StrToInt( PetDBrow[10] );
					Capture     := StrToInt( PetDBrow[11] );
					// 12th is the Species name - not stored.
					SkillTime   := StrToInt( PetDBrow[13] );
				end;
				PetDB.AddObject( PDB.MobID, PDB );
			except
				on EConvertError do begin
					//No number where a number should be...
					debugout.lines.add('[' + TimeToStr(Now) + '] ' +  Format(
						'pet_db.txt Error handled : Incorrect/missing field on line %d : %s', [LineCount, Str]
					) );
					PetErrors := TRUE;
					if Assigned(PDB) then
						PDB.Free;
				end;
			end;//try-e
		end else begin
			// No match for MobID in mobdb, or line wasn't up to 14 parts.
			case ID_Idx of
			-1 : begin
					debugout.lines.add('[' + TimeToStr(Now) + '] ' +  Format(
						'pet_db.txt Error handled : Invalid MobID on line %d : %s',
						[LineCount, Str]
					) );
					PetErrors := TRUE;
				end;
			-2 : begin
					debugout.lines.add('[' + TimeToStr(Now) + '] ' +  Format(
						'pet_db.txt Error handled : Line %d has less than 14 fields',
						[LineCount]
					) );
					PetErrors := TRUE;
				end;
				else begin
					debugout.lines.add('[' + TimeToStr(Now) + '] ' +  Format(
						'pet_db.txt Error handled : Invalid MobID on line %d : %s',
						[LineCount, Str]
					) );
					PetErrors := TRUE;
				end;
			end;//case
		end;
	end;
	CloseFile(txt);

	if PetErrors then begin
		debugout.lines.add('[' + TimeToStr(Now) + '] ' +  Format(
			'*** Error(s) in %sdatabase\pet_db.txt found.',
			[AppPath]
		) );
		debugout.lines.add('[' + TimeToStr(Now) + '] ' +  '	This may affect game play. Please repair this file.' );
	end;
	debugout.lines.add('[' + TimeToStr(Now) + '] ' +  Format( '-> Total %d pet(s) database loaded.', [PetDB.Count] ) );
	Application.ProcessMessages;

End;(* Proc LoadPetData
*-----------------------------------------------------------------------------*)




//==============================================================================
// 僨乕僞儀乕僗撉傒崬傒
procedure DatabaseLoad(Handle:HWND);
var
	i   : Integer;
	j   : Integer;
	k   : Integer;
	l   : Integer;
	w   : Word;
	xy  : TPoint;
	str : string;