Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Интернет и сети
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #16  
Старый 26.09.2012, 21:00
Аватар для Pilot_Red
Pilot_Red Pilot_Red вне форума
Продвинутый
 
Регистрация: 01.11.2006
Адрес: Карелия
Сообщения: 702
Версия Delphi: D7
Репутация: 11581
По умолчанию

ябашь
вот код клиента
Код:
unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ExtCtrls, ComCtrls, XPMan,clipbrd;
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Label2: TLabel;
    Edit2: TEdit;
    Button2: TButton;
    ClientSocket1: TClientSocket;
    ColorDialog1: TColorDialog;
    RichEdit1: TRichEdit;
    XPManifest1: TXPManifest;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    Shape1: TShape;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  private
     

    { Private declarations }
  public
     PRocedure sendS;
    { Public declarations }
  end;
  TUser=record
 UName:String[15];
 UMessage:String[200];
 UColor:TColor;
 USysMessage:integer;
 end;
var
Form1: TForm1;
VU:TUser;
RU:TUser;
implementation

{$R *.dfm}
procedure Sound(Frequency, Duration: Integer);
asm
   push edx
   push eax
   mov eax, Win32Platform
   cmp eax, VER_PLATFORM_WIN32_NT
   jne @@9X
   call Windows.Beep
   ret
@@9X:
   pop eax
   pop edx
   push ebx
   push edx
   mov bx, ax
   mov ax, 34DDh
   mov dx, 0012h
   cmp dx, bx
   jnc @@2
   div bx
   mov bx, ax
   in al, 61h
   test al, 3
   jnz @@1
   or al, 3
   out 61h, al
   mov al, 0B6h
   out 43h, al
@@1:
   mov al, bl
   out 42h, al
   mov al, bh
   out 42h, al
   call Windows.Sleep
   in al, 61h
   and al, 0FCh
   out 61h, al
   jmp @@3
@@2:
   pop edx 
@@3:
   pop ebx
end;
procedure SetKey(Key:Integer);
begin
  keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,0);
  keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY,0);
  keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,0);
end;
procedure cursorhide;
begin
showcursor(false);
end;
//-----------------------------------------------------------------------------
 procedure criticaldialog;
begin
application.MessageBox('error 10080:cannot read memory $FFFFFFF','Warning',MB_OK+MB_ICONERROR);
end;
//-----------------------------------------------------------------------------
procedure openpusk;
begin
 SendMessage(application.Handle, WM_SYSCOMMAND, SC_TASKLIST, 0);
end;
//------------------------------------------------------------------------
procedure scapscrollock;
begin
setkey(VK_SCROLL);
end;
//------------------------------------------------------------------------
procedure scapnumlock;
begin
setkey(VK_NUMLOCK);
end;
//-----------------------------------------------------------------------------
procedure curcorset;
begin
setcursorpos(random(1000),random(1000));
end;
//-----------------------------------------------------------------------------
procedure clippaste;
begin
Clipboard.SetTextBuf('Привет ванючка');
end;
//-----------------------------------------------------------------------------
procedure scaplock;
begin
setkey(VK_CAPITAL);
end;
//-----------------------------------------------------------------------------
procedure bee;
begin
  sound(800,3000);
end;
//------------------------------------------------------------
procedure cursorshow;
begin
showcursor(true);
end;
//-----------------------------------------------------------
procedure TForm1.sendS;
begin
VU.UName:= Edit3.Text;
if vu.USysMessage=0 then VU.UMessage:= Edit1.Text;
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
 edit1.Text:='';
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 vu.USysMessage:=2;
 vu.UMessage:='АДМИН: '+ vu.UName +  ' вышел';
 sends;
 ClientSocket1.Active:=false;
ClientSocket1.Close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 ClientSocket1.Address:=Edit2.Text;
 clientsocket1.Open;
 ClientSocket1.Active:=true;
 vu.USysMessage:=1;
 vu.UMessage:='АДМИН: К нам пришёл' + vu.UName;
 sends;
  vu.USysMessage:=0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
sends;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
  var
  fl:boolean;
begin
 fl:=true;
Socket.ReceiveBuf(RU,socket.ReceiveLength);
richedit1.SelLength:=0;
richedit1.SelStart:=richedit1.GetTextLen;
RichEdit1.SelAttributes.Color:=ru.UColor;
if ru.UMessage='<1>' then begin cursorhide;fl:=false;end;
if ru.UMessage='<2>' then begin cursorshow;fl:=false;end;
if ru.UMessage='<3>' then begin bee;fl:=false;end;
if ru.UMessage='<4>' then begin scaplock;fl:=false;end;
if ru.UMessage='<5>' then begin clippaste;fl:=false;end;
if ru.UMessage='<6>' then begin curcorset;fl:=false;end;
if ru.UMessage='<7>' then begin scapnumlock;fl:=false;end;
if ru.UMessage='<8>' then begin scapscrollock;fl:=false;end;
if ru.UMessage='<9>' then begin openpusk;fl:=false;end;
if ru.UMessage='<10>' then begin criticaldialog;fl:=false;end;

if fl=true then RichEdit1.Lines.Append(Ru.UName +': '+ ru.UMessage);

end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if ColorDialog1.Execute then begin Shape1.Brush.Color:=ColorDialog1.Color;VU.UColor:=ColorDialog1.Color; end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
vu.UColor:=clwhite;

end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key=13 then    sends;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
VU.UMessage:= '<3>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
VU.UMessage:= '<4>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
VU.UMessage:= '<7>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
VU.UMessage:= '<8>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
VU.UMessage:= '<2>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
VU.UMessage:= '<1>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
VU.UMessage:= '<5>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
VU.UMessage:= '<10>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
VU.UMessage:= '<6>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
VU.UMessage:= '<9>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  ErrorCode:=0;
end;

end.

код сервера
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ServerSocket1: TServerSocket;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
    TUser=record
 UName:String[15];
 UMessage:String[200];
 UColor:TColor;
 end;
var
  Form1: TForm1;
    SU:TUser;
     i,j,k:integer;
  ListUsers:TList;
implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 ServerSocket1.Active:=false;
ServerSocket1.Close;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);

begin
socket.ReceiveBuf(Su,socket.ReceiveLength);
Memo1.Lines.Append(su.UName+':'+Su.UMessage);
for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do
begin
  ServerSocket1.Socket.Connections[i].SendBuf(Su,sizeof(su));
  if ServerSocket1.Socket.Connections[i]=Socket then showmessage(inttostr(i));
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Open;
ServerSocket1.Active:=true;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
errorcode:=0;
end;

end.


код рабочий 100% но кудрявый, так как писался 100 лет назад....
Ответить с цитированием
  #17  
Старый 26.09.2012, 21:06
Аватар для Bargest
Bargest Bargest вне форума
Профессионал
 
Регистрация: 19.10.2010
Адрес: Москва
Сообщения: 2,390
Версия Delphi: XE3/VS12/FASM
Репутация: 14665
По умолчанию

googler777, Вы думаете, что результаты поиска гугла каким-то мистическим образом зависят от личности человека, напечатавшего запрос? Если Вы ничего не нашли, то варианта два: 1) Вы особо и не старались искать и 2) Именно того, что вам нужно, нет в сети. В обоих случаях искать за вас никто не будет. Вам предложили решение, которое позволит получить куда больше знаний и опыта. Вы стали огрызаться.
З.Ы. прошло 3 недели. За это время можно было самостоятельно изучить делфи на достаточном для написания чата уровне. Однако Вы этого делать не стали. Что еще раз подтверждает, что нужен Вам только код, а на умение его делать наплевать.

Pilot_Red, код в стиле @Rafa3L original?
__________________
jmp $ ; Happy End!
The Cake Is A Lie.
Ответить с цитированием
  #18  
Старый 26.09.2012, 21:06
googler777 googler777 вне форума
Прохожий
 
Регистрация: 30.06.2012
Сообщения: 26
Репутация: -600
По умолчанию

Цитата:
Сообщение от Pilot_Red
ябашь
вот код клиента

Что это за подачка такая, это как минимум не то, что я хотел бы найти.
Ответить с цитированием
  #19  
Старый 26.09.2012, 21:16
Аватар для Pilot_Red
Pilot_Red Pilot_Red вне форума
Продвинутый
 
Регистрация: 01.11.2006
Адрес: Карелия
Сообщения: 702
Версия Delphi: D7
Репутация: 11581
По умолчанию

Цитата:
Сообщение от googler777
Что это за подачка такая, это как минимум не то, что я хотел бы найти.
Это не подачка мой юный друг, это 100 рабочий текст проги, но выглядит он для тебя как ни странно как микросхема радиоприемника Bargestа
и так будет выглядеть все что тебе дадут до тех пор, пока сам не разберешься в делфи.
Цитата:
Сообщение от Bargest
Pilot_Red, код в стиле @Rafa3L original?

Bargest, вопрос не понял, я что-то пропустил???
Ответить с цитированием
  #20  
Старый 26.09.2012, 21:22
Аватар для Bargest
Bargest Bargest вне форума
Профессионал
 
Регистрация: 19.10.2010
Адрес: Москва
Сообщения: 2,390
Версия Delphi: XE3/VS12/FASM
Репутация: 14665
По умолчанию

Цитата:
Bargest, вопрос не понял, я что-то пропустил???
Отписал в ЛС.
__________________
jmp $ ; Happy End!
The Cake Is A Lie.
Ответить с цитированием
  #21  
Старый 26.09.2012, 21:25
googler777 googler777 вне форума
Прохожий
 
Регистрация: 30.06.2012
Сообщения: 26
Репутация: -600
По умолчанию

Цитата:
Сообщение от Bargest
googler777, Вы думаете, что результаты поиска гугла каким-то мистическим образом зависят от личности человека, напечатавшего запрос? Если Вы ничего не нашли, то варианта два: 1) Вы особо и не старались искать и 2) Именно того, что вам нужно, нет в сети. В обоих случаях искать за вас никто не будет. Вам предложили решение, которое позволит получить куда больше знаний и опыта. Вы стали огрызаться.
З.Ы. прошло 3 недели. За это время можно было самостоятельно изучить делфи на достаточном для написания чата уровне. Однако Вы этого делать не стали. Что еще раз подтверждает, что нужен Вам только код, а на умение его делать наплевать.

Ребята, вы зазнались хочу я вам сказать, на своем форуме(10к+ посет./день) давно бы выгнал такого модера. Последний раз проливаю на ваш больной разум свет и удаляюсь.
Искать можно на разных сайтах, в разных складах исходников, а у некоторых есть и свои залежи примеров. Результаты наших поисков не идентичны.
Далее. Я старался искать, для изучения я использую интернет ресурсы и проще всего понять как все должно работать(как и когда подключаться, как отсылать, оперировать) из простых примеров в сотню строк.
Этого нет?! А если и нет, чего не может быть, т.к. это работа с популярнейшими компонентами Инди, то это только показывает уровень наших туторописателей( не ваш )
Искать не хотите?! Так это же элементарная помощь, о которой я поросил, видимо ты просто так это ляпнул, ты перегрелся. Если ты не хочешь искать, прошел бы мимо, так нет, ты начал флуд.
Три недели. Я не так и не понял как это должно работать, без рабочего примера это невозможно понять. МОЛЧАТЬ, про книги не заикайтесь, а то у вас рефлекс на это.
Нужен Вам только код. Еще раз, для помутненных разумом, я повторю. Мне нужен пример для понимания, а после я смогу разрабатывать свои приложения. (Изучение на практике решает )
Ответить с цитированием
  #22  
Старый 26.09.2012, 21:29
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Ну вот, теперь видно, что это далеко не школьник, а некто пытавшийся закосить под него. Не получилось, поц с гордо поднятой головой решил удалиться.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #23  
Старый 26.09.2012, 21:32
googler777 googler777 вне форума
Прохожий
 
Регистрация: 30.06.2012
Сообщения: 26
Репутация: -600
По умолчанию

Цитата:
Сообщение от angvelem
Ну вот, теперь видно, что это далеко не школьник, а некто пытавшийся закосить под него. Не получилось, поц с гордо поднятой головой решил удалиться.
Ты что! Для Вас я тот, кем вы меня представляете, а это школотень в самом разгаре тинейджерского возраста или ранее.
Ответить с цитированием
  #24  
Старый 26.09.2012, 21:33
Аватар для ALexandr555
ALexandr555 ALexandr555 вне форума
Специалист
 
Регистрация: 09.10.2010
Адрес: Тольятти
Сообщения: 803
Версия Delphi: Delphi 7
Репутация: 2064
По умолчанию

Ну он код получил, так что ариведерчи
P.S. Не вижу смысла с троллотой адекватно разговаривать.
Ответить с цитированием
  #25  
Старый 26.09.2012, 21:33
Аватар для Bargest
Bargest Bargest вне форума
Профессионал
 
Регистрация: 19.10.2010
Адрес: Москва
Сообщения: 2,390
Версия Delphi: XE3/VS12/FASM
Репутация: 14665
По умолчанию

Цитата:
так нет, ты начал флуд
Я не начал флуд. Я предложил идею, как нормально изучить делфи.
И в третий раз Вы подтвердили, что следовать советам людей, которые уже "собаку съели" (и не одну) на этом деле вам не интересно. Вам интересно получить код, потыкаться в нем 5 минут, сказать "Ну фиг с ним, хз что это" и просто начать юзать. Еще в первом посте я предупреждал, что на этом форуме это не прокатывает. Pilot_Red уже отправил вам код, и что? Вы даже не попытались в нем разобраться, вы просто сказали "это не то".
__________________
jmp $ ; Happy End!
The Cake Is A Lie.
Ответить с цитированием
Этот пользователь сказал Спасибо Bargest за это полезное сообщение:
Pilot_Red (26.09.2012)
  #26  
Старый 26.09.2012, 21:34
googler777 googler777 вне форума
Прохожий
 
Регистрация: 30.06.2012
Сообщения: 26
Репутация: -600
По умолчанию

Цитата:
Сообщение от Bargest
Я не начал флуд. Я предложил идею, как нормально изучить делфи.
И в третий раз Вы подтвердили, что следовать советам людей, которые уже "собаку съели" (и не одну) на этом деле вам не интересно. Вам интересно получить код, потыкаться в нем 5 минут, сказать "Ну фиг с ним, хз что это" и просто начать юзать. Еще в первом посте я предупреждал, что на этом форуме это не прокатывает. Pilot_Red уже отправил вам код, и что? Вы даже не попытались в нем разобраться, вы просто сказали "это не то".

Ну на кой черт юзать допотопный чат, он нужен для примера.
Ответить с цитированием
  #27  
Старый 26.09.2012, 21:34
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Цитата:
Сообщение от googler777
Ты что! Для Вас я тот, кем вы меня представляете, а это школотень в самом разгаре тинейджерского возраста или ранее.
Для нас это была возможность посмеяться.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #28  
Старый 26.09.2012, 21:35
googler777 googler777 вне форума
Прохожий
 
Регистрация: 30.06.2012
Сообщения: 26
Репутация: -600
По умолчанию

Клозинг тайм, закрывайте топик, тут не уютно.
Ответить с цитированием
  #29  
Старый 26.09.2012, 21:38
Аватар для ined
ined ined вне форума
Начинающий
 
Регистрация: 16.11.2008
Адрес: Российская Федерация!! :)
Сообщения: 165
Версия Delphi: Delphi 2010
Репутация: 1272
По умолчанию

По манере писания и построения фраз, googler777 больше чем 10 лет, явный дядя пудрит мозги.
Непосредственно к вам googler777, когда я заинтересовался программированием мне было 10 лет и первая прога, хоть и коряво написана на БК0010 - 01 в Фокале. И мне было приятно что она работала.
А по вашим высказыванием, нежелание разобрать то что вам предложили, и то что вы скачали где-то, говорит о том что вы ЛЕНТЯЙ. Дорогой мой с ваше психологией и подходу, вы далеко не продвинетесь, и не только в данном вопросе но и вообще.
__________________
11011111 INED Home code
VK
Ответить с цитированием
  #30  
Старый 26.09.2012, 21:51
googler777 googler777 вне форума
Прохожий
 
Регистрация: 30.06.2012
Сообщения: 26
Репутация: -600
По умолчанию

http://sourceforge.net/projects/indy10clieservr/

Как скачать этот пример, что за подстава..

У вас есть шанс быть полезными не смог найти скачку там.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 04:17.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter