Envoi de repertoire d'un serveur avec socket

Signaler
Messages postés
40
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
25 mai 2009
-
 Utilisateur anonyme -
bonsoir
voila avec le code suivant j'arrive bien a recevoir la liste des fichiers mais je voudrais avoir la liste des sous dossiers et en affichant les dossiers dans un TTreeView et les fichiers dans un TListview

Coordialement
Et Joyeux noel à tous!

unit commun;


interface
uses Windows, Classes, SysUtils, ScktComp;


const
ServerPort = 788;
MSG_REQUEST_FILE = $00010001;
MSG_FILE_FOLLOWS = $00010002;
MSG_REQUEST_LIST = $00020001;
MSG_LIST_FOLLOWS = $00020002;
MSG_ERR_DOES_NOT_EXIST = $00030001;
MSG_ERR_NO_FILES = $00030002;
MSG_ERR_ILLEGAL_CODE = $00030003;
MSG_ERR_CANNOT_SEND = $00030004;


type
TMsgHeader = packed record
OpCode : DWORD;
PayLoadLen : DWORD;
end;


procedure SendData( Sock: TCustomWinSocket; Code: DWORD; PayLoad: string);
procedure Log( Destination: TStrings; Txt : string );
procedure SendFile( Socket: TCustomWinSocket; FName: string );
procedure SendFileList( Socket: TCustomWinSocket; DirPath: string;
WildCard: string );
procedure SendError( Socket: TCustomWinSocket; Error: DWORD );
procedure EnumFiles(WildCard : string;
FileList : TStrings;
StripExtensions: boolean);
function MessageComplete( var SockBuf: string; var Header: TMsgHeader;
var PayLoad: string ): boolean;


implementation


//------------------------------------------------------------------------------
// Enumére la liste de fichier partagé
//------------------------------------------------------------------------------


procedure EnumFiles(WildCard : string;
FileList : TStrings;
StripExtensions: boolean);
var
SRec: TSearchRec;
Error: DWORD;
begin
try
FileList.Clear;
Error := FindFirst(WildCard, faANYFILE, SRec);
while Error = 0 do
begin
if SRec.Attr and faDIRECTORY = 0 then
if not StripExtensions then
FileList.Add(lowercase(SRec.Name))
else
FileList.Add(ChangeFileExt(lowercase(SRec.Name), ''));
Error := FindNext(SRec);
end;
Sysutils.FindClose(SRec);
except
messagebeep(0);
end;
end;


//------------------------------------------------------------------------------
// Envoie de donnée
//------------------------------------------------------------------------------
procedure SendData( Sock: TCustomWinSocket; Code: DWORD; PayLoad: string);
var
S : TMemoryStream;
Header : TMsgHeader;
begin
// installe header
with Header do
begin
OpCode := Code;
PayLoadLen := Length(PayLoad);
end;
S := TMemoryStream.Create;
S.Write( Header, SizeOf(Header) );
// en cas de messages utile sans charge ...
if Header.PayLoadLen > 0 then
S.Write( PayLoad[1], Header.PayLoadLen );
S.Position := 0;
Sock.SendStream( S ); // **note** stream will be freed by socket !!
end;



//------------------------------------------------------------------------------
//Journal
//------------------------------------------------------------------------------
procedure Log( Destination: TStrings; Txt : string );
begin


if not Assigned(Destination) then EXIT;
if length(Destination.Text) > 20000 then
Destination.Clear;
Destination.Add( TimeToStr(Now) + ' : ' + Txt );


end;


//------------------------------------------------------------------------------
//Envoie du fichier
//------------------------------------------------------------------------------
procedure SendFile( Socket: TCustomWinSocket; FName: string );
var
Header : TMsgHeader;
Fs : TFileStream;
S : TMemoryStream;
begin
if FileExists( FName ) then
try


// ouvrir le fichier
Fs := TFileStream.Create( FName, fmOPENREAD);
Fs.Position := 0;


// créer les tetes
S := TMemoryStream.Create;
Header.OpCode := MSG_FILE_FOLLOWS;
Header.PayLoadLen := Fs.Size;


// écrire d'abord l'en-tête
S.Write( Header, SizeOf(Header) );


// apposez alors le contenu de dossier
S.CopyFrom( Fs, Fs.Size );
S.Position := 0; // important...
// envoie du socket
Socket.SendStreamThenDrop( S );
Fs.Free;
except
SendError( Socket, MSG_ERR_CANNOT_SEND );
end
else
SendError( Socket, MSG_ERR_DOES_NOT_EXIST );
end;


//------------------------------------------------------------------------------
//Envoie de la liste des fichiers
//------------------------------------------------------------------------------
procedure SendFileList( Socket : TCustomWinSocket;
DirPath : string;
WildCard : string );
var
Buf : TStringList;
begin
Buf := TStringList.Create;
if not ( DirPath[Length(DirPath)] in ['/', '\'] ) then
DirPath := DirPath + '/';
EnumFiles( DirPath + WildCard, Buf, false );
SendData( Socket, MSG_LIST_FOLLOWS, Buf.Text );
Buf.Free;
end;


//------------------------------------------------------------------------------
//Envoie d'erreur
//------------------------------------------------------------------------------
procedure SendError( Socket: TCustomWinSocket; Error: DWORD );
begin
SendData( Socket, Error, '' );
end;


//------------------------------------------------------------------------------
//Message complet
//------------------------------------------------------------------------------
function MessageComplete( var SockBuf: string;
var Header : TMsgHeader;
var PayLoad: string ): boolean;
begin
Result := false;
if Length( SockBuf ) > SizeOf(Header) then // frappement de paranoïa...
begin
Move( SockBuf[1], Header, SizeOf(Header));
// avons-nous au moins un message complet?
if length(SockBuf) >= Header.PayLoadLen + SizeOf(Header) then
begin
// si oui, supprimez l'en-tête
Delete( SockBuf, 1, SizeOf(Header));
// copiez du buf à la charge utile
PayLoad := Copy( SockBuf, 1, Header.PayLoadLen);
// juste au cas où un autre message serait déjà dans la canalisation!
Delete( SockBuf, 1, Header.PayLoadLen );
Result := true;
end;
end;
end;



end.

4 réponses


Salut,

Il me parait bien compliqué ton code simplement pour lister les fichiers d'un serveur avec un client : il y a bcp plus simple.

Petit conseil : refait le entièrement

bonne prog

a+
Messages postés
1418
Date d'inscription
samedi 12 juin 2004
Statut
Membre
Dernière intervention
5 juillet 2010
13
Francky >> je ne sais pas si cela avancera cybersky
si tu lui dis que son code est trop compliqué et qu'il faut qu'il le
refasse entièrement... Donne au moins des axes de modification, donne
des exemples, justifie ta remarque quoi...



@+

Nico { http://www.ni69.new.fr/ }




<hr size="2" width="100%">

N'oubliez pas de cliquer sur Réponse Acceptée lorsque la réponse vous convient !

Salut,

Ni69 j'ai déjà répondu à cette question sur autre topic. Je me répète alors :

Prendre la méthode récursive de Mister GrandVizir et au lieu d'afficher dans le mémo utiliser un sendtext. Ensuite à lui de distinguer au niveau de la récursivité et du sendtext les fichiers et les sous répertoires.

Réception : en fonction du sendtext on envoye soit dans un mémo spécial pour les fichiers soit dans un mémo spécial pour les répertoires.

Le mieux est d'aller voir le topic (il y avait un début de code je crois)

:)

a+

Pour être plus constructif :j'ai dis que c'était compliqué. En effet il me semble pas utile de passer par un stream.

La technique citée avant est basée sur : recherche des fichiers du HD et envoye du nom de chaque fichiers par un sendtext (plutot que de l'afficher dans un mémo).

Coté serveur : recherche les fichiers environ 5-10 lignes. Envoyer par un sendtext 1 lign donc au max une dizaine de ligne et 1 procédure (et 1 autre pour appeler cette procédure).

coté client : identique

Donc je trouve ca un peu lourd personnellement. Ce qui m'a choqué est l'utilisation pour moi abusive du stream.

J'ai modifié par le passé la source de grand vizir, j'ai pu transferer une arborescence en 13 lignes bon c'était pas tres esthétique mais c'était juste pour le fun.

A+