Home > IT, Programe > Program realizat in TDE pentru urmarirea statusurilor mai multor ID-uri de Yahoo Messenger

Program realizat in TDE pentru urmarirea statusurilor mai multor ID-uri de Yahoo Messenger

Săptămâna asta am ţinut-o cu verificarea status-urilor ID-urilor de Yahoo Messenger. Şi astăzi va fi tot un articol despre acelaşi subiect. Doar că puţin mai avansat. Este vorba despre o aplicaţie realizată sub Turbo Delphi Explorer. Paşii de realizare sunt descrişi în cele ce urmează. Se crează un nou proiect din meniul File – VCL Forms Application – Delphi for Win32:

01

Implicit se va crea o fereastră – Form1:

02

Pe ea vom adăuga componentele de care vom avea nevoie. Începem cu o etichetă – TLabel pe care o vom trage cu ajutorul mouse-ului din paleta de obiecte Standard pe form-ul principal:

03

Vom modifica proprietăţile acestei etichete, de exemplu pentru proprietatea Caption vom seta textul New ID:

04

Vom adăuga apoi toate obiectele de care avem nevoie: o casetă de editare – Edit1, două butoane – Button1 şi Button2, două liste – ListBox1 şi ListBox2, două imagini – Image1 şi Image2, un Timer, un meniu – PopupMenu1, trei ferestre de dialog – OpenDialog1, SaveDialog1 şi SavePictureDialog1:

05

Apoi vom edita codul sursă – vom programa evenimentele ataşate obiectelor. De exemplu, la modificarea Edit1 vom activa/dezactiva posibilitatea de apăsare a butonului Button1:

06

Apoi vom scrie evenimentul declanşat de apăsarea pe butonul Button1 – respectiv adăugarea în lista ListBox1 a ID-ului din Edit1. ID-ul este adăugat doar dacă nu există deja în listă:

07

Codul sursă al fişierului Unit1.pas:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, GIFImage, JPeg, IdHashMessageDigest, idHash, ExtCtrls,
  URLMon, ShellApi, Menus, ExtDlgs;

type
  TForm2 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    ListBox2: TListBox;
    Timer1: TTimer;
    Image1: TImage;
    PopupMenu1: TPopupMenu;
    Remove1: TMenuItem;
    N1: TMenuItem;
    Sendmessage1: TMenuItem;
    Addtofriendlist1: TMenuItem;
    N2: TMenuItem;
    Savelisttotextfile1: TMenuItem;
    Loadlistfromtextfile1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Clearentirelist1: TMenuItem;
    Downloadavatar1: TMenuItem;
    SavePictureDialog1: TSavePictureDialog;
    Image2: TImage;
    Viewavatar1: TMenuItem;
    N3: TMenuItem;
    procedure Edit1Change(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Sendmessage1Click(Sender: TObject);
    procedure Addtofriendlist1Click(Sender: TObject);
    procedure Savelisttotextfile1Click(Sender: TObject);
    procedure Loadlistfromtextfile1Click(Sender: TObject);
    procedure Clearentirelist1Click(Sender: TObject);
    procedure Downloadavatar1Click(Sender: TObject);
    procedure Viewavatar1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  Status, StatusMD5, CurrentMD5:Array[0..99] Of String;

implementation

{$R *.dfm}

function MD5(const fileName : string) : string;
 var
   idmd5 : TIdHashMessageDigest5;
   fs : TFileStream;
 begin
   idmd5 := TIdHashMessageDigest5.Create;
   fs := TFileStream.Create(fileName, fmOpenRead OR fmShareDenyWrite) ;
   try
     result := idmd5.AsHex(idmd5.HashValue(fs)) ;
   finally
     fs.Free;
     idmd5.Free;
   end;
 end;

function GetTempDirectory: String;
var tempFolder: array[0..MAX_PATH] of Char;
begin
  GetTempPath(MAX_PATH, @tempFolder);
  result := StrPas(tempFolder);
end;

Function DownloadFile(SourceFile,DestFile:String):Boolean;
Begin
  Try
    Result:=UrlDownloadToFile(Nil,PChar(SourceFile),PChar(DestFile),0,Nil)=0;
  Except
    Result:=False;
  End;
End;

procedure TForm2.Addtofriendlist1Click(Sender: TObject);
begin
  If ListBox1.ItemIndex<>-1 Then
    ShellExecute(Handle,'open',
                 PChar('ymsgr:addfriend?'+ListBox1.Items[ListBox1.ItemIndex]),
                 Nil,Nil,SW_SHOWNORMAL);
end;

procedure TForm2.Button1Click(Sender: TObject);
Var i:Integer;
    b:Boolean;
begin
  b:=False;
  For i:=0 To ListBox1.Items.Capacity-1 Do
    If LowerCase(ListBox1.Items[i])=LowerCase(Edit1.Text) Then
      Begin
        b:=True;
        Break;
      End;
  If Not b Then
    Begin
      ListBox1.Items.Add(Edit1.Text);
      ListBox1.ItemIndex:=ListBox1.Items.Capacity-1;
      Edit1.Clear;
    End;
end;

procedure TForm2.Edit1Change(Sender: TObject);
begin
  Button1.Enabled:=Edit1.Text<>'';
end;

procedure TForm2.FormCreate(Sender: TObject);
Var i:Integer;
begin
  For i:=0 To 99 Do
    StatusMD5[i]:='';
end;

procedure TForm2.ListBox1Click(Sender: TObject);
begin
  Button2.Enabled:=ListBox1.ItemIndex<>-1;
end;

procedure TForm2.Loadlistfromtextfile1Click(Sender: TObject);
Procedure LoadOneByOne;
Var f:TextFile;
    s:String;
    i:Integer;
    b:Boolean;
Begin
  AssignFile(f,OpenDialog1.FileName);
  Reset(f);
  Repeat
    ReadLn(f,s);
    b:=False;
    For i:=0 To ListBox1.Items.Capacity-1 Do
      Begin
        If s=ListBox1.Items[i] Then
          Begin
            b:=True;
            Break;
          End;
      End;
    If Not b Then
      ListBox1.Items.Add(s);
  Until EOF(f);
  CloseFile(f);
End;
begin
  If OpenDialog1.Execute Then
    If ListBox1.Items.Capacity>0 Then
      If MessageDlg('Clear before add new IDs?',mtConfirmation,[mbYes,mbNo],0)=mrYes Then
        ListBox1.Items.LoadFromFile(OpenDialog1.FileName)
      Else
        LoadOneByOne
    Else
      LoadOneByOne;
end;

procedure TForm2.Savelisttotextfile1Click(Sender: TObject);
begin
  If ListBox1.Items.Capacity>0 Then
    If SaveDialog1.Execute Then
      ListBox1.Items.SaveToFile(SaveDialog1.FileName);
end;

procedure TForm2.Sendmessage1Click(Sender: TObject);
begin
  If ListBox1.ItemIndex<>-1 Then
    ShellExecute(Handle,'open',
                 PChar('ymsgr:sendim?'+ListBox1.Items[ListBox1.ItemIndex]),
                 Nil,Nil,SW_SHOWNORMAL);
end;

procedure TForm2.Timer1Timer(Sender: TObject);
Var i:Integer;
    SourceFile,CurrentID:String;
    Gif:TGifImage;
begin
  For i:=0 To ListBox1.Items.Capacity-1 Do
    Begin
      CurrentID:=ListBox1.Items[i];
      SourceFile:='http://opi.yahoo.com/online?u='+CurrentID+
                 '&m=g&t=1&l=us';
      Status[i]:=GetTempDirectory+CurrentID+'.GIF';
      If DownloadFile(SourceFile, Status[i]) Then
        Begin
          Try
            Gif:=TGIFImage.Create;
            Try
              Gif.LoadFromFile(Status[i]);
              Image1.Picture.Bitmap:=GIF.Bitmap;
              CurrentMD5[i]:=MD5(Status[i]);
              If CurrentMD5[i]<>StatusMD5[i] Then
                Begin
                  If CurrentMD5[i]='B0B7D04958579858C1F626E616DB330C' Then
                    ListBox2.Items.Add(FormatDateTime('yyyy/mm/dd hh:nn:ss - ',Now)
                                       +CurrentID+' is Online')
                  Else //602B11BD969DCE7195C3C1D114FB88A1
                    ListBox2.Items.Add(FormatDateTime('yyyy/mm/dd hh:nn:ss - ',Now)
                                       +CurrentID+' is Not Online');
                  ListBox2.ItemIndex:=ListBox2.Items.Capacity-1;
                  StatusMD5[i]:=CurrentMD5[i];
                End;
            Finally
              Gif.Free;
            End;
          Finally
            //
          End;
        End
    End;
end;

procedure TForm2.Viewavatar1Click(Sender: TObject);
begin
  If ListBox1.ItemIndex<>-1 Then
    If DownloadFile('http://img.msg.yahoo.com/avatar.php?yids='+
                    ListBox1.Items[ListBox1.ItemIndex]+'&format=jpg',
                    GetTempDirectory+ListBox1.Items[ListBox1.ItemIndex]+'.jpg') Then
      ShellExecute(Handle,'open',
                    PChar(GetTempDirectory+ListBox1.Items[ListBox1.ItemIndex]+'.jpg'),
                    Nil,Nil,SW_Normal);
end;

procedure TForm2.Button2Click(Sender: TObject);
begin
  If ListBox1.ItemIndex<>-1 Then
    If MessageDlg('Delete the "'+ListBox1.Items[ListBox1.ItemIndex]+'"?',
                  mtConfirmation,[mbYes,mbNo],0)=mrYes Then
      Begin
        Edit1.Text:=ListBox1.Items[ListBox1.ItemIndex];
        ListBox1.DeleteSelected;
      End;
end;             

procedure TForm2.Clearentirelist1Click(Sender: TObject);
begin
  If MessageDlg('Do you know what are you doing?',mtConfirmation,[mbYes,mbNo],0)=mrYes Then
    ListBox1.Clear;
end;

procedure TForm2.Downloadavatar1Click(Sender: TObject);
begin
  If ListBox1.ItemIndex<>-1 Then
    Begin
      SavePictureDialog1.FileName:=ListBox1.Items[ListBox1.ItemIndex]+'.jpg';
      If SavePictureDialog1.Execute Then
        Begin
          If DownloadFile('http://img.msg.yahoo.com/avatar.php?yids='+
                          ListBox1.Items[ListBox1.ItemIndex]+'&format=jpg',
                          SavePictureDialog1.FileName) Then
            If MessageDlg('View the avatar?',mtConfirmation,[mbYes,mbNo],0)=mrYes Then
              ShellExecute(Handle,'open',PChar(SavePictureDialog1.FileName),Nil,Nil,SW_Normal);
        End;
    End;
end;

end.

Programul lansat în execuţie arată astfel:

08

Lista de ID-uri are un meniu contextual activabil prin click drepata. Opţiunile disponibile sunt:

– eliminare a ID-ului selectat;
– ştergerea întregii liste de ID-uri;
– trimiterea unui mesaj către ID-ul selectat (necesită Yahoo Messenger instalat);
– adăugarea ID-ului în lista de prieteni (necesită Yahoo Messenger instalat);
– vizualizează avatarul ID-ului selectat;
– descarcă în calculator avatarul;
– salvează lista de ID-uri într-un fişier text;
– încarcă o listă de ID-uri dintr-un fişier text;

09

Fereastra de dialog ce permite selectarea fişierului text ce conţine ID-uri de Yahoo Messenger:

10

Programul monitorizează status-ul ID-urior din listă fără a fi necesară conectarea la programul Yahoo Messnger, fără a se accesa periodic diverse site-uri. Programul verifică status-ul chiar şi a ID-urilor persoanelor pe care nu le aveţi în lista de prieteni:

11

  1. 2010/07/22 at 9:45 pm

    Executabilul putin modificat poate fi accesat de aici:
    http://stedanarh.go.ro/ymid.zip

  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: