restemplate/indy/Protocols/IdFTPListParseNovellNetware...

293 lines
8.8 KiB
Plaintext

{
$Project$
$Workfile$
$Revision$
$DateUTC$
$Id$
This file is part of the Indy (Internet Direct) project, and is offered
under the dual-licensing agreement described on the Indy website.
(http://www.indyproject.org/)
Copyright:
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
$Log$
}
{
Rev 1.9 2/23/2005 6:34:26 PM JPMugaas
New property for displaying permissions ina GUI column. Note that this
should not be used like a CHMOD because permissions are different on
different platforms - you have been warned.
Rev 1.8 10/26/2004 9:51:14 PM JPMugaas
Updated refs.
Rev 1.7 4/20/2004 4:01:30 PM JPMugaas
Fix for nasty typecasting error. The wrong create was being called.
Rev 1.6 4/19/2004 5:05:24 PM JPMugaas
Class rework Kudzu wanted.
Rev 1.5 2004.02.03 5:45:20 PM czhower
Name changes
Rev 1.4 1/22/2004 4:59:16 PM SPerry
fixed set problems
Rev 1.3 1/22/2004 7:20:44 AM JPMugaas
System.Delete changed to IdDelete so the code can work in NET.
Rev 1.2 10/19/2003 3:36:06 PM DSiders
Added localization comments.
Rev 1.1 4/7/2003 04:04:08 PM JPMugaas
User can now descover what output a parser may give.
Rev 1.0 2/19/2003 02:02:08 AM JPMugaas
Individual parsing objects for the new framework.
}
unit IdFTPListParseNovellNetware;
interface
{$i IdCompilerDefines.inc}
uses
Classes,
IdFTPList, IdFTPListParseBase, IdFTPListTypes;
{
This parser should work with Netware 3 and 4. It will probably work on later
versions of Novell Netware as well.
}
type
TIdNovellNetwareFTPListItem = class(TIdNovellBaseFTPListItem);
TIdFTPLPNovellNetware = class(TIdFTPListBase)
protected
class function MakeNewItem(AOwner : TIdFTPListItems) : TIdFTPListItem; override;
class function ParseLine(const AItem : TIdFTPListItem; const APath : String = ''): Boolean; override;
public
class function GetIdent : String; override;
class function CheckListing(AListing : TStrings; const ASysDescript : String = ''; const ADetails : Boolean = True): Boolean; override;
class function ParseListing(AListing : TStrings; ADir : TIdFTPListItems) : Boolean; override;
end;
// RLebeau 2/14/09: this forces C++Builder to link to this unit so
// RegisterFTPListParser can be called correctly at program startup...
{$IFDEF HAS_DIRECTIVE_HPPEMIT_LINKUNIT}
{$HPPEMIT LINKUNIT}
{$ELSE}
{$HPPEMIT '#pragma link "IdFTPListParseNovellNetware"'}
{$ENDIF}
implementation
uses
IdException,
IdGlobal, IdFTPCommon, IdGlobalProtocols, SysUtils;
{ TIdFTPLPNovellNetware }
class function TIdFTPLPNovellNetware.CheckListing(AListing: TStrings;
const ASysDescript: String; const ADetails: Boolean): Boolean;
function IsNetwareLine(const AData : String) : Boolean;
var
LPerms : String;
begin
Result := AData <> '';
if Result then
begin
//The space in the set might be necessary for a test case I had captured
//from a website. I don't know if that is an real FTP list or not but it's
//better to be safe then sorry. At least I did tighten up the Novell Permissions
//check.
Result := CharIsInSet(AData, 1, 'dD- '); {Do not localize}
if Result then
begin
// we need to test HellSoft separately from this even though they will be handled by
//the same parser.
if Result then
begin
LPerms := ExtractNovellPerms(AData);
Result := IsValidNovellPermissionStr(LPerms) and
(Length(LPerms) = 8) and
(not IsNovelPSPattern(AData));
end;
end;
end;
end;
begin
Result := False;
if AListing.Count > 0 then
begin
if IsTotalLine(AListing[0]) then begin
Result := (AListing.Count > 1) and IsNetwareLine(AListing[1]);
end else begin
Result := IsNetwareLine(AListing[0]);
end;
end;
end;
class function TIdFTPLPNovellNetware.GetIdent: String;
begin
Result := 'Novell Netware'; {do not localize}
end;
class function TIdFTPLPNovellNetware.MakeNewItem(AOwner: TIdFTPListItems): TIdFTPListItem;
begin
Result := TIdNovellNetwareFTPListItem.Create(AOwner);
end;
class function TIdFTPLPNovellNetware.ParseLine(const AItem: TIdFTPListItem;
const APath: String): Boolean;
var
strs : TStrings;
wYear, LCurrentMonth, wMonth, wDay: Word;
wHour, wMin, wSec, wMSec: Word;
ADate: TDateTime;
LBuf : String;
NameStartPos : Integer;
NameStartIdx : Integer;
LName : String;
LI : TIdNovellNetwareFTPListItem;
begin
{
- [RWCEAFMS] 0 1576 Feb 08 2000 00README
- [RWCEAFMS] 0 742 Jan 03 2001 00INDEX
- [RWCEAFMS] tjhamalainen 1020928 Sep 25 2001 winntnw.exe
d [RWCEAFMS] Okkola 512 Aug 17 03:42 WINDOWS
-[R----F-] 1 raj 857 Feb 23 2000 !info!
d[R----F-] 1 raj 512 Nov 30 2001 incoming
d [R----F--] supervisor 512 Jan 16 18:53 login
- [R----F--] rhesus 214059 Oct 20 15:27 cx.exe
}
LI := AItem as TIdNovellNetwareFTPListItem;
NameStartIdx := 5;
// Get defaults for modified date/time
ADate := Now;
DecodeDate(ADate, wYear, wMonth, wDay);
DecodeTime(ADate, wHour, wMin, wSec, wMSec);
LCurrentMonth := wMonth;
if TextStartsWith(LI.Data, 'D') then begin {do not localize}
LI.ItemType := ditDirectory;
end else begin
LI.ItemType := ditFile;
end;
//Most FTP Clients don't support permissions on a Novel Netware server.
LBuf := AItem.Data;
LI.NovellPermissions := ExtractNovellPerms(LBuf);
LI.PermissionDisplay := '[' + LI.NovellPermissions + ']'; {do not localize}
Fetch(LBuf, '] '); {do not localize}
if LBuf <> '' then
begin
//One Novell Server I found at nf.wsp.krakow.pl
//uses an old version of Novell Netware (3.12 or so). That differs slightly
if LBuf[1] = ' ' then {do not localize}
begin
IdDelete(LBuf, 1, 1);
// LBuf := TrimLeft(LBuf);
Fetch(LBuf);
end;
strs := TStringList.Create;
try
SplitDelimitedString(LBuf, strs, True);
{
0 - owner
1 - size
2 - month
3 - day of month
4 - time or year
5 - start of file name or time
6 - start of file name if 5 was time
}
if strs.Count > 4 then
begin
LI.OwnerName := strs[0];
LI.Size := IndyStrToInt64(strs[1], 0);
wMonth := StrToMonth(strs[2]);
if wMonth < 1 then begin
wMonth := LCurrentMonth;
end;
wDay := IndyStrToInt(strs[3], wDay);
if IndyPos(':', Strs[4]) = 0 then {do not localize}
begin
wYear := IndyStrToInt(strs[4], wYear);
wYear := Y2Year(wYear);
wHour := 0;
wMin := 0;
if (Strs.Count > 5) and (IndyPos(':', Strs[5]) > 0) then {do not localize}
begin
LBuf := Strs[5];
wHour := IndyStrToInt(Fetch(LBuf, ':'), wHour); {do not localize}
wMin := IndyStrToInt(Fetch(LBuf, ':'), wMin); {do not localize}
NameStartIdx := 6;
end;
end else
begin
wYear := AddMissingYear(wDay, wMonth);
LBuf := Strs[4];
wHour := IndyStrToInt(Fetch(LBuf, ':'), wHour); {do not localize}
wMin := IndyStrToInt(Fetch(LBuf, ':'), wMin); {do not localize}
end;
LI.ModifiedDate := EncodeDate(wYear, wMonth, wDay);
LI.ModifiedDate := LI.ModifiedDate + EncodeTime(wHour, wMin, 0, 0);
//Note that I doubt a file name can start with a space in Novel/
//Netware. Some code I've seen strips those off.
for NameStartPos := NameStartIdx to Strs.Count -1 do begin
LName := LName + ' ' + Strs[NameStartPos]; {do not localize}
end;
IdDelete(LName, 1, 1);
LI.FileName := LName;
//Novell Netware is case sensitive I think.
LI.LocalFileName := LName;
end;
finally
FreeAndNil(strs);
end;
end;
Result := True;
end;
class function TIdFTPLPNovellNetware.ParseListing(AListing: TStrings;
ADir: TIdFTPListItems): Boolean;
var
LStartLine, i : Integer;
LItem : TIdFTPListItem;
begin
if AListing.Count = 0 then
begin
Result := True;
Exit;
end;
If IsTotalLine(AListing[0]) then begin
LStartLine := 1;
end else begin
LStartLine := 0;
end;
for i := LStartLine to AListing.Count -1 do
begin
LItem := MakeNewItem(ADir);
LItem.Data := AListing[i];
ParseLine(LItem);
end;
Result := True;
end;
initialization
RegisterFTPListParser(TIdFTPLPNovellNetware);
finalization
UnRegisterFTPListParser(TIdFTPLPNovellNetware);
end.