Ir para conteúdo
Fórum Script Brasil
  • 0

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


Rento

Pergunta

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 por Rento
Link para o comentário
Compartilhar em outros sites

7 respostass a esta questão

Posts Recomendados

  • 0
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?

Link para o comentário
Compartilhar em outros sites

  • 0

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 por Rento
Link para o comentário
Compartilhar em outros sites

  • 0

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.

Link para o comentário
Compartilhar em outros sites

  • 0

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.

Link para o comentário
Compartilhar em outros sites

  • 0

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

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...