program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' ,
accountForm in 'accountForm.pas' ,
ChatForm in 'ChatForm.pas' ,
Unit4 in 'Unit4.pas' ;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
Application.CreateForm(TForm3, Form3);
Application.CreateForm(TForm4, Form4);
Application.Run;
end.
<b><font color="Red">unit Unit1;</font></b>
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, Menus, StdCtrls, ImgList, Proto, WinSock, Mrim,
ExtCtrls;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
ConnectBtn: TMenuItem;
DisconnectBtn: TMenuItem;
N4: TMenuItem;
N10: TMenuItem;
StatusBtn: TMenuItem;
N12: TMenuItem;
N2: TMenuItem;
N5: TMenuItem;
ImageList2: TImageList;
MailAgent: TMrim;
ListView1: TListView;
ConnectBar: TProgressBar;
N6: TMenuItem;
StatusBar1: TStatusBar;
PopupMenu1: TPopupMenu;
N3: TMenuItem;
procedure ConnectBtnClick(Sender: TObject);
procedure MailAgentConnectProgress(state: Integer);
procedure N2Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure DisconnectBtnClick(Sender: TObject);
procedure MailAgentList(list: AContact_List);
procedure MailAgentDisconnect(eMessage: String);
procedure MailAgentListUpdate(List: AContact_List);
procedure MailAgentSecondLogin(error: String);
procedure MailAgentStatus(id: Integer; email: String; oldstatus,
newstatus: Integer; adv_s_id, adv_s_name, adv_s_desc,
adv_s_cid: String);
procedure MailAgentNewMail(mess_: String);
procedure MailAgentMessage(msg_type_flags: Cardinal; from,
message_text: String);
procedure ListView1DblClick(Sender: TObject);
procedure MailAgentAuthReq(email, nick, req_msg: String);
procedure N3Click(Sender: TObject);
private
_ContactList: Mrim.AContact_list;
procedure SetStatus(Status:Integer; Name:string; Desc:String);
procedure CreateNewTab (user_email:string; text:string);
procedure GetUserList;
function GetStatusImage(status:integer; advStatusId:string):integer;
public
end;
var
Form1: TForm1;
implementation
uses accountForm, ChatForm, Unit4;
{$R *.dfm}
procedure TForm1.ConnectBtnClick(Sender: TObject);
begin
ConnectBar.Visible := true;
StatusBar1.Panels[0].Text := 'Подключение...';
If Form2.ShowModal = mrCancel Then
Exit;
MailAgent.Login := Form2.LoginEdit.Text;
MailAgent.Password := Form2.PassEdit.Text;
MailAgent.LoginStatus := STATUS_ONLINE;
MailAgent.login_s__desc := 'Я в сети!!!!';
MailAgent.Connect2(MailAgent.Login, MailAgent.Password);
end;
procedure TForm1.MailAgentConnectProgress(state: Integer);
begin
ConnectBar.Position := State;
If State = 100 Then
begin
Sleep(100);
ConnectBar.Visible := false;
StatusBar1.Panels[0].Text := 'В сети';
end;
end;
procedure TForm1.SetStatus(Status: Integer; Name:string; Desc:string);
begin
MailAgent.MyStatus(Status, IntToStr(Status), Name, Desc);
end;
procedure TForm1.N2Click(Sender: TObject);
begin
SetStatus(STATUS_ONLINE, 'В сети', 'Я в онлайне');
end;
procedure TForm1.N5Click(Sender: TObject);
begin
SetStatus(STATUS_AWAY, 'Отошел', 'Ушел хакать пентагон, вернусь не скоро');
end;
procedure TForm1.N6Click(Sender: TObject);
begin
SetStatus(STATUS_ONLINE+STATUS_FLAG_INVISIBLE, 'Невидимый','');
end;
procedure TForm1.DisconnectBtnClick(Sender: TObject);
begin
MailAgent.Disconnect;
end;
procedure TForm1.MailAgentList(list: AContact_List);
begin
_ContactList := List;
GetUserList;
end;
procedure TForm1.GetUserList;
var
i:integer;
_User : AUser;
begin
ListView1.Items.Clear;
for i:=0 to _ContactList.users_num-1 do
begin
_User := _ContactList.users_id[i];
with ListView1.Items.Add do
begin
Caption := _User.user_nick;
ImageIndex := GetStatusImage(_User.user_status, _user.user_status_id);
end;
end;
end;
procedure TForm1.MailAgentDisconnect(eMessage: String);
begin
StatusBar1.Visible := True;
StatusBar1.Panels[0].Text := 'Отключен';
end;
procedure TForm1.MailAgentListUpdate(List: AContact_List);
begin
_ContactList := List;
GetUserList;
end;
function TForm1.GetStatusImage(status: integer; advStatusId:string): integer;
begin
Result := 1;
Case Status Of
STATUS_ONLINE: Result := 0;
STATUS_OFFLINE: Result := 1;
STATUS_AWAY: Result := 2;
STATUS_FLAG_INVISIBLE : Result := 5;
STATUS_USER_DEFINED:
begin
if advStatusId = 'status_chat' then Result := 3;
if advStatusId = 'status_dnd' then Result := 4;
end;
end;
end;
procedure TForm1.MailAgentSecondLogin(error: String);
begin
ShowMessage('Ахтунг!!! Кто вошел под твоим логином!!!');
end;
procedure TForm1.MailAgentStatus(id: Integer; email: String; oldstatus,
newstatus: Integer; adv_s_id, adv_s_name, adv_s_desc, adv_s_cid: String);
begin
ListView1.Items[id].ImageIndex := GetStatusImage(newStatus, adv_s_id);
end;
procedure TForm1.MailAgentNewMail(mess_: String);
begin
ShowMessage('Получено новое письмо: '+mess_);
end;
procedure TForm1.MailAgentMessage(msg_type_flags: Cardinal; from,
message_text: String);
begin
CreateNewTab(from, message_text);
Form3.Show;
end;
procedure TForm1.CreateNewTab(user_email: string; text:string);
var
_NewTab : TTabSheet;
_NewTextMemo, _NewChatMemo:TMemo;
i:integer;
begin
for i:=0 to form3.PageControl1.PageCount-1 Do
if form3.PageControl1.Pages[i].Caption = user_nick then
begin
form3.PageControl1.ActivePageIndex := i;
if Text <> '' then
TMemo(Form3.PageControl1.Pages[i].FindComponent('ChatMemo'+IntToStr(i+1))).Lines.Add(user_nick+': '+text);
form3.Show;
Exit;
end;
_NewTab := TTabSheet.Create(form3.PageControl1);
_NewTab.Caption := user_nick;
_NewTab.Name := 'Tab'+IntToStr(form3.PageControl1.PageCount);
_NewTab.PageControl := form3.PageControl1;
_NewChatMemo := TMemo.Create(_NewTab);
_NewChatMemo.Name := 'ChatMemo'+IntToStr(Form3.PageControl1.PageCount);
_NewChatMemo.Align := alTop;
_NewTab.InsertControl(_NewChatMemo);
_NewTextMemo := TMemo.Create(_NewTab);
_NewTextMemo.Name := 'TextMemo'+IntToStr(form3.PageControl1.PageCount);
_NewTextMemo.Align := alTop;
_NewTab.InsertControl(_NewTextMemo);
_NewChatMemo.Lines.Clear;
_NewTextMemo.Lines.Clear;
If Text <> '' Then
_NewChatMemo.Lines.Add(user_nick+': '+text);
Form3.PageControl1.ActivePage := _NewTab;
Form3.Show;
end;
procedure TForm1.ListView1DblClick(Sender: TObject);
var
i:integer;
begin
i:=ListView1.Selected.Index;
CreateNewTab(_ContactList.users_id[i].user_mail, '');
end;
procedure TForm1.MailAgentAuthReq(email, nick, req_msg: String);
begin
with form4 do
begin
UserLabel.Caption := nick;
UserMailLabel.Caption := email;
Memo1.Lines.Clear;
Memo1.Lines.Add(req_msg);
ShowModal;
end;
if form4.ModalResult = mrYes Then
MailAgent.Send_Auth(email);
end;
procedure TForm1.N3Click(Sender: TObject);
begin
if ListView1.Selected = nil then
Exit;
MailAgent.DeleteUser(_ContactList.users_id[ListView1.Selected.Index].user_mail);
end;
end.
<b><font color="Red">
unit accountForm;</font></b>
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm2 = class(TForm)
Label1: TLabel;
LoginEdit: TEdit;
Label2: TLabel;
PassEdit: TEdit;
Button1: TButton;
Button2: TButton;
private
public
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
end.
<b><font color="Red">unit ChatForm;</font></b>
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm3 = class(TForm)
SendBtn: TButton;
PageControl1: TPageControl;
procedure SendBtnClick(Sender: TObject);
private
public
end;
var
Form3: TForm3;
implementation
uses Unit1;
{$R *.dfm}
procedure TForm3.SendBtnClick(Sender: TObject);
var
index : integer;
TextMemo, ChatMemo:TMemo;
begin
index := PageControl1.ActivePageIndex;
TextMemo := TMemo(PageControl1.Pages[index].FindComponent('TextMemo'+IntToStr(index+1)));
ChatMemo := TMemo(PageControl1.Pages[index].FindComponent('ChatMemo'+IntToStr(index+1)));
form1.MailAgent.SendMessage(PageControl1.Pages[index].Caption, TextMemo.Text);
CHatMemo.Lines.Add('Я: '+TextMemo.Text);
TextMemo.Clear;
end;
end.
<b><font color="Red">unit Unit4;</font></b>
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TForm4 = class(TForm)
Memo1: TMemo;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Label1: TLabel;
UserLabel: TLabel;
Label2: TLabel;
UserMailLabel: TLabel;
private
public
end;
var
Form4: TForm4;
implementation
{$R *.dfm}
end.
06.09.2008, 21:11
ПРИШЕМ ЧАТ ClientSocket-ServerSocket
Реал
Линейный вид
