Получение IdTCPClient'ом сообщения

[100GRamm]

Сообщение от Пепел Феникса

TIdTCPClient в отличие от ClientSocket не асинхронен, в нем можно проверить есть ли данные, и затем попытаться их прочесть.
это делается через таймер или поток

Каким образом это реализовать?

Клиент:

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

procedure TForm1.idcConnected(Sender: TObject);
begin
   idc.IOHandler.WriteLn('bay!!!');
   memo1.Lines.Add(idc.IOHandler.ReadLn);
   idc.Disconnect;
end;

procedure TForm1.idcDisconnected(Sender: TObject);
begin
    memo1.Lines.Add('disconnect');
end;

Сервер:

procedure TForm1.idsExecute(AContext: TIdContext);
var ss:string;
begin
  memo1.Lines.Add(AContext.Connection.IOHandler.ReadLn);
  AContext.Connection.SendCmd('eeeeeeeeeeerrrrrrrt');
end;

Получилось как-то так:
77.jpg

Выходит : Отправка-ответ... использовал события Connected (клиент) и Execute (сервер)... без таймеров .. пока... надо проббовать теперь со стремами, для списков.

..вопрос только.. если какой-нибудь чекер портов или тп подключится, то сервер повиснет, ожидая команду.. ставить (TerminateWaitTime) что ли?

...курю Подгорецкого...

[100GRamm]

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

сервер

procedure TForm1.FormCreate(Sender: TObject);
var i:integer;
begin
  for I := 0 to 10000 do  Listbox1.Items.Add(inttostr(random(10000000)))
end;

procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  ms: TMemoryStream;
begin
  if Socket.ReceiveText = 'send' then
  begin
    ms:= TMemoryStream.Create;
    try
      Listbox1.Items.SaveToStream(ms);
      ms.Position:= 0;
      Socket.SendText(IntToStr(ms.Size) + #0); memo1.Lines.Add(IntToStr(ms.Size));
      Socket.SendStream(ms);
    except
      ms.Free;
    end;
  end;
end;

клиент

var
  Form1: TForm1;
  Reciving:boolean;  DataSize:LongInt;   Data:TMemoryStream;
....

procedure TForm1.Button1Click(Sender: TObject);
begin
  cs.Socket.SendText('send');
end;

procedure TForm1.csRead(Sender: TObject; Socket: TCustomWinSocket);
var
  s, sl: string;
begin
  s:= Socket.ReceiveText;
  // Если мы не в режиме приёма:
  if not Reciving then
  begin
    SetLength(sl, StrLen(PChar(s))+1); // +1 for the null terminator
    StrLCopy(@sl[1], PChar(s), Length(sl)-1);
    DataSize:= StrToInt(sl);  memo1.Lines.Add(sl);
    Data:= TMemoryStream.Create;
    Delete(s, 1, Length(sl));
    Reciving:= true;
  end;
  try
    Data.write(s[1], length(s));
    if Data.Size = DataSize then
    begin
      Data.Position:= 0;
      Listbox1.Items.LoadFromStream(Data);
      Data.Free;
      Reciving:= false;
      Socket.Close;
    end;
  except
    Data.Free;
    memo1.Lines.Add('error');
  end;
end;

в результате передается размер стрима и один байт данных (первый символ) и всё!
77wr.jpg
... как видно и ошибки при передаче никакой не вызывается

[Slym]

Делай в блокирующем режиме... это гораздо проще чем склейка неблокирующего...
а самый прикол: этож можно на http запилить... idHttpServer (в дальнейшем если вдруг на левый хостинг перейти задумаешь)

[100GRamm]

В итоге отказался от Индейца.. жаль, но сроки поджимают. Сделал так:
Сервер (часть текста(неважного) пришлось удалить - не влвзил)

type
MTX=record
IP:string;
Protect:boolean;
CMD:string;
indx:integer;
TimeConnect, TimeBegin, TimeEnd: TTime;
TS: TStringList;
end;
const MaxCount=10;
var
Form1: TForm1;
Mtrx: array [0..MaxCount] of MTX;
..
function TForm1.findFree:integer;
var i:integer;
begin
result:=-1; i:=0;
while (Mtrx[i].Protect=true)and(i<=MaxCount) do inc(i);
if Mtrx[i].Protect=false then
begin
Mtrx[i].Protect:=true;
Mtrx[i].CMD:='';
Mtrx[i].IP:='';
Mtrx[i].TS.Clear;
Mtrx[i].indx:=0;
result:=i;
end;
end;

function TForm1.findIP(IP:string):integer;
var i:integer;
begin
result:=-1; i:=0;
while (Mtrx[i].IP<>IP)and(i<=MaxCount) do inc(i);
if Mtrx[i].IP=IP then result:=i;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var i:integer;
begin
for I := 0 to MaxCount do Mtrx[i].TS.Free;
end;

procedure TForm1.ssClientConnect(Sender: TObject; Socket: TCustomWinSocket);
var i:integer;
begin
i:=findFree;
if i<>-1 then begin Mtrx[i].IP:=Socket.RemoteAddress; Mtrx[i].TimeConnect:=time; end;
end;

procedure TForm1.ssClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
var i,k:integer;
begin
for I := 0 to MaxCount do
if Mtrx[i].IP = Socket.RemoteAddress then begin Mtrx[i].Protect:=false; k:=i; end;
m1.Lines.Add('Disconnect '+Socket.RemoteAddress+', Slot #'+inttostr(k)+' free, Timing of sesion:'+timetostr(Mtrx[k].TimeConnect)+'-'+ timetostr(Mtrx[k].TimeBegin)+'-'+timetostr(Mtrx[k].TimeEnd));
end;

procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
var s:string; lck:integer;
begin
s:=Socket.ReceiveText;
lck:= findIP(Socket.RemoteAddress);
if lck<>-1 then
if Mtrx[lck].CMD='' then
begin
Mtrx[lck].CMD:=s; Mtrx[lck].indx:=-1;
if Mtrx[lck].CMD='[GetPatList]' then begin Mtrx[lck].TS.Assign(lb.Items);
Mtrx[lck].TS.Insert(0,'[GetPatList]'+inttostr(Mtrx[lck].TS.Count+1));
Mtrx[lck].indx:=0;
Mtrx[lck].TimeBegin:=time; end;
if Mtrx[lck].indx<>-1 then Socket.SendText('<AllReadyForYou>'{ +inttostr(Mtrx[lck].TS.Count)}) else Socket.Close;
end
else
begin
if Mtrx[lck].CMD='[GetPatList]' then begin Socket.SendText(GetStrMTRX(lck)); end;
end;
end;

function TForm1.GetStrMTRX(iMTRX:integer):st ring;
var i:integer;
begin
if Mtrx[iMTRX].indx < Mtrx[iMTRX].TS.Count then
begin
result:= Mtrx[iMTRX].TS[Mtrx[iMTRX].indx];
inc(Mtrx[iMTRX].indx);
end
else
begin
result:='<EndOfSending>';
Mtrx[iMTRX].CMD:='';
Mtrx[iMTRX].Protect:=false;
Mtrx[iMTRX].TimeEnd:=time;
end;
end;

end.

Клиент

var
Form1: TForm1;
CMD: string;
RecNow:boolean;
st:TStringList;
..

procedure TForm1.Button1Click(Sender: TObject);
begin
cs.Open;
lb.Clear;
pb.Position:=0;
st:=TStringList.Create; st.Clear;
CMD:= '[GetPatList]' ;
RecNow:=false;
end;

procedure TForm1.csConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Memo1.Lines.Add('Connect ' + Socket.RemoteHost);
cs.Socket.SendText(CMD);
Memo1.Lines.Add('Begin ask: ' + timetostr(time));
end;

procedure TForm1.csRead(Sender: TObject; Socket: TCustomWinSocket);
var s:string;
begin
s:=Socket.ReceiveText;

if (RecNow) then if s<>'<EndOfSending>' then begin st.Add(s); Socket.SendText('NXT');
if st.Count=1 then pb.Max:= strtoint(GetWord(s,1,']'));
pb.Position:=st.Count;
end
else begin Socket.Close; RecNow:=false;
Memo1.Lines.Add('End rec: ' + timetostr(time)+', count recs: '+inttostr(st.Count));
lb.Items.Assign(st); st.Destroy;
end;
if s='<AllReadyForYou>' then begin RecNow:=true; Socket.SendText('NXT'); Memo1.Lines.Add('Begin rec: ' + timetostr(time)); end;

end;

end.

Всё ок, но скорость , конечно, не та ((
77wr3.jpg

[100GRamm]

Сообщение от Slym

Делай в блокирующем режиме... это гораздо проще чем склейка неблокирующего...
а самый прикол: этож можно на http запилить... idHttpServer (в дальнейшем если вдруг на левый хостинг перейти задумаешь)

Надо попробовать