Udało mi się znaleźć jak stworzyć prosty serwer - taki dla ułomnych ale kod działa. Poniżej wstawiam unit1 z klientem i zaraz potem unit1 z serwerem. Po uruchomieniu przesyła stringa z edit1 klienta do serwera a w odpowiedzi dostaje stringa z edit1 serwera. Button1 na formie serwera tworzy serwer i znika. W form1.caption klienta jest ip odczytany, odpowiedź serwera oraz ew. błąd - opisowo. Teraz pracuję nad sposobem odczytania ip przydzielanego dla komputera przez główny serwer sieci domowej 192.168.0.1. Z jakiegoś powodu getip zawsze czyta ip= 127.0.0.1
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
blcksock, synsock;
type
tclient = class(TThread)
private
{ Private declarations }
public
protected procedure execute; override;
end;
//***********************
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
end;
var
Form1: TForm1;
klient:TTCPBlockSocket;
ip,port:string;
timeout:integer;
WysylanyTekst:string;
PrzyjmowanyTekst:string;
implementation
{$R *.lfm}
{ TForm1 }
function GetIP: string;
var
TcpSock: TTCPBlockSocket;
ipList: TStringList;
begin
Result := '';
ipList := TStringList.Create;
try
TcpSock := TTCPBlockSocket.create;
try
TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
Result := ipList.CommaText;
finally
TcpSock.Free;
end;
finally
ipList.Free;
end;
end;
procedure tclient.execute;
var
s:string;
begin
klient := TTCPBlockSocket.Create;
while not terminated do begin
klient.Connect(ip, port);
if klient.LastError=0 then begin;
if klient.CanWrite(timeout) then begin
klient.SendString(wysylanytekst+#13#10);
PrzyjmowanyTekst:=klient.RecvString(1000);
end;
end;
if klient.LastError<>0 then PrzyjmowanyTekst:=klient.GetErrorDescEx;
klient.ResetLastError;
klient.CloseSocket;
sleep(1000);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
cli:tclient;
begin
port:='40516';
timeout:=1000;
ip:=getip;
wysylanytekst:='Wiadomosc dla serwera';
form1.Button1.Caption:='Wyślij edit1';
cli:=tclient.Create(false);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
wysylanyTekst:=form1.Edit1.Text;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
form1.Caption:='Client ip:'+ip+' serwer odpowiedział: '+przyjmowanyTekst;
end;
end.
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
blcksock, synsock,process,synautil;
//****************
type
tserver = class(TThread)
private
{ Private declarations }
procedure wpisz;
procedure AttendConnection(ASocket: TTCPBlockSocket);
procedure connect;
protected procedure execute; override;
end;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
klient,serwer:TTCPBlockSocket;
ip,port:string;
timeout:integer;
WysylanyTekst:string;
PrzyjmowanyTekst:string;
implementation
{$R *.lfm}
{ TForm1 }
procedure tserver.AttendConnection(ASocket: TTCPBlockSocket);
var
timeout: integer;
s: string;
method, uri, protocol: string;
OutputDataString: string;
ResultCode: integer;
begin
timeout := 12000000;
s := ASocket.RecvString(timeout);
przyjmowanytekst:=s;
synchronize(@wpisz);
asocket.SendString(wysylanytekst+#13#10);
end;
procedure tserver.connect;
var
ListenerSocket, ConnectionSocket: TTCPBlockSocket;
begin
ListenerSocket := TTCPBlockSocket.Create;
ConnectionSocket := TTCPBlockSocket.Create;
ListenerSocket.CreateSocket;
ListenerSocket.setLinger(true,10);
ListenerSocket.bind(ip,port);
ListenerSocket.listen;
repeat
if ListenerSocket.canread(1000) then
begin
ConnectionSocket.Socket := ListenerSocket.accept;
if connectionsocket.LastError<>0 then
przyjmowanytekst:=('Error code: '+ inttostr(ConnectionSocket.lasterror));
AttendConnection(ConnectionSocket);
end;
until false;
ConnectionSocket.CloseSocket;
ListenerSocket.Free;
ConnectionSocket.Free;
end;
function GetIP: string;
var
TcpSock: TTCPBlockSocket;
ipList: TStringList;
begin
Result := '';
ipList := TStringList.Create;
try
TcpSock := TTCPBlockSocket.create;
try
TcpSock.ResolveNameToIP(TcpSock.LocalName, ipList);
Result := ipList.CommaText;
finally
TcpSock.Free;
end;
finally
ipList.Free;
end;
end;
lenovo
procedure tserver.wpisz;
begin
form1.Memo1.Lines.Add(przyjmowanytekst);
wysylanytekst:=form1.Edit1.Text;
end;
procedure tserver.execute;
begin
connect;
synchronize(@wpisz);
end;
//***************
procedure TForm1.FormCreate(Sender: TObject);
var
ser:tserver;
begin
port:='40516';
ip:=getip;
end;
//*******************
procedure TForm1.Button1Click(Sender: TObject);
var
ser:tserver;
begin
ser:=tserver.Create(false);
button1.Visible:=false;
end;
end.