Synchronizacja plików - Prośba o pomoc

Witam wszystkich !!! Mam wielką prośbę o pomoc. Piszę aplikację klient-server która ma synchronizować pliki (katalogi). Jak dotąd udało mi się zrobić aplikację klient-serwer kopiującą pliki tylko z serwera do klienta. Aplikacja korzysta z gotowych komponentów (TClientSocket i TServerSocket).
Byłbym bardzo wdzięczny gdyby ktoś mógł zerknąć na poniższy listing programu i coś mi doradzić podpowiedzieć odnośnie jak mógłbym zrobić tą synchroniżację plików.

Oto kod serwera:
unit ServUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ScktComp, common, StdCtrls, FileCtrl, Buttons;
const
Version = ' 1.0';
type
TForm1 = class( TForm )
ServSock: TServerSocket;
Memo1: TMemo;
edtDir: TEdit;
StaticText1: TStaticText;
lbFiles: TListBox;
StaticText2: TStaticText;
sbSetDir: TSpeedButton;
procedure ServSockClientConnect( Sender: TObject;
Socket: TCustomWinSocket );
procedure ServSockClientDisconnect( Sender: TObject;
Socket: TCustomWinSocket );
procedure ServSockClientError( Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer );
procedure ServSockClientRead( Sender: TObject;
Socket: TCustomWinSocket );
procedure sbSetDirClick( Sender: TObject );
procedure ServSockListen( Sender: TObject; Socket: TCustomWinSocket );
procedure FormCreate( Sender: TObject );
private
{ Private declarations }
FServerDir: string;
public
{ Public declarations }
end;

var
Form1 : TForm1;

implementation

{$R *.DFM}

//*****************************************************************************
procedure TForm1.FormCreate( Sender: TObject );
begin
Caption := Caption + Version;
// set default directory;
FServerDir := ExtractFileDir( Application.ExeName );
EdtDir.Text := FServerDir;
EnumFiles( FServerDir + '*.*', lbFiles.Items, false );
ServSock.Open;
end;

//*****************************************************************************
procedure TForm1.ServSockListen( Sender: TObject; Socket: TCustomWinSocket );
begin
Log( Memo1.Lines, ' serwer nasluchuje na porcie ' + IntTostr( ServSock.Port ) +
'...' );
end;

//*****************************************************************************
procedure TForm1.ServSockClientConnect( Sender: TObject;
Socket: TCustomWinSocket );
begin
Log( memo1.lines, 'klient polaczony : ' + Socket.RemoteHost );
end;

//*****************************************************************************
procedure TForm1.ServSockClientDisconnect( Sender: TObject;
Socket: TCustomWinSocket );
begin
Log( memo1.lines, 'klient rozlaczony : ' + Socket.RemoteHost );
end;

//*****************************************************************************
procedure TForm1.ServSockClientError( Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer );
begin
Log( memo1.lines, 'blad gniazda ' + IntToStr( ErrorCode ) );
Socket.Close;
ErrorCode := 0; // avoid exceptions !
end;

//*****************************************************************************
procedure TForm1.ServSockClientRead( Sender: TObject;
Socket: TCustomWinSocket );
var
Buf : string;
MsgLen,
LenReceived : integer;
Header : TMsgHeader;

begin

// przybliżona dlugosc wiadomosci
MsgLen := Socket.ReceiveLength;

// przygotuj bufer i pobierz wiadomosc
SetLength( Buf, MsgLen );
LenReceived := Socket.ReceiveBuf( Buf[1], MsgLen );

Buf := Copy( Buf, 1, LenReceived );

if Length( Buf ) >= SizeOf( Header ) then
begin

 // wypisz naglowek
move( Buf[1], Header, SizeOf( Header ) );
 // skasuj naglowek z wiadomosci
Delete( Buf, 1, SizeOf( Header ) );
 //
case Header.OpCode of
  MSG_REQUEST_FILE: begin
      Log( memo1.Lines, 'przesylanie ' + Buf
        + ' to ' + Socket.RemoteHost );
      if SendFile( Socket, Buf ) then
        Log( memo1.Lines, ' plik wyslany.' )
      else begin
        Log( memo1.Lines, ' blad podczas wysylania pliku.' );
        Socket.Close;
      end
    end;

  MSG_REQUEST_LIST: begin
      Log( memo1.Lines, 'wysylanie listy plików'
        + ' to ' + Socket.RemoteHost );
      SendFileList( Socket, FServerDir, '*.*' );
    end;
else
  SendError( Socket, MSG_ERR_ILLEGAL_CODE );
end;

end
else begin
Log( memo1.lines, 'uszkodzona wiadomosc ! zamykanie polaczenia' );
Socket.Close;
end;

end;

//*****************************************************************************
procedure TForm1.sbSetDirClick( Sender: TObject );
begin
if SelectDirectory( FServerDir, [], 0 ) then
begin
edtDir.Text := FServerDir;
EnumFiles( FServerDir + '*.*', lbFiles.Items, false );
end;
end;

end.</span>

Kod Klienta:
unit ClntUnit;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Common,
ScktComp, Buttons, StdCtrls, ComCtrls, ExtCtrls;

const
Version = ' 1.0';
type
TReceiveMode = ( rmCzekaj, rmRECEIVING_FILE, rmRECEIVING_LIST );

TForm1 = class( TForm )
edtServer: TEdit;
btnConnect: TSpeedButton;
ClSock: TClientSocket;
Memo1: TMemo;
lbFiles: TListBox;
StaticText1: TStaticText;
PBar: TProgressBar;
Timer1: TTimer;
lbFetch: TListBox;
StaticText3: TStaticText;
btnFetch: TSpeedButton;
btnDisconnect: TSpeedButton;
procedure btnConnectClick( Sender: TObject );
procedure ClSockConnect( Sender: TObject; Socket: TCustomWinSocket );
procedure ClSockDisconnect( Sender: TObject; Socket: TCustomWinSocket );
procedure ClSockError( Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer );
procedure ClSockRead( Sender: TObject; Socket: TCustomWinSocket );
procedure lbFilesClick( Sender: TObject );
procedure Timer1Timer( Sender: TObject );
procedure FormCreate( Sender: TObject );
procedure lbFetchClick( Sender: TObject );
procedure btnFetchClick( Sender: TObject );
procedure btnDisconnectClick( Sender: TObject );
private
{ Private declarations }
RMode: TReceiveMode;
FRequestedFile: string;
DataLen: integer;
KbReceived: integer;
Fs: TFileStream;
Header: TMsgHeader;
TotalBytes: integer;
TotalSecs: integer;
procedure ProcessHeader( Data: string );
procedure ProcessFile( Data: string );
procedure ProcessList( Data: string );
procedure BailOut;
procedure FetchNext;
public
{ Public declarations }
end;

var
Form1 : TForm1;

implementation

{$R *.DFM}

//*****************************************************************************
procedure TForm1.FormCreate( Sender: TObject );
begin
Caption := Caption + Version;
RMode := rmCzekaj;
end;

//*****************************************************************************
procedure TForm1.btnConnectClick( Sender: TObject );
var
OldMode : DWORD;
begin
OldMode := SetErrorMode( SEM_FAILCRITICALERRORS );
with ClSock do
try
Host := edtServer.Text;
Port := Common.ServerPort;
Open;
edtServer.Color := clGREEN;
except
Log( memo1.lines, 'blad polaczenia, sprwdz nazwe/adres hosta' );
end;
SetErrorMode( OldMode );
end;

//*****************************************************************************
procedure TForm1.ClSockConnect( Sender: TObject; Socket: TCustomWinSocket );
begin
Log( memo1.Lines, 'polaczony, żądanie listy plików...' );
SendData( ClSock.Socket, MSG_REQUEST_LIST, '' );
end;

//*****************************************************************************
procedure TForm1.ClSockDisconnect( Sender: TObject;
Socket: TCustomWinSocket );
begin
Log( memo1.Lines, 'polaczenie z serwerem przerwane' );
lbFiles.Clear;
lbFetch.Clear;
edtServer.Color := clRED;
BailOut;
end;

//*****************************************************************************
procedure TForm1.ClSockError( Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer );
begin
Log( memo1.Lines, 'Blad gniazda ' + IntToStr( ErrorCode ) );
ErrorCode := 0;
BailOut;
end;

//*****************************************************************************
procedure TForm1.BailOut;
begin
ClSock.Close;
case RMode of
rmRECEIVING_LIST: lbFiles.Clear;
rmRECEIVING_FILE: begin
Fs.Free;
DeleteFile( PChar( FRequestedFile ) );
end;
end;
end;

//*****************************************************************************
procedure TForm1.ProcessHeader( Data: string );
begin
Move( Data[1], Header, SizeOf( Header ) );
// delete header
Delete( Data, 1, SizeOf( Header ) );
// remember number of bytes
DataLen := Header.PayLoadLen;
// init. progressbar
PBar.Max := DataLen;
PBar.StepBy( length( Data ) );
KbReceived := 0;
case Header.OpCode of
MSG_FILE_FOLLOWS:
begin
RMode := rmRECEIVING_FILE;

    try
      Fs := TFileStream.Create( FRequestedFile,
        fmCREATE or fmOPENWRITE );
      Log( memo1.lines, 'odebrane pliki, '
        + IntToStr( DataLen ) + ' bajtów...' );
      inc( TotalBytes, DataLen );
      ProcessFile( Data );
    except
      Log( memo1.lines, 'blad zapisu pliku: '
        + SysErrorMessage( GetLastError ) );
    end;
  end;
MSG_LIST_FOLLOWS:
  begin
    RMode := rmRECEIVING_LIST;
    lbFiles.Clear;
    ProcessList( Data );
  end

else begin
Log( memo1.lines, 'blad serwera!' );
BailOut;
end;
end;

end;

//*****************************************************************************
procedure TForm1.ProcessFile( Data: string );
begin
try
if Length( Data ) = 0 then EXIT;
inc( KbReceived, Length( Data ) );
PBar.StepBy( length( Data ) );
Fs.Write( Data[1], Length( Data ) );
Dec( DataLen, Length( Data ) );

//Log(memo1.lines,'received:' + Inttostr(length(Data)) +', left:'+ IntToStr(DataLen));
if DataLen = 0 then
begin
RMode := rmCzekaj;
Fs.Free;
lbFiles.Enabled := true;
PBar.Position := 0;
FetchNext;
end;
Data := '';
except
Log( memo1.lines, 'blad zapisu pliku: '
+ SysErrorMessage( GetLastError ) );
end;
end;

//*****************************************************************************
procedure TForm1.ProcessList( Data: string );
begin
lbFiles.Items.Text := lbFiles.Items.Text + Data;
dec( DataLen, Length( Data ) );
Data := '';
if DataLen = 0 then
begin
Log( Memo1.Lines, ' lista odebranych plików, '
+ IntToStr( lbFiles.Items.Count )
+ ' pozycji' );
RMode := rmCzekaj;
lbFiles.Enabled := true;
PBar.Position := 0;
end;
end;

//*****************************************************************************
procedure TForm1.ClSockRead( Sender: TObject; Socket: TCustomWinSocket );
var
Buf : string;
MsgLen,
LenReceived : integer;
begin

// get the approximate message length
MsgLen := Socket.ReceiveLength;

while MsgLen > 0 do
begin
// prepare a buffer and get message
SetLength( Buf, MsgLen );
LenReceived := Socket.ReceiveBuf( Buf[1], MsgLen );
// always adjust for actual received # of bytes!
Buf := Copy( Buf, 1, LenReceived );
case RMode of
rmCzekaj: ProcessHeader( Buf );
rmRECEIVING_FILE: ProcessFile( Buf );
rmRECEIVING_LIST: ProcessList( Buf );
end;
MsgLen := Socket.ReceiveLength;
end;

end;

//*****************************************************************************
procedure TForm1.lbFilesClick( Sender: TObject );
begin
if lbFetch.Items.IndexOf( lbFiles.Items[lbFiles.ItemIndex] ) = -1 then
lbFetch.Items.Add( lbFiles.Items[lbFiles.ItemIndex] );

end;

//*****************************************************************************
procedure TForm1.Timer1Timer( Sender: TObject );
begin
inc( TotalSecs );
end;

procedure TForm1.lbFetchClick( Sender: TObject );
begin
lbFetch.Items.Delete( lbFetch.ItemIndex );
end;

//*****************************************************************************
procedure TForm1.FetchNext;
begin
if lbFetch.Items.Count > 0 then
begin
FRequestedfile := lbFetch.Items[0];
lbFetch.Items.Delete( 0 );
Log( memo1.Lines, 'zadanie pliku ' + FRequestedFile + ' ...' );
SendData( ClSock.Socket, MSG_REQUEST_FILE, FRequestedFile );
end
else begin
Timer1.Enabled := false;
if TotalSecs > 0 then
Log( memo1.Lines, 'Zrobione, srednia: ' + Format( '%0.2f Kb/sec', [(
TotalBytes / TotalSecs ) / 1024] ) );
ClSock.Close;
lbFiles.Enabled := true;
lbFetch.Enabled := true;
btnFetch.Enabled := true;
btnDisconnect.Enabled := true;
end;
end;

//*****************************************************************************
procedure TForm1.btnFetchClick( Sender: TObject );
begin
if ( lbFetch.Items.Count = 0 )
or not ClSock.Socket.Connected then EXIT;
btnDisconnect.Enabled := false;
btnFetch.Enabled := false;
lbFiles.Enabled := false;
lbFetch.Enabled := false;
TotalBytes := 0;
TotalSecs := 0;
Timer1.Enabled := true;
FetchNext;
end;

procedure TForm1.btnDisconnectClick( Sender: TObject );
begin
BailOut;
end;

end.

Common (tu przechowywane są funkcje SendData, SendFile itp.)
unit common;

interface
uses Windows, Classes, SysUtils, Forms, ScktComp;

const
ServerPort = 49999;
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 );

function SendFile( Socket: TCustomWinSocket; FName: string ): boolean;

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

//*****************************************************************************
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;

//*****************************************************************************
procedure SendData( Sock: TCustomWinSocket; Code: DWORD; PayLoad: string );
var
S : TMemoryStream;
Header : TMsgHeader;
begin

with Header do
begin
OpCode := Code;
PayLoadLen := Length( PayLoad );
end;
S := TMemoryStream.Create;
S.Write( Header, SizeOf( Header ) );

if Header.PayLoadLen > 0 then
S.Write( PayLoad[1], Header.PayLoadLen );
S.Position := 0;
Sock.SendStream( S );
end;

//*****************************************************************************
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;

//*****************************************************************************
function SendFile( Socket: TCustomWinSocket; FName: string ): boolean;
var
Header : TMsgHeader;
Fs : TFileStream;
S : TMemoryStream;
begin
Result := false;
if FileExists( FName ) then
try

// otwieranie pliku
Fs := TFileStream.Create( FName, fmOPENREAD );
Fs.Position := 0;

// otworzenie naglowka
S := TMemoryStream.Create;
Header.OpCode := MSG_FILE_FOLLOWS;
Header.PayLoadLen := Fs.Size;

// pierwszy zapisuje naglowek
S.Write( Header, SizeOf( Header ) );

// nastepnie dodaje zawartosc pliku do strumienia
S.CopyFrom( Fs, Fs.Size );
S.Position := 0; // ważne...
// wysyla do soketa
Result := Socket.SendStream( S );
Fs.Free;

except
SendError( Socket, MSG_ERR_CANNOT_SEND );
end
else
SendError( Socket, MSG_ERR_DOES_NOT_EXIST );
end;

//*****************************************************************************
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;

//*****************************************************************************
procedure SendError( Socket: TCustomWinSocket; Error: DWORD );
begin
SendData( Socket, Error, '' );
end;

//*****************************************************************************
function MessageComplete( var SockBuf: string;
var Header: TMsgHeader;
var PayLoad: string ): boolean;
begin
Result := false;
if Length( SockBuf ) > SizeOf( Header ) then
begin
Move( SockBuf[1], Header, SizeOf( Header ) );
// czy mamy w końcu jedną kompletną wiadomosc ?
if length( SockBuf ) >= Header.PayLoadLen + SizeOf( Header ) then
begin
// jezeli tak, skasuj naglowek
Delete( SockBuf, 1, SizeOf( Header ) );
// kopiuj z buf do payload
PayLoad := Copy( SockBuf, 1, Header.PayLoadLen );
// just in case another message is already in the pipeline!
Delete( SockBuf, 1, Header.PayLoadLen );
Result := true;
end;
end;
end;

end.

Z góry dziękuję za wszelką pomoc :)
Pozdrawiam

Synchronizacja plików - Prośba o pomoc

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami