Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.09.11;
Скачать: CL | DM;

Вниз

Люди помогите сам никак...   Найти похожие ветки 

 
Андрей235   (2005-08-05 18:52) [0]

Действительно вопрос Ламовский
Это даже не вопрос а просьба сделать мне текстовый чат (LAN) с одним Edit_oм и кнопкой- "подключится" (изначально ты - сервак) что-бы у приятеля по ентеру (на Edit_e) выскакивал мессаge с принятым текстом или подскажите как можно переслать инфу не в текстовом виде ответы лучше скидывать на мыло
заранее спасибо


 
X9 ©   (2005-08-05 19:22) [1]

Код взят из проекта DelphiWorld ( http://delphiworld.narod.ru/dw.html )
Не соовем с одной кнопкой, но всё-же...

unit main;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 Menus, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls;

type
 TChatForm = class(TForm)
   MainMenu1: TMainMenu;
   File1: TMenuItem;
   Exit1: TMenuItem;
   FileConnectItem: TMenuItem;
   FileListenItem: TMenuItem;
   StatusBar1: TStatusBar;
   Bevel1: TBevel;
   Panel1: TPanel;
   Memo1: TMemo;
   Memo2: TMemo;
   N1: TMenuItem;
   SpeedButton1: TSpeedButton;
   Disconnect1: TMenuItem;
   ServerSocket: TServerSocket;
   ClientSocket: TClientSocket;
   procedure FileListenItemClick(Sender: TObject);
   procedure FileConnectItemClick(Sender: TObject);
   procedure Exit1Click(Sender: TObject);
   procedure Memo1KeyDown(Sender: TObject; var Key: Word;
     Shift: TShiftState);
   procedure FormCreate(Sender: TObject);
   procedure ServerSocketError(Sender: TObject; Number: Smallint;
     var Description: string; Scode: Integer; const Source,
     HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
   procedure Disconnect1Click(Sender: TObject);
   procedure ClientSocketConnect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
   procedure ServerSocketClientRead(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ServerSocketAccept(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ServerSocketClientConnect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ClientSocketDisconnect(Sender: TObject;
     Socket: TCustomWinSocket);
   procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
     ErrorEvent: TErrorEvent; var ErrorCode: Integer);
   procedure ServerSocketClientDisconnect(Sender: TObject;
     Socket: TCustomWinSocket);
 protected
   IsServer: Boolean;
 end;

var
 ChatForm: TChatForm;
 Server: string;

implementation

{$R *.DFM}

procedure TChatForm.FileListenItemClick(Sender: TObject);
begin
 FileListenItem.Checked := not FileListenItem.Checked;
 if FileListenItem.Checked then
 begin
   ClientSocket.Active := False;
   ServerSocket.Active := True;
   Statusbar1.Panels[0].Text := "Listening...";
 end
 else
 begin
   if ServerSocket.Active then
     ServerSocket.Active := False;
   Statusbar1.Panels[0].Text := "";
 end;
end;

procedure TChatForm.FileConnectItemClick(Sender: TObject);
begin
 if ClientSocket.Active then
   ClientSocket.Active := False;
 if InputQuery("Computer to connect to", "Address Name:", Server) then
   if Length(Server) > 0 then
     with ClientSocket do
     begin
       Host := Server;
       Active := True;
       FileListenItem.Checked := False;
     end;
end;

procedure TChatForm.Exit1Click(Sender: TObject);
begin
 ServerSocket.Close;
 ClientSocket.Close;
 Close;
end;

procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
 if Key = VK_Return then
   if IsServer then
     ServerSocket.Socket.Connections[0].SendText(Memo1.Lines[Memo1.Lines.Count
       - 1])
   else
     ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.Count - 1]);
end;

procedure TChatForm.FormCreate(Sender: TObject);
begin
 FileListenItemClick(nil);
end;

procedure TChatForm.ServerSocketError(Sender: TObject; Number: Smallint;
 var Description: string; Scode: Integer; const Source, HelpFile: string;
 HelpContext: Integer; var CancelDisplay: Wordbool);
begin
 ShowMessage(Description);
end;

procedure TChatForm.Disconnect1Click(Sender: TObject);
begin
 ClientSocket.Active := False;
 ServerSocket.Active := True;
 Statusbar1.Panels[0].Text := "Listening...";
end;

procedure TChatForm.ClientSocketConnect(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 Statusbar1.Panels[0].Text := "Connected to: " + Socket.RemoteHost;
end;

procedure TChatForm.ClientSocketRead(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TChatForm.ServerSocketClientRead(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TChatForm.ServerSocketAccept(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 IsServer := True;
 Statusbar1.Panels[0].Text := "Connected to: " + Socket.RemoteAddress;
end;

procedure TChatForm.ServerSocketClientConnect(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 Memo2.Lines.Clear;
end;

procedure TChatForm.ClientSocketDisconnect(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 FileListenItemClick(nil);
end;

procedure TChatForm.ClientSocketError(Sender: TObject;
 Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
 var ErrorCode: Integer);
begin
 Memo2.Lines.Add("Error connecting to : " + Server);
 ErrorCode := 0;
end;

procedure TChatForm.ServerSocketClientDisconnect(Sender: TObject;
 Socket: TCustomWinSocket);
begin
 Statusbar1.Panels[0].Text := "Listening...";
end;

end.


 
Андрей235   (2005-08-06 10:09) [2]

Такой и уменя есть а мне надо с Edit_om


 
Anatoly Podgoretsky ©   (2005-08-06 12:45) [3]

Андрей235   (05.08.05 18:52)  
В Demos пример Chat


 
Андрей235   (2005-08-07 12:21) [4]

Anatoly Podgoretsky, а я о чем он мне код этот же даёт


 
Alexander Panov ©   (2005-08-07 14:34) [5]

Андрей235   (07.08.05 12:21) [4]

Значит, надо изучать и пробовать изменять в соответствии с твоей необходимостью. За тебя программы здесь никто делать не будет.


 
evvcom ©   (2005-08-08 09:03) [6]


> Андрей235

См. http://delphimaster.net/view/2-1123411165/ пост [3], особое внимание с 3 по 5 абзац.



Страницы: 1 вся ветка

Текущий архив: 2005.09.11;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.023 c
1-1124246971
Киря
2005-08-17 06:49
2005.09.11
Как ускорить работу программы


1-1124370115
Aleksandr.
2005-08-18 17:01
2005.09.11
Почему Excel не понимает формат даты?


14-1124074481
Alexander Panov
2005-08-15 06:54
2005.09.11
Просьба потестировать.


3-1122644556
Silver ...
2005-07-29 17:42
2005.09.11
Панели DBCtrlGrid цветом из Базы


1-1124425972
Ксардас
2005-08-19 08:32
2005.09.11
Как в ричэдите отловить нажатие pageup и pagedown?