Add(MainForm,15375397,483,217)
{
 Width=418
 Height=337
 link(onCreate,16569644:doLoad,[])
}
Add(InlineCode,15900963,546,301)
{
 @Hint=#6:GetTok|
 WorkPoints=#6:doWork|
 EventPoints=#8:onEvent1|
 DataPoints=#3:Str|
 Code=#15:unit HiAsmUnit;|0:|9:interface|0:|21:uses kol,Share,Debug;|0:|4:type|28: THiAsmClass = class(TDebug)|10:   private|3:   |9:   public|23:    onEvent1:THI_Event;|18:    Str:THI_Event;|50:    procedure doWork(var _Data:TData; Index:word);|5: end;|0:|14:implementation|0:|29:procedure THiAsmClass.doWork;|16:var s,st:string;|5:begin|27:  st := ToStringEvent(Str);|25:  Replace(st,#10#13,#13);|18:  while s <> ' do|24:    s := GetTok(st,#13);|35:  _hi_CreateEvent(_Data,@onEvent1);|4:end;|0:|4:end.|
 link(onEvent1,3108918:doStop,[(589,307)(589,292)(471,292)(471,314)])
 link(Str,7684654:Var2,[])
 AddHint(102,-35,51,13,@Hint)
}
Add(InlineCode,5160255,560,364)
{
 @Hint=#5:Parse|
 WorkPoints=#6:doWork|
 EventPoints=#8:onEvent1|
 DataPoints=#3:Str|
 Code=#15:unit HiAsmUnit;|0:|9:interface|0:|21:uses kol,Share,Debug;|0:|4:type|28: THiAsmClass = class(TDebug)|10:   private|3:   |9:   public|23:    onEvent1:THI_Event;|22:    Str:THI_Event;    |50:    procedure doWork(var _Data:TData; Index:word);|5: end;|0:|14:implementation|0:|29:procedure THiAsmClass.doWork;|16:var s,st:string;|5:begin|27:  st := ToStringEvent(Str);|18:  while s <> ' do|26:    s := parse(st,#10#13);|35:  _hi_CreateEvent(_Data,@onEvent1);|4:end;|0:|4:end.|
 link(onEvent1,13161856:doStop,[(607,370)(607,407)(471,407)(471,377)])
 link(Str,7684654:Var3,[(566,271)])
 AddHint(86,46,42,13,@Hint)
}
Add(Button,15788778,378,301)
{
 Left=180
 Top=270
 link(onClick,6912630:doEvent1,[])
}
Add(Hub,6912630,434,301)
{
 link(onEvent1,3108918:doStart,[])
 link(onEvent2,13161856:doStart,[(469,314)(469,370)])
}
Add(TimeCounter,3108918,483,301)
{
 link(onStart,15900963:doWork,[])
 link(onStop,15773989:doWork1,[(529,314)])
}
Add(TimeCounter,13161856,483,364)
{
 link(onStart,5160255:doWork,[])
 link(onStop,15773989:doWork3,[(529,377)])
}
Add(Message,2019792,616,343)
{
}
Add(HubEx,15773989,525,343)
{
 link(onEvent,2019792:doMessage,[])
}
Add(ListBox,16569644,546,203)
{
 Left=30
 Top=10
 Width=360
 Height=255
 FileName=".compilerfpckol.pas"
}
Add(GetDataEx,7684654,546,266)
{
 link(Data,16569644:Text,[])
}

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

[Type]
Class=Element
Info=icq

[Property]

[Methods]

*GetStatusFromCmbStatus=
*DoConnectClick=Осуществляет соединение с сервером|1|       
*cmbXStatusChange=  |1|
*DoSetNewXStatusClick= |2|
*FormCreate=у12у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.