TOP MEMBRES CODES-SOURCES

unit UTopMembersMainForm;

interface

uses
  shellapi, strman, inet, HyperParse, Windows, Messages, SysUtils, Variants,
  Classes, Graphics, Controls, Forms,
  Dialogs, Menus, UnPas2, XPMan, ComCtrls, ExtCtrls, StdCtrls, ImgList;

type
  TTopMembersForm = class(TForm)
    lvMembers: TListView;
    PopupMenu: TPopupMenu;
    XPManifest1: TXPManifest;
    UnPas21: TUnPas2;
    pop_profil: TMenuItem;
    pop_ecrire: TMenuItem;
    pop_msgsite: TMenuItem;
    pop_voirtout: TMenuItem;
    pop_voirsourcessite: TMenuItem;
    pop_voirtssources: TMenuItem;
    pop_siteweb: TMenuItem;
    ImagesSites: TImageList;
    rg_top: TRadioGroup;
    bt_find: TButton;
    cb_photo: TCheckBox;
    pnlstatusbar: TPanel;
    pb_load: TProgressBar;
    lblstatus: TLabel;
    cb: TComboBoxEx;
    procedure bt_findClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure cb_photoClick(Sender: TObject);
    procedure lvMembersClick(Sender: TObject);
    procedure GoToDetails(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PopupMenuPopup(Sender: TObject);
  private
    { Site choisi ds la liste}
    Site: string;
    { Liste de chaines contenant les membres}
    MembersList: TStringList;
    { si on choisit le Site "codes sources" il y a une ligne en moins
    par utilisateur donc on utilise un Offset}
    Offset: integer;
    procedure GetMembers;
    { Ouvre la page web à l'url reçue en paramètre}
    procedure Go(const Url: string);
    { Actualise la barre de statut}
    procedure Loader(Max: Word; const Status: string);
  end;

var
  TopMembersForm: TTopMembersForm;

implementation

uses USnapshotForm;

{$R *.dfm}
type
  THtmlParser = THyperParse;

const // création du tableau des hôtes, 17 sites, maxi 13 caractères
  Hosts: array[0..17] of string[13] =
  ('codes-sources', 'aspfr', 'asmfr',
    'cppfrance', 'csharpfr', 'cfmfrance',
    'delphifr', 'flashkod', 'foxprofr',
    'graphfr', 'ircfr', 'javafr',
    'javascriptfr', 'pdafr', 'phpcs',
    'pythonfrance', 'sqlfr', 'vbfrance');

  sUrlPhoto = 'http://www.codes-sources.com/userphoto.aspx?ID=%s&normal=1';

procedure TTopMembersForm.Loader(Max: Word; const Status: string);
begin
  pb_load.position := 0;
  pb_load.Max := Max;
  lblStatus.Caption := Status;
end;

procedure TTopMembersForm.GetMembers;
var
  MemberItem: TListItem;
  Parser: THtmlParser;
  // la requête et le retour (resultat) de la requete, utilisé par Inet.pas
  squery, sreturn: string;
  // i : index de boucle
  i: integer;
  // TotalCS : position de la ligne "Total CodeS-SourceS" ds le Tstring,
  TotalCS: integer;
  // TotalCsSem : idem pour "... cette semaine"
  TotalCSsem: integer;
  // pub : idem pour la ligne "Pub",
  Pub: integer;
  // nb: sert a passer des lignes lors de l'ajout de membres
  nb: integer;
  // Listes de chaines pour les 2 tops
  slLastMonth, slLastWeek: TStringList;
const
  FileName = 'members.dat';
begin
  // page contenant les données des tops membres
  sQuery := 'topmembres.aspx';
  // requete http envoyée par inet.pas
  sReturn :=
    SendData(format('www.%s.com', [Hosts[cb.itemindex]]), '', sQuery, '');
  // si le retour (resultat) de la requete n'est pas vide, alors ...
  if sreturn <> '' then
  begin
    // effacer le contenu de la liste des membres
    lvMembers.Clear;
    // initialiser les variables
    TotalCS := 0;
    TotalCSsem := 0;
    Pub := 0;
    Nb := 0;
    slLastMonth := TStringList.Create;
    try
      slLastWeek := TStringList.Create;
      try
        // ajouter le retour ds le slLastMonth
        slLastMonth.Add(sReturn);
        // sauver ds un fichier pour le Parser
        slLastMonth.SaveToFile(FileName);
        // vider le slLastMonth
        slLastMonth.Clear;

        Parser := THtmlParser.Create;
        try
          // si le fichier n'existe pas (ce qui me semble pas logique)
          if not FileExists(FileName) then
          begin
            MessageDlg('Problème de lecture de fichier ...', mtError,
              [mbOk], 0);
            // et on ferme l'application
            Close;
          end;
          // choix du fichier pour le parser
          Parser.FileName := FileName;

          Parser.Execute;
          Loader(parser.Count - 1, 'Tri des infos reçues');
          { j'ajoute dans mon TS le texte de la page html, je ne prends
           pas les <tags> ni les lignes vides}
          for i := 0 to parser.count - 1 do
          begin
            // je ne garde qu'un seul TAG, celui qui contient le n° du membre
            if sm.strip(Parser[i].Text) <> EmptyStr then
              if (Parser[i].isTag) then
              begin
                if (pos('a href="auteurdetail.aspx?ID=', Parser[i].Text) > 0)
                  then
                  slLastMonth.add(sm.betweenrev('=', '"', Parser[i].Text));
              end
              else
                slLastMonth.Add(Parser[i].Text);

            pb_load.StepIt;
          end;

          Loader(slLastMonth.Count - 1, 'Traitement des infos');

          // détection des lignes qui délimitent les top membres
          for i := slLastMonth.Count - 1 downto 0 do
          begin
            if slLastMonth.Strings[i] = 'Total CodeS-SourceS cette semaine' then
              TotalCSsem := i
            else if slLastMonth.Strings[i] = 'Total CodeS-SourceS' then
              TotalCS := i
            else if slLastMonth.Strings[i] = 'Pub' then
              Pub := i;

            pb_load.StepIt;
          end;
          // séparation du top membres du mois de celui de la semaine
          for i := TotalCSsem + 1 to pub - 1 do
            slLastWeek.Add(slLastMonth[i]);
          // suppression de tout ce qui se trouve aprés "pub"
          for i := slLastMonth.Count - 1 downto pub do
            slLastMonth.Delete(i);
          // suppression de tout ce qui se trouve avant le top de la semaine
          for i := 0 to TotalCS do
            slLastMonth.Delete(0);
          // détection du top en cours
          if rg_top.ItemIndex = 0 then
            MembersList.Assign(slLastMonth)
          else
            MembersList.Assign(slLastWeek);

          Loader(29, 'Ajout des membres');
          // boucle jusqu'a 29, car il y a 30 membres (29 + l'index 0 = 30)
          for i := 0 to 29 do
          begin
            // ajout du membre
            MemberItem := lvMembers.Items.Add;
            // le caption (ex: #1)
            MemberItem.Caption := MembersList[nb];
            { on incremente deux fois NB pour passer le rang
             et le n° du membre que l'on affiche pas}
            inc(nb, 2);
            // on ajoute le pseudo
            MemberItem.SubItems.Add(MembersList[nb]);
            inc(nb);
            { puis on le passe
             on ajoute le nb de points du Site choisi avec la Combobox}
            MemberItem.SubItems.Add(MembersList[nb]);
            // si on a choisi le top de la semaine ...
            if cb.ItemIndex > 0 then
              // alors on passe la ligne des points
              inc(nb);
            MemberItem.SubItems.Add(MembersList[nb]);
            // puis on ajoute la suivante
            inc(nb);
          end;
        finally
          Parser.Free;
        end;
      finally
        slLastWeek.Free;
      end;
    finally
      slLastMonth.Free;
    end;
  end;
  Loader(0, '= Fin =');
end;

procedure TTopMembersForm.bt_findClick(Sender: TObject);
var
  OldCursor: TCursor;
begin
  // modif de la barre de status
  lblStatus.caption := format('Recherche du %s',
    [rg_top.Items[rg_top.itemindex]]);
  // modif du titre le la form et de l'appli
  Caption := Format('Top Membres Actifs %s', [cb.Items[cb.ItemIndex]]);

  Application.Title := Caption;
  // on garde sous la main le Site choisi
  Site := cb.Items[cb.ItemIndex];
  // modif du titre de la 3eme colonne selon le Site choisi
  lvMembers.Column[2].Caption := format('Pts %s', [Site]);
  // calcul du Offset selon le top choisi
  if cb.ItemIndex = 0 then
    Offset := 4
  else
    Offset := 5;
  // desactive l'appli complete (facultatif)
  Enabled := False;
  // un ptit processmessages pour eviter le "(Ne reponds pas)"
  application.ProcessMessages;
  oldCursor := Screen.Cursor;
  Screen.Cursor := crHourGlass;
  try
    // on lance la procédure de recup
    GetMembers;
  finally
    Screen.Cursor := OldCursor;
    // et on reactive la form
    Enabled := True;
  end;
end;

procedure TTopMembersForm.FormCreate(Sender: TObject);
begin
  cb.ItemIndex := 0;
  MembersList := TStringList.Create;
end;

procedure TTopMembersForm.FormDestroy(Sender: TObject);
begin
  MembersList.Free;
end;

procedure TTopMembersForm.cb_photoClick(Sender: TObject);
var
  s: string;  //juste pour le débogage
begin
  // on affiche ou pas la FormWeb (unit2) que si la case est cochée
  FormWeb.Visible := cb_photo.Checked;
  // si la case est cochée, alors on affiche la photo
  if cb_photo.Checked then
  begin
    FormWeb.Show;
    s := format(sUrlPhoto, [MembersList[lvMembers.ItemIndex * Offset + 1]]);
    FormWeb.web.Navigate(s);
    // Dimensionner FormWeb (unit2) et mettre à coté
    FormWeb.Left := Left + Width + 10;
    FormWeb.top := top;
  end;
end;

procedure TTopMembersForm.lvMembersClick(Sender: TObject);
begin
  cb_photo.Enabled := lvMembers.ItemIndex > -1;
  { activation de la case a cocher seulement
  si on a cliqué sur une ligne renseignée}
  if cb_photo.Checked then
    cb_photoClick(nil);
end;

procedure TTopMembersForm.Go(const Url: string);
begin
  shellexecute(hInstance, 'OPEN', PChar(format('%s%s', [Url,
    MembersList[(lvMembers.ItemIndex * Offset) + 1]])), nil, nil,
      SW_NORMAL);
end;

procedure TTopMembersForm.GoToDetails(Sender: TObject);
begin
  { quand on click sur un des menus du popupmenu, selon le sender,
    on envoie une page web}
  if sender = pop_profil then
    Go(Format('http://www.%s.com/auteurdetail.aspx?ID=',
      [Hosts[cb.itemindex]]))
  else if sender = pop_ecrire then
    Go(Format('http://www.%s.com/ecriremsg.aspx?ID=', [Hosts[cb.itemindex]]))
  else if sender = pop_msgsite then
    Go(Format('http://www.%s.com/forum.v2.aspx?MID=', [Hosts[cb.itemindex]]))
  else if sender = pop_voirtout then
    Go('http://www.codes-sources.com/forum.v2.aspx?TMID=')
  else if sender = pop_voirsourcessite then
    Go(Format('http://www.%s.com/listeauteur2.aspx?ID=', [Hosts[cb.itemindex]]))
  else if sender = pop_voirtssources then
    Go('http://www.codes-sources.com/listeauteur2.aspx?TID=')
  else if sender = pop_siteweb then
    Go(Format('http://www.%s.com/membresite.aspx?ID=', [Hosts[cb.itemindex]]));
end;

procedure TTopMembersForm.PopupMenuPopup(Sender: TObject);
var
  //Pseudo du membre sélectionné
  Pseudo: string;
begin
  // si on a cliqué ailleurs que sur un membre
  if lvMembers.ItemIndex <> -1 then
  begin
    Pseudo := lvMembers.ItemFocused.SubItems[0];
    // mise à jour de tous les caption du popupmenu
    pop_profil.Caption := Format('Profil de %s', [Pseudo]);
    pop_ecrire.Caption := Format('Ecrire à %s', [Pseudo]);
    pop_msgsite.Caption := Format('Voir les msgs %s de %s', [Site, Pseudo]);
    pop_voirtout.Caption := Format('Voir tous les msgs de %s', [Pseudo]);
    pop_voirsourcessite.Caption := Format('Voir les sources %s de %s', [Site,
      Pseudo]);
    pop_voirtssources.Caption := Format('Voir tous les sources de %s',
      [Pseudo]);
    pop_siteweb.Caption := Format('Visiter le Site web de %s', [Pseudo]);
  end;
end;

end.