source: trunk/ImportZWebu.pas

unit ImportZWebu;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, ComCtrls, StdCtrls, ImgList, ExtCtrls, Menus, ShellApi, Registry;

type
  TForm8 = class(TForm)
    ListView1: TListView;
    IdHTTP1: TIdHTTP;
    ImageList16default: TImageList;
    PopupMenu1: TPopupMenu;
    Registrovat1: TMenuItem;
    ZobrazitWeb1: TMenuItem;
    Pidat1: TMenuItem;
    procedure Pidat1Click(Sender: TObject);
    procedure Registrovat1Click(Sender: TObject);
    procedure ZobrazitWeb1Click(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    //regisry
    procedure SaveCountRegServers;
    procedure LoadCountRegServers;

    procedure WriteServers(Addres: string);
    procedure WriteServersWoWStatus(Addres: string);
    procedure AddServer;
  end;

var
  Form8: TForm8;
  //akční proměné
  EndLoadingBool: Boolean;
  //nastavení
  CountWoWStatusServers: Integer = 1132;
  CountWoWResourceServers: integer = 34;

implementation

uses Loading, Add, Main;

{$R *.dfm}

procedure TForm8.WriteServers(Addres: string);
var
  Data, DataURL: string;
  URL, RegistrationURL, WebURL, NameServer, xp, Patch, Typ, Players, Online,
  EndLoading: string;
begin
  Application.ProcessMessages;

  Data := IdHTTP1.Get(Addres);
  Delete(Data,1,POS('<table',Data)+10);
  Delete(Data,1,POS('<table',Data)-3);

repeat
  Delete(Data,1,POS('href="',Data)+5);
  URL := copy(Data,1,pos('">',Data)-1);
  Delete(Data,1,pos('"',Data)+1);
  NameServer := copy(Data,1,pos('<',Data)-1);

  Delete(Data,1,POS('<td>',Data)+3);
 // xp := copy(Data,1,pos('<',Data)-1);

  Delete(Data,1,POS('<td>',Data)+3);
  Patch := copy(Data,1,pos('<',Data)-1);

  Delete(Data,1,POS('<td>',Data)+3);
  Typ := copy(Data,1,pos('<',Data)-1);

  Delete(Data,1,POS('<td>',Data)+3);
  xp := copy(Data,1,pos('<',Data)-1);

  Delete(Data,1,POS('<td>',Data)+3);
  Players := copy(Data,1,pos('<',Data)-1);

  Delete(Data,1,POS('<td>',Data)+3);
  Online := copy(Data,1,pos('<',Data)-1);

  Delete(Data,1,POS('</tr>',Data)+4);
  Delete(Data,1,POS('<',Data)-1);
  EndLoading := copy(Data,1,8);
  //adresa  onlinehráčů, webu

  DataURL := IdHTTP1.Get(URL);
  Delete(DataURL,1,POS('<strong>Web</strong>',DataURL));
  Delete(DataURL,1,POS('href="',DataURL)+5);
  WebURL := copy(DataURL,1,pos('"',DataURL)-1);

  Delete(DataURL,1,POS('<strong>Registrace</strong>',DataURL));
  Delete(DataURL,1,POS('href="',DataURL)+5);
  RegistrationURL := copy(DataURL,1,pos('"',DataURL)-1);



  with ListView1.Items.Add do begin
    Caption := NameServer;
    SubItems.Add(Players);
    SubItems.Add('');
    SubItems.Add(Patch);
    SubItems.Add(xp);
    SubItems.Add(Online);
    SubItems.Add(WebURL);
    SubItems.Add(RegistrationURL);
  end;
  Form9.Gauge1.Progress := Form9.Gauge1.Progress+1;
 // if Form9.Showing = False then Form9.Show;
  Application.ProcessMessages;
  until ('</table>' = EndLoading) or (EndLoading = '') or (EndLoadingBool = True);
   //   ListView1.Items.Add.SubItems.Add(News[i].Text);
     // ListView1.Items.Add.ImageIndex := News[i].Read;


 // Form8.Caption := Data;
//  Memo1.Text := Data;
end;

procedure TForm8.Pidat1Click(Sender: TObject);
begin
  AddServer;
end;

procedure TForm8.Registrovat1Click(Sender: TObject);
begin
  if Assigned(ListView1.Selected) then begin
    ShellExecute(Application.Handle, 'open', PChar(ListView1.Selected.SubItems[6]), nil, nil, SW_NORMAL);
  end;
end;

procedure TForm8.ZobrazitWeb1Click(Sender: TObject);
begin
  if Assigned(ListView1.Selected) then begin
    ShellExecute(Application.Handle, 'open', PChar(ListView1.Selected.SubItems[5]), nil, nil, SW_NORMAL);
  end;
end;

procedure TForm8.ListView1DblClick(Sender: TObject);
begin
  AddServer;
end;

procedure TForm8.AddServer;
begin
  if Assigned(ListView1.Selected) then begin
    Form4.Edit1.Text := ListView1.Selected.Caption;
    Form4.Edit2.Text := ListView1.Selected.SubItems[1];  //není na stránkách
    Form4.Edit3.Text := Form1.GetWoWExeFile;

    Form4.Memo1.Text := 'Maximální počet hráčů: '+ListView1.Selected.SubItems[0];
    Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Patch: '+ListView1.Selected.SubItems[2];
    Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'xprate: '+ListView1.Selected.SubItems[3];
    Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Online: '+ListView1.Selected.SubItems[4];
    Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Web: '+ListView1.Selected.SubItems[5];
    Form4.Memo1.Text := Form4.Memo1.Text+chr(13)+chr(10)+'Registrace web: '+ListView1.Selected.SubItems[6];

    ServerIndex := -1;
    Form4.Show;
  end;
end;

procedure TForm8.ListView1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  MousePos: TPoint;
begin
  if Assigned(ListView1.GetItemAt(x,y)) and (Button = mbRight) then begin
    GetCursorPos(MousePos);
    PopupMenu1.Popup(MousePos.X,MousePos.y);
  end;
end;

procedure TForm8.WriteServersWoWStatus(Addres: string);
var
  Data: string;
  WebURL, NameServer, xp, Patch, Online, Reamlist,
  EndLoading: string;
begin
  Form9.Gauge1.Progress := 20;
  Application.ProcessMessages;
  Data := IdHTTP1.Get(Addres);
  Form9.Gauge1.Progress := 80;
  Application.ProcessMessages;

//  Delete(Data,1,POS('<table',Data)+10);
  Delete(Data,1,POS('Status*',Data)-3);
repeat
  Delete(Data,1,POS('href="',Data)+5);
  Delete(Data,1,pos('"',Data)+1);
  NameServer := copy(Data,1,pos('<',Data)-1);

  Delete(Data,1,POS('<td',Data)+4);
  Patch := copy(Data,1,pos('<',Data)-1);

  //skip information
  Delete(Data,1,POS('<td',Data)+3);
  Delete(Data,1,POS('<td',Data)+3);

  Delete(Data,1,POS('<td',Data)+4);
  xp := copy(Data,1,pos('<',Data)-1);

  Delete(Data,1,POS('href="',Data)+11);
  Reamlist := copy(Data,1,pos('"',Data)-1);

  Delete(Data,1,POS('href="',Data)+5);
  WebURL := copy(Data,1,pos('"',Data)-1);

  Delete(Data,1,POS('<td',Data)+3);
  Delete(Data,1,POS('<td',Data)+3);
  Delete(Data,1,POS('<td',Data)+18);
  Online := copy(Data,1,pos('<',Data)-1);

//  Delete(Data,1,POS('<td>',Data)+19);
//  Players := copy(Data,1,pos('<',Data)-1);


  Delete(Data,1,POS('</tr>',Data)+4);
  Delete(Data,1,POS('<',Data)-1);
  EndLoading := copy(Data,1,8);



  with ListView1.Items.Add do begin
    Caption := NameServer;
    SubItems.Add('');
    SubItems.Add(Reamlist);
    SubItems.Add(Patch);
    SubItems.Add(xp);
    SubItems.Add(Online);
    SubItems.Add(WebURL);
    SubItems.Add(WebURL);
  end;
  Form9.Gauge1.Progress := Form9.Gauge1.Progress+1;
 // if Form9.Showing = False then Form9.Show;
  Application.ProcessMessages;
  until ('</table>' = EndLoading) or (EndLoading = '') or (EndLoadingBool = True);
end;

procedure TForm8.LoadCountRegServers;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    // načítání pozice formuláře
    if Reg.OpenKey(R + 'CountSerers', False) then begin
      CountWoWStatusServers := Reg.ReadInteger('WoWStatus');
      CountWoWResourceServers := Reg.ReadInteger('WoWResource');
    end;
  finally
    Reg.Free;
  end;
end;

procedure TForm8.SaveCountRegServers;
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  try
    // načítání pozice formuláře
    if Reg.OpenKey(R + 'CountSerers', True) then begin
      Reg.WriteInteger('WoWStatus', CountWoWStatusServers);
      Reg.WriteInteger('WoWResource', CountWoWResourceServers);
    end;
  finally
    Reg.Free;
  end;
end;

end.