source: tools/WoWHeadLoader/WoWHeadLoader.lpr

Last change on this file was 634, checked in by maron, 10 years ago
  • Added: options from
  • Fixed: some bugs
File size: 30.7 KB
Line 
1program WoWHeadLoader;
2
3{$mode objfpc}{$H+}
4
5uses
6 {$IFDEF UNIX}{$IFDEF UseCThreads}
7 cthreads,
8 {$ENDIF}{$ENDIF}
9 Classes, SysUtils, CustApp
10 { you can add units after this }
11 , IdHTTP, USqlDatabase
12
13 ;
14//poznámka mazání pro testování
15{
16DELETE FROM `wowpreklad`.`TextQuest` WHERE `VersionStart` = 17359;
17DELETE FROM `wowpreklad`.`TextAchievement` WHERE `VersionStart` = 17359;
18DELETE FROM `wowpreklad`.`TextGameObject` WHERE `VersionStart` = 17359;
19DELETE FROM `wowpreklad`.`TextItem` WHERE `VersionStart` = 17359;
20DELETE FROM `wowpreklad`.`TextCreature` WHERE `VersionStart` = 17359;
21DELETE FROM `wowpreklad`.`TextArea` WHERE `VersionStart` = 17359;
22
23UPDATE `wowpreklad`.`TextItem` SET `VersionEnd` = 12340 WHERE `VersionEnd` = 17359;
24UPDATE `wowpreklad`.`TextGameObject` SET `VersionEnd` = 12340 WHERE `VersionEnd` = 17359;
25UPDATE `wowpreklad`.`TextQuest` SET `VersionEnd` = 12340 WHERE `VersionEnd` = 17359;
26UPDATE `wowpreklad`.`TextAchievement` SET `VersionEnd` = 12340 WHERE `VersionEnd` = 17359;
27UPDATE `wowpreklad`.`TextCreature` SET `VersionEnd` = 12340 WHERE `VersionEnd` = 17359;
28UPDATE `wowpreklad`.`TextArea` SET `VersionEnd` = 12340 WHERE `VersionEnd` = 17359;
29}
30type
31
32 { TWoWHeadLoader }
33
34 TWoWHeadLoader = class(TCustomApplication)
35 protected
36 procedure DoRun; override;
37 public
38 IdHTTP1: TIdHTTP;
39 Database: TSqlDatabase;
40 constructor Create(TheOwner: TComponent); override;
41 destructor Destroy; override;
42 procedure WriteHelp; virtual;
43 procedure Main;
44 function skipto(part: string; text: string): string;
45 function TextStringReplace(text:string):string;
46 function CompareStrings(textdb: string; textimport: string): boolean;
47 function DelHtmlTags(text:string):string;
48 function SqlPre(text: string):string;
49 procedure UpdateTranslated(table:string);
50 function GetLastVersion: integer;
51 function GetPartText(textname: string; text: string): string;
52
53 function GetEndtextData(data:string): string;
54 procedure GetTextQuest(Id: Integer);
55
56 function GetMaxID(TextType: string): integer;
57 procedure GetText(Id: Integer;TextType : integer);
58end;
59var
60 ImportedVersion: integer;
61 Group: array [1..6] of string = ('achievement','item','npc','object','zone','quest');
62 GroupDB: array [1..6] of string = ('TextAchievement','TextItem','TextCreature','TextGameObject','TextArea','TextQuest');
63 Column2DB: array [1..6] of string = ('Description','Description','SubName','','','');
64 ImportTable: integer = 6;
65 From: integer = 1;
66{ TWoWHeadLoader }
67// IdHTTP1.Request.UserAgent:= 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)';
68// IdHTTP1.ReadTimeout:= 1000;
69// IdHTTP1.RedirectCount := 15;
70// IdHTTP1.HandleRedirects:=true;
71procedure TWoWHeadLoader.DoRun;
72var
73 ErrorMsg: String;
74begin
75 // quick check parameters
76 ErrorMsg:=CheckOptions('hsuptaif','helpschemauserpasswordhostCharsetimporttablefrom');
77 if ErrorMsg<>'' then begin
78 ShowException(Exception.Create(ErrorMsg));
79 Terminate;
80 Exit;
81 end;
82
83 // parse parameters
84 if HasOption('h','help') then begin
85 WriteHelp;
86 Terminate;
87 Exit;
88 end;
89
90 //inicialization
91 Database := TSqlDatabase.Create;
92 IdHTTP1:= TIdHTTP.Create(nil);
93
94 if HasOption('s', 'schema') then begin
95 Database.Database := GetOptionValue('s', 'schema');
96 end else Database.Database := 'wowpreklad';
97 if HasOption('u', 'user') then begin
98 Database.UserName := GetOptionValue('u', 'user');
99 end else Database.UserName := 'import';
100 if HasOption('p', 'password') then begin
101 Database.Password := GetOptionValue('p', 'password');
102 end else Database.Password := 'test';
103 if HasOption('t', 'host') then begin
104 Database.Hostname := GetOptionValue('t', 'host');
105 end else Database.Hostname := 'localhost';
106 if HasOption('a', 'Charset') then begin
107 Database.Encoding := GetOptionValue('a', 'Charset');
108 end else Database.Encoding := 'utf8';
109 if HasOption('i', 'importtable') then begin
110 ImportTable := StrToInt(GetOptionValue('i', 'importtable'));
111 end else ImportTable := 6;
112 if HasOption('f', 'from') then begin
113 From := StrToInt(GetOptionValue('f', 'from'));
114 end else From := 1;
115
116 Database.Connect;
117 WriteLn('Nez zacnete, aktualizujte udaje v tabulce ClientVersion. Texty se budou importovat jako nejpozdejsi pojmenovana verze!');
118 // ReadLn;
119
120 ImportedVersion:=GetLastVersion;
121
122 Main;
123 { add your program here }
124 Database.Disconnect;
125 Database.Free;
126 IdHTTP1.Free;
127 // stop program loop
128 Terminate;
129end;
130
131constructor TWoWHeadLoader.Create(TheOwner: TComponent);
132begin
133 inherited Create(TheOwner);
134 StopOnException:=True;
135end;
136
137destructor TWoWHeadLoader.Destroy;
138begin
139 inherited Destroy;
140end;
141
142procedure TWoWHeadLoader.WriteHelp;
143begin
144 { add your help code here }
145 WriteLn('Usage: ', ExtractFileName(ExeName), ' [options]');
146 WriteLn(' -h --help Show this help');
147 WriteLn(' -u --user Database user name, default root');
148 WriteLn(' -p --password Database password name');
149 WriteLn(' -s --schema Database schema name, default wowpreklad');
150 WriteLn(' -t --host Database host name, default localhost');
151 WriteLn(' -a --Charset Database Charset, default utf8');
152 WriteLn(' -i --importtable Table import: TextAchievement=1,TextItem=2,TextCreature=3,TextGameObject=4,TextArea=5,TextQuest=6, default 6');
153 WriteLn(' -f --from ID text begin importing');
154end;
155
156procedure TWoWHeadLoader.Main;
157var
158 i,t: integer;
159begin
160// UpdateQuest;
161 {
162 GetText(1132,2);
163 GetText(1132,2);
164 GetText(1284,2);
165 GetText(1180,2);
166 GetText(1327,2);
167 GetText(1361,2);
168 GetText(1384,2);
169 GetText(1111,1);
170 GetText(29,3);
171 GetText(55,4);
172 GetText(15,5);
173 GetText(4,6);
174 }
175
176// GetText(3977,3);
177// GetText(29265,3);
178
179 // for t :=1 to Length(Group) do
180 for i := From to GetMaxID(Group[ImportTable]) do begin //GetMaxID('quest')
181 GetText(i,ImportTable);
182 // write('.');
183 end;
184 write('Done!!!');
185 //čekej před uzavřením
186// ReadLn;
187end;
188
189procedure TWoWHeadLoader.GetTextQuest(Id: Integer);
190var
191 part,data,
192 textname,textobject,textdescription,
193 textcomplection,textprogress,textend,
194 textobjective1,textobjective2,textobjective3,textobjective4: string;
195 foundtext: boolean= true;
196 itemfound: boolean = false;
197 DBRows : TDbRows;
198 i: integer;
199begin
200 try
201
202 //načtení
203 data := IdHTTP1.Get('http://www.wowhead.com/quest='+IntToStr(Id));
204 // WriteLn(data);
205 if (pos('<b style="color: red">This quest was marked obsolete',data) > 0) or (pos('<b style="color: red">This quest is no longer available',data) > 0) then begin
206 foundtext:=false;
207 WriteLn('obsolete');
208 Exit;
209 end;
210
211
212 textdescription := TextStringReplace(GetPartText('Description',data));
213 textcomplection := TextStringReplace(GetPartText('completion',data)); //OfferRewardText
214 textprogress := TextStringReplace(GetPartText('progress',data)); //RequestItemsText
215 if (textprogress = '') then
216 textprogress := TextStringReplace(GetPartText('Progress',data)); //RequestItemsText
217
218 //skok na text
219 data := skipto('<div class="text">',data);
220
221 //name
222 data := skipto('<h1>',data);
223 textname := TextStringReplace(Copy(data,0,Pos('</h1>',data)-1));
224
225 //objektiv
226 data := skipto('</h1>',data);
227 for i:= 0 to 4 do begin
228 data := StringReplace(data,'<br>','$B',[rfIgnoreCase]);
229 data := StringReplace(data,'<br />','$B',[rfIgnoreCase]);
230 end;
231 textobject := TextStringReplace(Copy(data,0,Pos('<',data)-1));
232
233 //endtext+objects
234 data:=GetEndtextData(data);
235 // WriteLn(data);
236
237
238 repeat
239 data := skipto('<td>',data);
240 part := Copy(data,0,Pos('</td>',data)-1);
241
242 if (Copy(part,0,Length(part)-1) = 'Suggested players: ') then Continue;
243
244 if ((Pos('item',part) > 0)) then begin
245 itemfound:=true;
246 textend:='';
247 end;
248 if ((Pos('<',part) = 0) and (Pos('#',part) = 0) and (Pos('&nbsp;',part) = 0)) then begin
249 // part := Copy(part,0,Pos('&nbsp;',part)-1);
250 textend:=TextStringReplace(DelHtmlTags(part));
251 end;
252 if ((Pos('object=',part) > 0) or (Pos('javascript',part) > 0) or ((itemfound = false) and (Pos('#',part) = 0) and (Pos('<',part) = 0))) then begin
253 part := Copy(part,0,Pos('&nbsp;',part)-1);
254 part := TextStringReplace(DelHtmlTags(part)); //todo
255 if (textobjective1 = '') then textobjective1:=part else
256 if (textobjective2 = '') then textobjective2:=part else
257 if (textobjective3 = '') then textobjective3:=part else
258 if (textobjective4 = '') then textobjective4:=part;
259 end;
260
261 data := skipto('</td>',data);
262 until (Pos('<td>',data) = 0);
263 if ((itemfound = false) and (textend <> '')) then begin
264 if (textobjective4 <> '') then textobjective4:='' else
265 if (textobjective3 <> '') then textobjective3:='' else
266 if (textobjective2 <> '') then textobjective2:='' else
267 if (textobjective1 <> '') then textobjective1:='';
268 end;
269
270
271
272 If foundtext then begin
273 DBRows := Database.Query('SELECT * FROM `TextQuest` WHERE `Entry` ='+IntToStr(Id)+' AND `Language` =0 ORDER BY `TextQuest`.`VersionEnd` DESC ');
274 if (DBRows.Count > 0) then begin
275 if (DBRows.Data[0].Values['VersionEnd'] = IntToStr(ImportedVersion)) then begin
276 WriteLn('Allready importet');
277 Exit; //konec pokud už tam text je
278 end;
279 if (
280 CompareStrings(DBRows.Data[0].Values['Title'],textname) and
281 CompareStrings(DBRows.Data[0].Values['Objectives'],textobject) and
282 CompareStrings(DBRows.Data[0].Values['Details'],textdescription) and
283 CompareStrings(DBRows.Data[0].Values['OfferRewardText'],textcomplection) and
284 CompareStrings(DBRows.Data[0].Values['RequestItemsText'],textprogress) and
285 CompareStrings(DBRows.Data[0].Values['ObjectiveText2'],textobjective2) and
286 CompareStrings(DBRows.Data[0].Values['ObjectiveText3'],textobjective3) and
287 CompareStrings(DBRows.Data[0].Values['ObjectiveText4'],textobjective4) and
288 (
289 (
290 CompareStrings(DBRows.Data[0].Values['EndText'],textend) and
291 CompareStrings(DBRows.Data[0].Values['ObjectiveText1'],textobjective1)
292 ) or
293 (
294 CompareStrings(DBRows.Data[0].Values['EndText'],textobjective1) and
295 CompareStrings(DBRows.Data[0].Values['ObjectiveText1'],textend)
296 )
297 )
298 ) then
299 begin
300 //text je stejný
301 Database.Query('UPDATE `TextQuest` SET `VersionEnd` = '+IntToStr(ImportedVersion)+' WHERE `Id` = '+DBRows.Data[0].Values['Id']+' AND `Entry` ='+IntToStr(Id)+';');
302 Database.Query('UPDATE `TextQuest` SET `VersionEnd` = '+IntToStr(ImportedVersion)+' WHERE `Take` = '+DBRows.Data[0].Values['Id']+' AND `Entry` ='+IntToStr(Id)+';');
303 UpdateTranslated('textquest');
304 WriteLn('update');
305 Exit; //konec: text je stejný upravili se jenom výsledné verze
306 end;
307// if not (
308// CompareStrings(DBRows.Data[0].Values['EndText'],textend) and
309 // CompareStrings(DBRows.Data[0].Values['ObjectiveText1'],textobjective1) and
310 // CompareStrings(DBRows.Data[0].Values['ObjectiveText2'],textobjective2) and
311// CompareStrings(DBRows.Data[0].Values['ObjectiveText3'],textobjective3) and
312// CompareStrings(DBRows.Data[0].Values['ObjectiveText4'],textobjective4)
313 // ) then Readln;
314 end;
315
316 begin
317 {
318 WriteLn('INSERT INTO `TextQuest` ('
319 +'`ID` ,`Entry` ,`Title` ,`Details` ,`Objectives` ,`OfferRewardText` ,`RequestItemsText` ,`EndText` ,'
320 +'`ObjectiveText1` ,`ObjectiveText2` ,`ObjectiveText3` ,`ObjectiveText4` '
321 +',`Language` , `User` , `Complete` ,`CompleteParts` ,`Take` ,`VersionStart` ,`VersionEnd` ,`ModifyTime`)'
322 +'VALUES (NULL,'+IntToStr(Id)+','
323 +SqlPre(textname)+', '
324 +SqlPre(textdescription)+', '
325 +SqlPre(textobject)+', '
326 +SqlPre(textcomplection)+', '
327 +SqlPre(textprogress)+', '
328 +SqlPre(textend)+', '
329 +SqlPre(textobjective1)+', '
330 +SqlPre(textobjective2)+', '
331 +SqlPre(textobjective3)+', '
332 +SqlPre(textobjective4)+', '
333 +'0, NULL, 1,0,NULL,'+IntToStr(ImportedVersion)+','+IntToStr(ImportedVersion)+',NOW())');
334 }
335 Database.Query('INSERT INTO `TextQuest` ('
336 +'`ID` ,`Entry` ,`Title` ,`Details` ,`Objectives` ,`OfferRewardText` ,`RequestItemsText` ,`EndText` ,'
337 +'`ObjectiveText1` ,`ObjectiveText2` ,`ObjectiveText3` ,`ObjectiveText4` '
338 +',`Language` , `User` , `Complete` ,`CompleteParts` ,`Take` ,`VersionStart` ,`VersionEnd` ,`ModifyTime`)'
339 +'VALUES (NULL,'+IntToStr(Id)+','
340 +SqlPre(textname)+', '
341 +SqlPre(textdescription)+', '
342 +SqlPre(textobject)+', '
343 +SqlPre(textcomplection)+', '
344 +SqlPre(textprogress)+', '
345 +SqlPre(textend)+', '
346 +SqlPre(textobjective1)+', '
347 +SqlPre(textobjective2)+', '
348 +SqlPre(textobjective3)+', '
349 +SqlPre(textobjective4)+', '
350 +'0, NULL, 1,0,NULL,'+IntToStr(ImportedVersion)+','+IntToStr(ImportedVersion)+',NOW())');
351 WriteLn('insert');
352
353 //TODO: zkopírovat přeložený text pokud je celý anglický přeložený
354
355 end;
356
357 {
358 if (DBRows.Count = 0) then Exit;
359 WriteLn('guest='+IntToStr(Id)+' DB "'
360 +DBRows.Data[0].Values['Title']+ '" '+chr(10)+
361 'Objektiv:"'+DBRows.Data[0].Values['Objectives']+ '" '+chr(10)
362 +'Description: "'+DBRows.Data[0].Values['Details']+'"'+chr(10)
363 +'Complection: "'+DBRows.Data[0].Values['OfferRewardText']+'"'+chr(10)
364 +'Progress: "'+DBRows.Data[0].Values['RequestItemsText']+'"'+chr(10)
365 +'textend: "'+DBRows.Data[0].Values['EndText']+'"'+chr(10)
366 +'textobjective1: "'+DBRows.Data[0].Values['ObjectiveText1']+'"'+chr(10)
367 +'textobjective2: "'+DBRows.Data[0].Values['ObjectiveText2']+'"'+chr(10)
368 +'textobjective3: "'+DBRows.Data[0].Values['ObjectiveText3']+'"'+chr(10)
369 +'textobjective4: "'+DBRows.Data[0].Values['ObjectiveText4']+'"'+chr(10)
370 );
371
372 WriteLn('guest='+IntToStr(Id)+' "'+textname+ '" '+chr(10)+
373 'Objektiv:"'+textobject+ '" '+chr(10)
374 +'Description: "'+textdescription+'"'+chr(10)
375 +'Complection: "'+textcomplection+'"'+chr(10)
376 +'Progress: "'+textprogress+'"'+chr(10)
377 +'textend: "'+textend+'"'+chr(10)
378 +'textobjective1: "'+textobjective1+'"'+chr(10)
379 +'textobjective2: "'+textobjective2+'"'+chr(10)
380 +'textobjective3: "'+textobjective3+'"'+chr(10)
381 +'textobjective4: "'+textobjective4+'"'+chr(10)
382 );
383 }
384
385 end;
386 except
387 on E: EIdHTTPProtocolException do
388 begin
389 if E.ErrorCode = 404 then begin
390 foundtext := false;
391 WriteLn('notfound');
392 end;
393
394 end;
395 on E:Exception do
396 GetTextQuest(Id);
397 end;
398end;
399
400procedure TWoWHeadLoader.GetText(Id: Integer; TextType: Integer);
401var
402 part,data, sql,
403 textname,textdescription: string;
404 foundtext: boolean = true;
405 DBRows : TDbRows;
406 i: integer;
407begin
408 WriteLn();
409 WriteLn(Group[TextType]+'='+IntToStr(Id));
410 if (TextType = 6) then begin
411 GetTextQuest(Id);
412 Exit;
413 end;
414
415 try
416
417 //načtení
418 data := IdHTTP1.Get('http://www.wowhead.com/'+Group[TextType]+'='+IntToStr(Id));
419
420 if (pos('<b style="color: red">',data) > 0) then begin
421 WriteLn('color:red');
422 // ReadLn;
423 foundtext:=false;
424 Exit;
425 end;
426 if ((pos('is no longer available within the game.</b>',data) > 0)) then begin
427 foundtext:=false;
428 Exit;
429 end;
430
431 if ('item' = Group[TextType]) then begin
432 if (Pos('<span class="q2">Use:',data) >0) then begin
433 data := skipto('<span class="q2">Use:',data);
434 data := skipto('>',data);
435 // textdescription := TextStringReplace(Copy(data,0,Pos('</a',data)-1));
436 //zatím nefunguje
437 end;
438 end;
439
440 //skok na text
441 data := skipto('<div class="text">',data);
442
443 //name
444 data := skipto('<h1',data);
445 data := skipto('>',data);
446 textname := TextStringReplace(Copy(data,0,Pos('</h1>',data)-1));
447 //description
448 data := skipto('</h1>',data);
449
450 if ('' <> Column2DB[TextType]) then
451 if ('item' <> Group[TextType]) then begin
452 data := skipto('<script type="text/javascript">',data);
453 data := skipto('</script>',data);
454 textdescription := TextStringReplace(Copy(data,0,Pos('<',data)-1));
455 end;
456 if ('npc' = Group[TextType]) then begin
457 if not (Pos('src="',textname) >0) then begin
458 if (Pos('>',textname) > 0) then
459 textdescription := skipto('<',textname);
460 textdescription := TextStringReplace(Copy(textdescription,0,Length(textdescription)-1));
461 end;
462 if (Pos('<',textname) >0) then
463 textname := TextStringReplace(Copy(textname,0,Pos('<',textname)-1));
464 end;
465 textname:=DelHtmlTags(textname);
466
467 If foundtext then begin
468 DBRows := Database.Query('SELECT * FROM `'+GroupDB[TextType]+'` WHERE `Entry` ='+IntToStr(Id)+' AND `Language` =0 ORDER BY `VersionEnd` DESC ');
469 if (DBRows.Count > 0) then begin
470 WriteLn('"'+DBRows.Data[0].Values['Name']+'"-"'+DBRows.Data[0].Values[Column2DB[TextType]]+'"');
471 WriteLn('"'+textname+'"-"'+textdescription+'"');
472 if (DBRows.Data[0].Values['VersionEnd'] = IntToStr(ImportedVersion)) then Exit; //konec pokud už tam text je
473 if (
474 CompareStrings(DBRows.Data[0].Values['Name'],textname) and
475 CompareStrings(DBRows.Data[0].Values[Column2DB[TextType]],textdescription)
476 ) then
477 begin
478 //text je stejný
479 Database.Query('UPDATE `'+GroupDB[TextType]+'` SET `VersionEnd` = '+IntToStr(ImportedVersion)+' WHERE `Id` = '+DBRows.Data[0].Values['Id']+' AND `Entry` ='+IntToStr(Id)+';');
480 Database.Query('UPDATE `'+GroupDB[TextType]+'` SET `VersionEnd` = '+IntToStr(ImportedVersion)+' WHERE `Take` = '+DBRows.Data[0].Values['Id']+' AND `Entry` ='+IntToStr(Id)+';');
481 WriteLn('update');
482 UpdateTranslated(GroupDB[TextType]);
483 Exit; //konec: text je stejný upravili se jenom výsledné verze
484 end;
485 end;
486 sql := 'INSERT INTO `'+GroupDB[TextType]+'` (`ID` ,`Entry` ,`Name`,';
487 if (Column2DB[TextType] <> '') then sql += '`'+Column2DB[TextType]+'` ,';
488 sql +='`Language` , `User` , `Complete` ,`CompleteParts` ,`Take` ,`VersionStart` ,`VersionEnd` ,`ModifyTime`)'
489 +'VALUES (NULL,'+IntToStr(Id)+','
490 +SqlPre(textname)+', ';
491 if (Column2DB[TextType] <> '') then sql += SqlPre(textdescription)+', ';
492 sql +='0, NULL, 1,0,NULL,'+IntToStr(ImportedVersion)+','+IntToStr(ImportedVersion)+',NOW())';
493 WriteLn('insert');
494 Database.Query(sql);
495 end;
496 except
497 on E: EIdHTTPProtocolException do
498 begin
499 if E.ErrorCode = 404 then begin
500 foundtext := false;
501 WriteLn('notfound');
502 end;
503 end;
504 on E:Exception do
505 // GetText(Id,TextType);
506 end;
507end;
508
509function TWoWHeadLoader.GetMaxID(TextType: string): integer;
510var
511 data,cr:string;
512 maxid:integer=1000; //34000 pro questy
513begin
514// http://www.wowhead.com/quests?filter=cr=30;crs=1;crv=34000
515 if (TextType = 'quest') then begin
516 maxid := 34000;
517 cr := '30';
518 end;
519 if (TextType = 'npc') then begin
520 //http://www.wowhead.com/npcs?filter=cr=37;crs=1;crv=10000
521 maxid := 74000;
522 cr := '37';
523 end;
524 if (TextType = 'achievement') then begin
525 //http://www.wowhead.com/achievements?filter=cr=9;crs=1;crv=8000
526 maxid := 8000;
527 cr := '9';
528 end;
529 if (TextType = 'object') then begin
530 //http://www.wowhead.com/objects?filter=cr=15;crs=1;crv=230000
531 maxid := 230000;
532 cr := '15';
533 end;
534 if (TextType = 'item') then begin
535 //http://www.wowhead.com/items?filter=cr=151;crs=1;crv=106000
536 maxid := 106000;
537 cr := '151';
538 end;
539 if (TextType = 'zone') then begin
540 maxid := 10000;
541 result := maxid;
542 Exit;
543 cr := '30';
544 end;
545 result := maxid;
546 try
547 repeat
548 data := IdHTTP1.Get('http://www.wowhead.com/'+TextType+'s?filter=cr='+cr+';crs=1;crv='+IntToStr(maxid));
549 result := maxid;
550 WriteLn(TextType+'s MaxID='+IntToStr(maxid));
551 maxid := maxid+400;
552 until (Pos('Your criteria did not match',data) > 0);
553 except
554 on E: EIdHTTPProtocolException do
555 begin
556 if E.ErrorCode = 404 then begin
557 end;
558 end;
559 on E:Exception do
560 end;
561end;
562
563function TWoWHeadLoader.GetLastVersion: integer;
564var
565 DBRows: TDbRows;
566begin
567 //TODO: automaticky zjišťovat verze http://www.wowwiki.com/Patch_5.4.0
568 DBRows := Database.Query('SELECT * FROM ClientVersion WHERE `Title` != "" ORDER BY `ClientVersion`.`BuildNumber` DESC LIMIT 0 , 30');
569 Result := StrToInt(DBRows.Data[0].Values['BuildNumber']);
570 Database.Query('UPDATE `ClientVersion` SET `Imported` = 1 WHERE `clientversion`.`BuildNumber` ='+DBRows.Data[0].Values['BuildNumber']+';');
571end;
572
573function TWoWHeadLoader.skipto(part: string; text: string): string;
574begin
575 if (Pos(part,text) > 0) then
576 Result := Copy(text,Pos(part,text)+Length(part),Length(text))
577 else
578 Result := Copy(text,Pos(part,text),Length(text))
579end;
580
581function TWoWHeadLoader.GetPartText(textname: string; text: string): string;
582begin
583 text := skipto('>'+textname+'<',text);
584 text := skipto('-'+textname+'"',text);
585 text := skipto('>',text);
586
587 text := StringReplace(text,'<br />','$B',[rfReplaceAll, rfIgnoreCase]);
588 text := StringReplace(text,'<br>','$B',[rfReplaceAll, rfIgnoreCase]);
589
590 Result := Copy(text,0,Pos('<',text)-1);
591
592
593// if ((Copy(Result,0,1) = chr(10)) or (Copy(Result,0,1) = chr(13)) or (Copy(Result,0,1) = ' ') )then
594// Result := Copy(Result,1,Length(Result));
595// if ((Copy(Result,0,1) = chr(10)) or (Copy(Result,0,1) = chr(13)) or (Copy(Result,0,1) = ' ')) then
596// Result := Copy(Result,1,Length(Result));
597
598end;
599
600function TWoWHeadLoader.TextStringReplace(text: string): string;
601var
602 part,part2: string;
603begin
604 text := StringReplace(text,'<br />','$B',[rfReplaceAll, rfIgnoreCase]);
605 text := StringReplace(text,'<br>','$B',[rfReplaceAll, rfIgnoreCase]);
606 text := StringReplace(text,'&nbsp;',' ',[rfReplaceAll, rfIgnoreCase]);
607 text := StringReplace(text,'&amp;','&',[rfReplaceAll, rfIgnoreCase]);
608 text := StringReplace(text,'&#039;',chr(39),[rfReplaceAll, rfIgnoreCase]);
609 text := StringReplace(text,'&lt;name&gt;','$N',[rfReplaceAll, rfIgnoreCase]);
610 text := StringReplace(text,'&lt;class&gt;','$C',[rfReplaceAll, rfIgnoreCase]);
611 text := StringReplace(text,'&lt;race&gt;','$R',[rfReplaceAll, rfIgnoreCase]);
612 // text := StringReplace(text,'&lt;name&gt;','$G',[rfReplaceAll, rfIgnoreCase]);
613 //&lt;good sir/my lady&gt;
614 repeat
615 part := Copy(text,Pos('&lt;',text),Pos('&gt;',text)-Pos('&lt;',text));
616 if (part <> '') then begin
617 if (Pos('/',part) > 0) then begin
618 part2 := '$G'+Copy(part,5,Pos('/',part)-5)+':'+Copy(part,Pos('/',part)+1,Length(part))+';';
619 text := StringReplace(text,part+'&gt;',part2,[rfReplaceAll, rfIgnoreCase]);
620 end;
621 text := StringReplace(text,'&lt;','<',[rfIgnoreCase]);
622 text := StringReplace(text,'&gt;','>',[rfIgnoreCase]);
623 end;
624 until not (Pos('&lt;',text) > 0);
625
626
627 text := StringReplace(text,'&lt;','<',[rfReplaceAll, rfIgnoreCase]);
628 text := StringReplace(text,'&gt;','>',[rfReplaceAll, rfIgnoreCase]);
629 text := StringReplace(text,'&quot;','"',[rfReplaceAll, rfIgnoreCase]);
630 Result := text;
631
632 while ((Copy(Result,0,1) = chr(10)) or (Copy(Result,0,1) = chr(13)) or (Copy(Result,0,1) = ' ')) do begin
633 Result := Copy(Result,2,Length(Result));
634 end;
635 while ((Copy(Result,Length(Result),Length(Result)-1) = chr(10)) or (Copy(Result,Length(Result),Length(Result)-1) = chr(13)) or (Copy(Result,Length(Result),Length(Result)-1) = ' ')) do begin
636 Result := Copy(Result,0,Length(Result)-1);
637 end;
638
639end;
640
641function TWoWHeadLoader.CompareStrings(textdb: string; textimport: string): boolean;
642var
643 part,data :string;
644begin
645 textdb:=DelHtmlTags(LowerCase(textdb));
646 textdb := StringReplace(textdb,'s'+chr(39)+'s','',[rfReplaceAll, rfIgnoreCase]);
647 textdb := StringReplace(textdb,'s'+chr(39),'',[rfReplaceAll, rfIgnoreCase]);
648 textdb := StringReplace(textdb,chr(39)+'s','',[rfReplaceAll, rfIgnoreCase]);
649 textdb := StringReplace(textdb,chr(39),'',[rfReplaceAll, rfIgnoreCase]);
650
651 textdb := StringReplace(textdb,' ','',[rfReplaceAll, rfIgnoreCase]);
652 textdb := StringReplace(textdb,',','',[rfReplaceAll, rfIgnoreCase]);
653 textdb := StringReplace(textdb,'.','',[rfReplaceAll, rfIgnoreCase]);
654 textdb := StringReplace(textdb,chr(10),'',[rfReplaceAll, rfIgnoreCase]);
655 textdb := StringReplace(textdb,chr(13),'',[rfReplaceAll, rfIgnoreCase]);
656 textdb := StringReplace(textdb,'$b','',[rfReplaceAll, rfIgnoreCase]);
657
658 textimport:=DelHtmlTags(LowerCase(textimport));
659 textimport := StringReplace(textimport,'s'+chr(39)+'s','',[rfReplaceAll, rfIgnoreCase]);
660 textimport := StringReplace(textimport,'s'+chr(39),'',[rfReplaceAll, rfIgnoreCase]);
661 textimport := StringReplace(textimport,chr(39)+'s','',[rfReplaceAll, rfIgnoreCase]);
662 textimport := StringReplace(textimport,chr(39),'',[rfReplaceAll, rfIgnoreCase]);
663
664 textimport := StringReplace(textimport,' ','',[rfReplaceAll, rfIgnoreCase]);
665 textimport := StringReplace(textimport,',','',[rfReplaceAll, rfIgnoreCase]);
666 textimport := StringReplace(textimport,'.','',[rfReplaceAll, rfIgnoreCase]);
667 textimport := StringReplace(textimport,chr(10),'',[rfReplaceAll, rfIgnoreCase]);
668 textimport := StringReplace(textimport,chr(13),'',[rfReplaceAll, rfIgnoreCase]);
669 textimport := StringReplace(textimport,'$b','',[rfReplaceAll, rfIgnoreCase]);
670 if ((textdb = textimport) or ( (textdb <> '') and (textimport = '') )) then Result := true
671 else begin
672 //zkusím rozgenerovat $g nejdřív podle prvního
673 data:=textdb;
674 while (Pos('$g',data)> 0) do begin
675 part := skipto('$g',data);
676 part := '$g'+Copy(part,0,Pos(';',part));
677 data := StringReplace(data,part,Copy(part,3,Pos(':',part)-3),[rfReplaceAll, rfIgnoreCase]);
678 end;
679 if (data = textimport) then
680 Result := true else begin
681 data:=textdb;
682 while (Pos('$g',data)> 0) do begin
683 part := skipto('$g',data);
684 part := '$g'+Copy(part,0,Pos(';',part));
685 data := StringReplace(data,part,Copy(part,Pos(':',part)+1,Length(part)-1-Pos(':',part)),[rfReplaceAll, rfIgnoreCase]);
686 end;
687 if (data = textimport) then
688 Result := true else begin
689 Result:=false;
690 WriteLn('db: '+textdb);
691 WriteLn('in: '+textimport);
692 end;
693 end;
694 end;
695end;
696
697function TWoWHeadLoader.DelHtmlTags(text: string): string;
698begin
699 while ((Result = '') and (text <> '')) do begin
700 if (Pos('<',text) <> 0) then begin
701 text := StringReplace(text,Copy(text,Pos('<',text),Pos('>',text)-Pos('<',text)+1),'',[rfReplaceAll, rfIgnoreCase]);
702 Result := Copy(text,0,Pos('<',text)-1);
703
704 end else Result := text;
705 end;
706 // Result := text;
707end;
708
709function TWoWHeadLoader.SqlPre(text: string): string;
710begin
711 text := StringReplace(text,'"','\"',[rfReplaceAll, rfIgnoreCase]);
712 text := StringReplace(text,chr(39),'\'+chr(39),[rfReplaceAll, rfIgnoreCase]);
713 Result := chr(39)+text+chr(39);
714end;
715
716procedure TWoWHeadLoader.UpdateTranslated(table: string);
717var
718 i:integer;
719 DBRows : TDbRows;
720begin
721 {
722 global $TranslationTree, $PatchVersion, $Config;
723
724 $Output = '<br /><br />Začínám se synchronizací VersionEnd u přeložených textů<br />';
725 foreach($TranslationTree as $Group)
726 {
727 $Output .= '<br />'.$Group['Name'].' ';
728 $DbResult = $this->System->Database->query('SELECT `gs_tran`.`ID`, '.
729 '`gs_tran`.`VersionEnd` AS `VersionEnd_tran`, '.
730 '`gs_orig`.`VersionEnd` AS `VersionEnd_orig` FROM `'.
731 $Group['TablePrefix'].'` AS `gs_tran` JOIN `'.$Group['TablePrefix'].
732 '` AS `gs_orig` ON `gs_orig`.`ID` = `gs_tran`.`Take` WHERE '.
733 '`gs_tran`.`VersionEnd` <> `gs_orig`.`VersionEnd`');
734 while($DbRow = $DbResult->fetch_assoc())
735 {
736 $this->System->Database->query('UPDATE `'.$Group['TablePrefix'].'` SET `VersionEnd` = '.$DbRow['VersionEnd_orig'].' WHERE `ID` = '.$DbRow['ID']);
737 $Output .= '. ';
738 }
739 $Output .= '<strong>Dokončeno.</strong>';
740 }
741 return($Output);
742 }
743 repeat
744 DBRows := Database.Query('SELECT `gs_tran`.`ID` , `gs_tran`.`VersionEnd` AS `VersionEnd_tran` ,'
745 +'`gs_orig`.`VersionEnd` AS `VersionEnd_orig`'
746 +' FROM `'+table+'` AS `gs_tran` JOIN `'+table+'` AS `gs_orig` ON `gs_orig`.`ID` = `gs_tran`.`Take`'
747 +'WHERE `gs_tran`.`VersionEnd` <> `gs_orig`.`VersionEnd` ');
748 for i:=0 to DBRows.Count-1 do begin
749 Database.Query('UPDATE `'+table+'` SET `VersionEnd` = '+DBRows.Data[i].Values['VersionEnd_orig']+' WHERE `ID` = '+DBRows.Data[i].Values['ID']);
750 end;
751 until (DBRows.Count = 0);
752
753end;
754
755function TWoWHeadLoader.GetEndtextData(data: string): string;
756var
757 i:integer;
758begin
759 data := skipto('<table class="iconlist">',data);
760 //mazání podsupin u objektů questu
761 for i:=0 to 4 do begin
762 if (0 < Pos('<div id="npcgroup-',data)) then begin
763 data := StringReplace(data,'<div','#@{',[rfIgnoreCase]);
764 while (Pos('<div',data) < Pos('</div',data)) and (Pos('<div',data) >0) do begin
765 data := StringReplace(data,'</div','',[rfIgnoreCase]);
766 data := StringReplace(data,'<div','',[rfIgnoreCase]);
767 end;
768 data := Copy(data,0,Pos('#@{',data))+Copy(data,Pos('</div',data),Length(data));
769 data := StringReplace(data,'</div','',[rfIgnoreCase]);
770 end;
771 end;
772// WriteLn(Copy(data,0,Pos('</table',data)));
773 if (skipto('<table class="iconlist">',data) <> data) then
774 data := Copy(data,0,Pos('</table',data))+skipto('<table class="iconlist">',data);
775// WriteLn(Copy(data,0,Pos('</table',data)));
776 //writeln(data);
777 //mazání podsupin u objektů questu
778 for i:=0 to 4 do begin
779 if (0 < Pos('<div id="npcgroup-',data)) then begin
780 data := StringReplace(data,'<div','#@{',[rfIgnoreCase]);
781 while (Pos('<div',data) < Pos('</div',data)) and (Pos('<div',data) >0) do begin
782 data := StringReplace(data,'</div','',[rfIgnoreCase]);
783 data := StringReplace(data,'<div','',[rfIgnoreCase]);
784 end;
785 data := Copy(data,0,Pos('#@{',data))+Copy(data,Pos('</div',data),Length(data));
786 data := StringReplace(data,'</div','',[rfIgnoreCase]);
787 end;
788 end;
789 data := Copy(data,0,Pos('</table',data));
790 Result:=data;
791end;
792
793var
794 Application: TWoWHeadLoader;
795begin
796 Application:=TWoWHeadLoader.Create(nil);
797 Application.Run;
798 Application.Free;
799end.
800
Note: See TracBrowser for help on using the repository browser.