main.pas

本程序是转载的

unit Main;
{(C) Alex Demchenko([e-mail])}

interface

uses
  Windows, Messages, Classes, Graphics, Controls, Forms,
  ComCtrls, ImgList, Menus, ICQClient, ICQWorks, RecvMsg,
  SendMsg, UserInfo, StdCtrls, UserSearch, AutoAway, PktDump, UserReg, UserRegNew,
  ExtCtrls;

type
  TMainForm = class(TForm)
    ListView1: TListView;
    IconList: TImageList;
    MainMenu1: TMainMenu;
    Main1: TMenuItem;
    Status1: TMenuItem;
    Exit1: TMenuItem;
    Online1: TMenuItem;
    Away1: TMenuItem;
    DND1: TMenuItem;
    Invisible1: TMenuItem;
    Offline1: TMenuItem;
    NA1: TMenuItem;
    StatusBar1: TStatusBar;
    ICQClient1: TICQClient;
    PopupMenu1: TPopupMenu;
    UserInfo1: TMenuItem;
    Search1: TMenuItem;
    Search2: TMenuItem;
    PacketDumps1: TMenuItem;
    RemoveContact1: TMenuItem;
    LoadContactList1: TMenuItem;
    ReadAwayMessage1: TMenuItem;
    RegisterNewUIN1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Online1Click(Sender: TObject);
    procedure Away1Click(Sender: TObject);
    procedure DND1Click(Sender: TObject);
    procedure NA1Click(Sender: TObject);
    procedure Invisible1Click(Sender: TObject);
    procedure Offline1Click(Sender: TObject);
    procedure ICQClient1Login(Sender: TObject);
    procedure ICQClient1ConnectionFailed(Sender: TObject);
    procedure ICQClient1StatusChange(Sender: TObject; UIN: String;
      Status: Cardinal);
    procedure ICQClient1UserOffline(Sender: TObject; UIN: String);
    procedure ListView1DblClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure UserInfo1Click(Sender: TObject);
    procedure ICQClient1UserInfoMore(Sender: TObject; UIN: String;
      Age: Word; Gender: Byte; HomePage: String; BirthYear, BirthMonth,
      BirthDay: Word; Lang1, Lang2, Lang3: String);
    procedure ICQClient1UserInfoAbout(Sender: TObject; UIN, About: String);
    procedure ICQClient1UserWorkInfo(Sender: TObject; UIN, WCity, WState,
      WPhone, WFax, FAddress, WZip, WCountry, WCompany, WDepartment,
      WPosition, WOccupation, WHomePage: String);
    procedure ICQClient1UserInfoInterests(Sender: TObject; UIN: String;
      Interests: TStringList);
    procedure Search1Click(Sender: TObject);
    procedure ICQClient1UserFound(Sender: TObject; UIN, Nick, FirstName,
      LastName, Email: String; Status: Word; Gender, Age: Byte;
      SearchComplete: Boolean; Authorize: Boolean);
    procedure ICQClient1UserNotFound(Sender: TObject);
    procedure ICQClient1PktParse(Sender: TObject; Buffer: Pointer;
      BufLen: Cardinal; Incoming: Boolean);
    procedure PacketDumps1Click(Sender: TObject);
    procedure ICQClient1UserInfoBackground(Sender: TObject; UIN: String;
      Pasts, Affiliations: TStringList);
    procedure ICQClient1UserGeneralInfo(Sender: TObject; UIN, NickName,
      FirstName, LastName, Email, City, State, Phone, Fax, Street,
      Cellular, Zip, Country: String; TimeZone: Byte;
      PublishEmail: Boolean);
    procedure RemoveContact1Click(Sender: TObject);
    procedure LoadContactList1Click(Sender: TObject);
    procedure ICQClient1ServerListRecv(Sender: TObject;
      SrvContactList: TList);
    procedure ReadAwayMessage1Click(Sender: TObject);
    procedure ICQClient1AutoMsgResponse(Sender: TObject; UIN: String;
      ID: Word; RespStatus: Byte; Msg: String);
    procedure ICQClient1PktDirectParse(Sender: TObject; Buffer: Pointer;
      BufLen: Cardinal; Incoming: Boolean);
    procedure ICQClient1URLRecv(Sender: TObject; Description, URL,
      UIN: String);
    procedure ICQClient1MessageRecv(Sender: TObject; Msg, UIN: String);
    procedure ICQClient1OfflineMsgRecv(Sender: TObject; Msg, UIN: String);
    procedure ICQClient1OfflineURLRecv(Sender: TObject; Description, URL,
      UIN: String);
    procedure ICQClient1Error(Sender: TObject; ErrorType: TErrorType;
      ErrorMsg: String);
    procedure RegisterNewUIN1Click(Sender: TObject);
    procedure ICQClient1NewUINRefused(Sender: TObject);
    procedure ICQClient1NewUINRegistered(Sender: TObject; UIN: String);
  private
    procedure ReCreateContactList;
    procedure DoStatusChange(NewStatus: LongWord);
  public
    FConnecting: Boolean;
    FInfoList: TList;
    function GetUserInfoIdx(Value: String): Integer;
    procedure DoCreateInfoQuery(UIN: String);
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

function DoLoadIcons(FileName: String): Boolean;
var
  dllHandle: HMODULE;
  procedure DoSingleEntry(Name: String);
  var
    Icon: TIcon;
  begin
    Icon := TIcon.Create;
    Icon.Handle := LoadIcon(dllHandle, PChar(Name));
    MainForm.IconList.AddIcon(Icon);
  end;
begin
  Result := False;
  dllHandle := LoadLibrary(PChar(FileName));
  if dllHandle <> 0 then
  begin
    DoSingleEntry('#104');  //Online      0
    DoSingleEntry('#128');  //Away        1
    DoSingleEntry('#159');  //DND         2
    DoSingleEntry('#131');  //N/A         3
    DoSingleEntry('#130');  //Invisible   4
    DoSingleEntry('#105');  //Offline     5
    DoSingleEntry('#159');  //Occupied    6
    DoSingleEntry('#129');  //FFC         7
    FreeLibrary(dllHandle);
    Result := True;
  end;
end;

procedure TMainForm.ReCreateContactList;
var
  i: Integer;
  ListItem: TListItem;
begin
  ListView1.Items.Clear;
  if ICQClient1.ContactList.Count > 0 then
    for i := 0 to ICQClient1.ContactList.Count - 1 do
    begin
      ListItem := ListView1.Items.Add;
      ListItem.ImageIndex := 5;
      ListItem.Caption := ICQClient1.ContactList.Strings[i];
    end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  if not DoLoadIcons('icons.dll') then //Load icons
    MessageBox(0, 'Could not load icons!', 'Error', MB_ICONERROR);
  ReCreateContactList; //Add users from contactlist to listview in offline mode
  FInfoList := TList.Create; //List of avaible info query forms

  if FileExists('ContactList.txt') then
    ICQClient1.ContactList.LoadFromFile('ContactList.txt');
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  ICQClient1.ContactList.SaveToFile('ContactList.txt');
  FInfoList.Free;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := 'Offline';
  ReCreateContactList;
end;

procedure TMainForm.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.DoStatusChange(NewStatus: LongWord);
begin
  if not ICQClient1.LoggedIn then
  begin
    if (ICQClient1.Password = '') and (ICQClient1.UIN = 0) then
    begin
      MessageBox(MainForm.Handle, 'Please set UIN & Password in TICQClient component!', 'Error!', MB_ICONERROR);
      Exit;
    end;
    StatusBar1.Panels[0].Text := 'Connecting...';
    ICQClient1.Login(NewStatus);
  end
  else
  begin
    ICQClient1.Status := NewStatus;
    StatusBar1.Panels[0].Text := StatusToStr(ICQClient1.Status);
  end;
end;

procedure TMainForm.Online1Click(Sender: TObject);
begin
  DoStatusChange(S_ONLINE);
end;

procedure TMainForm.Away1Click(Sender: TObject);
begin
  DoStatusChange(S_AWAY);
end;

procedure TMainForm.DND1Click(Sender: TObject);
begin
  DoStatusChange(S_DND);
end;

procedure TMainForm.NA1Click(Sender: TObject);
begin
  DoStatusChange(S_NA);
end;

procedure TMainForm.Invisible1Click(Sender: TObject);
begin
  DoStatusChange(S_INVISIBLE);
end;

procedure TMainForm.Offline1Click(Sender: TObject);
begin
  ICQClient1.Disconnect;
  StatusBar1.Panels[0].Text := 'Offline';
  ReCreateContactList;
end;

procedure TMainForm.ICQClient1Login(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := StatusToStr(ICQClient1.Status);
end;

procedure TMainForm.ICQClient1ConnectionFailed(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := 'Connection failed';
  ReCreateContactList;
end;

procedure TMainForm.ICQClient1StatusChange(Sender: TObject; UIN: String;
  Status: Cardinal);
var
  i, img: Integer;
  S: String;
begin
  if ListView1.Items.Count > 0 then
    for i := 0 to ListView1.Items.Count - 1 do
      if ListView1.Items.Item[i].Caption = UIN then
      begin
        S := StatusToStr(Status);
        if S = 'Online' then img := 0 else
        if S = 'Away' then img := 1 else
        if S = 'DND' then img := 2 else
        if S = 'N/A' then img := 3 else
        if S = 'Invisible' then img := 4 else
        if S = 'Occupied' then img := 6 else
        if S = 'FFC' then img := 7 else
          img := 0;
        ListView1.Items.Item[i].ImageIndex := img;
        Exit;
      end;
end;

procedure TMainForm.ICQClient1UserOffline(Sender: TObject; UIN: String);
var
  i: Integer;
begin
  if ListView1.Items.Count > 0 then
    for i := 0 to ListView1.Items.Count - 1 do
      if ListView1.Items.Item[i].Caption = UIN then
      begin
        ListView1.Items.Item[i].ImageIndex := 5;
        Exit;
      end;
end;

procedure TMainForm.ListView1DblClick(Sender: TObject);
begin
  if ListView1.Selected = nil then Exit;
  with TSendMsgForm.Create(Self) do
  begin
    Caption := 'Send message to: ' + ListView1.Selected.Caption;
    FDest := ListView1.Selected.Caption;
    Show;
  end;
end;

procedure TMainForm.PopupMenu1Popup(Sender: TObject);
begin
  if ListView1.Selected = nil then
  begin
    PopUpMenu1.Items[0].Enabled := False;
    PopUpMenu1.Items[2].Enabled := False;
    PopUpMenu1.Items[3].Enabled := False
  end
  else
  begin
    PopUpMenu1.Items[0].Enabled := True;
    PopUpMenu1.Items[2].Enabled := True;
    //If user not in Online or Invisible or Offline mode then enable Read away message item in popup menu

    if (ListView1.Selected.ImageIndex <> -1) and
       (ListView1.Selected.ImageIndex <> 0) and
       (ListView1.Selected.ImageIndex <> 4) and
       (ListView1.Selected.ImageIndex <> 5) then
         PopUpMenu1.Items[3].Enabled := True
    else
      PopUpMenu1.Items[3].Enabled := False;    
  end;
end;

function TMainForm.GetUserInfoIdx(Value: String): Integer;
var
  i: Integer;
begin
  Result := -1;
  if FInfoList.Count > 0 then
    for i := 0 to FInfoList.Count - 1 do
      if TUserInfoForm(FInfoList.Items[i]).FSource = Value then
      begin
        Result := i;
        Exit;
      end;
end;

procedure TMainForm.DoCreateInfoQuery(UIN: String);
var
  i: Integer;
  UIForm: TUserInfoForm;
begin
  i := GetUserInfoIdx(UIN);
  if i > -1 then
  begin
    TUserInfoForm(FInfoList.Items[i]).Show;
    Exit;
  end;
  UIForm := TUserInfoForm.Create(nil);
  FInfoList.Add(UIForm);
  with UIForm do
  begin
    Caption := 'Info about ' + UIN;
    FSource := UIN;
    Show;
  end;
  ICQClient1.RequestInfo(StrToInt(UIN));
end;

procedure TMainForm.ICQClient1UserGeneralInfo(Sender: TObject; UIN,
  NickName, FirstName, LastName, Email, City, State, Phone, Fax, Street,
  Cellular, Zip, Country: String; TimeZone: Byte; PublishEmail: Boolean);
var
  Form: TUserInfoForm;
  i: Integer;
begin
  i := GetUserInfoIdx(UIN);
  if i < 0 then Exit;
  Form := FInfoList.Items[i];
  with Form do
  begin
    UINLabel.Caption := UIN;
    NickNameLabel.Caption := NickName;
    FirstNameLabel.Caption := FirstName;
    LastNameLabel.Caption := LastName;
    EmailLabel.Caption := Email;
    {}
    StreetLabel.Caption := Street;
    CityLabel.Caption := City;
    CountryLabel.Caption := Country;
    ZipLabel.Caption := Zip;
    TimeZoneLabel.Caption := IntToStr(- ShortInt(TimeZone) div 2) + ':' + IntToStr(Abs(ShortInt(TimeZone) mod 2 * 30));
    if - ShortInt(TimeZone) > 0 then
      TimeZoneLabel.Caption := '+' + TimeZoneLabel.Caption;
    CellularLabel.Caption := Cellular;
  end;
end;

procedure TMainForm.ICQClient1UserInfoMore(Sender: TObject; UIN: String;
  Age: Word; Gender: Byte; HomePage: String; BirthYear, BirthMonth,
  BirthDay: Word; Lang1, Lang2, Lang3: String);
var
  Form: TUserInfoForm;
  i: Integer;
begin
  i := GetUserInfoIdx(UIN);
  if i < 0 then Exit;
  Form := FInfoList.Items[i];
  with Form do
  begin
    AgeLabel.Caption := IntToStr(Age);
    if Gender = GEN_MALE then
      GenderLabel.Caption := 'Male'
    else if Gender = GEN_FEMALE then
      GenderLabel.Caption := 'Female'
    else
      GenderLabel.Caption := 'Not specified';
    HomePageLabel.Caption := HomePage;