Процедура GetDirList
procedure TCsKeeper.GetDirList; var F : TextFile; SearchRec : TSearchRec; SizeStr, FileName, S : String; TDate : TDateTime; Result, K, L : Integer; begin AssignFile(F, DirListFile);
Rewrite(F);
if Pos('\',FDirPath) = length(FDirPath) then FileName := Concat(FDirPath,'*.*') else if Pos('\',FDirPath) < length(FDirPath) then FileName := Concat(FDirPath,'\*.*');
Result := FindFirst(FileName, faAnyFile, SearchRec);
if Result <>
0 then begin Status := Failure; Exit; end; try TDate := FileDateToDateTime(SearchRec.Time);
except on EConvertError do begin Status := Failure; Data := '500 Internal error'; closesocket(FSocket);
Exit; end; end; S := FormatDateTime('mmm dd hh'':''mm',TDate);
if DirectoryExists(SearchRec.Name) then writeln(F, 'drwxrwxrwx 1 noone nogroup ','0',' ',S,' ',SearchRec.Name) else begin { вычисляем длину строки для размера файла } SizeStr := IntToStr(SearchRec.Size);
L := Length(SizeStr);
for K := 9 - L downto 1 do SizeStr := ConCat(' ',SizeStr);
write(F,'-rwxrwxrwx 1 noone nogroup');
writeln(F, SizeStr,' ',S,' ',SearchRec.Name);
end; while Result = 0 do begin TDate := FileDateToDateTime(SearchRec.Time);
S := FormatDateTime('mmm dd hh'':''mm',TDate);
if DirectoryExists(SearchRec.Name) then writeln(F, 'drwxrwxrwx 1 noone nogroup ','0',' ',S,' ',SearchRec.Name) else begin SizeStr := IntToStr(SearchRec.Size);
L := Length(SizeStr);
for K := 9 - L downto 1 do SizeStr := ConCat(' ',SizeStr);
write(F,'-rwxrwxrwx 1 noone nogroup');
writeln(F, SizeStr,' ',S,' ',SearchRec.Name);
end; Result := FindNext(SearchRec);
end; SysUtils.FindClose(SearchRec);
CloseFile(F);
end;
Как и в случае с CsShopper, процедура CsKeeper1.OnInfo передает KEEPER32 сообщения, отображаемые затем в Memo-элементе memStatus (см. Рисунок 7.7). Любые ошибки FTP передаются обработчиком CsKeeper1.OnError на панель pnErrorMsg.
