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.

Télécharger le zip

10 novembre 2004 18:53:12 :

12 novembre 2004 11:59:46 :

Optimisation n°1 : v 1.2 :) j'ai supprimé le case...of au profis d'un array( merci grandvizir), j'ai supprimé mes memos qui n'étaient la que pour mes tests, avoir un visuel de sortie, ils sont transformés en TStringList. Ajout d'une procedure pour le changement de la barre de status. Suppression d'une 10aine de ligne au niveau des boucles pour garder seulement les membres ds les TS Ajout de qqs verif (if ...) Suppression de qqs variables inutiles Source commentée au maximum

12 novembre 2004 12:20:21 :

Euh il y avais un bug avec TheTString, c réglé

12 novembre 2004 17:40:24 :

correction bénine de commentaire

20 novembre 2004 18:09:18 :

Code retouché par delphiprog merci a lui :) Prochaine mise a jour : ne plus utiliser Inet.pas