// Projeto: Exemplo de Servidor Socket para simular um Gerenciador de Banco de Dados

// Descrição: O Servidor instância uma lista de strings, e recebe solicitações

// : de Cliente para Inserir, Excluir ou Listar.

// Desenvolvedor: Alberto Henrique Sousa

// Faculdade: Facthus - Talentos Humanos

// Curso: Sistemas de Informação

// Disciplinas: Redes de Computadores II

// Professor: Diovani Milhorim

// Data: 23/08/2007

unit Princ;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Sockets, ScktComp, ExtCtrls;

type

TFormPrincipal = class(TForm)

ServerSocket1: TServerSocket; // Componente servidor "Socket"

Panel1: TPanel;

Edit1: TEdit;

Label1: TLabel;

Log: TMemo;

Button1: TButton;

procedure ServerSocket1ClientRead(Sender: TObject;

Socket: TCustomWinSocket);

procedure FormShow(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

{ Private declarations }

List: TStringList; // Lista para armazenamento de Strings

procedure Status;

procedure MsgLog(S: String);

procedure AnalisaSolicitacao(S: String);

public

{ Public declarations }

end;

var

FormPrincipal: TFormPrincipal;

implementation

{$R *.dfm}

// Package: dclsocket70.bpl

procedure TFormPrincipal.AnalisaSolicitacao(S: String); // Método para Análise das Solicitações

var // enviadas pelo Cliente

Comando, Msg: String;

P: Integer;

Sucesso: Boolean;

begin

Sucesso := False;

MsgLog('Solicitação: '+S);

Comando := TrimLeft(S);

if LowerCase(Trim(S)) = 'select' then // Comando Select

begin

Msg := '';

for P:=0 to List.Count-1 do

Msg := Msg + '['+ IntTostr(P+1) + '] ' + List[P] + ' ';

ServerSocket1.Socket.Connections[0].SendText(Msg); // Envia uma mensagem para o cliente

Sucesso := True; // Envia todos registros cadastrado na lista

end

else if LowerCase(Copy(Comando, 01, 07)) = 'insert ' then // Comando Insert

begin

List.Add(Copy(Comando, 08, Length(Comando))); // Inseri nova String na Lista

Sucesso := True;

end

else if LowerCase(Copy(Comando, 01, 07)) = 'delete ' then // Comando Delete

begin

P := StrToIntDef(Copy(Comando, 08, Length(Comando)), 0);

Dec(P);

if (P > -1) and (P < List.Count) then

begin

List.Delete(P); // Deleta String da Lista, o comando possui um parâmetro

Sucesso := True; // para indicar a posição do registro a ser deletado

end;

end;

if Sucesso then

Msg := 'Sucesso.'

else

Msg := 'Falha!';

MsgLog(Msg);

ServerSocket1.Socket.Connections[0].SendText(Msg); // Envia uma mensagem para o cliente

end; // com a mensagem de Sucesso ou Falha.

procedure TFormPrincipal.ServerSocket1ClientRead(Sender: TObject;

Socket: TCustomWinSocket);

begin

// O Método "ClientRead" faz a leitura da mensagem enviada pelo cliente através

// da propriedade "ReceiveText" do componente "TCustomWinSocket".

AnalisaSolicitacao(Socket.ReceiveText);

end;

procedure TFormPrincipal.FormShow(Sender: TObject);

begin

Button1Click(Self);

end;

procedure TFormPrincipal.FormClose(Sender: TObject;

var Action: TCloseAction);

begin

// Desativa Servidor ao fechar

ServerSocket1.Active := False;

end;

procedure TFormPrincipal.Status;

begin

if ServerSocket1.Active then // Status do Servidor

begin

Button1.Caption := 'Stop';

MsgLog('Servidor Conectado...');

end

else

begin

Button1.Caption := 'Start';

MsgLog('Servidor Desconectado...');

end;

end;

procedure TFormPrincipal.MsgLog(S: String);

begin

Log.Lines.Add(S);

Application.ProcessMessages;

end;

procedure TFormPrincipal.Button1Click(Sender: TObject);

begin

List.Clear;

if not ServerSocket1.Active then

ServerSocket1.port := StrToIntdef(Edit1.text, 0); // Define a porta de conexão

ServerSocket1.Active := not ServerSocket1.Active; // Ativa/Desativa conexão

Status;

end;

procedure TFormPrincipal.FormCreate(Sender: TObject);

begin

List := TStringList.Create; // Instância a Lista

end;

procedure TFormPrincipal.FormDestroy(Sender: TObject);

begin

List.Free; // Remove a Lista da Memória

end;

end.