envoi de repertoire d'un serveur avec socket

Question

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 &#224; 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&#233;re la liste de fichier partag&#233;
//------------------------------------------------------------------------------


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&#233;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&#233;er les tetes
    S := TMemoryStream.Create;
    Header.OpCode     := MSG_FILE_FOLLOWS;
    Header.PayLoadLen := Fs.Size;


    // &#233;crire d'abord l'en-t&#234;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&#239;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&#234;te
      Delete( SockBuf, 1, SizeOf(Header));
      // copiez du buf &#224; la charge utile
      PayLoad := Copy( SockBuf, 1, Header.PayLoadLen);
      // juste au cas o&#249; un autre message serait d&#233;j&#224; dans la canalisation!
      Delete( SockBuf, 1, Header.PayLoadLen );
      Result := true;
    end;
  end;
end;



end.

Francky23012301 · Answer

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+

ni69 · Answer

Francky >> je ne sais pas si cela avancera cybersky
si tu lui dis que son code est trop compliqu&#233; et qu'il faut qu'il le
refasse enti&#232;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&#233;ponse Accept&#233;e lorsque la r&#233;ponse vous convient !

Francky23012301 · Answer

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+

Francky23012301 · Answer

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+

Envoi de repertoire d'un serveur avec socket

4 réponses

Votre réponse

Discussions similaires