📄 idftplistparseunix.pas
字号:
{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence }
{ Team Coherence is Copyright 2002 by Quality Software Components }
{ }
{ For further information / comments, visit our WEB site at }
{ http://www.TeamCoherence.com }
{**********************************************************************}
{}
{ $Log: 16166: IdFTPListParseUnix.pas
{
{ Rev 1.20 10/26/2004 9:56:00 PM JPMugaas
{ Updated refs.
}
{
{ Rev 1.19 8/5/2004 11:18:16 AM JPMugaas
{ Should fix a parsing problem I introeduced that caused errors with Unitree
{ servers.
}
{
{ Rev 1.18 8/4/2004 12:40:12 PM JPMugaas
{ Fix for problem with total line.
}
{
{ Rev 1.17 7/15/2004 4:02:48 AM JPMugaas
{ Fix for some FTP servers. In a Unix listing, a : at the end of a filename
{ was wrongly being interpretted as a subdirectory entry in a recursive
{ listing.
}
{
{ Rev 1.16 6/14/2004 12:05:54 AM JPMugaas
{ Added support for the following Item types that appear in some Unix listings
{ (particularly a /dev or /tmp dir):
{
{ FIFO, Socket, Character Device, Block Device.
}
{
{ Rev 1.15 6/13/2004 10:44:06 PM JPMugaas
{ Fixed a problem with some servers returning additional columns in the owner
{ and group feilds. Note that they will not be parsed correctly in all cases.
{ That's life.
{
{ drwx------ 1 BUILTIN NT AUTHORITY 0 Dec 7 2001
{ System Volume Information
}
{
{ Rev 1.14 4/20/2004 4:01:18 PM JPMugaas
{ Fix for nasty typecasting error. The wrong create was being called.
}
{
{ Rev 1.13 4/19/2004 5:05:20 PM JPMugaas
{ Class rework Kudzu wanted.
}
{
{ Rev 1.12 2004.02.03 5:45:18 PM czhower
{ Name changes
}
{
{ Rev 1.11 2004.01.23 9:53:32 PM czhower
{ REmoved unneded check because of CharIsInSet functinoalty. Also was a short
{ circuit which is not permitted.
}
{
{ Rev 1.10 1/23/2004 12:49:52 PM SPerry
{ fixed set problems
}
{
{ Rev 1.9 1/22/2004 8:29:02 AM JPMugaas
{ Removed Ansi*.
}
{
{ Rev 1.8 1/22/2004 7:20:48 AM JPMugaas
{ System.Delete changed to IdDelete so the code can work in NET.
}
{
Rev 1.7 10/19/2003 3:48:10 PM DSiders
Added localization comments.
}
{
{ Rev 1.6 9/28/2003 03:02:30 AM JPMugaas
{ Now can handle a few non-standard date types.
}
{
{ Rev 1.5 9/3/2003 07:34:40 PM JPMugaas
{ Parsing for /bin/ls with devices now should work again.
}
{
{ Rev 1.4 4/7/2003 04:04:26 PM JPMugaas
{ User can now descover what output a parser may give.
}
{
{ Rev 1.3 4/3/2003 03:37:36 AM JPMugaas
{ Fixed a bug in the Unix parser causing it not to work properly with Unix BSD
{ servers using the -T switch. Note that when a -T switch s used on a FreeBSD
{ server, the server outputs the millaseconds and an extra column giving the
{ year instead of either the year or time (the regular /bin/ls standard
{ behavior).
}
{
{ Rev 1.2 3/3/2003 07:17:58 PM JPMugaas
{ Now honors the FreeBSD -T flag and parses list output from a program using
{ it. Minor changes to the File System component.
}
{
{ Rev 1.1 2/19/2003 05:53:14 PM JPMugaas
{ Minor restructures to remove duplicate code and save some work with some
{ formats. The Unix parser had a bug that caused it to give a False positive
{ for Xercom MicroRTOS.
}
{
{ Rev 1.0 2/19/2003 02:02:02 AM JPMugaas
{ Individual parsing objects for the new framework.
}
unit IdFTPListParseUnix;
interface
uses
Classes,
IdFTPList, IdFTPListParseBase, IdFTPListTypes, IdTStrings;
{
Notes:
- The Unitree and Unix parsers are closely tied together and share just
about all of the same code. The reason is that Unitee is very similar to
a Unix dir list except it has an extra column which the Unix line parser
can handle in the Unitree type.
- The Unix parser can parse MACOS - Peters server (no relationship to this
author :-) ).
- It is worth noting that the parser does handle /bin/ls -s and -i switches as
well as -g and -o. This is important sometimes as the Unix format comes
from FTP servers that simply piped output from the Unix /bin/ls command.
- This parser also handles recursive lists which is good for mirroring software.
}
type
{Note that for this, I am violating a convention.
The violation is that I am putting parsers for two separate servers
in the same unit. The reason is this, Unitree has two additional columns (a file family
and a file migration status. The line parsing code is the same because I thought it
was easier to do that way in this case.
}
TIdUnixFTPListItem = class(TIdUnixBaseFTPListItem)
protected
FNumberBlocks : Integer;
FInode : Integer;
public
property NumberBlocks : Integer read FNumberBlocks write FNumberBlocks;
property Inode : Integer read FInode write FInode;
end;
TIdUnitreeFTPListItem = class(TIdUnixFTPListItem)
protected
FMigrated : Boolean;
FFileFamily : String;
public
property Migrated : Boolean read FMigrated write FMigrated;
property FileFamily : String read FFileFamily write FFileFamily;
end;
TIdFTPLPUnix = class(TIdFTPListBase)
protected
class function MakeNewItem(AOwner : TIdFTPListItems) : TIdFTPListItem; override;
class function InternelChkUnix(const AData : String) : Boolean; virtual;
class function IsUnitree(AData:string): Boolean; virtual;
class function IsUnitreeBanner(const AData: String): Boolean; virtual;
class function ParseLine(const AItem : TIdFTPListItem; const APath : String=''): Boolean; override;
public
class function GetIdent : String; override;
class function CheckListing(AListing : TIdStrings; const ASysDescript : String =''; const ADetails : Boolean = True): boolean; override;
class function ParseListing(AListing : TIdStrings; ADir : TIdFTPListItems) : boolean; override;
end;
TIdFTPLPUnitree = class(TIdFTPLPUnix)
protected
class function MakeNewItem(AOwner : TIdFTPListItems) : TIdFTPListItem; override;
public
class function GetIdent : String; override;
end;
const
UNIX = 'Unix'; {do not localize}
UNITREE = 'Unitree'; {do not localize}
implementation
uses
IdGlobal, IdFTPCommon, IdGlobalProtocols,
SysUtils;
{ TIdFTPLPUnix }
class function TIdFTPLPUnix.CheckListing(AListing: TIdStrings;
const ASysDescript: String; const ADetails: Boolean): boolean;
var
i : Integer;
begin
Result := False;
for i := 0 to AListing.Count - 1 do
begin
if (AListing[i]<>'') then
begin
//workaround for the XBox MediaCenter FTP Server
//which returns something like this:
//
//dr-xr-xr-x 1 ftp ftp 1 Feb 23 00:00 D:
//and the trailing : is falsely assuming that a ":" means
//a subdirectory entry in a recursive list.
if InternelChkUnix(AListing[i]) then
begin
if GetIdent= UNITREE then
begin
Result := IsUnitree(AListing[i]);
end
else
begin
Result := not IsUnitree(AListing[i]);
end;
Break;
end;
if IsTotalLine(AListing[i]) or
IsSubDirContentsBanner(AListing[i]) then
begin
Continue;
end
else
begin
break;
end;
end;
end;
end;
class function TIdFTPLPUnix.GetIdent: String;
begin
Result := UNIX;
end;
class function TIdFTPLPUnix.InternelChkUnix(const AData: String): Boolean;
var s : TIdStrings;
LCData : String;
begin
//pos 1 values
// d - dir
// - - file
// l - symbolic link
// b - block device
// c - charactor device
// p - pipe (FIFO)
// s - socket
LCData := UpperCase(AData);
Result := IsValidUnixPerms(AData);
if Result then
begin
//Do NOT attempt to do Novell Netware Print Services for Unix FTPD in NFS
//namespace if we have a block device.
if CharIsInSet(LCData, 1, ['C','B']) then
begin
Exit;
end;
//This extra complexity is required to distinguish Unix from
//a Novell Netware server in NFS namespace which is somewhat similar
//to a Unix listing. Beware.
s := TIdStringList.Create;
try
SplitColumns(LCData,s);
if (s.Count > 9) then
begin
Result := (s[9] <> 'AM') and (s[9] <> 'PM'); {do not localize}
if Result then
begin
//we test the month with a copy because Netware Print Services may return a 4 char month such as Sept
Result := ((IndyPos(':', s[8]) = 0) and (StrToMonth(Copy(s[6], 1, 3)) > 0)) = False;
end;
end;
finally
FreeAndNil(s);
end;
end
else
begin
//we make an additional check for two additional rows before the
//the permissions. These are the inode and block count for the item.
//These are specified with the -i and -s parameters.
s := TIdStringList.Create;
try
SplitColumns(LCData,s);
if s.Count > 3 then
begin
if IsNumeric(s[0]) then
begin
Result := IsValidUnixPerms(S[1]);
if Result=False then
begin
Result := IsNumeric(s[1]) and IsValidUnixPerms(S[2]);
end;
end;
end;
finally
FreeAndNil(s);
end;
end;
end;
class function TIdFTPLPUnix.IsUnitree(AData: string): Boolean;
var s : TIdStrings;
begin
s := TIdStringList.Create;
try
SplitColumns(AData,s);
Result := (s.Count >4) and (PosInStrArray(s[4],UnitreeStoreTypes)<>-1);
if Result=False then
begin
Result := IsUnitreeBanner(AData);
end;
finally
FreeAndNil(s);
end;
end;
class function TIdFTPLPUnix.IsUnitreeBanner(const AData: String): Boolean;
begin
Result := (IndyPos('/',AData)=1) and (Copy(AData,Length(AData)-1,2)=').')
and (IndyPos('(',AData)>0);
end;
class function TIdFTPLPUnix.MakeNewItem(
AOwner: TIdFTPListItems): TIdFTPListItem;
begin
Result := TIdUnixFTPListItem.Create(AOwner);
end;
class function TIdFTPLPUnix.ParseLine(const AItem: TIdFTPListItem;
const APath: String): Boolean;
{Note that we also use this parser for Unitree FTP Servers because that server
is like Unix except that in Unitree, there's two additional columns before the size.
Those are:
Storage Type - AR - archived or migrated to tape and DK
File family -
}
type
TParseUnixSteps = (pusinode, pusBlocks, pusPerm,pusCount,pusOwner,pusGroup,pusSize,pusMonth,pusDay,pusYear,pusTime,pusName,pusDone);
var
LStep: TParseUnixSteps;
LData, LTmp: String;
LInode, LBlocks, LDir, LGPerm, LOPerm, LUPerm, LCount, LOwner, LGroup: String;
LName, LSize, LLinkTo: String;
wYear, wMonth, wDay: Word;
// wYear, LCurrentMonth, wMonth, wDay: Word;
wHour, wMin, wSec, wMSec: Word;
ADate: TDateTime;
i: Integer;
LI : TIdUnixFTPListItem;
function IsGOSwitches(const AString : String) : Boolean;
var s : TIdStrings;
//check to see if both the -g and -o switches were used. Both
//owner and group are surpressed in that case. We have to check that
//so our interpretation does not cause an error.
begin
Result := False;
s := TIdStringList.Create;
try
SplitColumns(AString,s);
if s.Count >2 then
begin
//if either inode or block count were given
if IsNumeric(s[0]) then
begin
s.Delete(0);
end;
//if both inode and block count were given
if IsNumeric(s[0]) then
begin
s.Delete(0);
end;
if s.Count > 5 then
begin
if StrToMonth(s[3])>0 then
begin
Result := IsNumeric(s[4]) and
(IsNumeric(s[5]) or (IndyPos(':',s[5])>0));
end;
end;
end;
finally
FreeAndNil(s);
end;
end;
function FixBonkedYear(const AStrPart : String) : String;
var LB : String;
begin
LB := AStrPart;
Result := Fetch(LB);
Result := StringReplace(Result,'-',' ',[rfReplaceAll]);
Result := StringReplace(Result,'/',' ',[rfReplaceAll]);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -