Functions.pas

unit Functions;

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,
  Fmx.StdCtrls,
  FMX.Header,
  FMX.Graphics,
  Winapi.Windows,
  System.Win.Registry,

  DBCFILE;

type
   TParameter = (tpInteger, tpFloat, tpString, tpDate, tpTime, tpDateTime,
                  tpCurrency, tpBinaryData, tpBool);
  TRootKey = (CurrentUser, LocalMachine);

  TDateTimeRepresent = (ttTime, ttDate, ttDateTime);

procedure GetWhoAndKey(Text: string; var Who: string; var Key: string); forward;

procedure LoadListFromFile(List: TListView; Fname: string); forward; overload;
procedure LoadListFromFile(List: TListView; Fname: string; id1: string); forward; overload;

function LoadListFromDBCFile(List: TListView; Name: string ): boolean; forward; overload;
function LoadListFromDBCFile(List: TListView; FName: string ; idx_str: Cardinal ): boolean; forward; overload;

procedure SetList(List: TListView; Name: string; Sorted: boolean = false ); forward; overload;
procedure SetList(List: TListView; Name: string; id1: string ; Sorted: boolean = false); forward; overload;

procedure LoadSimpleIDListFromDBCFile(List: TWideStringList; Name: string); forward; export;
procedure LoadStringListFromFile(List: TStrings; csvname: string); forward; export;
procedure Sort(List: TListView; Column: integer); forward; export;

procedure WriteToRegistry(Root: TRootKey; Part, Param: string; TypeOfParam: TParameter; Value: OleVariant); forward; overload;
function ReadFromRegistry(Root: TRootKey; Part, Param: string; TypeOfParam: TParameter; const DefaultValue: OleVariant): OleVariant; forward; overload;
procedure WriteToRegistry(Root: TRootKey; Part, Param: string; var Buffer; BufSize: Integer); forward; overload;
procedure ReadFromRegistry(Root: TRootKey; Part, Param: string; var Buffer; BufSize: Integer); forward; overload;

function GetRaceAcronym(value: integer): string; forward;
function GetClassAcronym(value: integer): string; forward;

function CustomIDSortProc(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall; forward;
function CustomNameSortProc(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall; forward;

function LoadLocales(): string;
procedure ShowHourGlassCursor;

implementation

uses MainUnit, MyDataModule;

const
  I_CreatureFamily       =  10;
  I_ChrClasses           =  4;
  I_QuestInfo            =  1;
  I_Faction              =  20;
  I_SkillLine            =  3;
  I_ChrRaces             =  14;
  I_CreatureType         =  1;
  I_Languages            =  1;
  I_SpellItemEnchantment =  14;
  I_ItemClass            =  3;
  I_ItemSet              =  1;
  I_Map                  =  4;
  I_ItemPetFood          =  1;
  I_AreaTable            =  11;
  I_SpellName            =  136;
  I_SpellRank            =  153;

  MAX_ITEM_LENGTH        = 1000;

  I_AREA_TRIGGER         = 1001;
  I_AREA_TABLE           = 1002;
  I_FACTION_TEMPLATE     = 1003;
  I_GEM_PROPERTIES       = 1004;
  I_QUEST_SORT           = 1005;
  I_EMOTES               = 1006;
  I_SPELL                = 1007;
  I_PAGE_TEXT_MATERIAL   = 1008;
  I_CLASS                = 1009;

function CustomIDSortProc(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
  result := 0;
  if StrToIntDef(Item1.Caption,0) > StrToIntDef(Item2.Caption,0) then  Result := 1
  else if StrToIntDef(Item1.Caption,0) < StrToIntDef(Item2.Caption,0) then  Result := -1;
  if ParamSort < 0 then Result := -Result;
end;

function CustomNameSortProc(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
  Result := CompareStr(Item1.SubItems[0], Item2.SubItems[0]);
  if ParamSort < 0 then Result := -Result;  
end;

function LoadListFromDBCFile(List: TListView; Name: string ): boolean;
var
  FileName : TFileName;
  str : integer;
  SL : TWideStringList;
begin
    SL := TWideStringList.Create;
  try
    // these values mean column number of string value in DBC file
    SL.Add(WideFormat('CreatureFamily=%d',[I_CreatureFamily]));
    SL.Add(WideFormat('ChrClasses=%d',[I_ChrClasses]));
    SL.Add(WideFormat('QuestInfo=%d',[I_QuestInfo]));
    SL.Add(WideFormat('Faction=%d',[I_Faction]));
    SL.Add(WideFormat('SkillLine=%d',[I_SkillLine]));
    SL.Add(WideFormat('ChrRaces=%d',[I_ChrRaces]));
    SL.Add(WideFormat('CreatureType=%d',[I_CreatureType]));
    SL.Add(WideFormat('Languages=%d',[I_Languages]));
    SL.Add(WideFormat('SpellItemEnchantment=%d',[I_SpellItemEnchantment]));
    SL.Add(WideFormat('ItemClass=%d',[I_ItemClass]));
    SL.Add(WideFormat('ItemSet=%d',[I_ItemSet]));
    SL.Add(WideFormat('Map=%d',[I_Map]));
    SL.Add(WideFormat('ItemPetFood=%d',[I_ItemPetFood]));

    // this values mean indexes of case
    SL.Add(WideFormat('AreaTrigger=%d',[I_AREA_TRIGGER]));
    SL.Add(WideFormat('AreaTable=%d',[I_AREA_TABLE]));
    SL.Add(WideFormat('FactionTemplate=%d',[I_FACTION_TEMPLATE]));
    SL.Add(WideFormat('GemProperties=%d',[I_GEM_PROPERTIES]));
    SL.Add(WideFormat('QuestSort=%d',[I_QUEST_SORT]));
    SL.Add(WideFormat('Emotes=%d',[I_EMOTES]));
    SL.Add(WideFormat('Spell=%d',[I_SPELL]));
    SL.Add(WideFormat('PageTextMaterial=%d',[I_PAGE_TEXT_MATERIAL]));
    SL.Add(WideFormat('Class=%d',[I_CLASS]));

    str := StrToIntDef(SL.Values[Name],0);
  finally
    SL.Free;
  end;

  if Name = 'Class' then Name := 'ChrClasses';
  FileName := WideFormat('%s\%s.dbc',[dmMain.DBCDir, Name]);
  if (str > 0) and FileExists(FileName) then
    Result := LoadListFromDBCFile(List, FileName, str)
  else
    Result := False;
end;


function LoadSListFromDBCFile(List: TWideStringList; Name: string; idx_str: Cardinal): boolean;
var
  i: integer;
  Dbc : TDBCFile;
  Fname : TFileName;
begin
  Result := false;
  Fname := WideFormat('%s\%s.dbc',[dmMain.DBCDir, Name]);
  if FileExists(Fname) then
  try
    dbc := TDBCFile.Create;
    try
      Dbc.Load(Fname);
      List.BeginUpdate;
      for i := 0 to Dbc.recordCount - 1 do
      begin
        Dbc.setRecord(i);
        List.Add(WideFormat('%d=%s',[Dbc.getUInt(0),Dbc.getString(idx_str)]));
      end;
    finally
      List.EndUpdate;
      Dbc.Free;
    end;
    Result := true;
  except
    Result := false;
  end;
end;

procedure LoadSimpleIDListFromDBCFile(List: TWideStringList; Name: string);
var
  i: integer;
  Dbc : TDBCFile;
  Fname : TFileName;
begin
  Fname := WideFormat('%s\%s.dbc',[dmMain.DBCDir, Name]);
  if FileExists(Fname) then
  begin
    dbc := TDBCFile.Create;
    try
      Dbc.Load(Fname);
      List.BeginUpdate;
      for i := 0 to Dbc.recordCount - 1 do
      begin
        Dbc.setRecord(i);
        List.Add(WideFormat('%d',[Dbc.getUInt(0)]));
      end;
    finally
      List.EndUpdate;
      Dbc.Free;
    end;
  end;
end;

function LoadListFromDBCFile(List: TListView; Fname: string; idx_str: Cardinal ): boolean;
var
  i: integer;
  Dbc : TDBCFile;
  s, s1, s2: WideString;
  SL, SL2: TWideStringList;
begin
  Sl := TWideStringList.Create;
  Sl2 := TWideStringList.Create;
  try
    case idx_str of
      I_AREA_TRIGGER: LoadSListFromDBCFile(SL, 'Map', I_Map);
      I_AREA_TABLE:
      begin
        LoadSListFromDBCFile(SL, 'Map', I_Map);
        LoadSListFromDBCFile(SL2, 'AreaTable', I_AreaTable);
      end;
      I_FACTION_TEMPLATE:
        LoadSListFromDBCFile(SL, 'Faction', I_Faction);
      I_GEM_PROPERTIES:
        LoadSListFromDBCFile(SL, 'SpellItemEnchantment', I_SpellItemEnchantment);
    end;

    try
      dbc := TDBCFile.Create;
      try
        Dbc.Load(Fname);
        List.Items.BeginUpdate;
        for i := 0 to Dbc.recordCount - 1 do
        begin
          Dbc.setRecord(i);
          case idx_str of
            I_AREA_TRIGGER:
            begin
              s := SL.Values[IntToStr(Dbc.getUInt(1))];
              if s = '' then s := WideFormat('< unknown map %d>',[Dbc.getUInt(1)]);
              s := WideFormat('%s (%.3f, %.3f, %.3f)',[s, Dbc.getFloat(2), Dbc.getFloat(3), Dbc.getFloat(4)]);
            end;
            I_AREA_TABLE:
            begin
              s1 := SL.Values[IntToStr(Dbc.getUInt(1))];
              if s1 <> '' then s1 := s1 + ' - ';
              s2 := SL2.Values[IntToStr(Dbc.getUInt(2))];
              if s2 <> '' then s2 := s2 + ' - ';
              s := WideFormat('%s%s%s',[s1, s2, Dbc.getString(11)]);
            end;
            I_FACTION_TEMPLATE:
            begin
              s := SL.Values[IntToStr(Dbc.getUInt(1))];
              if s = '' then s := WideFormat('< unknown faction %d>',[Dbc.getUInt(1)]);
            end;
            I_GEM_PROPERTIES:
            begin
              s := SL.Values[IntToStr(Dbc.getUInt(1))];
              if s = '' then s := WideFormat('< unknown SpellItemEnchantment %d>',[Dbc.getUInt(1)]);
            end;
            I_QUEST_SORT: s := Dbc.getString(1);
            I_CLASS: s := Dbc.getString(I_ChrClasses);
            I_SPELL:
            begin
              if MainForm.IsSpellInBase(dbc.getUInt(0)) then
                s := WideFormat('%s %s', [dbc.getString(I_SpellName), Dbc.getString(I_SpellRank)])
              else
                s := '';
            end;
            I_EMOTES, I_PAGE_TEXT_MATERIAL:
            begin
              dbc.IsLocalized := false;
              s := dbc.getString(1);
            end
            else
              s := Dbc.getString(idx_str);
          end;
          if s <> '' then
          begin
            with List.Items.Add do
            begin
              if (idx_str = I_QUEST_SORT) or (idx_str = I_CLASS) then
                Caption := IntToStr(-Dbc.getUInt(0))
              else
                Caption := IntToStr(Dbc.getUInt(0));
              SubItems.Add(s);
            end;
          end;
        end;
      finally
        List.Items.EndUpdate;
        Dbc.Free;
      end;
      Result := true;
    except
      Result := false;
    end;
  finally
    Sl.Free;
    Sl2.Free;
  end;
end;

procedure GetWhoAndKey(Text: string; var Who: string; var Key: string);
var
  i: integer;
  s1, s2: string;
begin
  i:=Pos(',',Text);
  s1:=MidStr(Text,1,i-1);
  s2:=MidStr(Text,i+1, Length(Text)-i);
  Who:=s1;
  Key:=s2;
end;

procedure SetList(List: TListView; Name: string; Sorted: boolean );
var
  FileName: TFileName;
begin
    if Name = 'FactionTemplate' then
        Name := 'Faction';

    FileName := WideFormat('%sCSV\%s.csv',[dmMain.ProgramDir, Name]);
    if FileExists(FileName) then
    begin
        List.Items.Clear;
        LoadListFromFile(List, FileName);
    end
    else
    begin
        if Name = 'Faction' then
            Name := 'FactionTemplate';
        LoadListFromDBCFile(List, Name);
    end;

    if Sorted then Sort(List, 1);
end;

procedure SetList(List: TListView; Name: string; id1: string; Sorted: boolean = false);
begin
  LoadListFromFile(List, WideFormat('%s\%s.dbc',[dmMain.DBCDir, Name]), id1);
  if Sorted then Sort(List, 1);
end;

procedure LoadListFromFile(List: TListView; Fname: string);
var
  L: TStringList;
  i: integer;
  n: integer;
  s: string;
begin
  L := TStringList.Create;
  try
    if FileExists(FName) then
      L.LoadFromFile(FName);
    List.Items.BeginUpdate;
    for i:=0 to L.Count - 1 do
    begin
      s:=L[i];
      with List.Items.Add do
      begin
        n:=Pos(';', s);
        Caption:=Copy(s, 1, n-1);
        SubItems.Add(Copy(s, n+1, MAX_ITEM_LENGTH));
      end;
    end;
  finally
    L.Free;
    List.Items.EndUpdate;
  end;
end;

procedure LoadListFromFile(List: TListView; Fname: string; id1: string);
var
  i: integer;
  Dbc : TDBCFile;
begin
  if FileExists(Fname) then
  begin
    dbc := TDBCFile.Create;
    try
      Dbc.Load(Fname);
      List.Items.BeginUpdate;
      for i:=0 to dbc.recordCount - 1 do
      begin
        Dbc.setRecord(i);
        if IntToStr(dbc.getUInt(0)) = id1 then
        begin
          with List.Items.Add do
          begin
            Caption := IntToStr(Dbc.getUInt(1));
            SubItems.Add(Dbc.getString(10));
          end;
        end;
      end;
    finally
      List.Items.EndUpdate;
      dbc.free;
    end;
  end;
end;

procedure LoadStringListFromFile(List: TStrings; csvname: string);
var
  i: integer;
  n: integer;
  F, s: string;
begin
  F := dmMain.ProgramDir+'CSV\'+csvname+'.csv';
  if FileExists(F) then
  begin
    List.LoadFromFile(F);
    List.BeginUpdate;
    try
      for i:=0 to List.Count - 1 do
      begin
        s := List[i];
        n := Pos(';', s);
        List[i] := midStr(s, n+1, MAX_ITEM_LENGTH);;
        List.Objects[i] := pointer( StrToInt(MidStr(s, 1, n-1)));
      end;
    finally
      List.EndUpdate;
    end;
  end;
end;

procedure Sort(List: TListView; Column: integer);
begin
  List.Items.BeginUpdate;
  try
    case Column of
      0: List.CustomSort(@CustomIDSortProc, 1);
      1: List.CustomSort(@CustomNameSortProc, 1);
    end;
  finally
    List.Items.EndUpdate;
  end;
end;

procedure WriteToRegistry(Root: TRootKey; Part, Param: string;
                         TypeOfParam: TParameter; Value: OleVariant);
var
  Section: string;
begin
  try
    if Part='' then
      Section:='Software\'+ Trim(ProgramName)
    else
      Section:='Software\'+ Trim(ProgramName) + '\' + Trim(Part);
    with TRegistry.Create do
    try
      case Root of
        CurrentUser: RootKey:=HKEY_CURRENT_USER;
        LocalMachine: RootKey:=HKEY_LOCAL_MACHINE;
      end;
      OpenKey(Section, true);
      case TypeOfParam of
        tpInteger     :   WriteInteger(Param, Value);
        tpFloat       :   WriteFloat(Param, Value);
        tpString      :   WriteString(Param, Value);
        tpDate        :   WriteDate(Param, Value);
        tpTime        :   WriteTime(Param, Value);
        tpDateTime    :   WriteDateTime(Param, Value);
        tpBool        :   WriteBool(Param, Value);
        tpCurrency    :   WriteCurrency(Param, Value);
        tpBinaryData  :   raise Exception.Create('use overloaded procedure');
      end;
    finally
      Free;
    end;
  except
  end;
end;

procedure WriteToRegistry(Root: TRootKey; Part, Param: string;
                         var Buffer; BufSize: Integer);
var
  Section: string;
begin
  try
  {  if (Trim(ProgramName)='') then
      raise Exception.Create('ProgramName can not be empty');}
    if Part='' then
      Section:='Software\'+ Trim(ProgramName)
    else
      Section:='Software\'+ Trim(ProgramName) + '\' + Trim(Part);
    with TRegistry.Create do
    try
      case Root of
        CurrentUser: RootKey:=HKEY_CURRENT_USER;
        LocalMachine: RootKey:=HKEY_LOCAL_MACHINE;
      end;
      OpenKey(Section, true);
      WriteBinaryData(Param, Buffer, BufSize);
    finally
      Free;
    end;
  except
  end;
end;


function ReadFromRegistry(Root: TRootKey; Part, Param: string;
                         TypeOfParam: TParameter; const DefaultValue: OleVariant): OleVariant;
var
  Section: string;
  Value: OleVariant;
begin
  Value := DefaultValue;
  Section:='Software\' + Trim(ProgramName) + '\' + Trim(Part);
  with TRegistry.Create do
  try
    case Root of
      CurrentUser:    RootKey:=HKEY_CURRENT_USER;
      LocalMachine:   RootKey:=HKEY_LOCAL_MACHINE;
    end;

    if KeyExists(Section) then
    begin
      OpenKeyReadOnly(Section);
      if ValueExists(Param) then
      begin
        case TypeOfParam of
          tpInteger     :   Value:=ReadInteger(Param);
          tpFloat       :   Value:=ReadFloat(Param);
          tpString      :   Value:=ReadString(Param);
          tpDate        :   Value:=ReadDate(Param);
          tpTime        :   Value:=ReadTime(Param);
          tpDateTime    :   Value:=ReadDateTime(Param);
          tpBool        :   Value:=ReadBool(Param);
          tpCurrency    :   Value:=ReadCurrency(Param);
          tpBinaryData  :   raise Exception.Create('use overloaded procedure');
        end;
      end;
    end;
  finally
    Free;
  end;
  result:=Value;
end;

procedure ReadFromRegistry(Root: TRootKey; Part, Param: string;
                         var Buffer; BufSize: Integer);
var
  Section: string;
begin
{  if (Trim(ProgramName)='') then
    raise Exception.Create('ProgramName can not be empty');}
  if Part='' then
    Section:='Software\'+ Trim(ProgramName)
  else
    Section:='Software\'+ Trim(ProgramName) + '\' + Trim(Part);
  with TRegistry.Create do
  try
    case Root of
      CurrentUser: RootKey:=HKEY_CURRENT_USER;
      LocalMachine: RootKey:=HKEY_LOCAL_MACHINE;
    end;
    if OpenKey(Section, false) then
    begin
      ReadBinaryData(Param, Buffer, BufSize);
    end;
  finally
    Free;
  end;
end;

function GetRaceAcronym(value: integer): string;
begin
  case value of
    1: Result := 'Human';
    2: Result := 'Orc';
    3: Result := 'Dwarf';
    4: Result := 'NightElf';
    5: Result := 'Undead';
    6: Result := 'Tauren';
    7: Result := 'Gnome';
    8: Result := 'Troll';
    10:	Result := 'BloodElf';
    11:	Result := 'Draenei';
    690: Result := 'Horde';
    1101: Result := 'Alliance';
    0,-1: Result := 'Both';
  else
    Result:= '';
  end;
end;

function GetClassAcronym(value: integer): string;
begin
  case value of
    1: Result := 'Warrior';
    2: Result := 'Paladin';
    3: Result := 'Hunter';
    4: Result := 'Rogue';
    5: Result := 'Priest';
    7: Result := 'Shaman';
    8: Result := 'Mage';
    9: Result := 'Warlock';
    11: Result := 'Druid';
  else
    Result:= '';
  end;
end;

procedure ShowHourGlassCursor;
begin
  SetCursor(LoadCursor(0,IDC_WAIT));
end;

function LoadLocales():string;
begin
 with TRegistry.Create do
  try
    RootKey := HKEY_CURRENT_USER;
    if not OpenKey('SOFTWARE\Truice', false) then exit;
    try
     case ReadInteger('Locales') of
      0: result:= 'enUS';
      1: result:= 'koKR';
      2: result:= 'frFR';
      3: result:= 'deDE';
      4: result:= 'zhCN';
      5: result:= 'zhTW';
      6: result:= 'esES';
      7: result:= 'esMX';
      8: result:= 'ruRU';
     end;
   except
      Result:= 'enUS';
    end;
  finally
    free;
  end;
end;
end.