source: tags/3.3/ImportZWebu.pas

Last change on this file was 6, checked in by george, 16 years ago
  • Přesunuto: Hlavní vývojová větev přesunuta do podsložky trunk.
File size: 7.8 KB
Line 
1unit ImportZWebu;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
8 IdHTTP, ComCtrls, StdCtrls, ImgList, ExtCtrls, Menus, ShellApi, Registry;
9
10type
11 TForm8 = class(TForm)
12 ListView1: TListView;
13 IdHTTP1: TIdHTTP;
14 ImageList16default: TImageList;
15 PopupMenu1: TPopupMenu;
16 Registrovat1: TMenuItem;
17 ZobrazitWeb1: TMenuItem;
18 Pidat1: TMenuItem;
19 procedure Pidat1Click(Sender: TObject);
20 procedure Registrovat1Click(Sender: TObject);
21 procedure ZobrazitWeb1Click(Sender: TObject);
22 procedure ListView1DblClick(Sender: TObject);
23 procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
24 Shift: TShiftState; X, Y: Integer);
25 private
26 { Private declarations }
27 public
28 { Public declarations }
29 //regisry
30 procedure SaveCountRegServers;
31 procedure LoadCountRegServers;
32
33 procedure WriteServers(Addres: string);
34 procedure WriteServersWoWStatus(Addres: string);
35 procedure AddServer;
36 end;
37
38var
39 Form8: TForm8;
40 //akční proměné
41 EndLoadingBool: Boolean;
42 //nastavení
43 CountWoWStatusServers: Integer = 1132;
44 CountWoWResourceServers: integer = 34;
45
46implementation
47
48uses Loading, Add, Main;
49
50{$R *.dfm}
51
52procedure TForm8.WriteServers(Addres: string);
53var
54 Data, DataURL: string;
55 URL, RegistrationURL, WebURL, NameServer, xp, Patch, Typ, Players, Online,
56 EndLoading: string;
57begin
58 Application.ProcessMessages;
59
60 Data := IdHTTP1.Get(Addres);
61 Delete(Data,1,POS('<table',Data)+10);
62 Delete(Data,1,POS('<table',Data)-3);
63
64repeat
65 Delete(Data,1,POS('href="',Data)+5);
66 URL := copy(Data,1,pos('">',Data)-1);
67 Delete(Data,1,pos('"',Data)+1);
68 NameServer := copy(Data,1,pos('<',Data)-1);
69
70 Delete(Data,1,POS('<td>',Data)+3);
71 // xp := copy(Data,1,pos('<',Data)-1);
72
73 Delete(Data,1,POS('<td>',Data)+3);
74 Patch := copy(Data,1,pos('<',Data)-1);
75
76 Delete(Data,1,POS('<td>',Data)+3);
77 Typ := copy(Data,1,pos('<',Data)-1);
78
79 Delete(Data,1,POS('<td>',Data)+3);
80 xp := copy(Data,1,pos('<',Data)-1);
81
82 Delete(Data,1,POS('<td>',Data)+3);
83 Players := copy(Data,1,pos('<',Data)-1);
84
85 Delete(Data,1,POS('<td>',Data)+3);
86 Online := copy(Data,1,pos('<',Data)-1);
87
88 Delete(Data,1,POS('</tr>',Data)+4);
89 Delete(Data,1,POS('<',Data)-1);
90 EndLoading := copy(Data,1,8);
91 //adresa onlinehráčů, webu
92
93 DataURL := IdHTTP1.Get(URL);
94 Delete(DataURL,1,POS('<strong>Web</strong>',DataURL));
95 Delete(DataURL,1,POS('href="',DataURL)+5);
96 WebURL := copy(DataURL,1,pos('"',DataURL)-1);
97
98 Delete(DataURL,1,POS('<strong>Registrace</strong>',DataURL));
99 Delete(DataURL,1,POS('href="',DataURL)+5);
100 RegistrationURL := copy(DataURL,1,pos('"',DataURL)-1);
101
102
103
104 with ListView1.Items.Add do begin
105 Caption := NameServer;
106 SubItems.Add(Players);
107 SubItems.Add('');
108 SubItems.Add(Patch);
109 SubItems.Add(xp);
110 SubItems.Add(Online);
111 SubItems.Add(WebURL);
112 SubItems.Add(RegistrationURL);
113 end;
114 Form9.Gauge1.Progress := Form9.Gauge1.Progress+1;
115 // if Form9.Showing = False then Form9.Show;
116 Application.ProcessMessages;
117 until ('</table>' = EndLoading) or (EndLoading = '') or (EndLoadingBool = True);
118 // ListView1.Items.Add.SubItems.Add(News[i].Text);
119 // ListView1.Items.Add.ImageIndex := News[i].Read;
120
121
122 // Form8.Caption := Data;
123// Memo1.Text := Data;
124end;
125
126procedure TForm8.Pidat1Click(Sender: TObject);
127begin
128 AddServer;
129end;
130
131procedure TForm8.Registrovat1Click(Sender: TObject);
132begin
133 if Assigned(ListView1.Selected) then begin
134 ShellExecute(Application.Handle, 'open', PChar(ListView1.Selected.SubItems[6]), nil, nil, SW_NORMAL);
135 end;
136end;
137
138procedure TForm8.ZobrazitWeb1Click(Sender: TObject);
139begin
140 if Assigned(ListView1.Selected) then begin
141 ShellExecute(Application.Handle, 'open', PChar(ListView1.Selected.SubItems[5]), nil, nil, SW_NORMAL);
142 end;
143end;
144
145procedure TForm8.ListView1DblClick(Sender: TObject);
146begin
147 AddServer;
148end;
149
150procedure TForm8.AddServer;
151begin
152 if Assigned(ListView1.Selected) then begin
153 Form4.Edit1.Text := ListView1.Selected.Caption;
154 Form4.Edit2.Text := ListView1.Selected.SubItems[1]; //není na stránkách
155 Form4.Edit3.Text := Form1.GetWoWExeFile;
156
157 Form4.Memo1.Text := 'Maximální počet hráčů: '+ListView1.Selected.SubItems[0];
158 Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Patch: '+ListView1.Selected.SubItems[2];
159 Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'xprate: '+ListView1.Selected.SubItems[3];
160 Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Online: '+ListView1.Selected.SubItems[4];
161 Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Web: '+ListView1.Selected.SubItems[5];
162 Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Registrace web: '+ListView1.Selected.SubItems[6];
163
164 ServerIndex := -1;
165 Form4.Show;
166 end;
167end;
168
169procedure TForm8.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
170 Shift: TShiftState; X, Y: Integer);
171var
172 MousePos: TPoint;
173begin
174 if Assigned(ListView1.GetItemAt(x,y)) and (Button = mbRight) then begin
175 GetCursorPos(MousePos);
176 PopupMenu1.Popup(MousePos.X,MousePos.y);
177 end;
178end;
179
180procedure TForm8.WriteServersWoWStatus(Addres: string);
181var
182 Data: string;
183 WebURL, NameServer, xp, Patch, Online, Reamlist,
184 EndLoading: string;
185begin
186 Form9.Gauge1.Progress := 20;
187 Application.ProcessMessages;
188 Data := IdHTTP1.Get(Addres);
189 Form9.Gauge1.Progress := 80;
190 Application.ProcessMessages;
191
192// Delete(Data,1,POS('<table',Data)+10);
193 Delete(Data,1,POS('Status*',Data)-3);
194repeat
195 Delete(Data,1,POS('href="',Data)+5);
196 Delete(Data,1,pos('"',Data)+1);
197 NameServer := copy(Data,1,pos('<',Data)-1);
198
199 Delete(Data,1,POS('<td',Data)+4);
200 Patch := copy(Data,1,pos('<',Data)-1);
201
202 //skip information
203 Delete(Data,1,POS('<td',Data)+3);
204 Delete(Data,1,POS('<td',Data)+3);
205
206 Delete(Data,1,POS('<td',Data)+4);
207 xp := copy(Data,1,pos('<',Data)-1);
208
209 Delete(Data,1,POS('href="',Data)+11);
210 Reamlist := copy(Data,1,pos('"',Data)-1);
211
212 Delete(Data,1,POS('href="',Data)+5);
213 WebURL := copy(Data,1,pos('"',Data)-1);
214
215 Delete(Data,1,POS('<td',Data)+3);
216 Delete(Data,1,POS('<td',Data)+3);
217 Delete(Data,1,POS('<td',Data)+18);
218 Online := copy(Data,1,pos('<',Data)-1);
219
220// Delete(Data,1,POS('<td>',Data)+19);
221// Players := copy(Data,1,pos('<',Data)-1);
222
223
224 Delete(Data,1,POS('</tr>',Data)+4);
225 Delete(Data,1,POS('<',Data)-1);
226 EndLoading := copy(Data,1,8);
227
228
229
230 with ListView1.Items.Add do begin
231 Caption := NameServer;
232 SubItems.Add('');
233 SubItems.Add(Reamlist);
234 SubItems.Add(Patch);
235 SubItems.Add(xp);
236 SubItems.Add(Online);
237 SubItems.Add(WebURL);
238 SubItems.Add(WebURL);
239 end;
240 Form9.Gauge1.Progress := Form9.Gauge1.Progress+1;
241 // if Form9.Showing = False then Form9.Show;
242 Application.ProcessMessages;
243 until ('</table>' = EndLoading) or (EndLoading = '') or (EndLoadingBool = True);
244end;
245
246procedure TForm8.LoadCountRegServers;
247var
248 reg: TRegistry;
249begin
250 Reg := TRegistry.Create;
251 try
252 // načítání pozice formuláře
253 if Reg.OpenKey(R+'CountSerers', False) then begin
254 CountWoWStatusServers := Reg.ReadInteger('WoWStatus');
255 CountWoWResourceServers := Reg.ReadInteger('WoWResource');
256 end;
257 finally
258 reg.Free;
259 end;
260end;
261
262procedure TForm8.SaveCountRegServers;
263var
264 reg: TRegistry;
265begin
266 Reg := TRegistry.Create;
267 Reg.RootKey := HKEY_CURRENT_USER;
268 try
269 // načítání pozice formuláře
270 if Reg.OpenKey(R+'CountSerers', True) then begin
271 Reg.WriteInteger('WoWStatus',CountWoWStatusServers);
272 Reg.WriteInteger('WoWResource',CountWoWResourceServers);
273 end;
274 finally
275 reg.Free;
276 end;
277end;
278
279end.
Note: See TracBrowser for help on using the repository browser.