[Tutorial] Criando o Search Share
Antes de comercarmos a codar, irei mostrar a logica do funcionamento do Search Share.
1 - Servidor e cliente se conectam.
2 - Servidor envia pedido para receber a lista de arquivos contidos no servidor.
3 - Servidor recebe a resposta, vê de que se trata, envia a lista para o cliente.
4 - Cliente recebe a resposta, ve do que se trata, poe a lista no listbox.
5 - Usuario seleciona um arquivo.
6 - Destina o caminho a ser salvo o arquivo.
7 - Faz o pedido de download.
8 - Servidor recebe a resposta, ve do que se trata, manda o arquivo.
9 - cliente recebe a resposta, ve do que se trata, recebe o arquivo.
10 - Processo concluido ;).
ListBox.
O liztbox irá conter o nome dos arquivos compartilhador, aonde o usuario deve selecionar um para o download.
ProgressBar.
O progressbar serve para mostrar como está indo o download.
Label's.
Os label's servem apenas para indicar o que cada editbox ou coisa do tipo serve, para que o usuario nao fique perdido, arrume ele's para que fiquem parecido com a imagem acima ;)
Componentes:
1 - editbox.
3 - Label's.
2 - GroupBox.
1 - ListBox.
1 - Memo.
1 - Button.
1 - ServerSocket.
Arrume o seu projeto a ficar de acordo com o da imagem abaixo:
(//http://img402.imageshack.us/img402/7774/imgservermg0.th.jpg) (//http://img402.imageshack.us/my.php?image=imgservermg0.jpg)
Entendendo o cada um faz:
Editbox.
O usuario deve colocar aqui a porta em que o server vai escutar.
Memo.
O memo irá ser o nosso status, ele irá mostrar o que está acontecendo, se ocorreu algum erro, etc.
Label's.
Os label's servem apenas para indicar o que cada editbox ou coisa do tipo serve, para que o usuario nao fique perdido, arrume ele's para que fiquem parecido com a imagem acima ;)...
Prosseguindo com os codigos...
Cliquem no button 1, que no caso é o botão de conectar e coloque o seguinte codigo:
Quoteprocedure TForm1.Button1Click(Sender: TObject);
begin
try
ClientSocket1.Port:=StrToInt(edit1.Text);
ClientSocket1.Address := IPBox.Text;
ClientSocket1.Active := True;
except
Memo1.Lines.Add('**Erro ao tentar se conectar');
end;
end;
Explicando...
Aqui tentamos no conectar no servidor pelo ip e porta informados, Caso aja algum erro será informado no Memo1 ;D
Button3 - Download.
Quoteprocedure TForm1.Button3Click(Sender: TObject);
var
item: string;
begin
if listbox1.Items.Text = '' then
begin
ShowMessage('Nenhuma arquivo existente!');
exit;
end;
if form1.ListBox1.ItemIndex < 0 then
begin
showmessage('Nenhum arquivo selecionado!');
exit;
end;
item := ListBox1.Items[listBox1.ItemIndex];
if form1.DownloadAs.Text = '' then
begin
ShowMessage('Você deve escolher aonde será salvo o arquivo primeiro!');
form1.DownloadAs.SetFocus;
exit;
end;
if clientsocket1.Active then
begin
RemoteFile := item;
StoredLocalAs := DownloadAs.Text;
ClientSocket1.Socket.SendText(''+RemoteFile);
end;
end;
Explicando...
Aqui verificamos as seguintes coisas:
Se tem arquivos compartilhados.
Se tem alguma arquivo selecionado.
Se o usuario escolhe qual será o nome e o caminho do arquivo a ser salvo.
E por fim envia o pedido do arquivo.
Button 4 - Salvar.
Quoteprocedure TForm1.Button4Click(Sender: TObject);
begin
if save.Execute then
begin
DownloadAs.Text := save.FileName;
end;
end;
Explicando...
Aqui colocamos aonde o arquivo deve ser salvo.
Agora iremos inserir no evento Create do form o seguinte codigo.
Quoteprocedure TForm1.FormCreate(Sender: TObject);
begin
CState := CSIdle;
end;
Explicando...
aqui definos o status do cliente como normal, ou seja: Ele ainda não está baixando nada xD.
Evento Connectingo do ClienSocket.
Quoteprocedure TForm1.ClientSocket1Connecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo1.Lines.Add('Conectando...');
end;
Explicando...
Colocamos no memo que estamos tentando nos conectar...Apenas um charme ;)
Bom galera chegamos ao final do cliente agora iremos codar o server.
[Codando o Server]Digamos que o server será mais simples, para o começo vamos definir as variaveis globais.
QuoteRequestedFile: string;
Explicando...
Conterá o nome do arquivo que o cliente deseja baixar.
Procedures usadas.
Precisamos definir uma procedure para envia o arquivo.
Colocaremos ela na parte do type, aonde está definida outras procedures do form
Quote...
procedure ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure SendClientFile;
procedure ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
...
Button1 - Compartilhar...Ativa o servidor.
Quoteprocedure TForm1.Button1Click(Sender: TObject);
begin
ServerSocket1.Port:=StrToInt(edit1.Text);
ServerSocket1.Active:=true;
end;
Explicando...
Coloca o servidor em modo de escuta.
Evento Create do form.
Quoteprocedure TForm1.FormCreate(Sender: TObject);
var
SR: TSearchRec;
I: integer;
pat:string;
begin
pat:=ExtractFilePath(application.ExeName);
I := FindFirst(pat+'\*', faAnyFile, SR);
while I = 0 do
begin
if ( sr.Name <> '.' ) and ( sr.Name <> '..' ) then
listbox1.Items.Add(sr.Name);
I := FindNext(SR);
end;
end;
Explicando...
Ao criar o form pegamos tudo o que tem no diretorio e colocamos no listbox.
Evento Listen do serversocket.
Quoteprocedure TForm1.ServerSocket1Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo1.Lines.Add('Esperando por conexões...');
end;
Adoro isso xD.Mais um charme \o/.
Evento Disconnect do ServerSocket.
Quoteprocedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
memo1.Lines.Add('O cliente se desconectou');
end;
Informamos que o cliente se desconectou;
Error do ServerSocket.
Quoteprocedure TForm1.ServerSocket1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
errorcode:=0;
memo1.Lines.Add('**Erro');
end;
Ao ocorrer um erro, mostra que ocorreu algo, e zeramos esse erro para que o programa não trave

.
Evento Read do ServeSocket.
Quoteprocedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
Buf : string;
MsgLen,LenReceived : integer;
begin
MsgLen := Socket.ReceiveLength;
SetLength( buf,MsgLen );
LenReceived := Socket.ReceiveBuf( buf[1], msgLen );
Buf := Copy(buf, 1, LenReceived);
if Pos('',buf) = 1 then
begin
socket.SendText('|'+listbox1.Items.Text);
end;
if Pos('', buf) = 1 then
begin
delete(buf, 1, 11);
RequestedFile := buf;
SendClientFile;
end;
end;
Essa parte merece um atenção.
Ao receber algo do cliente, verificamos qual é o tipo de pedido.
Se for
ele está pedindo a lista dos arqivos compartilhados.
Se for ele está pedindo um arquivo, então pegamos qual arquivo ele quer e transferimos o controle para o procedure SendClientFile.
Procedure SendClientFile.
Quoteprocedure Tform1.SendClientFile;
var
TheFileSize : integer;
FS : TFileStream;
begin
if FileExists(RequestedFile) then
begin
try
FS := TFileStream.Create(RequestedFile, fmOpenRead);
Fs.Position := 0;
TheFileSize := Fs.Size;
serversocket1.Socket.Connections[0].SendText(''+IntToStr(TheFileSize)+'|') ;
serversocket1.Socket.Connections[0].SendStream(FS);
except
serversocket1.Socket.Connections[0].SendText('|Não pode enviar o arquivo');
end;
end
else begin
serversocket1.Socket.Connections[0].SendText('|O Arquivo nao existe');
end;
end;
Explicando...
Tentamos ler o arquivo desejado.
Pegamos o tamanho dele.
Enviamos o tamanho dele.
Depois enviamos o arquivo.
Caso aja algum erro. Enviamos o erro.
Caso o arquivo não exista. Enviamos o erro novamente.
Bom galera chegamos ao fim do tutorial. Se alguém quiser baixar o source completo do Search Share, segue o link:
http://www.4shared.com/file/31225413/fe ... Share.html (http://www.4shared.com/file/31225413/fecf445c/Source_-_Search_Share.html)
Bye.
/****************** End Of File ******************\
hunm muito legal...
Não sei se em delphi tem como, mas tipo o seu servidor apenas atenderia a uma conexão né....
Como teria jeito de um servidor mandar mais de uma arquivo a mais de um cliente?
nao entenda como ofensa , mas se vc usar mais os neuronios e fizer umas pesquisas google se faz isso bem melhor , mais otimizado , e uma pena q eu nao posso liberar Black Rose , senao vcs teriam uma ideia
Eu pretendo arruma-lo sim, mais isso numa proxima versão...
coloca um opção de conexão reversa para ele funcionar na minha rede ;)
Bye