Клиент-серверное приложение под Linux

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Клиент-серверное приложение под Linux

Сообщение vladimirse » 11.06.2013 00:05:43

Доброго времени суток, уважаемые!
Подскажите пожалуйста где можно посмотреть пример реализации с описанием простенького клиент-серверного приложения на Lazarus\freepascal под ОС Linux?
Может есть у кого опыт написания подобного?
Вообще есть ли где внятное (желательно на русском) описание работы с сетью в Lazarus под Linux?
Аватара пользователя
vladimirse
незнакомец
 
Сообщения: 6
Зарегистрирован: 19.11.2012 09:43:00

Re: Клиент-серверное приложение под Linux

Сообщение vad78 » 11.06.2013 11:45:50

Если смогу чем-нибудь помочь, буду рад.
Есть мало-мальский опыт в этом вопросе.
Использовал библиотеки Sockets(Для работы с сокетами) и BaseUnix(если не ошибаюсь для функции FpFcntl);
procedure perrror(const S:string);

Я объявил глобальными переменными:
var
Sock:Tsocket;
Addr:TInetSockAddr;
buf: Tbuf;

begin
WriteLn(S,socketerror);
halt(100); //Эту строку можно не писать, не знаю может и нет необходимости в ней
end;


Sock:=fpsocket(PF_INET, SOCK_DGRAM, IPPROTO_UDP); //Открываем сокет (протокол UDP)
if Sock=-1 then perrror('socket: ');
FpFcntl(Sock,F_SetFl,O_NONBLOCK); // Переводим в асинхронный режим
Addr.sin_family:=AF_INET;
addr.sin_port:=htons(prt); //указываем порт и IP адрес
addr.sin_addr.s_addr:=0;
if fpbind(Sock,@Addr,SizeOf(Addr))=-1 then //Связываем адрес с сокетом
perrror('bind: ');

для отправки данных есть функция
fpsendto(Sock,@buff,SizeOf(buff),0,@addr,SizeOf(addr));
или просто (fpsend)
перед отправкой надо конкретно указать IP адрес кому
Addr.sin_port:=htons(StrToInt(Form1.port.Text));
Addr.sin_addr:=StrToNetAddr(fip); //fip - это строка '192.168.1.12'
Для приема:
fprecvfrom(Sock,@pack,SizeOf(pack),0, @from, @FromLen)
или (fprecv) параметры другие, надо смотреть в справке.

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

написал с ходу, могут быть ошибки.
vad78
незнакомец
 
Сообщения: 2
Зарегистрирован: 11.06.2013 11:07:54

Re: Клиент-серверное приложение под Linux

Сообщение VirtUX » 11.06.2013 11:46:11

Возможно поможет: viewtopic.php?f=34&t=7025
Аватара пользователя
VirtUX
энтузиаст
 
Сообщения: 880
Зарегистрирован: 05.02.2008 10:52:19
Откуда: Крым, Алушта

Re: Клиент-серверное приложение под Linux

Сообщение vad78 » 11.06.2013 11:48:15

Код: Выделить всё
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls, Sockets, BaseUnix;

type
     TPacket = packed record
      b1 : boolean;
      us : byte;
      int16 : Word;
      int32 : longword;
      end;
  { TForm1 }

  Tbuf =  array [0..120] of char;
  TForm1 = class(TForm)
    byte1: TEdit;
    int16: TEdit;
    int32: TEdit;
    Button1: TButton;
    Edit1: TEdit;
    bool: TEdit;
    IPaddr: TLabeledEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Memo1: TMemo;
    port: TLabeledEdit;
    Timer1: TTimer;
    Timer2: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);

  private
    { private declarations }
  public
    pack : TPacket;
  end;

var
  Form1: TForm1;
   Sock:Tsocket;
  Addr:TInetSockAddr;
  buf: Tbuf;
  n:integer;
implementation

{$R *.lfm}

{ TForm1 }

procedure perrror(const S:string);
begin
  WriteLn(S,socketerror);
  halt(100);
end;

procedure InitUDP(prt:integer);
begin
  Sock:=fpsocket(PF_INET, SOCK_DGRAM, IPPROTO_UDP);
  if Sock=-1 then perrror('socket: ');
   FpFcntl(Sock,F_SetFl,O_NONBLOCK);
  Addr.sin_family:=AF_INET;
  addr.sin_port:=htons(prt);
  addr.sin_addr.s_addr:=0;
  if fpbind(Sock,@Addr,SizeOf(Addr))=-1 then
  perrror('bind: ');

end;

procedure SendToIp(fip: AnsiString; fpack: string);
          procedure Send(var buff: Tbuf; var addr:TInetSockAddr);
          begin
            fpsendto(Sock,@buff,SizeOf(buff),0,@addr,SizeOf(addr));
          end;
   var BufToSend: Tbuf;
     i:integer;

begin
  //st:= Form1.Edit1.Text;
    Addr.sin_port:=htons(StrToInt(Form1.port.Text));
    Addr.sin_addr:=StrToNetAddr(fip);
    for i:=0 to Length(fpack) - 1 do
    BufToSend[i]:=Char(fpack[i+1]);
    send(BufToSend,Addr)
end;

procedure DestroyUDP;
begin
  CloseSocket(Sock);
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  DestroyUDP;
end;

procedure TForm1.Button1Click(Sender: TObject);
var st:string;
begin
  Inc(n);
  st:=Edit1.Text+IntToStr(n);
  SendToIp(IPaddr.Text,st);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
Timer2.Interval:=StrToInt(Edit1.Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitUDP(StrToInt(port.Text));
  n:=0;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  newStatus : string;
  Count: LongInt;
  from: TInetSockAddr;
  FromLen:integer;
  i, j: LongInt;
begin
    fromlen:=SizeOf(from);
    if fprecvfrom(Sock,@pack,SizeOf(pack),0, @from, @FromLen) > 0 then
    begin;
    newStatus:=NetAddrToStr( addr.sin_addr);
    bool.Text:=BoolToStr(pack.b1);
    byte1.Text:=IntToStr(pack.us);
    int16.Text:=IntToStr(pack.int16);
    int32.Text:=IntToStr(pack.int32);
    Memo1.Lines.Add('Ответ РѕС‚ '+ newStatus+'  '+ IntToStr(sizeof(pack)));
    end;

end;

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

end.

vad78
незнакомец
 
Сообщения: 2
Зарегистрирован: 11.06.2013 11:07:54

Re: Клиент-серверное приложение под Linux

Сообщение vladimirse » 11.06.2013 22:04:56

Большое спасибо за информацию!!!!
Буду разбираться.
Аватара пользователя
vladimirse
незнакомец
 
Сообщения: 6
Зарегистрирован: 19.11.2012 09:43:00


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Yandex [Bot] и гости: 242

Рейтинг@Mail.ru