unit RedirTst;

{ Test Network-redirector
  `Remote' operation is simply operation in a special directory.
  Copr. 1998 Matthias K"oppe
}

interface

uses {$ifdef Windows}WinDos,{$endif} Dos, GvRedir;

type
  PTestFileSystem = ^TTestFileSystem;
  TTestFileSystem = object(TFileSystem)
    SaveSystem: PFileSystem;
    constructor Init(ASystem: PFileSystem);
    function GetFAttr(const Name: string): Word; virtual;
    procedure SetFAttr(const Name: string; Attr: Word); virtual;
    procedure Rename(const Name, NewName: string); virtual;
    procedure Delete(const Name: string); virtual;
    function GetDriveType(const Name: string): Word; virtual;
    procedure FindFirst(const Path: string; Attr: Word;
			var SR: TRedirSearchRec); virtual;
    procedure DoFindNext(var SR: TRedirSearchRec); virtual;
    procedure DoFindEnd(var SR: TRedirSearchRec); virtual;
    procedure FSplit(Path: PathStr; var Dir: DirStr; var Name: NameStr;
      var Ext: ExtStr); virtual;
    function FExpand(Path: PathStr): PathStr; virtual;
    function CopyFile(const SourceName, TargetName: string): Boolean; virtual;
  private
    function Native(const Name: string): Boolean;
    function Demangle(const Name: string): string;
  end;

implementation

uses Misc, Objects, GvFmCopy;

type
  TSilentFileCopy = object(TFileCopy)
    procedure ReadMsg(const FName: FNameStr; Progress: Longint); virtual;
    procedure WriteMsg(const FName: FNameStr; Progress: Longint); virtual;
    procedure ReportError(S: String); virtual;
  end;

procedure TSilentFileCopy.ReadMsg(const FName: FNameStr; Progress: Longint);
begin
end;

procedure TSilentFileCopy.WriteMsg(const FName: FNameStr; Progress: Longint);
begin
end;

procedure TSilentFileCopy.ReportError(S: String);
begin
end;

constructor TTestFileSystem.Init(ASystem: PFileSystem);
begin
  inherited Init;
  SaveSystem := ASystem
end;

function TTestFileSystem.Native(const Name: string): Boolean;
begin
  Native := (Length(Name) >= 2) and (Name[2] = '@')
end;

function TTestFileSystem.Demangle(const Name: string): string;
begin
  Demangle := 'C:\REMOTE.$$$\' + Name[1] + '\' + Copy(Name, 3, Length(Name)-2);
end;

function TTestFileSystem.GetFAttr(const Name: string): Word;
begin
  if Native(Name) then GetFAttr := SaveSystem^.GetFAttr(Demangle(Name))
  else GetFAttr := SaveSystem^.GetFAttr(Name);
end;

procedure TTestFileSystem.SetFAttr(const Name: string; Attr: Word);
begin
  if Native(Name) then SaveSystem^.SetFAttr(Demangle(Name), Attr)
  else SaveSystem^.SetFAttr(Name, Attr);
end;

procedure TTestFileSystem.Rename(const Name, NewName: string);
begin
  if Native(Name)
  then begin
    if Native(NewName) then SaveSystem^.Rename(Demangle(Name), Demangle(NewName))
    else FileSystemError := 1
  end
  else begin
    if Native(NewName) then FileSystemError := 1
    else SaveSystem^.Rename(Name, NewName)
  end
end;

procedure TTestFileSystem.Delete(const Name: string);
begin
  if Native(Name) then SaveSystem^.Delete(Demangle(Name))
  else SaveSystem^.Delete(Name);
end;

function TTestFileSystem.GetDriveType(const Name: string): Word;
var
  Attr: Word;
  F: File;
begin
  if Native(Name)
  then begin
    Assign(F, 'c:\REMOTE.$$$\' + Name[1]);
    {$ifdef Windows}WinDos{$else}Dos{$endif}.GetFAttr(F, Attr);
    if DosError = 0
    then GetDriveType := dtNetDrive
    else GetDriveType := dtInvalid;
  end
  else GetDriveType := SaveSystem^.GetDriveType(Name);
end;

procedure TTestFileSystem.FindFirst(const Path: string; Attr: Word;
  var SR: TRedirSearchRec);
begin
  if Native(Path)
  then begin
    SaveSystem^.FindFirst(Demangle(Path), Attr, SR);
    SR.System := @Self
  end
  else SaveSystem^.FindFirst(Path, Attr, SR)
end;

procedure TTestFileSystem.DoFindNext(var SR: TRedirSearchRec);
begin
  { only native requests go here }
  SaveSystem^.DoFindNext(SR);
end;

procedure TTestFileSystem.DoFindEnd(var SR: TRedirSearchRec);
begin
  { only native requests go here }
  SaveSystem^.DoFindEnd(SR);
end;

procedure TTestFileSystem.FSplit(Path: PathStr; var Dir: DirStr; var Name: NameStr;
  var Ext: ExtStr);
begin
  if Native(Path)
  then begin
    Path[2] := ':';
    Dos.FSplit(Path, Dir, Name, Ext);
    Dir[2] := '@';
  end
  else SaveSystem^.FSplit(Path, Dir, Name, Ext)
end;

function TTestFileSystem.FExpand(Path: PathStr): PathStr;
begin
  if Native(Path)
  then begin
    { Remove '.' and '..' from the path }
    Path[2] := ':';
    Path := Dos.FExpand(Path);
    Path[2] := '@';
    FExpand := Path;
  end
  else FExpand := SaveSystem^.FExpand(Path)
end;

function TTestFileSystem.CopyFile(const SourceName, TargetName: string): Boolean;
var
  Copier: TSilentFileCopy;
begin
  if Native(SourceName)
  then begin
    if Native(TargetName)
    then begin { Remote--Remote copy }
      Copier.Init(1);
      CopyFile := Copier.CopyFile(Demangle(SourceName), Demangle(TargetName), coNormal);
      Copier.Done;
    end
    else begin { Download }
      Copier.Init(1);
      CopyFile := Copier.CopyFile(Demangle(SourceName), TargetName, coNormal);
      Copier.Done;
    end
  end
  else begin
    if Native(TargetName)
    then begin { Upload }
      Copier.Init(1);
      CopyFile := Copier.CopyFile(SourceName, Demangle(TargetName), coNormal);
      Copier.Done;
    end
    else begin { Local--Local copy; this is not actually called. }
      Copier.Init(1);
      CopyFile := Copier.CopyFile(SourceName, TargetName, coNormal);
      Copier.Done;
    end
  end
end;

begin
  FileSystem := New(PTestFileSystem, Init(FileSystem))
end.
