Вверх ↑
Ответов: 109
Рейтинг: 4
#1: 2009-09-02 16:28:02 ЛС | профиль | цитата
а как нада
------------ Дoбавленo в 16.34:
ини тесть через мин 20 попробую pas правельно )) и ини подредактируйте

#ini
[About]
Version=1.1
Author=Иван Балван
Mail=У болванов маила нету

[Type]
Class=Element
Info=icq

[Property]

[Methods]

*GetStatusFromCmbStatus=
*DoConnectClick=Осуществляет соединение с сервером|1|       
*cmbXStatusChange=  |1|
*DoSetNewXStatusClick= |2|
*FormCreate12у1 |3|
*FormDestroy=  12у12|4|
*OnLogin= 12у |15|
*OnLoginOff=12у12у   |6|                       
*DoDisconnectClick=121у2  |7|
*cmbStatusChange= 1у  |8|
*onConnectionFailed=12у    |9|
*OnError=12у           21у     |10|
*onServerListRecv=  1у12у        |12|
*SrvContactList=   2у1у      |11|
*onStatusChange= 12у12у          |13|
*Status=  у12у1                |14|
*tmrWaitToAskCLTimer= 12у1     |15|
*onUserOffline= 12у1           |16|
*OnMessageRecv=  12у12          |17|
*onOfflineMsgRecv=  у21у       |18|
*onAddedYou=     12у1у1          |19|
*DoSendMsgClick=   12у1у         |20|
*lblHyperlinkClick= 12у1у       |21|
INI файл


interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, XPMan, ICQClient, ICQWorks, StdCtrls, Buttons, ExtCtrls;

type
  PUINNickItem = ^TUINNickItem;
  TUINNickItem = record
    UIN : LongWord;
    Nick : ShortString;
  end;

  PUINStatusItem = ^TUINStatusItem;
  TUINStatusItem = record
    UIN, Status : LongWord;
  end;

  TfrmMain = class(TForm)
    ICQClient: TICQClient;
    procedure AddEvent(EventText : String);
    function GetStatusFromCmbStatus : Cardinal;
    procedure DoConnectClick(Sender: TObject);
    procedure cmbXStatusChange(Sender: TObject);
    procedure DoSetNewXStatusClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure OnLogin(Sender: TObject);
    procedure OnLogOff(Sender: TObject);
    procedure DoDisconnectClick(Sender: TObject);
    procedure cmbStatusChange(Sender: TObject);
    procedure OnConnectionFailed(Sender: TObject);
    procedure OnError(Sender: TObject; ErrorType: TErrorType;
      ErrorMsg: String);
    procedure OnServerListRecv(Sender: TObject;
      SrvContactList: TList);
    procedure OnStatusChange(Sender: TObject; UIN: String;
      Status: Cardinal);
    procedure tmrWaitToAskCLTimer(Sender: TObject);
    procedure OnUserOffline(Sender: TObject; UIN: String);
    procedure OnMessageRecv(Sender: TObject; Msg, UIN: String);
    procedure OnOfflineMsgRecv(Sender: TObject; DateTime: TDateTime;
      Msg, UIN: String);
    procedure OnAddedYou(Sender: TObject; UIN: String);
    procedure DoSendMsgClick(Sender: TObject);
    procedure lblHyperlinkClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  Crlf = Chr(13) + Chr(10);

var
  frmMain: TfrmMain;
  NeedToConnectAgain : Boolean;
  T : TextFile;
  UINNickList, UINStatusList : TList;
  
implementation

{$R *.dfm}
procedure TfrmMain.AddEvent(EventText : String);
begin
  EventText := DateToStr(Date) + ' ' + TimeToStr(Time) + ' | ' + EventText;
  if mmoEvents.Text = '' then
    mmoEvents.Text := EventText
  else
    mmoEvents.Text := mmoEvents.Text + Crlf + EventText;
  Write(T, Crlf + EventText);
end;

function TfrmMain.GetStatusFromCmbStatus : Cardinal;
var
  Rs : Cardinal;
begin
  Rs := S_ONLINE;
  case cmbStatus.ItemIndex of
    1: Rs := S_INVISIBLE;
    2: Rs := S_AWAY;
    3: Rs := S_NA;
    4: Rs := S_OCCUPIED;
    5: Rs := S_DND;
    6: Rs := S_FFC;
    7: Rs := S_HOME;       //дома
    8: Rs := S_ANGRY;      //злой
    9: Rs := S_DEPRESSION; //депрессия
    10: Rs := S_WORK;      //на работе
    11: Rs := S_EATING;    //кушаю
  end;
  Result := Rs;
end;

procedure TfrmMain.DoConnectClick(Sender: TObject);
begin
  ICQClient.ConvertToPlaintext := True;  //Convert RTF text to plain (when you don't use TRichEdit)
  ICQClient.UIN := StrToInt(edtUIN.Text);
  ICQClient.Password := edtPwd.Text;
  try
    if cmbStatus.ItemIndex = 0 then
      ICQClient.Login()
    else
      ICQClient.Login(GetStatusFromCmbStatus);
  except
    ShowMessage('Невозможно установить соединение, проверьте настройки файерволла и подключения к интернету!');
  end;
end;

procedure TfrmMain.cmbXStatusChange(Sender: TObject);
begin
  if cmbXStatus.ItemIndex = 0 then
    ICQClient.SetEmptyXStatus
  else
    ICQClient.SetXStatus(cmbXStatus.ItemIndex);
end;

procedure TfrmMain.DoSetNewXStatusClick(Sender: TObject);
begin
  if cmbNewXStatus.ItemIndex > 0 then
    ICQClient.SetNewXStatusByICQMoodNum(cmbNewXStatus.ItemIndex - 1, mmoNewXStatusText.Text + ' ')
  else
    ICQClient.SetNewXStatus(X_NONE, mmoNewXStatusText.Text + ' ');
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  AssignFile(T, 'events.log');
  if FileExists('events.log') then
    Append(T)
  else
    begin
      Rewrite(T);
      Write(T, '------ Лог событий программы CheatICQ ------');
    end;
  UINNickList := TList.Create;
  UINStatusList := TList.Create;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  UINNickList.Destroy;
  UINStatusList.Destroy;
  if ICQClient.LoggedIn then
    ICQClient.LogOff;
  CloseFile(T);
end;

procedure TfrmMain.OnLogin(Sender: TObject);
begin
  AddEvent('Успешно подключились под номером ' + IntToStr(ICQClient.UIN));
  NeedToConnectAgain := True;
  if cmbXStatus.ItemIndex <> 0 then
    cmbXStatusChange(Self);
  btnConnect.Enabled := False;
  btnDisconnect.Enabled := True;
  tmrWaitToAskCL.Enabled := True;
end;

procedure TfrmMain.OnLogOff(Sender: TObject);
begin
  AddEvent('Успешно отключились');
  btnDisconnect.Enabled := False;
  btnConnect.Enabled := True;
end;

procedure TfrmMain.DoDisconnectClick(Sender: TObject);
begin
  NeedToConnectAgain := False;
  ICQClient.LogOff;
end;

procedure TfrmMain.cmbStatusChange(Sender: TObject);
begin
  ICQClient.Status := GetStatusFromCmbStatus;
  ICQClient.Status := GetStatusFromCmbStatus;
end;

procedure TfrmMain.OnConnectionFailed(Sender: TObject);
begin
  if NeedToConnectAgain then
    begin
      AddEvent('Подключение сорвалось! Переподключаемся...');
      btnConnectClick(Self);
    end;
end;

procedure TfrmMain.OnError(Sender: TObject; ErrorType: TErrorType;
  ErrorMsg: String);
begin
  AddEvent('Ошибка! ' + ErrorMsg);
end;

function GetStatusFor(UIN : Cardinal) : String;
var
  Rs : String;
  i : LongInt;
begin
  Rs := StatusToStr_rus(S_OFFLINE);
  if UINStatusList.Count > 0 then
    for i := 0 to UINStatusList.Count - 1 do
      if PUINStatusItem(UINStatusList.Items[i])^.UIN = UIN then
        Rs := StatusToStr_rus(PUINStatusItem(UINStatusList.Items[i])^.Status);
  Result := Rs;
end;

procedure TfrmMain.OnServerListRecv(Sender: TObject;
  SrvContactList: TList);
var
  i : LongInt;
  UserInfo: TUINEntry;
  UINNickItem : PUINNickItem;
begin
  lstContactList.Clear;
  UINNickList.Clear;
  if SrvContactList.Count > 0 then
    for i := 0 to SrvContactList.Count - 1 do
      begin
        UserInfo := PUINEntry(SrvContactList.Items[i])^;
        if UserInfo.CType = 0 then  //adding contact to contact list
          begin
            lstContactList.AddItem(UserInfo.Nick + ' (' + IntToStr(UserInfo.UIN) + ') - ' + GetStatusFor(UserInfo.UIN), Self);
            GetMem(UINNickItem, SizeOf(UINNickItem^));
            UINNickItem^.UIN := UserInfo.UIN;
            UINNickItem^.Nick := UserInfo.Nick;
            UINNickList.Add(UINNickItem);
          end;
      end;
  AddEvent('Получен список контактов');
  ICQClient.DestroyUINList(SrvContactList);
end;

procedure TfrmMain.OnStatusChange(Sender: TObject; UIN: String;
  Status: Cardinal);
var
  UINStatusItem : PUINStatusItem;
  i : LongInt;
  InListAlready : Boolean;
begin
  AddEvent('UIN ' + UIN + ' сменил статус на ' + StatusToStr_rus(Status) + ': ' + IntToStr(Status));
  InListAlready := False;
  if UINStatusList.Count > 0 then
    for i := 0 to UINStatusList.Count - 1 do
      if PUINStatusItem(UINStatusList.Items[i])^.UIN = StrToInt(UIN) then
        begin
          InListAlready := True;
          PUINStatusItem(UINStatusList.Items[i])^.Status := Status;
        end;
  if InListAlready = False then
    begin
      GetMem(UINStatusItem, SizeOf(UINStatusItem^));
      UINStatusItem^.UIN := StrToInt(UIN);
      UINStatusItem^.Status := Status;
      UINStatusList.Add(UINStatusItem);
    end;
  //next lines change status in the contact list
  if UINNickList.Count > 0 then
    for i := 0 to UINNickList.Count - 1 do
      if PUINNickItem(UINNickList.Items[i])^.UIN = StrToInt(UIN) then
        lstContactList.Items.Strings[i] := PUINNickItem(UINNickList.Items[i])^.Nick + ' (' + IntToStr(PUINNickItem(UINNickList.Items[i])^.UIN) + ') - ' + StatusToStr_rus(Status);
end;

procedure TfrmMain.tmrWaitToAskCLTimer(Sender: TObject);
begin
  tmrWaitToAskCL.Enabled := False;
  ICQClient.RequestContactList;
  AddEvent('Запрошен список контактов');
  ICQClient.RequestOfflineMessages;
  AddEvent('Запрошены оффлайн сообщения');
end;

procedure TfrmMain.OnUserOffline(Sender: TObject; UIN: String);
begin
  ICQClientStatusChange(Self, UIN, S_OFFLINE);
end;

procedure TfrmMain.OnMessageRecv(Sender: TObject; Msg, UIN: String);
begin
  AddEvent('От UIN ' + UIN + ' принято сообщение: [' + Msg + ']');
end;

procedure TfrmMain.OnOfflineMsgRecv(Sender: TObject;
  DateTime: TDateTime; Msg, UIN: String);
begin
  AddEvent('От UIN ' + UIN + ' принято сообщение в оффлайн в {' + DateTimeToStr(DateTime) + '}: [' + Msg + ']');
end;

procedure TfrmMain.OnAddedYou(Sender: TObject; UIN: String);
begin
  AddEvent('Меня добавил UIN ' + UIN + '.');
end;

procedure TfrmMain.DoSendMsgClick(Sender: TObject);
begin
  if ICQClient.LoggedIn then
    begin
      ICQClient.SendMessage(StrToInt(edtUINToSendTo.Text), mmoSendMsg.Text);
      AddEvent('На UIN ' + edtUINToSendTo.Text + ' отправлено сообщение: [' + mmoSendMsg.Text + '].');
    end;
end;

procedure TfrmMain.lblHyperlinkClick(Sender: TObject);
begin
  WinExec(PChar('explorer ' + lblHyperlink.Caption), 0);
end;

end.
карма: 0

0