MyDataModule.pas

unit MyDataModule;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  System.IniFiles,
  Data.DB,
  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Dialogs,
  FMX.Objects,
  FMX.Menus,
  FMX.Grid,
  FMX.ExtCtrls,
  FMX.ListBox,
  FMX.TreeView,
  FMX.Memo,
  FMX.TabControl,
  FMX.Layouts,
  FMX.Edit,
  FMX.Platform,
  FMX.Bind.DBEngExt,
  FMX.Bind.Editors,
  FMX.Bind.DBLinks,
  FMX.Bind.Navigator,
  Data.Bind.EngExt,
  Data.Bind.Components,
  Data.Bind.DBScope,
  Data.Bind.DBLinks,
  Datasnap.DBClient,
  Fmx.Bind.Grid,
  System.Rtti,
  System.Bindings.Outputs,
  Data.Bind.Grid,
  System.Actions,
  FMX.ActnList,
  Fmx.StdCtrls,
  FMX.Header,
  FMX.Graphics,

  Translate;

const
  DefaultLanguage = 'Default';
  ProgramName = 'Truice';

type
  TType = (ttNPC, ttItem, ttObject, ttQuest, ttChar);
  TSite = (sW, sRW, sA, sT, sD);

  TdmMain = class(TDataModule)
    ActionList: TActionList;
    BrowseURL: TBrowseURL;
    MyQuery: TFDQuery;
    procedure DataModuleDestroy(Sender: TObject);
  private
    { Private declarations }
    FLanguage : string;
    FSite: TSite;
    procedure SetLanguage(const Value: string);
  public
    { Public declarations }
    ProgramDir: string;
    DBCDir: string;
    LanguageFile: string;

    Translate: TTranslate;
    Text: array [0..3000] of string;

    IsAutoUpdates: boolean;
    ProxyServer,
    ProxyPort,
    ProxyUser,
    ProxyPass: string;

    DBCLocale: Cardinal;
    Locales: Cardinal;

    property Language: string read FLanguage write SetLanguage;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Site: TSite read FSite write FSite;
    procedure BrowseSite(T: TType; id: integer);

    procedure wowhead(T: TType; id: integer);
    procedure ruwowhead(T: TType; id: integer);
    procedure thottbot(T: TType; id: integer);
    procedure allakhazam(T: TType; id: integer);
    procedure wowdb(T: TType; id: integer);

    procedure Init;

  end;

var
  dmMain: TdmMain;

implementation

uses MainUnit, Functions;
{$R *.dfm}

{ TdmMain }

constructor TdmMain.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FSite := sW;
  Init;
  ProgramDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));

  DBCDir := ReadFromRegistry(CurrentUser, '', 'DBCDir', tpString, ProgramDir + 'DBC');
  DBCLocale := ReadFromRegistry(CurrentUser, '', 'DBCLocale', tpInteger, 16);
  Language := ReadFromRegistry(CurrentUser, '', 'Language', tpString, DefaultLanguage);
  IsAutoUpdates := ReadFromRegistry(CurrentUser, '', 'IsAutoUpdates', tpBool, True);

  ProxyServer := ReadFromRegistry(CurrentUser, '', 'ProxyServer', tpString, '');
  ProxyPort   := ReadFromRegistry(CurrentUser, '', 'ProxyPort', tpString, '');
  ProxyUser   := ReadFromRegistry(CurrentUser, '', 'ProxyUser', tpString, '');
  ProxyPass   := ReadFromRegistry(CurrentUser, '', 'ProxyPass', tpString, '');

  Translate:=TTranslate.Create;
  Translate.CreateCustomTranslation;
  if not FileExists(LanguageFile) then Language := DefaultLanguage;
  Translate.LoadTranslations(LanguageFile);
  Translate.TranslateCustomText;
end;

procedure TdmMain.BrowseSite(T: TType; id: integer);
begin
  case FSite of
    sW: wowhead(T, id);
    sRW: ruwowhead(T, id);
    sA: allakhazam(T, id);
    sT: thottbot(T, id);
    sD: wowdb(T, id);
  end;
end;

procedure TdmMain.allakhazam(T: TType; id: integer);
var
  url: string;
begin
  id:=abs(id);
  case T of
    ttNPC:     url := Format('http://wow.allakhazam.com/db/mob.html?wmob=%d',[id]);
    ttItem:    url := Format('http://wow.allakhazam.com/db/item.html?witem=%d',[id]);
    ttObject:  url := Format('http://wow.allakhazam.com/db/object.html?wobject=%d',[id]);
    ttQuest:   url := Format('http://wow.allakhazam.com/db/quest.html?wquest=%d',[id]);
  end;
  BrowseURL.URL:=url;
  BrowseURL.Execute;
end;

procedure TdmMain.thottbot(T: TType; id: integer);
var
  url: string;
begin
  id:=abs(id);
  case T of
    ttNPC:     url := Format('http://thottbot.com/c%d',[id]);
    ttItem:    url := Format('http://thottbot.com/i%d',[id]);
    ttObject:  url := Format('http://thottbot.com/o%d',[id]);
    ttQuest:   url := Format('http://thottbot.com/q%d',[id]);
  end;
  BrowseURL.URL:=url;
  BrowseURL.Execute;
end;

procedure TdmMain.wowdb(T: TType; id: integer);
var
  url: string;
begin
  id:=abs(id);
  case T of
    ttNPC:     url := Format('http://www.wowdb.com/npc.aspx?id=%d',[id]);
    ttItem:    url := Format('http://www.wowdb.com/item.aspx?id=%d',[id]);
    ttObject:  url := Format('http://www.wowdb.com/object.aspx?id=%d',[id]);
    ttQuest:   url := Format('http://www.wowdb.com/quest.aspx?id=%d',[id]);
  end;
  BrowseURL.URL:=url;
  BrowseURL.Execute;
end;

procedure TdmMain.wowhead(T: TType; id: integer);
var
  url: string;
begin
  id:=abs(id);
  case T of
    ttNPC:     url := Format('http://www.wowhead.com/?npc=%d',[id]);
    ttItem:    url := Format('http://www.wowhead.com/?item=%d',[id]);
    ttObject:  url := Format('http://www.wowhead.com/?object=%d',[id]);
    ttQuest:   url := Format('http://www.wowhead.com/?quest=%d',[id]);
  end;
  BrowseURL.URL:=url;
  BrowseURL.Execute;
end;

procedure TdmMain.ruwowhead(T: TType; id: integer);
var
  url: string;
begin
  id:=abs(id);
  case T of
    ttNPC:     url := Format('http://ru.wowhead.com/?npc=%d',[id]);
    ttItem:    url := Format('http://ru.wowhead.com/?item=%d',[id]);
    ttObject:  url := Format('http://ru.wowhead.com/?object=%d',[id]);
    ttQuest:   url := Format('http://ru.wowhead.com/?quest=%d',[id]);
  end;
  BrowseURL.URL:=url;
  BrowseURL.Execute;
end;

procedure TdmMain.DataModuleDestroy(Sender: TObject);
begin
  WriteToRegistry(CurrentUser, '', 'IsAutoUpdates', tpBool, IsAutoUpdates);
  WriteToRegistry(CurrentUser, '', 'ProxyServer', tpString, ProxyServer);
  WriteToRegistry(CurrentUser, '', 'ProxyPort', tpString, ProxyPort);
  WriteToRegistry(CurrentUser, '', 'ProxyUser', tpString, ProxyUser);
  WriteToRegistry(CurrentUser, '', 'ProxyPass', tpString, ProxyPass);
end;

destructor TdmMain.Destroy;
begin
  Translate.Free;
  inherited;
end;

procedure TdmMain.Init;
var
  i:integer;
begin
  for i:=0 to 3000 do
    Text[i]:='';
  Text[0]:='NONE';
  Text[1]:='Item cannot be a quest taker';
  Text[2]:='Error: Quest (%d) not found';
  Text[3]:='The error has accured while loading the Quest:';
  Text[4]:='Error: QuestGiver is not set';
  Text[5]:='Error: QuestGiver is not set correctly';
  Text[6]:='Error: QuestTaker is not set';
  Text[7]:='Error: QuestTaker is not set correctly';
  Text[8]:='Warning: There is no one component assigned to field `%s`. It will be assigned to default value if it has one.';
  Text[9]:='Are you sure to execute this script?';
  Text[10]:='Script executed successfully.';
  Text[11]:='QuestSort';
  Text[12]:='Zone';
  Text[13]:='Type';
  Text[14]:='Faction';
  Text[15]:='FactionTemplate';
  Text[16]:='Skill';
  Text[17]:='Creature location';
  Text[18]:='Gameobject location';
  Text[19]:='Item Loot';
  Text[20]:='Nothing to check.';
  Text[21]:='List of found quests is empty. Nothing to check.';
  Text[22]:='Terminating check. Please wait.';
  Text[23]:='Terminated';
  Text[24]:='quest = %d';
  Text[25]:='Fatal Error: Wrong quest id (%d)';
  Text[26]:='Fatal Error: Quest with entry = %d not found';
  Text[27]:='Warning: There more than one quest giver:';
  Text[28]:='Error: quest giver is creature with entry = %d, but (`npcflag` & 2) <> 2';
  Text[29]:='Warning: There more than one location for quest giver (id=%d) in table `creature`';
  Text[30]:='Error: Location for quest giver (id=%d) not found in table `creature`';
  Text[31]:='Error: quest giver is creature with entry = %d, but there is no one record in `creature_template` with entry = %0:d';
  Text[32]:='Warning: There more than one location for quest giver (id=%d) in table `gameobject`';
  Text[33]:='Error: Location for quest giver (id=%d) not found in table `gameobject`';
  Text[34]:='Warning: quest giver is item (id=%d), but there is no one loot in tables *_loot_template and npc_vendor. May be it is not error, just item need to be rewarded or gived from other quest.';
  Text[35]:='Warning: There more than one quest taker:';
  Text[36]:='Error: quest taker is creature with entry = %d, but (`npcflag` & 2) <> 2';
  Text[37]:='Warning: There more than one location for quest taker (id=%d) in table `creature`';
  Text[38]:='Error: Location for quest taker (id=%d) not found in table `creature`';
  Text[39]:='Error: quest taker is creature with entry = %d, but there is no one record in `creature_template` with entry = %0:d';
  Text[40]:='Warning: There more than one location for quest taker (id=%d) in table `gameobject`';
  Text[41]:='Error: Location for quest taker (id=%d) not found in table `gameobject`';
  Text[42]:='Error: quest taker is gameobject with entry = %d, but there is no one record in `gameobject_template` with entry = %0:d';
  Text[43]:='Error: quest giver not found';
  Text[44]:='Error: quest taker not found';
  Text[45]:='Warning: There is more than one different type quest giver (quest giver count=%d)';
  Text[46]:='Warning: There is more than one different type quest taker (quest taker count=%d)';
  Text[47]:='Error: PrevQuestId=%d, but quest with this id is not exists';
  Text[48]:='Error: NextQuestId=%d, but quest with this id is not exists';
  Text[49]:='Error: Type = %d, but Type with this id is not exists';
  Text[50]:='Error: %s = %d, but Faction with this id is not exists';
  Text[51]:='Error: ZoneOrSort = %d, but ZoneId with this id is not exists';
  Text[52]:='Error: ZoneOrSort = %d, but QuestSort with this id is not exists';
  Text[53]:='Error: MinLevel (%d) > QuestLevel (%d)';
  Text[54]:='Warning: QuestFlags is set to EXPLORATION but there is no one record in table `areatrigger_involvedrelation` for quest';
  Text[55]:='Warning: QuestFlags is set to SPEAK_TO but NextQuestId = 0';
  Text[56]:='Error: QuestFlags is set to DELIVER but ReqItemId1.-4. = 0';
  Text[57]:='Error: QuestFlags is set to KILL_OR_CAST but ReqCreatureOrGOId1.-4. = 0';
  Text[58]:='Warning: LimitTime = %d seconds, but QuestFlags is not set to TIMED';
  Text[59]:='Warning: ReqItemId <> 0, but QuestFlags is not set to DELIVER';
  Text[60]:='Warning: ReqCreatureOrGOId <> 0, but QuestFlags is not set to KILL_OR_CAST';
  Text[61]:='Warning: NextQuestId <> 0, but QuestFlags is not set to SPEAK_TO';
  Text[62]:='Error: %s = %d, but item with this id is not exists';
  Text[63]:='Warning: %s = %d, but there is no one loot in tables *_loot_template and npc_vendor. May be it is not error, just item need to be created or rewarded from other quest.';
  Text[64]:='Error: %s = %d. Loot for this item is gameobject_loot_template.entry = %d, but gameobject with this id not found in `gameobject` table';
  Text[65]:='Error: %s = %d. Loot for this item is creature_loot_template.entry = %d, but creature with this id not found in `creature` table';
  Text[66]:='Error: ReqSourceRef%d > 4';
  Text[67]:='Error: ReqSourceId%d=0, but ReqSourceRef%0:d=%1:d';
  Text[68]:='Error: ReqItemId%1:d=0, but ReqSourceRef%0:d=%1:d';
  Text[69]:='Error: ReqCreatureOrGOId%d = %d, but creature with this id is not exists';
  Text[70]:='Error: ReqCreatureOrGOId%d = %d, Location for creature not exists';
  Text[71]:='Error: ReqCreatureOrGOId%d = %d, but gameobject with this id is not exists';
  Text[72]:='Error: ReqCreatureOrGOId%d = %d, Location for gameobject not exists';
  Text[73]:='Check complete: %d errors, %d warnings';
  Text[74]:='Check quest (%d) : %d%%';
  Text[75]:='Check quest colmpete';
  Text[76]:='Error: quest giver is gameobject with entry = %d, but there is no one record in `gameobject_template` with entry = %0:d';
  Text[77]:='<< Details';
  Text[78]:='Details >>';
  Text[79]:='Quests found: %d';
  Text[80]:='Creatures found: %d';
  Text[81]:='Error: Creature (entry = %d) not found';
  Text[82]:='The error has accured while loading the Creature_Template:';
  Text[83]:='Rank';
  Text[84]:='Family';
  Text[85]:='Creature Type';
  Text[86]:='The error has accured while loading Creature:';
  Text[87]:='GameObjects found: %d';
  Text[88]:='Error: Gameobject (entry = %d) not found';
  Text[89]:='The error has accured while loading the Gameobject_Template:';
  Text[90]:='The error has accured while loading GameObject:';
  Text[91]:='The error has accured while loading creature_loot_template:';
  Text[92]:='The error has accured while loading gameobject_loot_template:';
  Text[93]:='GameObject Type';
  Text[94]:='Always = 0 or Unknown';
  Text[95]:='State';
  Text[96]:='LockID ( ID from Lock.dbc )';
  Text[97]:='flags';
  Text[98]:='ID gameobject ( Spawned GO type 6 )';
  Text[99]:='State Battleground';
  Text[100]:='QuestLoot ID';
  Text[101]:='LootID';
  Text[102]:='Time';
  Text[103]:='MinLoot';
  Text[104]:='MaxLoot';
  Text[105]:='QuestID ( Quest complete )';
  Text[106]:='Distance';
  Text[107]:='Spell ID';
  Text[108]:='Time/Distance';
  Text[109]:='Chain Effect';
  Text[110]:='Time/Distance for Chain Effect';
  Text[111]:='areatrigger_template.id';
  Text[112]:='Distance/ State';
  Text[113]:='ID SpellFocusObject.dbc';
  Text[114]:='Page ID';
  Text[115]:='ID from PageTextMaterial.dbc';
  Text[116]:='Items found: %d';
  Text[117]:='Error: Item (entry = %d) not found';
  Text[118]:='The error has accured while loading the Item_Template:';
  Text[119]:='Quality';
  Text[120]:='InventoryType';
  Text[121]:='RequiredReputationRank';
  Text[122]:='StatType';
  Text[123]:='DmgType';
  Text[124]:='Bonding';
  Text[125]:='Language';
  Text[126]:='PageMaterial';
  Text[127]:='Material';
  Text[128]:='Sheath';
  Text[129]:='BagFamily';
  Text[130]:='Class';
  Text[131]:='SubClass';
  Text[132]:='ItemSet';
  Text[133]:='Map';
  Text[134]:='Search filter is empty. This task returns all entries from table.$B$BAre you sure to continue?';
  Text[135]:='Script Command';
  Text[136]:='Characters found: %d';
  Text[137]:='New version of Truice (%s) is available. You want to download it?';
  Text[138]:='You have got the latest version.';  
  Text[139]:='The error has accured while loading Creature Addon:';
  Text[140]:='Are you sure to uninstall Truice?';
  Text[141]:='Trainer Type';
  Text[142]:='Race';
  Text[143]:='Class';
  Text[144]:='The error has accured while loading NPC gossip:';
  Text[145]:='The error has accured while loading NPC Text:';
  Text[146]:='~OBSOLETE';
  Text[147]:='Emote';
  Text[148]:='ItemPetFood';
  Text[149]:='The error has accured while loading Creature Template Addon:';
  Text[150]:='GemProperties';
  Text[151]:='SpellItemEnchantment';
  Text[152]:='ItemExtendedCost';
  Text[153]:='Error: Character (guid = %d) not found';
  Text[154]:='The error has accured while loading the Character:';
  Text[155]:='AreaTrigger';
  Text[156]:='LootMode';
  Text[157]:='The error has accured while loading Creature EventAI:';
  Text[158]:='Please specify a source type!';
  Text[159]:='The error has accured while loading Creature Template Movement:';
end;

procedure TdmMain.SetLanguage(const Value: string);
begin
  FLanguage := Value;
  LanguageFile := Format('%sLANG\%s.lng',[ProgramDir, Value]);
end;

end.