clftputils.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

{
  Clever Internet Suite Version 6.2
  Copyright (C) 1999 - 2006 Clever Components
  www.CleverComponents.com
}

unit clFtpUtils;

interface

{$I clVer.inc}

uses
  Classes, Windows, contnrs;
  
const
  cDefaultFtpPort = 21;
  cDefaultFtpProxyPort = 21;

type
  TclFtpTransferMode = (tmBlock, tmCompressed, tmStream, tmDeflate);
  TclFtpTransferStructure = (tsFile, tsRecord, tsPage);
  TclFtpTransferType = (ttAscii, ttBinary);
  TclDirListingStyle = (lsMsDos, lsUnix);
  TclFtpFilePermission = (fpRead, fpWrite, fpExecute);
  TclFtpFilePermissions = set of TclFtpFilePermission;


  TclFtpProxyType = (ptNone, ptUserSite, ptSite, ptOpen, ptUserPass, ptTransparent, ptCustomProxy);

  TclFtpProxySettings = class(TPersistent)
  protected
    FProxyType: TclFtpProxyType;
    FUserName: string;
    FPassword: string;
    FServer: string;
    FPort: Integer;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
  published
    property  ProxyType: TclFtpProxyType read FProxyType write FProxyType default ptNone;
    property  UserName: string read FUserName write FUserName;
    property  Password: string read FPassword write FPassword;
    property  Server: string read FServer write FServer;
    property  Port: Integer read FPort write FPort default cDefaultFtpProxyPort;
  end;

  TclFtpFileInfo = class;

  TclFtpFileInfoParser = class
  protected
    function ParseTime(const ASrc: string): TDateTime;
    function GetDelimiter(const ASrc: string): Char;
  public
    procedure Parse(AFileInfo: TclFtpFileInfo; const ASource: string); virtual; abstract;
    function Build(AFileInfo: TclFtpFileInfo): string; virtual; abstract;
    function Check(const ASource: string): Boolean; virtual; abstract;
  end;

  TclMsDosFileInfoParser = class(TclFtpFileInfoParser)
  private
    function ParseDate(const ASrc: string): TDateTime;
  public
    procedure Parse(AFileInfo: TclFtpFileInfo; const ASource: string); override;
    function Build(AFileInfo: TclFtpFileInfo): string; override;
    function Check(const ASource: string): Boolean; override;
  end;

  TclUnixFileInfoParser = class(TclFtpFileInfoParser)
  private
    function GetMonth(const AMonth: string): Integer;
    function CurrentYear: Integer;
    function IsSixMonth(ADate: TDateTime): Boolean;
    function GetPermissionsStr(APermissions: TclFtpFilePermissions): string;
    function ParsePermissionsStr(const APermissions: string): TclFtpFilePermissions;
  public
    procedure Parse(AFileInfo: TclFtpFileInfo; const ASource: string); override;
    function Build(AFileInfo: TclFtpFileInfo): string; override;
    function Check(const ASource: string): Boolean; override;
  end;

  TclAs400FileInfoParser = class(TclFtpFileInfoParser)
  private
    function ParseDate(const ASrc: string): TDateTime;
  public
    procedure Parse(AFileInfo: TclFtpFileInfo; const ASource: string); override;
    function Build(AFileInfo: TclFtpFileInfo): string; override;
    function Check(const ASource: string): Boolean; override;
  end;

  TclFtpFileInfo = class
  private
    FIsReadOnly: Boolean;
    FIsDirectory: Boolean;
    FSize: Int64;
    FFileName: string;
    FModifiedDate: TDateTime;
    FIsLink: Boolean;
    FOwner: TclFtpFilePermissions;
    FOther: TclFtpFilePermissions;
    FGroup: TclFtpFilePermissions;
    procedure Clear;
    function GetParser(const ASource: string): TclFtpFileInfoParser;
  public
    constructor Create;
    procedure Parse(const ASource: string);
    function Build(AStyle: TclDirListingStyle): string;

    property FileName: string read FFileName write FFileName;
    property IsDirectory: Boolean read FIsDirectory write FIsDirectory;
    property IsLink: Boolean read FIsLink write FIsLink;
    property IsReadOnly: Boolean read FIsReadOnly write FIsReadOnly;
    property Size: Int64 read FSize write FSize;
    property ModifiedDate: TDateTime read FModifiedDate write FModifiedDate;
    property Owner: TclFtpFilePermissions read FOwner write FOwner;
    property Group: TclFtpFilePermissions read FGroup write FGroup;
    property Other: TclFtpFilePermissions read FOther write FOther;
  end;

function GetFtpFilePermissionsInt(APermissions: TclFtpFilePermissions): Integer;
function GetFtpLocalHostStr(const AHost: string): string;
function GetFtpHostStr(const AHost: string; APort: Integer): string;
procedure ParseFtpHostStr(const ASource: string; var AHost: string; var APort: Integer);
function GetRegisteredFtpFileInfoParsers: TObjectList;
procedure RegisterFtpFileInfoParser(AParser: TclFtpFileInfoParser);

implementation

uses
  SysUtils, clUtils, clSocket;

var
  RegisteredFtpFileInfoParsers: TObjectList = nil;

function GetRegisteredFtpFileInfoParsers: TObjectList;
begin
  if (RegisteredFtpFileInfoParsers = nil) then
  begin
    RegisteredFtpFileInfoParsers := TObjectList.Create();
  end;
  Result := RegisteredFtpFileInfoParsers;
end;

procedure RegisterFtpFileInfoParser(AParser: TclFtpFileInfoParser);
begin
  GetRegisteredFtpFileInfoParsers().Add(AParser);
end;

function GetFtpFilePermissionsInt(APermissions: TclFtpFilePermissions): Integer;
begin
  Result := 0;
  if (fpRead in APermissions) then
    Result := 4;
  if (fpWrite in APermissions) then
    Result := Result or 2;
  if (fpExecute in APermissions) then
    Result := Result or 1;
end;

function GetFtpLocalHostStr(const AHost: string): string;
begin
  if SameText(AHost, 'LOCALHOST') or (Trim(AHost) = '127.0.0.1') then
  begin
    Result := 'LOCALHOST';
  end else
  begin
    Result := GetLocalHost();
  end;
end;

function GetFtpHostStr(const AHost: string; APort: Integer): string;
begin
  Result := Format('%s,%d,%d',
    [StringReplace(GetHostIP(AHost), '.', ',', [rfReplaceAll]), APort div 256, APort mod 256]);
end;

procedure ParseFtpHostStr(const ASource: string; var AHost: string; var APort: Integer);
var
  i: Integer;
begin
  AHost := '';
  APort := 0;

  for i := 1 to 4 do
  begin
    AHost := AHost + '.' + ExtractWord(i, ASource, [',']);
  end;
  system.Delete(AHost, 1, 1);
  APort := StrToIntDef(ExtractWord(5, ASource, [',']), 0) shl 8;
  APort := APort + StrToIntDef(ExtractWord(6, ASource, [',']), 0);
end;

{ TclFtpFileInfo }

procedure TclFtpFileInfo.Clear;
begin
  FIsReadOnly := False;
  FIsDirectory := False;
  FIsLink := False;
  FSize := 0;
  FFileName := '';
  FModifiedDate := 0;
  FOwner := [];
  FOther := [];
  FGroup := [];
end;

constructor TclFtpFileInfo.Create;
begin
  inherited Create();
  Clear();
end;

function TclFtpFileInfo.GetParser(const ASource: string): TclFtpFileInfoParser;
var
  i: Integer;
  list: TObjectList;
begin
  if (ASource = '') then
  begin
    Result := nil;
    Exit;
  end;

  list := GetRegisteredFtpFileInfoParsers();
  for i := 0 to list.Count - 1 do
  begin
    Result := TclFtpFileInfoParser(list[i]);
    if Result.Check(ASource) then Exit;
  end;

  Result := nil;
end;

procedure TclFtpFileInfo.Parse(const ASource: string);
var
  parser: TclFtpFileInfoParser;
begin
  Clear();

  parser := GetParser(ASource);
  if (parser <> nil) then
  begin
    parser.Parse(Self, ASource);
  end;
end;

function TclFtpFileInfo.Build(AStyle: TclDirListingStyle): string;
var
  parser: TclFtpFileInfoParser;
begin
  parser := nil;
  try
    case AStyle of
      lsMsDos: parser := TclMsDosFileInfoParser.Create();
      lsUnix: parser := TclUnixFileInfoParser.Create();
    end;
    if (parser <> nil) then
    begin
      Result := parser.Build(Self);
    end else
    begin
      Result := FileName;
    end;
  finally
    parser.Free();
  end;
end;

{ TclFtpProxySettings }

procedure TclFtpProxySettings.Assign(Source: TPersistent);
var
  Src: TclFtpProxySettings;
begin
  if (Source is TclFtpProxySettings) then
  begin
    Src := (Source as TclFtpProxySettings);
    ProxyType  := Src.ProxyType;
    UserName := Src.UserName;
    Password := Src.Password;
    Server := Src.Server;
    Port := Src.Port;
  end else
  begin
    inherited Assign(Source);
  end;
end;

procedure TclFtpProxySettings.Clear;
begin
  FProxyType := ptNone;
  FPort := cDefaultFtpProxyPort;
  FUserName := '';
  FPassword := '';
  FServer := '';
end;

constructor TclFtpProxySettings.Create;
begin
  inherited Create();
  Clear();
end;

{ TclMsDosFileInfoParser }

function TclMsDosFileInfoParser.Build(AFileInfo: TclFtpFileInfo): string;
var
  resSize: string;
begin
  DateTimeToString(Result, 'mm-dd-yy  hh:nnAM/PM', AFileInfo.ModifiedDate);
  resSize := IntToStr(AFileInfo.Size);
  if AFileInfo.IsDirectory then
  begin
    Result := Result + '       <DIR>         ';
  end else
  begin
    Result := Result + StringOfChar(#32, 21 - Length(resSize)) + resSize;
  end;
  Result := Result + ' ' + AFileInfo.FileName;
end;

function TclMsDosFileInfoParser.Check(const ASource: string): Boolean;
begin
  Result := (WordCount(ASource, [#32]) > 3);
  if Result then
  begin
    Result := (ParseDate(Trim(ExtractWord(1, ASource, [#32]))) > 0)
      and (ParseTime(Trim(ExtractWord(2, ASource, [#32]))) > 0);
  end;
end;

procedure TclMsDosFileInfoParser.Parse(AFileInfo: TclFtpFileInfo; const ASource: string);
var
  s: string;
begin
  if (WordCount(ASource, [#32]) < 4) then Exit;

  AFileInfo.ModifiedDate := ParseDate(Trim(ExtractWord(1, ASource, [' ']))) + ParseTime(Trim(ExtractWord(2, ASource, [' '])));

  s := Trim(ExtractWord(3, ASource, [' ']));
  AFileInfo.IsDirectory := SameText(s, '<DIR>');

  if not AFileInfo.IsDirectory then
  begin
    AFileInfo.Size := StrToInt64Def(s, 0);
  end;

  AFileInfo.FileName := Trim(system.Copy(ASource, WordPosition(4, ASource, [#32]), Length(ASource)));
end;

function TclMsDosFileInfoParser.ParseDate(const ASrc: string): TDateTime;
var
  m, d, y: Integer;
  delim: Char;
begin
  delim := GetDelimiter(ASrc);
  m := StrToIntDef(Trim(ExtractWord(1, ASrc, [delim])), 0);
  d := StrToIntDef(Trim(ExtractWord(2, ASrc, [delim])), 0);
  y := StrToIntDef(Trim(ExtractWord(3, ASrc, [delim])), 0);
  y := GetCorrectY2k(y);

{$IFDEF DELPHI6}
  if not TryEncodeDate(y, m, d, Result) then
  begin
    Result := 0;
  end;
{$ELSE}
  try
    Result := EncodeDate(y, m, d);
  except
    Result := 0;
  end;
{$ENDIF}
end;

{ TclUnixFileInfoParser }

function TclUnixFileInfoParser.Build(AFileInfo: TclFtpFileInfo): string;
var
  resTime, resAccessOwn, resAccessGrp, resAccessOth: string;
  temp, resMonth: Word;
  resSize: Int64;
begin
  if AFileInfo.IsDirectory then