(Resolvido) ServerSocket e ClientSocket: Enviar string grande. De uma

[Rento]

Oi, novamente eu aqui.

Dessa vez, Ai que inveja, fórum IPB...

Dessa vez eu preciso de uma ajuda.

Tenho um ServerSocket no servidor(dããã) e um Cliente no cliente( :clap: para mim!)

No evento conect do ServerSocket adiciono um Pointer do player em uma lista, e no Disconnect removo.

Até ai tudo bem, consigo manipular vários cliente em uma vez so.

Quando eu envio uma string de mais ou menos 4000 characters chega aos pedaços de 1300, 3000 mais ou menos, exceto quando executo em localhost....

Eu já tentei de tudo: Thread, sleep, mandar separado e fazer isso:

f := 1;

   for I := 1 to Length(lvText) do
      begin
      if (lvText[i] = #0) then
         begin
         Add(Copy(lvText, f, I));
         f := I;
         end;
      end;

Essa ultima tentava chegou até perto... Mas não é o que eu preciso. Se eu consertar o erro de quando enviar varias msg seguidas rapidamente e chegarem separadas não terei que fazer isso.

Eu vi uns negocio sobre o ctBlockin, mas não sei usar. Se isso for a solução eu aceito.

Ah, se alguém tiver a solução com sendstream aceito também, mas fiz aqui não conectou com o cliente(exceto em locahost)

Editado Abril 13, 2008 por Rento

[Micheus]

Eu já tentei de tudo: Thread, sleep, mandar separado e fazer isso:

f := 1;

   for I := 1 to Length(lvText) do
      begin
      if (lvText[i] = #0) then
         begin
         Add(Copy(lvText, f, I));
         f := I;
         end;
      end;

Essa ultima tentava chegou até perto... Mas não é o que eu preciso. Se eu consertar o erro de quando enviar varias msg seguidas rapidamente e chegarem separadas não terei que fazer isso.

Tá meio difícil.

Que tal você dizer onde este código está ou postar a parte do código onde há o envio e a parte do código onde há o recebimento?

[Rento]

servidor:

Port: 4072

stNonBlocking

servidorClientConnect:

var IDsocket : ^integer;
begin
   New(IDSocket);
   Socket.Data := IDSocket;
   pvLista.Add(Socket.data);
end;

servidorClientDisconnect:

pvLista.Remove(Socket.Data);
   Dispose(Socket.Data);

servidorClientRead:

var
  lvText , lvAux, lvMessag: string;
  lvActId: Integer;
  lvParam: TStringList;
begin
   lvParam  := TStringList.Create;
   lvText   := Socket.ReceiveText;
   lvText   := XTeaDecryptStr(lvText, fGetXteaPwd());
   lvMessag := (fGetString(lvText));
   lvAux	:= '';
   lvActId  := StrToInt(Copy(lvText, 1, 3));
   lvText   := Copy(lvText, 4, (Length(lvText) -4) - Length(lvMessag));
   case lvActId of
	  1: begin
		 lvMessag := Trim(lvMessag);
		 if lvMessag <> '' then begin
		 qry.SQL.Text :=
			'SELECT * FROM conta WHERE login = "' + Copy(lvMessag, 1, 32) + '" AND' +
			' pass = "' + Copy(lvMessag, 33, 32) + '"';
		 qry.Open;
		 lvActId := qry.RecordCount;
		 if lvActId = 1 then
			begin
			lvAux := '';
			rOpenRsQuery('SELECT * FROM player WHERE acc = "' + Copy(lvMessag, 1, 32) + '"');
			while not (fQrEof()) do
			   begin
			   lvAux := lvAux +  fQrStr('nome') + ';' + fQrStr('id') + ';';
			   rQrNext;
			   end;
			lvAux := Copy(lvAux, 1, Length(lvAux)-1);
			SendToPlayer(Socket.Data, '0041;'+lvAux, '');
			qry.Close;
			end
		 else if lvActId = 0 then
			begin
			SendToPlayer(Socket.Data, '0040', ''); // Senha ou acc errada
			end;
		 qry.Close;
		 end;
	  end;
	  2: begin
		 rOpenRsQuery('SELECT * FROM player WHERE id = ' + Trim(lvMessag));

		 for lvActId := Low(pvPlayers) to High(pvPlayers) do
			begin
			if pvPlayers[lvActId].havePlayer = False then
			   Continue;
			if pvPlayers[lvActId].playerData = Socket.Data then
			   Break;
			end;
		 mmCon.Lines.Add('Login: '+Socket.RemoteAddress +' New player: ' + fQrStr('nome'));
		 pvPlayers[lvActId].x := fStrToInt(fQrStr('x'));
		 pvPlayers[lvActId].y := fStrToInt(fQrStr('y'));
		 pvPlayers[lvActId].z := fStrToInt(fQrStr('z'));

		 pvPlayers[lvActId].hp := fStrToInt (fQrStr('hp'));
		 pvPlayers[lvActId].mp := fStrToInt (fQrStr('mp'));
		 pvPlayers[lvActId].exp := fStrToInt(fQrStr('exp'));
		 pvPlayers[lvActId].nome :=		 (fQrStr('nome'));
		 qry.Close;

		 rSendMap(pvPlayers[lvActId].x, pvPlayers[lvActId].y, pvPlayers[lvActId].z, Socket.Data);
	  end;
	  3: begin
		 lvActId := pvLista.IndexOf(Socket.Data);
		 if lvActId <> -1 then
			begin
			rSendMsg(pvPlayers[lvActId].x,
			   pvPlayers[lvActId].y,
			   pvPlayers[lvActId].z,
			   pvPlayers[lvActId].nome,
			   lvMessag);
			end;
	  end;
   end;
   FreeAndNil(lvParam);
end;

clientConnect:

if pvConected = False then
      begin
      lblErr.Caption := 'Checking login...';
      rSendAcc(txtLogin.Text, txtPass.Text);
      pvConected := True;
      end;

case ErrorCode of
      10060, 10061, 10065: begin
         pvConected := false;
         pnErrTit.Caption := '  Timeout';
         lblErr.Caption :=
            'Error: ' + IntToStr(ErrorCode) + ' Server not found.' + #10#13 + #10#13 +
            'Server is offline at the moment.' + #10#13 +
            'More information at the site.';
         prvErrNum  := 0;
         btnAct.Caption := 'Ok';
         ErrorCode  := 0;
      end;
   end;

clientRead:

var
  lvText , lvMessg: string;	  lvBool: Boolean;
  lvActId: Integer;
  lvParam: TStringList;
  I: Integer;
  lst: TStringList;
  S, f: Integer;
   procedure add(s: string);
   begin
	  if Trim(s) <> '' then
		 lst.Add(s);
   end;
begin
   lst	 := TStringList.Create;
   lvParam := TStringList.Create;
   lvText  := Socket.ReceiveText;
   lvText  := XTeaDecryptStr(lvText, fGetXteaPwd());
   f := 1;

   for I := 1 to Length(lvText) do
	  begin
	  if (lvText[i] = #0) then
		 begin
		 Add(Copy(lvText, f, I));
		 f := I;
		 end;
	  end;


   for S := 0 to lst.Count - 1 do
	  begin
		 lvText  := lst.Strings[s];

		 if Trim(lvText) <> '' then
			begin
			lvActId := StrToInt(Copy(lvText, 1, 3));

			lvMessg := fGetString(lvText);
			lvText  := Copy(lvText, 4, (Length(lvText) -4) - Length(lvMessg));
			lvMessg := Copy(lvMessg, 1, Length(lvMessg)-1);
			lvBool  := False;

			case lvActId of
			4: begin
			   rGetParam(lvText, lvParam);
			   if lvParam.Strings[0] = '0' then
				  begin
				  pnLoad.Show;
				  lblErr.Caption := 'Account number and passowrd is not correct.';
				  pnErrTit.Caption := '  Error';
				  end
			   else
				  begin
				  lstchar  .Clear;
				  lstCharId.Clear;
				  for I := 1 to lvParam.Count - 1 do
					 begin
					 lvBool := not lvBool;
					 case lvBool of
						True : lstchar  .Items.Add(lvParam.Strings[I]);
						False: lstCharId.Items.Add(lvParam.Strings[I]);
					 end;
					 end;
				  lstchar.ItemIndex := 0;
				  pnList.Show;
				  pnLoad.Hide;
				  end;
			   end;
			5: begin
			   Memo1.Lines.Add(lvMessg);
			   end;
			6: begin
			   //ShowMessage('Se apareceu isso, e que já pegou o mapa, so falta montar');
			   //Clipboard.AsText := lvMessg;
			   //Exit;
			   rMontaMapByStr(lvMessg);
			   end;
			end;
		 end;
	  end;
   FreeAndNil(lvParam);
   FreeAndNil(lst);[/codebox]

Existem varias funcoes que podem ser removidas, so coloquei para vocês ficarem sabendo do que se trata ^^

Editado Abril 9, 2008 por Rento

[Rento]

Resolvido:

Mais informações:

http://scriptbrasil.com.br/forum/index.php?showtopic=117637

[Micheus]

Resolvido:

Mais informações:

http://scriptbrasil.com.br/forum/index.php?showtopic=117637

Rento, vejo que compartilhou sua solução na sessão Tutoriais & Dicas. Tenho certeza de que será de proveito para muitos.

Eu dei uma passada no código e gostaria de fazer um pequeno comentário, apenas com o intuito de chamar a atenção para uma situação que pode vir a ser "problema" em algum tipo de aplicação. Vou pô-lo aqui, porque penso que naquela sessão, o lugar não é próprio às discussões.

Diz respeito ao 2º método rSendMessage. Apesar de ser apenas uma possibilidade, mas ela há, conforme aplicação implementada.

procedure TServer.rSendMessage(pData: Pointer; pMsg: string);
begin
  rSendMessage(FConIds.IndexOf(pData), pMsg);
end;

Partindo do princípio de que pData deveria ser um endereço válido armazenado na lista FConIds não há qualquer problema com a chamada realizada no código, passando o IndexOf. Entretanto, se por algum motivo a mensagem for enviada e o destino não mais for válido, IndexOf irá retornar -1 e como resultado, a mensagem que deveria ir para 1 única conexão, irá para todas (conforme implementação no 1º método: if pIdx = -1 then ...). Assim, seria interessante o teste antes do envio e você ainda poderia tratar o "erro" do ID da conexão inválida:

procedure TServer.rSendMessage(pData: Pointer; pMsg: string);
var
  Idx :integer;
begin
  Idx := FConIds.IndexOf(pData);
  if Idx >=0 then
    rSendMessage(Idx, pMsg)
  else
    ...  // ID da conexão inválida
end;

o uso da variável Idx evita que seja varrida a lista uma segunda vez.

E só mais uma observação com relação a criação de novas classes: é um bom hábito fazer referência aos métodos antecessores, como no caso do construtor Create e destruidor Destroy: é usar o inherited, no início do construtor e ao final do destruidor.

Abraços.

[Rento]

Nossa cara, essa ai do -1 foi muito bem pensada ^^ valeu!

Já sobre o inherited, eu não usei TX = Class(TSocket), criei por fora. Então não tem porque usar o inherited, eu acho.

Outra coisa ae pessoal, depois que eu usei.

Se chamar o .destroy, se apos ele der um FreeAndNil buga, é so remove o FREE AND NIL, se esquecer o destroy não vai da free nas listas. E vai bugar.

[Micheus]

dando continuidade às ponderações "técnicas"...

Já sobre o inherited, eu não usei TX = Class(TSocket), criei por fora. Então não tem porque usar o inherited, eu acho.

Rento, como eu disse, é apenas um bom hábito fazer isto.

Mas, para justificá-lo, vou por um trecho do que o help diz em TObject and TClass:

"(...) If the declaration of a class type doesn't specify an ancestor, the class inherits directly from TObject. Thus

type TMyClass = class

...

end;

is equivalent to

type TMyClass = class(TObject)

...

end;

(...) Se a declaração de uma classe não especifica ancestral, a classe herda diretamente de TObject. Assim

class ... é equivalente à ... class(TObject)

como você vê, esta sua classe criada "por fora" (eu diria sem herança), na verdade é sim descendente da classe base TObject e como esta classe possui constructor e destructor (dentre outros métodos), parece-me justificável que, ao reescrevê-los, os chamemos.

Você deve ter observado, por exemplo, que o recurso de auto-completar código deve ter lhe mostrados outros métodos que não os que você programou em sua classe.

Se chamar o .destroy, se apos ele der um FreeAndNil buga, é so remove o FREE AND NIL, se esquecer o destroy não vai da free nas listas. E vai bugar.

Correto. Ou você usa um, ou outro, visto que ambos irão remover a instância do objeto e uma segunda tentativa de remoção vai resultar em erro.

Entretanto, a recomendação constante no help, diz que para destruir o objeto, deve-se fazer a chamada ao método Free e não ao destructor Destroy:

"(...) Do not call Destroy directly. Call Free instead. Free verifies that the object reference is not nil before calling Destroy."

(...) Não chame Destroy diretamente. Prefira chame Free. Free verifica que a referência para o objeto não é nil antes de chamar Destroy.

Por este motivo, eu também diria que é um bom hábito utilizar Free ao invés de Destroy - exceção feita à classe TForm, quando o help recomenda seja utilizado Release.

Abraços

[Rento]

Valeu ae;

Quando tiver mais acordado(fui dormi as 4) eu posto os codigos modificados.

Sobre o free, vou por um if.

li um site todo(em ingles, mas ta bom) é o DelphiBasics, la tem tudo(espero eu) sobre as classes...

http://www.delphibasics.co.uk/Article.asp?Name=OOExample

Editado Abril 19, 2008 por Rento