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

Novas classes TServer e TClient [Exclusivo]


Rento

Pergunta

Após eu passar por dores de cabeças com o TServerSocket e o TClientSocket, fiz está classes.

Ela corrige os principais erros que enfrentei e mais alguns que podem estar acontecendo por ai:

  • MensagensComProblamaDeJuntaTudoAndBugarTudo
  • Mensagens grandes 100%
  • Address com "localhost" auto para 127.0.0.1
Junto com o arquivo unSocket.pas vem um projeto de exemplo.

Você pode modificar quaisquer arquivo, mantendo por favor o cabeçalho.

Link de tudo:

http://www.myfileupload.net/download.php?f...58d91c2146ebf79

unSocket.pas:

{*----------------------------------------------------------------------------*}
{* Socket Tools v1.0 written by Rento (rento@click21.com.br) ******************}
{*----------------------------------------------------------------------------*}
{* Constants for use with Socket Tools ****************************************}
{*----------------------------------------------------------------------------*}
{* Copyright © 2008 Rento *}
{* Permission is hereby granted, free of charge, to any person obtaining a *}
{* copy of this software and associated documentation files (the "Software"), *}
{* to deal in the Software without restriction, including without limitation *}
{* the rights to use, copy, modify, merge, publish, distribute, sublicense, *}
{* and/or sell copies of the Software, and to permit persons to whom the *}
{* Software is furnished to do so, subject to the following conditions: *}
{* *}
{* The above copyright notice and this permission notice shall be included in *}
{* all copies or substantial portions of the Software. *}
{* *}
{* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *}
{* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *}
{* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *}
{* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *}
{* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *}
{* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *}
{* DEALINGS IN THE SOFTWARE. *}
{********************************* FUNCTIONS **********************************}
// DAY | Function | Type
// 10/04/2008 create v1 Server
// 10/04/2008 rSendMessage v1 Server
// 10/04/2008 rOnBefRead v1 Server
// 10/04/2008 rChangeActive v1 Server
// 10/04/2008 Destroy v1 Server
//
// 11/04/2008 rSeparateMsg v1 unit
// 11/04/2008 rOnBefRead v2 Server
// 11/04/2008 onLogin v1 Server
// 11/04/2008 onLogout v1 Server
//
// 12/04/2008 rSendText overload v1 Server
// 12/04/2008 rOnBefRead v2 Server
// 12/04/2008 onError v1 Server
// 12/04/2008 create v1 Client
// 12/04/2008 rOnBefRead v1 Client
// 12/04/2008 Destroy v1 Client
// 12/04/2008 rSendMessage v1 Client
// 12/04/2008 onError v1 Client
// Ops! Are 00:03 of 13/04/2008
// 13/04/2008 onConnect v1 Client

{*----------------------------------------------------------------------------*}
unit unSocket;

interface

uses
ScktComp, WinSock, Classes, Windows, forms, SysUtils;
//------------------------------------------------------------------------------
procedure rSeparateMsg(var pLst: TStrings; pMsg: string);
type
{ 10060 | 10061 | 10065, 10064 | 10040 }
TErrorType = (etTimeOut, etRefused, etNoHost, etHostDown, etTooLong, etUnknow);
TRetEvt = procedure(pMessage: string; pFrom: Pointer) of object;
TEtnEvt = procedure(pSocket: TCustomWinSocket) of object;
TGetEvt = procedure(pSocket: TCustomWinSocket; pMsg: string) of object;
TErrEvt = procedure(pSocket: TCustomWinSocket; pErroType: TErrorType; var pErroCode: Integer) of object;
TServer = class
protected
FServer : TServerSocket;
FRetEvt : TRetEvt;
FLogin : TEtnEvt;
FLogout : TEtnEvt;
FLastMsg: string;
FMsgLst : TStrings;
FConIds : TList;
FErrEvt : TErrEvt;
procedure rOnBefRead(Sender: TObject; Socket: TCustomWinSocket);
procedure rOnBefLogin(Sender: TObject; Socket: TCustomWinSocket);
procedure rOnBefLogout(Sender: TObject; Socket: TCustomWinSocket);
procedure rOnBefError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
public
constructor Create(pPort: Integer; const pActive: Boolean = False);
destructor Destroy(); override;
property onExecute: TRetEvt read FRetEvt write FRetEvt;
property onLogin : TEtnEvt read FLogin write FLogin;
property onLogout : TEtnEvt read FLogout write FLogout;
procedure rSendMessage(pIdx: Integer; pMsg: string); overload;
procedure rSendMessage(pData: Pointer; pMsg: string); overload;
procedure rChangeActive(pValor: Boolean);
property onError : TErrEvt read FErrEvt write FErrEvt;
end;

TClient = class
protected
FGetEvt : TGetEvt;
FLastMsg: String;
FMsgLst : TStrings;
FClient : TClientSocket;
FErrEvt : TErrEvt;
FLogin : TEtnEvt;
procedure rOnBefRead(Sender: TObject; Socket: TCustomWinSocket);
procedure rOnBefError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure rOnBefCon(Sender: TObject; Socket: TCustomWinSocket);
public
constructor Create(pIp: string; pPort: Integer; const pActive: Boolean = False);
destructor Destroy(); override;
property onRead : TGetEvt read FGetEvt write FGetEvt;
property onError : TErrEvt read FErrEvt write FErrEvt;
property onConnect: TEtnEvt read FLogin write FLogin;
procedure rSendMessage(pMsg: string);
end;
//------------------------------------------------------------------------------
implementation

constructor TServer.Create(pPort: Integer; const pActive: Boolean = False);
begin
FServer := TServerSocket.Create(nil);
FMsgLst := TStringList .Create;
FConIds := TList .Create;
FServer.Port := pPort;
FServer.OnClientConnect := rOnBefLogin;
FServer.OnClientRead := rOnBefRead;
FServer.OnClientDisconnect := rOnBefLogout;
FServer.OnClientError := rOnBefError;
rChangeActive(pActive);
end;

procedure TServer.rSendMessage(pIdx: Integer; pMsg: string);
var
I: Integer;
begin
if pMsg <> '' then
begin
if pIdx = -1 then
begin
for I := 0 to FServer.Socket.ActiveConnections - 1 do
begin
Application.ProcessMessages; // If ActiveConnections so large...
FServer.Socket.Connections[I].SendText(#0 + pMsg + #0 + 'END');
end;
end
else
begin
if pIdx <= FServer.Socket.ActiveConnections - 1 then
begin
FServer.Socket.Connections[pIdx].SendText(#0 + pMsg + #0 + 'END');
end;
end;
end;
end;

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

procedure TServer.rOnBefRead(Sender: TObject; Socket: TCustomWinSocket);
var
lvAllRec: Boolean;
lvLength: Integer;
lvRecive: string;
lvAllMsg: string;
I: Integer;
begin
lvRecive := Socket.ReceiveText;
lvLength := Length(lvRecive);
lvAllRec := Copy(lvRecive, lvLength - 2, 3) = 'END';
if lvAllRec then
begin
lvAllMsg := FLastMsg + Copy(lvRecive, 1, lvLength - 3);
rSeparateMsg(FMsgLst, lvAllMsg);
for I := 0 to FMsgLst.Count - 1 do
onExecute(FMsgLst.Strings[I], Socket.Data);
end
else
begin
FLastMsg := FLastMsg + lvRecive;
end;
end;

procedure TServer.rOnBefLogin(Sender: TObject; Socket: TCustomWinSocket);
var
lvP: ^integer;
begin
New(lvP);
Socket.Data := lvP;
FConIds.Add(Socket.Data);
onLogin(Socket);
end;

procedure TServer.rOnBefLogout(Sender: TObject; Socket: TCustomWinSocket);
begin
onLogout(Socket);
FConIds.Remove(Socket.Data);
Dispose(Socket.Data);
end;

procedure rSeparateMsg(var pLst: TStrings; pMsg: string);
var
I: Integer;
lvTmp: String;
begin
lvTmp := '';
I := 1;
pLst.Clear;
while (I <= Length(pMsg)) do
begin
if pMsg[I] = #0 then
begin
Inc(I);
while ((pMsg[I] <> #0) and (I <= Length(pMsg))) do
begin
lvTmp := lvTmp + pMsg[I];
Inc(I);
end;
end;
Inc(I);
if lvTmp <> '' then
pLst.Add(lvTmp);
lvTmp := '';
end;
end;

procedure TServer.rOnBefError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
lvEt: TErrorType;
begin
case ErrorCode of
10060: lvEt := etTimeOut;
10061: lvEt := etRefused;
10065: lvEt := etNoHost;
10064: lvEt := etHostDown;
10040: lvEt := etTooLong;
else lvEt := etUnknow;
end;
onError(Socket, lvEt, ErrorCode);
end;

procedure TServer.rChangeActive(pValor: Boolean);
begin
if not pValor then
begin
FLastMsg := '';
FMsgLst.Clear;
FConIds.Clear;
FServer.Close;
end
else
begin
if not FServer.Active then
FServer.Open;
end;
end;

destructor TServer.Destroy();
begin
FMsgLst.Free;
FConIds.Free;
end;
//------------------------------------------------------------------------------
constructor TClient.Create(pIp: string; pPort: Integer; const pActive: Boolean = False);
begin
FLastMsg := '';
FMsgLst := TStringList .Create;
FClient := TClientSocket.Create(nil);
FClient.Port := pPort;
if (LowerCase(pIp) = 'localhost') or (Trim(pIp) = '') then
FClient.Address := '127.0.0.1'
else
FClient.Address := pIp;
FClient.OnRead := rOnBefRead;
FClient.OnError := rOnBefError;
if pActive then
if not FClient.Active then
FClient.Open;
end;

procedure TClient.rSendMessage(pMsg: string);
begin
if pMsg <> '' then
if FClient.Socket.Connected then
FClient.Socket.SendText(#0 + pMsg + #0+'END');
end;

procedure TClient.rOnBefRead(Sender: TObject; Socket: TCustomWinSocket);
var
lvAllRec: Boolean;
lvLength: Integer;
lvRecive: string;
lvAllMsg: string;
I: Integer;
begin
lvRecive := Socket.ReceiveText;
lvLength := Length(lvRecive);
lvAllRec := Copy(lvRecive, lvLength - 2, 3) = 'END';
if lvAllRec then
begin
lvAllMsg := FLastMsg + Copy(lvRecive, 1, lvLength - 3);
rSeparateMsg(FMsgLst, lvAllMsg);
for I := 0 to FMsgLst.Count - 1 do
onRead(Socket.Data, FMsgLst.Strings[I]);
end
else
begin
FLastMsg := FLastMsg + lvRecive;
end;
end;

procedure TClient.rOnBefError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
var
lvEt: TErrorType;
begin
case ErrorCode of
10060: lvEt := etTimeOut;
10061: lvEt := etRefused;
10065: lvEt := etNoHost;
10064: lvEt := etHostDown;
10040: lvEt := etTooLong;
else lvEt := etUnknow;
end;
onError(Socket,lvEt, ErrorCode);
ErrorCode := ErrorCode;
end;

procedure TClient.rOnBefCon(Sender: TObject; Socket: TCustomWinSocket);
begin
onConnect(Socket);
end;

destructor TClient.Destroy();
begin
FClient.Close;
FMsgLst.Free;
end;

end.[/codebox]

Editado por Rento
Link para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

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
      152k
    • Posts
      651,8k
×
×
  • Criar Novo...