unit TeUpdateDB;
interface
uses
System.Generics.Collections,IdHTTP, System.Threading,
IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL,
System.Classes;
type
TTeUpdateDBStatus =
record
id: Integer;
current,max: Integer;
end;
TTeUpdateDBIDState =
record
id:
String;
AccountBindOnUse: Boolean;
AccountBound: Boolean;
HideSuffix: Boolean;
MonsterOnly: Boolean;
NoMysticForge: Boolean;
NoSalvage: Boolean;
NoSell: Boolean;
NotUpgradeable: Boolean;
NoUnderwater: Boolean;
SoulbindOnAcquire: Boolean;
SoulBindOnUse: Boolean;
Unique: Boolean;
end;
type
TTeUpdateDB =
class(TObject)
private
IDList: TStringList;
IDListEx: TList<TTeUpdateDBIDState>;
IDListTask: ITask;
procedure AddToIDListEx(sl: TStringList;fstart,fend:Integer);
procedure BuiltIDList;
procedure BuiltIDListEx(fstart, fend: Integer);
function CountEntries(s:
String): Integer;
procedure SplitEntries(sl: TStringList; s:
String);
function BToStr(b:Boolean):
String;
public
state: TTeUpdateDBStatus;
constructor Create;
procedure GetIDInformation;
procedure SaveIDListEx(p:
String);
end;
implementation
uses
System.SysUtils,
Vcl.Dialogs;
const
maxidrequ = 200;
constructor TTeUpdateDB.Create;
begin
IDList := TStringList.Create;
IDListEx := TList<TTeUpdateDBIDState>.Create;
state.id := -2;
end;
procedure TTeUpdateDB.GetIDInformation;
begin
IDListTask := TTask.Create(
procedure()
var
max,fstart,fend: Integer;
begin
BuiltIDList;
//debugging
state.id := 0;
max := IDList.Count -1;
state.max := max;
fstart := 0; fend := -1;
IDListEx.Clear;
while fend <> max
do
begin
fstart := fend + 1;
fend := fstart + (maxidrequ-1);
state.current := fstart;
if fend > max
then fend := max;
if fstart > fend
then break;
BuiltIDListEx(fstart,fend);
end;
//debugging
SaveIDListEx('
test.dat');
end);
IDListTask.Start;
end;
procedure TTeUpdateDB.SaveIDListEx(p:
string);
var
sl:TStringList;
i: Integer;
begin
sl := TStringList.Create;
for i := 0
to IDListEx.Count-1
do
begin
sl.Add(IDListEx[i].id + '
;' + BToStr(IDListEx[i].AccountBindOnUse) + '
;' + BToStr(IDListEx[i].AccountBound) + '
;' + BToStr(IDListEx[i].HideSuffix) + '
;' + BToStr(IDListEx[i].MonsterOnly) + '
;' + BToStr(IDListEx[i].NoMysticForge) + '
;' + BToStr(IDListEx[i].NoSalvage) + '
;' + BToStr(IDListEx[i].NoSell) + '
;' + BToStr(IDListEx[i].NotUpgradeable) + '
;' + BToStr(IDListEx[i].NoUnderwater) + '
;' + BToStr(IDListEx[i].SoulbindOnAcquire) + '
;' + BToStr(IDListEx[i].SoulBindOnUse) + '
;' + BToStr(IDListEx[i].Unique));
end;
sl.SaveToFile(p,TEncoding.UTF8);
end;
//###########################################################################################################
procedure TTeUpdateDB.BuiltIDList;
var
http: TIdHttp;
ssl: TIdSSLIOHandlerSocketOpenSSL;
buffer:
String;
begin
IDList.Clear;
http := TIdHTTP.Create;
ssl := TIdSSLIOHandlerSocketOpenSSL.Create(
nil);
http.IOHandler := ssl;
buffer := http.Get('
https://url.de/items');
buffer := StringReplace(buffer,'
[','
',[]);
buffer := StringReplace(buffer,'
]','
',[]);
IDList.StrictDelimiter := True;
IDList.Delimiter := '
,';
IDList.DelimitedText := buffer;
end;
procedure TTeUpdateDB.BuiltIDListEx(fstart,fend: Integer);
var
http: TIdHttp;
ssl: TIdSSLIOHandlerSocketOpenSSL;
buffer:
String;
ids:
String;
i: Integer;
sl: TStringList;
begin
http := TIdHTTP.Create;
ssl := TIdSSLIOHandlerSocketOpenSSL.Create(
nil);
http.IOHandler := ssl;
sl := TStringList.Create;
try
ids := '
';
for i := fstart
to fend
do
begin
if i <> fend
then
ids := ids + IDList[i] + '
,'
else
ids := ids + IDList[i];
end;
buffer := http.Get('
https://url.de/items?ids=' + ids);
SplitEntries(sl,buffer);
//debugging
if sl.Count <> CountEntries(buffer)
then state.id := -1;
AddToIDListEx(sl,fstart,fend);
finally
sl.Free;
end;
end;
procedure TTeUpdateDB.AddToIDListEx(sl: TStringList; fstart: Integer; fend: Integer);
var
i: Integer;
d: TTeUpdateDBIDState;
pf: Integer;
begin
for i := 0
to sl.Count -1
do
begin
d.id := IDList[fstart+i];
pf := Pos('
"flags":',sl[i]);
if pf = 0
then
begin
d.AccountBindOnUse := false;
d.AccountBound := false;
d.HideSuffix := false;
d.MonsterOnly := false;
d.NoMysticForge := false;
d.NoSalvage := false;
d.NoSell := false;
d.NotUpgradeable := false;
d.NoUnderwater := false;
d.SoulbindOnAcquire := false;
d.SoulBindOnUse := false;
d.Unique := false;
end else
begin
d.AccountBindOnUse := (Pos('
"AccountBindOnUse"',sl[i],pf) <> 0);
d.AccountBound := (Pos('
"AccountBound"',sl[i],pf) <> 0);
d.HideSuffix := (Pos('
"HideSuffix"',sl[i],pf) <> 0);
d.MonsterOnly := (Pos('
"MonsterOnly"',sl[i],pf) <> 0);
d.NoMysticForge := (Pos('
"NoMysticForge"',sl[i],pf) <> 0);
d.NoSalvage := (Pos('
"NoSalvage"',sl[i],pf) <> 0);
d.NoSell := (Pos('
"NoSell"',sl[i],pf) <> 0);
d.NotUpgradeable := (Pos('
"NotUpgradeable"',sl[i],pf) <> 0);
d.NoUnderwater := (Pos('
"NoUnderwater"',sl[i],pf) <> 0);
d.SoulbindOnAcquire := (Pos('
"SoulbindOnAcquire"',sl[i],pf) <> 0);
d.SoulBindOnUse := (Pos('
"SoulBindOnUse"',sl[i],pf) <> 0);
d.Unique := (Pos('
"Unique"',sl[i],pf) <> 0);
end;
IDListEx.Add(d);
end;
end;
function TTeUpdateDB.CountEntries(s:
String): Integer;
var
p: Integer;
begin
p := 1;
result := 0;
while p <> 0
do
begin
p := Pos('
{"name":',s,p+1);
if p <> 0
then Inc(result);
end;
end;
procedure TTeUpdateDB.SplitEntries(sl: TStringList; s:
String);
var
p, pp: Integer;
b: Boolean;
begin
sl.Clear;
b := true;
p := 0;
while b
do
begin
p := Pos('
{"name":',s,p+1);
//1.Item
pp := Pos('
{"name":',s,p+1);
//2.Item
if pp = 0
then
begin
b := false;
pp := Length(s);
end else
begin
pp := pp - 1;
end;
sl.Add(Copy(s,p,pp-p));
end;
end;
function TTeUpdateDB.BToStr(b: Boolean):
String;
begin
if b
then result := '
1'
else result := '
0';
end;
end.
Zitat
Baum-Darstellung
