Просто TClientSocket

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

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

Просто TClientSocket

Сообщение mike » 29.07.2025 21:24:07

Всем привет.

Возникла необходимость переноса простецкой делфовой утилиты на Linux, но вместо работы сижу и офигеваю.

Под FPC/Lazarus есть что-то, хоть немного напоминающее по простоте использования стандартный делфовый клиентский TCP-сокет?
Мне от него почти ничего не надо: просто создать экземпляр класса, просто присвоить обработчик события типа OnRead, и чтобы в этот обработчик просто прилетали принятые данные. Все.

Без трахомудии с потоками. Без опроса сокета по таймеру ("родная" демка Indy, просто какой-то невероятный facepalm). Без необходимости угадывать, сколько именно байт прилетело от сервера.

Спасибо.
mike
новенький
 
Сообщения: 43
Зарегистрирован: 23.02.2007 17:25:00

Re: Просто TClientSocket

Сообщение Alex2013 » 29.07.2025 22:49:49

Alex2013
долгожитель
 
Сообщения: 3154
Зарегистрирован: 03.04.2013 11:59:44

Re: Просто TClientSocket

Сообщение mike » 30.07.2025 01:26:56

Alex2013 писал(а):А чем вам Synapse не угодил ?

А что общего он имеет с сабжем?
Прием данных не по принципу "прилетел пакет, можешь забрать сейчас, можешь заниматься своими делами до следующего пакета и забрать все вместе", а по принципу "говори, сколько тебе надо, и виси до таймаута если столько еще нет, а сколько есть -- не скажу".
Как с таким подходом принимать поток байт без отдельного треда со всеми вытекающими?

Целевая аудитория этой либы вообще не очень понятна.
В рамках моей задачи столь тонкая обертка ничего не меняет: мне проще самому написать собственный класс над юнитом sockets без лишних ненужностей, чем вникать в чужой и писать обертку уже над ним.
А формошлепщики даже не поймут что это, и с какой стороны к ней подходить.

И зачем хранить двоичные данные в строках, когда есть динамические массивы? Попахивает пионерством.
mike
новенький
 
Сообщения: 43
Зарегистрирован: 23.02.2007 17:25:00

Re: Просто TClientSocket

Сообщение Alex2013 » 30.07.2025 02:20:31

mike писал(а): И зачем хранить двоичные данные в строках, когда есть динамические массивы?

Медленные они ( при изменения размера чудовищные тормоза)
По прочему извиняюсь не особо вник в задачу ( или я туплю по жаре или описание проблемы действительно не очень внятное )
Зы
Как вариант можно попробовать адаптировать код из HIASM ( onRead есть лаконичность гарантируется + deepseek отлично транслирует эти допотопные кракозябры в рабочий код лазарус (проверенно!) )
Код: Выделить всё
unit TCP;

interface

uses kol,Windows,WinSock,Messages;

type
  TSocket = class;
  TSocketRead = procedure(Socket:TSocket; buf:pointer; len:cardinal) of object;
  TSocketNotify = procedure(Socket:TSocket) of object;

  TSocket = class
    private
     FParent:TSocket;
     FList:PList;

     function GetConnections(Index:integer):TSocket;
     function GetCount:cardinal;
     function GetConnected:boolean;

    protected
     FSocket:THandle;

    public
     SendBlocked:boolean;
     Tag:integer;
     IP:string;

     OnRead:TSocketRead;
     OnConnect:TSocketNotify;
     OnDisconnect:TSocketNotify;
     OnClientConnect:TSocketNotify;
     OnClientDisconnect:TSocketNotify;

     constructor Create; overload;
     constructor Create(par:TSocket); overload;
     destructor Destroy; override;

     procedure StartServer(Port:word; const Host:String);
     procedure StartClient(Port:word; const Host:String);
     procedure Listen(Max:word);
     procedure Close;
     procedure DisconnectClients;
     procedure DisconnectByIP(const Host:String);
     procedure Send(Buf:pointer; Size:cardinal);

     property Connections[Index:integer]:TSocket read GetConnections;
     property Count:cardinal read GetCount;
     property Connected:boolean read GetConnected;
     property Handle:THandle read FSocket;
     property Parent:TSocket read FParent;
  end;

implementation

var ToolWnd:THandle; AllSockets:PList;

function MWnd(window:hwnd; message:dword; wparam:WPARAM; lparam:LPARAM):LRESULT; stdcall;
var i:integer; sc,sc1:TSocket; buf:string; sz,szMax:integer;
begin
   Result := 0;
   case message of
    WM_USER: begin
      for i:=0 to AllSockets.Count-1 do begin
        sc := TSocket(AllSockets.Items[i]);
        if sc.Handle=THandle(wparam) then begin
          case lparam and $FFFF of
           FD_ACCEPT: begin
               sc1 := TSocket.Create(sc);
               if Assigned(sc.onClientConnect) then
                 sc.onClientConnect(sc1);
             end;
           FD_READ: begin
               ioctlsocket(sc.Handle, FIONREAD, szMax);
               SetLength(buf, szMax);
               while szMax>0 do begin
                 sz := Winsock.recv(sc.Handle, buf[1], szMax, 0);
                 if sz<=0 then break;
                 if Assigned(sc.onRead) then
                   sc.onRead(sc,@buf[1],sz);
                 dec(szMax,sz);
               end;
             end;
           FD_WRITE: sc.SendBlocked := False;
           FD_CLOSE: begin
               sc.Close;
               if Assigned(sc.Parent) then sc.Destroy;
             end;
          end;
          break;
        end;
      end;
    end;
    else Result := DefWindowProc(window,message,wparam,lparam);
   end;
end;

procedure CreateWindow;
var
  utilclass:TWndClass;
  wsaData:TWSAData; 
begin
   if ToolWnd > 0 then exit;

   WSAStartup($101,wsaData);
   ZeroMemory(@utilclass,sizeof(utilclass));
   utilclass.lpfnWndProc := @MWnd;
   utilclass.lpszClassName := 'TSocket';
   utilclass.hInstance := HInstance;
   RegisterClassA(utilclass);
   ToolWnd := CreateWindowEx(WS_EX_TOOLWINDOW,utilclass.lpszclassname,nil,
    WS_POPUP,0,0,0,0,0,0,hinstance,nil);
   AllSockets := NewList;
end;

procedure DestroyWindow;
begin
   AllSockets.Free;
   Windows.DestroyWindow(ToolWnd);
   ToolWnd := 0;
   WSACleanup;
end;

constructor TSocket.Create;
begin
   CreateWindow;
   FParent := nil;
   FSocket := 0;
   AllSockets.Add(Self);
end;

constructor TSocket.Create(par:TSocket);
type TChAddr = record c1,c2,c3,c4:byte; end;
var ad:TSockAddr; sz:integer;
begin
   FParent := par;
   sz := sizeof(TSockAddr);
   FSocket := accept(par.FSocket,@ad,@sz);
   SendBlocked := False;
   with TChAddr(Ad.sin_addr) do
     IP := int2str(c1) + '.' + int2str(c2) + '.' + int2str(c3) + '.' + int2str(c4);
   OnRead := par.OnRead;
   AllSockets.Add(Self);
   FParent.FList.Add(Self);
   WSAAsyncSelect(FSocket,ToolWnd,WM_USER,FD_READ or FD_WRITE or FD_CLOSE);
end;

destructor TSocket.Destroy;
begin
   Close;
   if FList<>nil then DisconnectClients;
   if FParent<>nil then FParent.FList.Remove(Self);
   AllSockets.Remove(Self);
   if AllSockets.Count=0 then DestroyWindow;
end;

procedure TSocket.StartServer;
var addr:sockaddr_in;
begin
   if FSocket<>0 then Exit;
   FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
   addr.sin_family := AF_INET;
   addr.sin_port := htons(Port);
   if Host = '' then
     addr.sin_addr.S_addr := INADDR_ANY
   else addr.sin_addr.S_addr := inet_addr(PChar(Host));
   if bind(FSocket,addr,sizeof(addr)) = -1 then
     begin
       closesocket(FSocket);
       FSocket := 0;
     end
   else
    begin
     FList := NewList;
     WSAAsyncSelect(FSocket,ToolWnd,WM_USER,FD_ACCEPT or FD_CLOSE);
     if Assigned(onConnect) then
       onConnect(Self);
    end;
end;

procedure TSocket.StartClient;
var addr:sockaddr_in;
begin
   if FSocket<>0 then Exit;
   FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_IP);
   SendBlocked := False;
   addr.sin_family := AF_INET;
   addr.sin_port := htons(Port);
   addr.sin_addr.S_addr := inet_addr(PChar(Host));
   if connect(FSocket,addr,sizeof(addr)) <> 0 then
     begin
       closesocket(FSocket);
       FSocket := 0;
     end
   else
    begin
     WSAAsyncSelect(FSocket,ToolWnd,WM_USER,FD_READ or FD_WRITE or FD_CLOSE);
     if Assigned(onConnect) then
       onConnect(Self);
    end;
end;

function TSocket.GetConnections;
begin
  Result := TSocket(FList.Items[Index]);
end;

function TSocket.GetCount;
begin
  if FList <> nil then
    Result := FList.Count
  else Result := 0;
end;

function TSocket.GetConnected;
begin
  Result := FSocket > 0;
end;

procedure TSocket.Listen;
begin
  if FSocket=0 then Exit;
  Winsock.Listen(FSocket,Max);
end;

procedure TSocket.DisconnectClients;
var i:smallint;
begin
  for i := FList.Count-1 downto 0 do with Connections[i] do
   begin
    Close;
    Destroy;
   end;
  FList.Clear;
end;

procedure TSocket.DisconnectByIP;
var i:smallint;
begin
  for i := FList.Count-1 downto 0 do with Connections[i] do
  begin
    if ip = Host then
    begin
      Close;
      Destroy;
    end;
  end;
end;

procedure TSocket.Send;
var sent:integer;
begin
  while (FSocket<>0) and (Size>0) do begin
    sent := Winsock.send(FSocket,buf^,Size,0);
    if sent=SOCKET_ERROR then begin
      if WSAGetLastError()=WSAEWOULDBLOCK then begin
        SendBlocked := True;
        //while SendBlocked and not AppletTerminated do begin
     //if Assigned(Applet) then Applet.ProcessMessages;
//     Sleep(1);  // ????
   //end;
      end else Exit;
    end else begin
      dec(Size, sent);
      buf := pointer(integer(buf)+sent);
    end;
  end;
end;

procedure TSocket.Close;
begin
  if FSocket=0 then Exit;
  WSAAsyncSelect(FSocket,ToolWnd,0,0);
  closesocket(FSocket); FSocket := 0; SendBlocked := False;
  if Assigned(onDisconnect) then
    onDisconnect(Self);
  if Assigned(FParent) then
    if Assigned(FParent.onClientDisconnect) then
      FParent.onClientDisconnect(Self);
end;
end.


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

interface

uses Kol,Share,Windows,TCP,Debug;

const
  dtInteger = 0;
  dtString = 1;
  dtReal = 2;
  dtStream = 3;

type
  THITCP_Client = class(TDebug)
   private
    Sock:TSocket;
    Mem:PStream;
    FSize:cardinal;
    FDeleteSocket:boolean;

    procedure _OnConnect(Sender: TSocket);
    procedure _OnDisConnect(Sender: TSocket);
    procedure _OnRes(Sender: TSocket; Buf: pointer; Count: cardinal);
    //procedure _OnError(Sender: PObj; const Error:integer);
   public
    _prop_IP:string;
    _prop_Port:integer;
    _prop_DataType:byte;
    _data_IP:THI_Event;
    _data_Data:THI_Event;
    _data_Port:THI_Event;
    _event_onConnect:THI_Event;
    _event_onDisconnect:THI_Event;
    _event_onRead:THI_Event;
    _event_onError:THI_Event;
    _event_onProgress:THI_Event;

    constructor Create;
    destructor Destroy; override;
    procedure Attach(sck:TSocket);
    function Detach:TSocket;
    procedure _work_doOpen(var _Data:TData; Index:word);
    procedure _work_doClose(var _Data:TData; Index:word);
    procedure _work_doSend(var _Data:TData; Index:word);
    procedure _var_Active(var _Data:TData; Index:word);
    procedure _var_IP(var _Data:TData; Index:word);
  end;

implementation

constructor THITCP_Client.Create;
begin
  inherited;
  Sock := nil;
  FDeleteSocket := false;
end;

destructor THITCP_Client.Destroy;
begin
  if Assigned(Sock) then
    if FDeleteSocket then Detach.Destroy else Detach;
  inherited;
end;

procedure THITCP_Client.Attach;
begin
  if Assigned(Sock) then
    if FDeleteSocket then Detach.Destroy else Detach;
  Sock := sck;
  Sock.OnConnect := _OnConnect;
  Sock.OnDisconnect := _OnDisConnect;
  Sock.OnRead := _OnRes;
  //Sock.OnError := _onError;
end;

function THITCP_Client.Detach;
begin
  Result := Sock;
  if Assigned(Sock) then begin
    Sock.OnConnect := nil;
    Sock.OnDisconnect := nil;
    Sock.OnRead := nil;
    //Sock.OnError := nil;
    Sock := nil;
    FDeleteSocket := false;
  end;
end;

procedure THITCP_Client._OnConnect;
begin
   _hi_OnEvent( _event_onConnect );
end;

procedure THITCP_Client._OnDisConnect;
begin
   _hi_OnEvent( _event_onDisConnect );
end;

{procedure THITCP_Client._OnError;
begin
  _hi_OnEvent( _event_onError,Error );
end;}

procedure THITCP_Client._OnRes;
var s:string;
    c:integer;
begin
    case _prop_DataType of
     0: _hi_OnEvent(_event_onRead,integer(buf^));
     1:
      begin
       SetLength(s,Count);
       CopyMemory(@s[1], buf, Count);
       _hi_OnEvent(_event_onRead,s);
      end;
     2: _hi_OnEvent(_event_onRead,real(buf^));
     3:
      while count > 0 do
       begin
         if Mem = nil then
          begin
           Mem := NewMemoryStream;
           FSize := cardinal(buf^);
           inc(integer(buf), 4);
           dec(Count, 4);
          end;
         
         if Count > 0 then
          begin
            c := Mem.Write(buf^,min(count,FSize - Mem.Size));
            dec(count, c);           
            inc(integer(buf), c);
          end;

         _hi_OnEvent(_event_onProgress, integer(Mem.Position));

         if FSize = Mem.Size then
          begin
             Mem.Position := 0;
             _hi_OnEvent(_event_onRead,mem);
             Free_and_nil(Mem);
          end;
       end;
    end;
end;

procedure THITCP_Client._work_doOpen;
var p:word;
   h:string;
begin
  if not Assigned(Sock) then begin
    Attach(TSocket.Create);
    FDeleteSocket := true;
  end;
  P := ReadInteger(_Data,_data_Port,_prop_Port);
  H := ReadString(_Data,_data_IP,_prop_IP);
  Sock.StartClient(p,h);
end;

procedure THITCP_Client._work_doClose;
begin
   if Assigned(Sock) then Sock.Close;
end;

procedure THITCP_Client._work_doSend;
var st:PStream;
    i:integer;
    r:real;
    s:string;
begin
  if not Assigned(Sock) then Exit;
  if Sock.Connected then
    case _prop_DataType of
     0:
       begin
        i := ReadInteger(_data,_data_Data,0);
        Sock.Send(@i,sizeof(i));
       end;
     1:
      begin
        s := ReadString(_data,_data_Data,'');
        Sock.Send(@s[1],length(s));
      end;
     2:
       begin
        r := ReadReal(_data,_data_Data,0);
        Sock.Send(@r,sizeof(r));
       end;
     3:
      begin
        st := ReadStream(_data,_data_Data,nil);
        if st <> nil then
         begin
         //_debug(int2str(st.size));
          st.Position := 0;
          i := st.Size;
          Sock.Send(@i,sizeof(i));
          Sock.Send(st.Memory,St.Size);
         end;
      end;
    end;
end;

procedure THITCP_Client._var_Active;
var a:integer;
begin
  if Assigned(Sock) then a := byte(Sock.Connected) else a := 0;
  Share.dtInteger(_Data, a);
end;

procedure THITCP_Client._var_IP;
begin
  if Assigned(Sock) then Share.dtString(_Data, Sock.IP);
end;

end.



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

interface

uses Kol,Share,Windows,TCP, Debug;

const
  dtInteger = 0;
  dtString = 1;
  dtReal = 2;
  dtStream = 3;

type
  THITCP_Server = class(TDebug)
   private
    Sock:TSocket;
    Arr:PArray;
    Mem:PStream;
    FSize:cardinal;
    FSizeCount:byte;

    function Read(Var Item:TData; var Val:TData):boolean;
    function Count:integer;

    procedure _OnConnect(Sender: TSocket);
    procedure _OnDisConnect(Sender: TSocket);

    procedure _OnClientConnect(Sender: TSocket);
    procedure _OnClientDisConnect(Sender: TSocket);
    procedure _OnRes(Sender: TSocket; Buf: pointer; Count: cardinal);
//    procedure _OnError(Sender: PObj; const Error:integer);
   public
    _prop_IP:string;
    _prop_Port:integer;
    _prop_DataType:byte;
    _data_Data:THI_Event;
    _data_Port:THI_Event;
    _event_onConnect:THI_Event;
    _event_onDisconnect:THI_Event;
    _event_onServerConnect:THI_Event;
    _event_onServerDisconnect:THI_Event;
    _event_onRead:THI_Event;
    _event_onError:THI_Event;
    _event_onProgress:THI_Event;

    constructor Create;
    destructor Destroy; override;
    procedure _work_doOpen(var _Data:TData; Index:word);
    procedure _work_doClose(var _Data:TData; Index:word);
    procedure _work_doSend(var _Data:TData; Index:word);
    procedure _work_doSendByIp(var _Data:TData; Index:word);
    procedure _work_doCloseAll(var _Data:TData; Index:word);
    procedure _work_doCloseByIP(var _Data:TData; Index:word);
    procedure _var_Count(var _Data:TData; Index:word);
    procedure _var_IP(var _Data:TData; Index:word);
  end;

implementation

constructor THITCP_Server.Create;
begin
   inherited;
   Sock := TSocket.Create;
   Sock.OnConnect := _OnConnect;
   Sock.OnDisconnect := _OnDisConnect;
   Sock.OnRead := _OnRes;
   Sock.OnClientConnect := _OnClientConnect;
   Sock.OnClientDisconnect := _OnClientDisConnect;
//   Sock.OnError := _OnError;
end;

destructor THITCP_Server.Destroy;
begin
  Sock.OnConnect := nil;
  Sock.OnDisconnect := nil;
  Sock.OnRead := nil;
  Sock.OnClientConnect := nil;
  Sock.OnClientDisconnect := nil;
  Sock.Destroy;
  if Arr <> nil then dispose(Arr);
  inherited;
end;

procedure THITCP_Server._work_doOpen;
begin
   if Sock.Connected then Exit;
   Sock.StartServer(ReadInteger(_Data,_data_Port,_prop_Port),'');
   if Sock.Connected then Sock.Listen(10);
end;

procedure THITCP_Server._work_doClose;
begin
   if Sock.Connected then Sock.DisconnectClients;
   Sock.Close;
end;

procedure THITCP_Server._OnClientConnect;
begin
   _hi_OnEvent( _event_onConnect,Sender.IP );
end;

procedure THITCP_Server._OnClientDisConnect;
begin
   _hi_OnEvent( _event_onDisConnect,Sender.IP );
end;

procedure THITCP_Server._OnConnect;
begin
   _hi_OnEvent( _event_onServerConnect );
end;

procedure THITCP_Server._OnDisConnect;
begin
   _hi_OnEvent( _event_onServerDisconnect );
end;

//procedure THITCP_Server._OnError;
//begin
//  _hi_OnEvent( _event_onError,Error );
//end;

procedure THITCP_Server._OnRes;
var
    dt,d:TData;
    f:PData;
    c:integer;
    s: string;
   
    procedure event;
    begin
      Share.dtString(d, Sender.IP);
      AddMTData(@dt, @d, f);
      _hi_OnEvent(_event_onRead, dt);
      FreeData(f);   
    end;
begin
    case _prop_DataType of
     0: begin Share.dtInteger(dt, integer(buf^)); event(); end;
     1: begin
          SetLength(s, Count);
          CopyMemory(@s[1], buf, Count);
          Share.dtString(dt, s);
          event();
         end;
     2: begin Share.dtReal(dt, real(buf^)); event(); end;
     3:
      while count > 0 do
       begin
         if Mem = nil then
          begin
           c := min(count, 4 - FSizeCount);
           CopyMemory(pointer(integer(@FSize) + FSizeCount), buf, c);
           inc(FSizeCount, c);
           if FSizeCount = 4 then
             begin
               Mem := NewMemoryStream;
               FSize := cardinal(buf^);
               if (count < 4) then
                  _debug('THITCP_Server: incorrect value count ' + int2str(count));
               inc(integer(buf), 4);
             end;
           dec(Count, c);
          end;
         
         if Count > 0 then
          begin
            c := Mem.Write(buf^,min(count,FSize - Mem.Size));
            dec(count, c);           
            inc(integer(buf), c);
          end;

         _hi_OnEvent(_event_onProgress, integer(Mem.Position));

         if FSize = Mem.Size then
          begin
             Mem.Position := 0;
             Share.dtStream(dt, Mem);
             event();
//             _hi_OnEvent(_event_onRead,mem);
             Free_and_nil(Mem);
             FSizeCount := 0;
          end;
       end;
    end;
end;

procedure THITCP_Server._work_doSend;
var i,j:integer;
  r:real;
  s:string;
  st:PStream;
begin
    st := nil;
    case _prop_DataType of
       0: j := ReadInteger(_data,_data_Data,0);
       1: s := ReadString(_data,_data_Data,'');
       2: r := ReadInteger(_data,_data_Data,0);
       3: begin
             st := ReadStream(_data,_data_Data,nil);
             if st <> nil then
               j := st.Size;
          end;
    end;

   if Sock.Connected then
    for i := 0 to Sock.Count-1 do
     case _prop_DataType of
       0: Sock.Connections[i].Send(@j,sizeof(j));
       1: Sock.Connections[i].Send(@s[1],length(s));
       2: Sock.Connections[i].Send(@r,sizeof(r));
       3: begin
              if st <> nil then
               begin
                 Sock.Connections[i].Send(@j,sizeof(j));
                 st.Position := 0;
                 Sock.Connections[i].Send(st.Memory,j);
               end;
          end;
    end;
end;

procedure THITCP_Server._work_doSendByIp;
var i,j:integer;
  r:real;
  s,ip:string;
  st:PStream;
  con:TSocket;
begin
    st := nil;
    case _prop_DataType of
       0: j := ReadInteger(_data,_data_Data,0);
       1: s := ReadString(_data,_data_Data,'');
       2: r := ReadInteger(_data,_data_Data,0);
       3: begin
             st := ReadStream(_data,_data_Data,nil);
             if st <> nil then
               j := st.Size;
          end;
    end;

   ip := ToString(_Data);
   con := nil;
   for i := 0 to Sock.Count-1 do
    if ip = Sock.Connections[i].ip then
     begin
      con := Sock.Connections[i];
      break;
     end;   
   
   if Sock.Connected and (con <> nil) then
     case _prop_DataType of
       0: con.Send(@j,sizeof(j));
       1: con.Send(@s[1],length(s));
       2: con.Send(@r,sizeof(r));
       3: begin
              if st <> nil then
               begin
                 con.Send(@j,sizeof(j));
                 st.Position := 0;
                 con.Send(st.Memory,j);
               end;
          end;
    end;
end;

procedure THITCP_Server._work_doCloseAll;
begin
  Sock.DisconnectClients;
end;

procedure THITCP_Server._work_doCloseByIP;
begin
  Sock.DisconnectByIP(ToString(_Data));
end;

procedure THITCP_Server._var_Count;
begin
  if Assigned(Sock) then
     Share.dtInteger(_Data,Sock.Count);
end;

procedure THITCP_Server._var_IP;
begin
  if Arr = nil then
    Arr := CreateArray(nil,read,count,nil);
  dtArray(_Data,Arr);
end;

function THITCP_Server.Read;
type
   TChAddr = record c1,c2,c3,c4:byte; end;
var
  ind:integer;
begin
  ind := ToIntIndex(Item);
  if(ind >= 0 )and(ind < integer(Sock.Count))then
    Share.dtString(Val,Sock.Connections[ind].IP)
  else dtNull(Val);
  Result := not _IsNull(Val);
end;

function THITCP_Server.Count;
begin
   if Assigned(Sock) then Result := Sock.Count else Result := 0;
end;

end.

Изображение
Alex2013
долгожитель
 
Сообщения: 3154
Зарегистрирован: 03.04.2013 11:59:44

Re: Просто TClientSocket

Сообщение v-t-l » 30.07.2025 12:06:01

https://github.com/serbod/dataport
По описанию подходит, сам не пробовал.

Добавлено спустя 9 минут 27 секунд:
https://github.com/almindor/lnet
Еще есть.
v-t-l
энтузиаст
 
Сообщения: 742
Зарегистрирован: 13.05.2007 16:27:22
Откуда: Belarus

Re: Просто TClientSocket

Сообщение stikriz11 » 31.07.2025 04:43:50

Хотел отправить файл, но администратором запрещено отправлять с расширением пас...
Хотел вставить текст модуля, но оказывается много буков в нем...
Как так-то? Запрещен паскаль тут? Неожиданно...

Добавлено спустя 12 минут 21 секунду:
Как в дельфи начиная с версии 4. И только для винды. Но, советую на синапсы перейти.

Добавлено спустя 3 минуты 15 секунд:
иконки
У вас нет необходимых прав для просмотра вложений в этом сообщении.
stikriz11
постоялец
 
Сообщения: 130
Зарегистрирован: 04.09.2023 15:54:19

Re: Просто TClientSocket

Сообщение sts » 31.07.2025 11:10:21

странно что в лазарусе нет реализации TClientSocket для "кроссплатформенности" исходников.
не увидел чегото невозможного для этого

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

в самих исходниках борланда бардак с названиями

Alex2013 писал(а):Медленные они ( при изменения размера чудовищные тормоза)

в динамических массивах такойже механизм как и у строк, собственно программистам дали возможность его использовать

mike писал(а):И зачем хранить двоичные данные в строках, когда есть динамические массивы?

динамические массивы появились позже, видимо для обратной совместимости кодовой базы не спешат, в той же indy на них перешли
sts
постоялец
 
Сообщения: 463
Зарегистрирован: 04.04.2008 12:15:44
Откуда: Тольятти

Re: Просто TClientSocket

Сообщение Sharfik » 31.07.2025 13:35:28

mike писал(а):Мне от него почти ничего не надо: просто создать экземпляр класса, просто присвоить обработчик события типа OnRead, и чтобы в этот обработчик просто прилетали принятые данные. Все.

Перевожу на русский: Сам не хочу ничего делать, хочу за бесплатно получить IDE и чтобы в ней были компоненты которые за меня все делают, а я буду изображать программиста и надувать щеки.
Indy для начинающего сложноват я думаю. Synapse отличная вещь и есть пример как в пакете, так и тут на форуме я приводил в соседней теме ссылки на примеры.

Delphi по сравнению с Lazarus это песочница в программировании. ПО сделанное на Delphi чаще всего завязано на всякую дичь типа OLE/ActiveX, .Net, и прочие фреймворки.

mike писал(а):Целевая аудитория этой либы вообще не очень понятна.

Те, кому надо сделать нормальное клиент серверное приложение.

Прием данных не по принципу "прилетел пакет, можешь забрать сейчас, можешь заниматься своими делами до следующего пакета и забрать все вместе", а по принципу "говори, сколько тебе надо, и виси до таймаута если столько еще нет, а сколько есть -- не скажу".

:lol: :lol: :lol: :lol:
Реально, лучше потратить пару дней и разобраться как работает прием-отправка пакетов. Размер буфера, размер пакета ethernet это все нельзя надо учитывать.
Аватара пользователя
Sharfik
энтузиаст
 
Сообщения: 813
Зарегистрирован: 20.07.2013 01:04:30

Re: Просто TClientSocket

Сообщение sts » 31.07.2025 13:49:09

Sharfik писал(а):Перевожу на русский: Сам не хочу ничего делать, хочу за бесплатно получить IDE

в этом смысл лазаруса
Sharfik писал(а):и чтобы в ней были компоненты которые за меня все делают

в этом смысл делфи
Sharfik писал(а):Delphi по сравнению с Lazarus это песочница в программировании.

вы видимо путаете с фрипаскалем, лазарус сделан чтоб бесплатно компилить исходники для делфы
sts
постоялец
 
Сообщения: 463
Зарегистрирован: 04.04.2008 12:15:44
Откуда: Тольятти

Re: Просто TClientSocket

Сообщение iskander » 31.07.2025 14:01:42

Имхо ближе всего к озвученной функциональности сокеты lNet.

Alex2013 писал(а):
mike писал(а):И зачем хранить двоичные данные в строках, когда есть динамические массивы?

Медленные они

"Медленный массив" немного напоминает синий вкус или горький цвет.
iskander
энтузиаст
 
Сообщения: 626
Зарегистрирован: 08.01.2012 18:43:34

Re: Просто TClientSocket

Сообщение Sharfik » 31.07.2025 14:21:35

sts писал(а):вы видимо путаете с фрипаскалем, лазарус сделан чтоб бесплатно компилить исходники для делфы

:? :shock: кошка сделана чтобы не выгуливать собаку....
Аватара пользователя
Sharfik
энтузиаст
 
Сообщения: 813
Зарегистрирован: 20.07.2013 01:04:30

Re: Просто TClientSocket

Сообщение sts » 31.07.2025 14:29:34

Sharfik писал(а):
sts писал(а):вы видимо путаете с фрипаскалем, лазарус сделан чтоб бесплатно компилить исходники для делфы

:? :shock: кошка сделана чтобы не выгуливать собаку....


Lazarus — это кроссплатформенная бесплатное программное обеспечение интегрированная среда разработки (IDE) для быстрой разработки приложений (RAD) с использованием Free Pascal компилятора . Её цель — предоставить простую в использовании среду разработки для работы с языком Object Pascal , максимально приближенным к Delphi
sts
постоялец
 
Сообщения: 463
Зарегистрирован: 04.04.2008 12:15:44
Откуда: Тольятти

Re: Просто TClientSocket

Сообщение Sharfik » 31.07.2025 14:51:36

и где тут "сделан чтоб бесплатно компилить исходники для делфы"? Причем вообще тут Delphi, когда Laz сделан для развития языка Object Pascal
Аватара пользователя
Sharfik
энтузиаст
 
Сообщения: 813
Зарегистрирован: 20.07.2013 01:04:30

Re: Просто TClientSocket

Сообщение sts » 31.07.2025 16:02:49

Sharfik писал(а):и где тут "сделан чтоб бесплатно компилить исходники для делфы"? Причем вообще тут Delphi, когда Laz сделан для развития языка Object Pascal

бесплатное программное обеспечение

максимально приближенным к Delphi
sts
постоялец
 
Сообщения: 463
Зарегистрирован: 04.04.2008 12:15:44
Откуда: Тольятти

Re: Просто TClientSocket

Сообщение Alex2013 » 31.07.2025 18:15:22

sts писал(а):в динамических массивах такойже механизм как и у строк, собственно программистам дали возможность его использовать

Просто почти никто не будет увеличивать размер строки по одному символу до мегабайтных размеров, а в случае бинарного динамического массива это чисто логически кажется вполне «штатным случаем». Но прикол в том, каждое изменение размера динамического массива вызывает копирование всего массива в новое место в памяти (то есть проблема в том, что «динамические» массивы не поддерживают фрагментации).

Хранить строчные данные принято в "быстрых" структурах и списках типа TStringList, так что, несмотря на кажущуюся экономию памяти, сохранение данных в виде списков строк часто вполне оправданный компромисс между удобством использования, скоростью доступа, простотой редактирования и занимаемым объемом памяти. В крайнем случае можно использовать нетипизированный список TList, но это не слишком отличается от TStringList. + это будет заменено мнение «гибкий способ» (в строку можно легко добавить новые поля, модификаторы, комментарии, сохранив совместимость формата и общий цикл обработки).

Пример строчного формата данных
Код: Выделить всё
RAPHAEL_GRADI 65280 8421376/90 17 3-633 683
OUTTEXT 0 16777215/0/0/default/0.0.0.1_Альфа_начало_преобразования_МА_RED_в_FORMred_ 31 49 END
OUTTEXT 0 16777215/0/0/default/0.0.0.2_Альфа_Жестокая_"рыба"_но_концепция_растет__. 31 74 END
OUTTEXT 0 16777215/0/0/default/0.0.0.3_Альфа_расширил_запись_элементов_+_настроил_чтение_из_ini-файла 31 101 END
OUTTEXT 0 16777215/0/0/default/0.0.0.4_добавил_загрузку_начальных_значений_в_инспектор_элементов_._ 31 129 END
BUTTON 255 16777215/10/12//http://lib.ru\БИБЛИОТЕКА_1 34 177 END
LINK 8388608 16777215/10/12/default/http://google.com\ГУГЛ_В_ПОМОЩЬ_! 33 238 END
OUTTEXT 0 65535/0/9/default/__0.0.0.4_12_Добавил__обратную__трансляцию(OТ)__данных_из_инспектора_элементов_в_команды._ 29 301 END
OUTTEXT 16777215 128/0/0/default/0.0.0.4_13_Добавил_ЖТ_для_управления_с_помощью_стрелок. 23 342 END
RAPHAEL_RECT 0 255 179 176-213 201
RAPHAEL_RECT 0 16777215 202 238-232 257
RAPHAEL_RECT 0 16777215 19 378-337 409
LINK 8388608 16777215/10/15/default/http://google.com\ГУГЛ_В_ПОМОЩЬ_! 33 380 END
RAPHAEL_RECT 0 255 14 2-488 6
RAPHAEL_RECT 0 255 26 419-469 521
OUTTEXT 0 255/0/29/default/Загадочный_HTML_ 72 449 END
OUTTEXT 65280 65535/100/22/Segoe_Script/Загадочный_HTML_ 70 492 END
RAPHAEL_ELIPS 65280 32768 295 166-437 293
RAPHAEL_ELIPS 65535 65280 319 190-412 279
RAPHAEL_LINE 65535 65280 320 228-412 228
RAPHAEL_LINE 65535 65280 365 229-365 277
RAPHAEL_LINE 65535 65280 334 260-344 226
RAPHAEL_LINE 65535 65280 376 228-398 258
RAPHAEL_ELIPS 65535 16711808 452 136-511 195
RAPHAEL_RECT 65535 0 436 145-529 186
OUTTEXT 65535 0/0/15/default/09:54:12 448 151 END
RAPHAEL_STAR 255 16777215 386 321-477 409
RAPHAEL_STAR 255 16777215 388 323-479 411
RAPHAEL_STAR 255 16777215 390 325-481 413
RAPHAEL_POLILINE 0 16777215 33 276 269 276 269 276 269 166 269 166 333 166 333 166 END
RAPHAEL_POLILINE 32768 16777215 478 209 448 241 448 241 484 273 484 273 509 246 509 246 486 226 486 226 467 244 467 244 483 257 483 257 497 244 497 244 END
RAPHAEL_POLILINE 32768 16777215 478 211 448 243 448 243 484 275 484 275 509 248 509 248 486 228 486 228 467 246 467 246 483 259 483 259 497 246 497 246 END
RAPHAEL_POLILINE 32768 16777215 478 213 448 245 448 245 484 277 484 277 509 250 509 250 486 230 486 230 467 248 467 248 483 261 483 261 497 248 497 248 END
RAPHAEL_KONTUR 65280 16777215 48 215 16 264 16 264 262 265 262 265 242 215 242 215 END
RAPHAEL_KONTUR 65280 16777215 50 217 18 266 18 266 264 267 264 267 244 217 244 217 END
RAPHAEL_KONTUR 65280 16777215 46 213 14 262 14 262 260 263 260 263 240 213 240 213 END
RAPHAEL_KUB 0 16777215 448 44-579 204
RAPHAEL_KUB 255 16777215 448 44-581 206
RAPHAEL_KUB 0 16777215 377 49-508 209
RAPHAEL_KUB 255 16777215 377 49-510 211
IMAGE pic_DRW.jpg 16777215 27 547-179 649
IMAGE pic_DRW.jpg 16777215 191 547-343 649
IMAGE pic_DRW.jpg 16777215 353 547-505 649
PAGE_SETUP [f.htm]  [16777215]  []  []  [<ZZZ>]

В при загрузке память все остается точно так же потому что затраты на парсинг практически незаметны а вот полное преобразование в бинарные данные при такой вариативности "командного языка" дело довольно гиблое .
Последний раз редактировалось Alex2013 31.07.2025 18:42:48, всего редактировалось 3 раз(а).
Alex2013
долгожитель
 
Сообщения: 3154
Зарегистрирован: 03.04.2013 11:59:44

След.

Вернуться в Lazarus

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

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 215

Рейтинг@Mail.ru