{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       Base Classes for File transfer protocols (VCL)  }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 16 Jun 2008                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}

unit nrftbase;

interface
uses classes, windows
     {$IFDEF NR_WITH_CONTROLS}
     , ComCtrls, CommCtrl
     {$ENDIF}
     , nrdataproc;

Type

  TnrFileTransferState = (fsListen, fsSend, fsReceive, fsCommand);

  TnrCustomFileTransfer = class (TnrDataProtocol)
  private
    fDefaultPath: string;
    fFileName: string;
    fOnProgress: TNotifyEvent;
    fOnError: TNotifyEvent;
    fOnFileEnd: TNotifyEvent;
    fOnFileStart: TNotifyEvent;
    fOnChangeState: TNotifyEvent;
    {$IFDEF NR_WITH_CONTROLS}
    fProgressBar: TProgressBar;
    {$ENDIF}
    procedure PrepareFileList(aFileName:string);
    procedure SetDefaultPath(const Value: string);
    function GetFilePosition: integer;

    {$IFDEF NR_WITH_CONTROLS}
    procedure SetProgressBar(const Value: TProgressBar);
    function GetProgressBar: TProgressBar;
    {$ENDIF}

  protected
    fFiles : TStringList;
    fFile:TFileStream;
    fState : TnrFileTransferState;
    fErrorLimit: integer;
    fErrors: integer;
    fTotalSize: integer;
    fFileSize: integer;
    //fFilePosition: integer;
    procedure DoCloseFile;  virtual;
    procedure DoAbort(aReason:string);  virtual;
    procedure DoOpenFile(aFileName:string; aMode:word); virtual;
    procedure SetFileTime(aDateTime:TDateTime); virtual;
    procedure DoProgress; virtual;
    function DoError:boolean; virtual;
    procedure DoChangeState(aNewState: TnrFileTransferState); virtual;
    procedure SetTotalSize(aTotal:integer); virtual;

    property DefaultPath:string read fDefaultPath write SetDefaultPath;
    property TotalSize:integer read fTotalSize;
    property FileSize:integer read fFileSize;
    property FilePosition:integer read GetFilePosition;
    property FileName:string read fFileName;
    property State:TnrFileTransferState read fState;
    property Errors:integer read fErrors;
    property ErrorLimit:integer read fErrorLimit write fErrorLimit;
    {$IFDEF NR_WITH_CONTROLS}
    property ProgressBar:TProgressBar read GetProgressBar write SetProgressBar;
    {$ENDIF}
    property OnFileStart:TNotifyEvent read fOnFileStart write fOnFileStart;
    property OnFileEnd:TNotifyEvent read fOnFileEnd write fOnFileEnd;
    property OnProgress:TNotifyEvent read fOnProgress write fOnProgress;
    property OnError:TNotifyEvent read fOnError write fOnError;
    property OnChangeState:TNotifyEvent read fOnChangeState write fOnChangeState;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Abort; virtual;
    procedure Send(aFileName:string); virtual;
    procedure DoFatalErrors(Code, Detail:cardinal; Msg:string); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SkipFile(aFileGroup, aDelete:boolean); virtual;
  end;

implementation
uses sysutils, nrclasses, nrsysutils, Math;

Const
  CS_ERROR_MESSAGE_ABORT        = 'Transfer aborted. ';
  CS_ERROR_MESSAGE_TOOMANYERROR = 'Too many errors.';
  CS_ERROR_MESSAGE_NOFILES      = 'There are no files for transmission.';
  CS_FILE_SKIPPED               = 'File transfer is skipped. File Group: %s. Deletion: %s';


{$IFDEF TRIAL}
var  ecx:integer = $5623F4c1;
{$ENDIF}

{ TnrCustomFileTransfer }

constructor TnrCustomFileTransfer.Create(AOwner: TComponent);
begin
  inherited;
  fFiles := TStringList.Create();
  fErrorLimit := 3;
end;

destructor TnrCustomFileTransfer.Destroy;
begin
  DoCloseFile;
  fFiles.Free;
  inherited;
end;

procedure TnrCustomFileTransfer.Abort;
begin
  DoAbort('');
end;

procedure TnrCustomFileTransfer.DoAbort(aReason: string);
begin
  fState := fsListen;
  Logging(dlSimple, CS_ERROR_MESSAGE_ABORT + aReason);
end;

{$IFDEF TRIAL}
function eax:string;
Const
  //You are using nrComm Lib trial version!
  //Please register! xor f
  esi:PChar=
  #$3F#$09#$13#$46#$07#$14#$03#$46#$13#$15#$0F#$08#$01#$46#$12#$14+
  #$0F#$07#$0A#$46#$08#$14#$25#$09#$0B#$0B#$2A#$0F#$04#$46#$10#$03+
  #$14#$15#$0F#$09#$08#$47#$6B#$6C#$36#$0A#$03#$07#$15#$03#$46#$14+
  #$03#$01#$0F#$15#$12#$03#$14#$47;

var i:integer;
begin
  Result := '';
  for i := 0 to 55 do Result := Result + Char(Byte(esi[i]) xor Byte('f'));
  Result := Result + #0;
end;
{$ENDIF}

procedure TnrCustomFileTransfer.PrepareFileList(aFileName: string);
var
  slFileFilters : TStringList;
  flNew:boolean;
  path:string;
  fs:TSearchRec;
begin
  aFileName := StringReplace(aFileName, ',', #13#10,[rfReplaceAll]);
  aFileName := StringReplace(aFileName, ';', #13#10,[rfReplaceAll]);

  slFileFilters := TStringList.Create;
  slFileFilters.Text := aFileName;
  flNew := True;
  fTotalSize := 0;
  fFiles.Clear;
  path := '';

  while True do begin
    if flNew then begin //extract next filter from send string
      if slFileFilters.Count = 0 then break;
      path := ExtractFilePath(slFileFilters[0]);
      while FindFirst(slFileFilters[0], faAnyFile, fs) <> 0 do begin
        slFileFilters.Delete(0);
        if slFileFilters.Count = 0
          then break;
      end;
      if slFileFilters.Count = 0 then break;
      flNew := False;
    end else begin
      if FindNext(fs) <> 0 then begin
        FindClose(fs);
        slFileFilters.Delete(0);
        flNew := True;
        continue;
      end;
    end;
    fTotalSize := fTotalSize + fs.Size;
    fFiles.AddObject(path + fs.Name, TObject(fs.Size));
  end;
  slFileFilters.Free;
end;

procedure TnrCustomFileTransfer.Send(aFileName: string);
var s:string;
begin
  s := aFileName;
  PrepareFileList(aFileName);

  {$IFDEF TRIAL}
  s := s + eax;
  {$ENDIF}

  //for i := 0 to fFiles.Count - 1 do OutputDebugString(PChar(fFiles[i]));
  if fFiles.Count = 0 then begin
    DoFatalErrors(ECC_FTBASE, ECCE_NO_FILES, CS_ERROR_MESSAGE_NOFILES);
    exit;
  end;

  Logging(dlSimple, s);

end;

procedure TnrCustomFileTransfer.SetDefaultPath(const Value: string);
begin
  if Value <> ''
    then fDefaultPath := IncludeTrailingPathDelimiter(Value)
    else fDefaultPath := Value;
end;

/// aMode can be following:
/// fmCreate	Create a file with the given name. If a file with the given name exists, open the file in write mode.
/// fmOpenRead	Open the file for reading only.
/// fmOpenWrite	Open the file for writing only. Writing to the file completely replaces the current contents.
/// fmOpenReadWrite	Open the file to modify the current contents rather than replace them.
procedure TnrCustomFileTransfer.DoOpenFile(aFileName:string; aMode:word);
begin
  DoCloseFile;
  if ExtractFilePath(aFileName) = ''
    then fFileName := fDefaultPath + aFileName
    else fFileName := aFileName;
  fFile := TFileStream.Create(fFileName, aMode);

  {$IFDEF TRIAL}
  if (ecx mod 3) = 0 then MessageBox(0, PChar(eax), nil, 0);
  {$ENDIF}

  if Assigned(fOnFileStart) then fOnFileStart(Self);

end;

procedure TnrCustomFileTransfer.DoCloseFile;
begin
  if fFile <> nil then begin
    FreeAndNil(fFile);
    if Assigned(fOnFileEnd) then fOnFileEnd(Self);
  end;
  {$IFDEF TRIAL}
  inc(ecx);
  {$ENDIF}
  fFileName := '';
end;

procedure TnrCustomFileTransfer.SetFileTime(aDateTime: TDateTime);
begin
  FileSetDate(fFile.Handle, DateTimeToFileDate(aDateTime));
end;
                                              
procedure TnrCustomFileTransfer.DoProgress;
begin
  {$IFDEF NR_WITH_CONTROLS}
  if Assigned(fProgressBar) then begin
    PostMessage(fProgressBar.Handle, PBM_SETPOS, FilePosition, 0);
    //fProgressBar.Position := FilePosition;
    //fProgressBar.Update;
  end;
  {$ENDIF}
  if Assigned(fOnProgress) then fOnProgress(Self);
end;

function  TnrCustomFileTransfer.DoError : boolean;
begin
  Inc(fErrors);
  Result := Errors <= ErrorLimit;

  if Result then begin
    if Assigned(fOnError) then fOnError(Self);
  end else
    DoFatalErrors(ECC_FTBASE, ECCE_TO_MANY_ERRORS, CS_ERROR_MESSAGE_TOOMANYERROR);
end;

procedure TnrCustomFileTransfer.DoChangeState(
  aNewState: TnrFileTransferState);
begin
  if aNewState <> fState then begin
    fState := aNewState;
    if Assigned(fOnChangeState)
      then fOnChangeState(Self);
  end;
end;

procedure TnrCustomFileTransfer.SetTotalSize(aTotal: integer);
begin
  fTotalSize := aTotal;
  {$IFDEF NR_WITH_CONTROLS}
  if Assigned(fProgressBar) then begin
    //fProgressBar.Max := aTotal;
    //fProgressBar.Min := 0;
    PostMessage(fProgressBar.Handle, PBM_SETRANGE32, 0, aTotal);
  end;
  {$ENDIF}
end;

function TnrCustomFileTransfer.GetFilePosition: integer;
begin
  if fFile <> nil
    then Result := fFile.Position
    else Result := 0;
end;

{$IFDEF NR_WITH_CONTROLS}
procedure TnrCustomFileTransfer.SetProgressBar(const Value: TProgressBar);
begin
  fProgressBar := Value;
  if Value <> nil then begin
    Value.FreeNotification(self);
    //fProgressBar.Max := fTotalSize;
    //fProgressBar.Min := 0;
    PostMessage(fProgressBar.Handle, PBM_SETRANGE32, 0, fTotalSize);
  end;
end;

function TnrCustomFileTransfer.GetProgressBar: TProgressBar;
begin
  Result := fProgressBar;
end;
{$ENDIF}

procedure TnrCustomFileTransfer.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then begin
    {$IFDEF NR_WITH_CONTROLS}
    if AComponent = fProgressBar then fProgressBar := nil;
    {$ENDIF}
  end;
end;

procedure TnrCustomFileTransfer.DoFatalErrors(Code, Detail: cardinal;
  Msg: string);
begin
  if fState <> fsListen then DoAbort(Msg);
  inherited DoFatalErrors(Code, Detail, Msg);
end;

procedure TnrCustomFileTransfer.SkipFile(aFileGroup, aDelete: boolean);
begin
  if fState <> fsListen then LoggingFmt(dlSimple, CS_FILE_SKIPPED, [IntToStr(Integer(aFileGroup)), IntToStr(Integer(aDelete))]);
end;

end.
