1) Voir le screen
2) Il "chope" la liste des 30 membres les plus actifs au mois ou a la semaine, sur le site de C-S de votre choix.
3) Grace au clic droit, vous avez acces a un menu pour visionner les messages, sources, profil, ecrire, site web de la personne.
4) demonstration de HyperParse, Inet
Source / Exemple :
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.
Conclusion :
uses en plus :
shellapi, strman, inet, HyperParse, Unpas2 (facultatif vous pouvez l'ignorer)
strman, inet et hyperparse :
http://diabloporc.free.fr/delphi/
Question : Pourquoi utiliser autre chose que des composants de base ?
Réponse : PARCE QUEEEEE !!
Vraie réponse : parce que HyperParse me parse une page HTML en 2 lignes, que Inet me chope une page web en 2 lignes et que strman joue avec les chaines comme personne :)
Pas d'installations de composants a faire, juste un chemin à ajouter dans le "library path" :D
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.