Re: [twsocket] (TFtpClient) Parsing list. Help, help.

2010-06-04 Thread newsgate

Thanks for example.

Thanks for Lionel Rault and Anton Sviridov.

--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be


Re: [twsocket] (TFtpClient) Parsing list. Help, help.

2010-06-03 Thread Anton Sviridov
Hello!
Here's routine from TurboPower iPRO component pack which I improved a bit

{ Set properties from Unix style line of directory listing }
procedure TIpFtpFileInfo.UnixStyleParse(Info : TStringList);
var
  S, A : string;
  i, idx : Integer;
  wYear, wMonth, wDay, wHour, wMin, shit: Word;
  fs: TFormatSettings;
begin
  // Get defaults for file creation date/time
  DecodeDate(GetTimeFn, wYear, wMonth, wDay);
  DecodeTime(GetTimeFn, wHour, wMin, shit, shit);

  {File Type}
  S := Info[0];
  case UpCase(S[1]) of
'-' : FFileType := ftFile;
'D' : FFileType := ftDir;
//'L' : FFileType := ftLink;
'L' : FFileType := ftDir;
  else
FFileType := ftUnknown;
  end;

  {Owner Permissions}
  FPermissions.Owner := [];
  A := UpperCase(Copy(S, 2, 3));
  if CharPos('R', A) > 0 then  {!!.02}
FPermissions.Owner := FPermissions.Owner + [faRead];
  if CharPos('W', A) > 0 then  {!!.02}
FPermissions.Owner := FPermissions.Owner + [faWrite];
  if CharPos('X', A) > 0 then  {!!.02}
FPermissions.Owner := FPermissions.Owner + [faExecute];

  {Group Permissions}
  FPermissions.Group := [];
  A := UpperCase(Copy(S, 5, 3));
  if CharPos('R', A) > 0 then  {!!.02}
FPermissions.Group := FPermissions.Group + [faRead];
  if CharPos('W', A) > 0 then  {!!.02}
FPermissions.Group := FPermissions.Group + [faWrite];
  if CharPos('X', A) > 0 then  {!!.02}
FPermissions.Group := FPermissions.Group + [faExecute];

  {Other Permissions}
  FPermissions.Other := [];
  A := UpperCase(Copy(S, 8, 3));   {!!.02}
  if CharPos('R', A) > 0 then
FPermissions.Other := FPermissions.Other + [faRead];
  if CharPos('W', A) > 0 then  {!!.02}
FPermissions.Other := FPermissions.Other + [faWrite];
  if CharPos('X', A) > 0 then  {!!.02}
FPermissions.Other := FPermissions.Other + [faExecute];

  {Search index of date property - to avoid owner/group bad data}
  // Date field always starts with 3-letter month name
  GetLocaleFormatSettings(LANG_ENGLISH, fs);
  idx:=0;
  for i := 1 to Info.Count-1 do
if AnsiIndexStr(Info[i],fs.ShortMonthNames)<>-1 then
  begin idx:=i; Break; end;
  if idx=0 then Exit;

  // Get other fields relative to Date
  {Owner}
  if (idx-3 > 0) then
FOwner := Info[idx-3];

  {Group}
  if (idx-2 > 0) then
FGroup := Info[idx-2];

  {Size}
  if (idx-1 > 0) then
FSize := StrToIntDef(Info[idx-1], 0);

  {Time stamp}
  if (idx <= Info.Count + 2) then
  // parse timestamp. got it from Indy :)
  // format: "Feb 27 19:07" or "Sep 20 2001", that is,   |
  begin
FTimeStamp := Info[idx] + ' ' + Info[idx+1] + ' ' + Info[idx+2];
i:=AnsiIndexStr(Info[idx],fs.ShortMonthNames);
if i>=0 then wMonth := i+1;
wDay := StrToIntDef(Info[idx+1], wDay);
i:=Pos(':', Info[idx+2]);
if i = 0 then // Not time info, scan year
begin
  wYear := StrToIntDef(Info[idx+2], wYear);
  wHour := 0;
  wMin := 0;
end
else
begin // Time info, correct year, scan hour, min
  if MonthOf(GetTimeFn) < wMonth then
Dec(wYear);
  wHour:= StrToIntDef(Copy(Info[idx+2],1,i-1),0);
  wMin := StrToIntDef(Copy(Info[idx+2],i+1,Length(Info[idx+2])),0);
end;
FDateCreated := EncodeDate(wYear, wMonth, wDay) + EncodeTime(wHour, wMin, 
0, 0);
  end;

  {File name}
  FFileName := '';
  for i := idx+3 to Info.Count-1 do begin
if(Info[i] = '->')then
  break;
if (FFileName <> '') then
  FFileName := FFileName + ' ';
FFilename := FFileName + Info[i];
  end;

  {Symbolic Link}
  FLinkPath := '';
  if (FFileType = ftLink) then begin
for i := 0 to Pred(Info.Count) do
  if (Info[i] = '->') then
break;
if (i <= (Info.Count - 2)) then
  FLinkPath := Info[i + 1];
  end;
end;

Moreover, I created more powerful & robust ICS FTP client descendant with Unix, 
VMS, DOS listing parsing. Let me know if someone's interested.

-- 
Anton
--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be


Re: [twsocket] (TFtpClient) Parsing list. Help, help.

2010-06-03 Thread Eric-Lionel Rault

And it is well. I will show the result.
-rwx-- 1 user group 311521 May 29 07:33 1.jpg
-rwx-- 1 user group 311521 May 29 07:38 2.jpg
drwx-- 1 user group  0 Jun 03 16:13 test1

I can not read the date of file ' May 29 07:33'
should be '2010-05-29 07:33:00' how do this???


use FTPLISTEINFO below
liglisteFTP represent one line like  '-rwx-- 1 user group 311521 
May 29 07:33 1.jpg'




function AJUSTELIG(chainex:String;lgmax:integer;bourrage:Byte):String;
//retourne une chaine contenant exactement lgmax caractères
//si chainex est supérieure à lgmax, chainex est tronquée
//si chainex est inférieure on y rajoute les caractères de bourrage
//bourrage=0 ou >3 : espaces derrière
// 1 espaces devant
// 2 zéros derrière
// 3 zéros devant
var lgchaine, cptcar:integer;
   chainetmp:string;
begin
If lgmax <= 0 Then chainex := '' else
 begin
   lgchaine := Length(chainex);
   If lgchaine > lgmax Then
 begin
   chainetmp:='';
   for cptcar:=1 to lgmax do chainetmp:=chainetmp+chainex[cptcar];
   chainex:=chainetmp;
 end
 else
   begin
 If lgchaine < lgmax Then
   begin
 Case bourrage of
  1:while length(chainex)0)and(numchamp=5)) then
   begin
 if liglisteftp[1]='d' then lgcar:=0;
   end;
 if ((lgcar>0)and (NumChamp>0)and(numchamp<=9)) then
   begin
 cptchamp:=1;
 cptcar:=0;
 champx:='';
 fin:=false;
 espace:=false;
 repeat
   inc(cptcar);
   case liglisteFTP[cptcar] of
 #32 :if cptchamp<9 then
begin
  if espace=false then
begin
  if cptchamp=NumChamp then fin:=true else
begin
  cptchamp:=cptchamp+1;
  champx:='';
end;
end;
  espace:=true;
end
else
  begin
//le nom peut comporter des espaces
champx:=champx+#32;
  end;
 else
   begin
 champx:=champx+liglisteFTP[cptcar];
 espace:=false;
   end;
   end;
   if cptcar>=lgcar then fin:=true;
 until (fin);
 if champx<>'' then
   begin
 if cptchamp=NumChamp then
   begin
 case numchamp of
   6:begin
   moisl:=0;
   moisx:=MAJUS(champx);//passer en majuscules
   if moisx='JAN' then moisl:=1
 else if moisx='FEB' then moisl:=2
   else if moisx='MAR' then moisl:=3
 else if moisx='APR' then moisl:=4
   else if moisx='MAY' then moisl:=5
 else if moisx='JUN' then moisl:=6
   else if moisx='JUL' then moisl:=7
 else if moisx='AUG' then moisl:=8
   else if moisx='SEP' then moisl:=9
 else if moisx='OCT' then moisl:=10
   else if moisx='NOV' then moisl:=11
 else if moisx='DEC' then 
moisl:=12;

   if moisl<>0 then champret:=AJUSTELIG(N(moisl),2,3);
 end;
   7:begin
   jol:=T(champx);
   if ((jol>0) and (jol<=31)) then 
champret:=AJUSTELIG(N(jol),2,3);

 end;
   8:begin
   heux:='';
   minx:='';
   heure:=true;
   for cptcar:=1 to length(champx) do
 begin
   if champx[cptcar]=':' then heure:=false
 else
   begin
 if heure=true then heux:=heux+champx[cptcar]
   else minx:=minx+champx[cptcar];
   end;
 end;
   heul:=T(heux);
   minl:=T(minx);
   if ((heul>-1)and(heul<24)and (minl>-1)and(minl<60)) then
 begin
   champret:=AJUSTELIG(N(heul),2,3)+AJUSTELIG(N(minl),2,3)
 end;
 end;
   else champret:=champx;
 end;
   end;
   end;
   end;
 result:=champret;
end;


--
To unsubscribe or change your settings for TWSocket mailing list
please goto http://lists.elists.org/cgi-bin/mailman/listinfo/twsocket
Visit our website at http://www.overbyte.be