Ver Mensaje Individual
  #4  
Antiguo 29-10-2007
Northern Northern is offline
Miembro
 
Registrado: ene 2006
Posts: 211
Reputación: 19
Northern Va por buen camino
Cita:
Empezado por ixMike Ver Mensaje
Bueno, amigo Northern, creo que a lo que Patho se refiere es a que los archivos se llaman ener.txt, febrero.txt, marzo.txt... (si no es así, por favor, corrígeme). En ese caso, para ordenarlos, no veo una solución directa.

......

Puedes ir llamando a la función GetAllFiles especificando el mes GetAllFiles(FileList, 'ene*.*', faArchive);etc.


Y como acabo de entrar y me he dado cuenta de que los enlaces que puse hacia www.tamaracka.comvan por tiempo pongo aquí los códigos pero que sepas que están sacados de allí:

Código Delphi [-]
type
  { New type of TStringList which can sort ascending and
    descending. It is specialized in sorting on filedates
    which are/must be stored in the objects part of the list}
  TNewStringList = class(TStringList)
  private
    FSortDir : integer;
  protected
    function CompareFileDates(Idx1, Idx2: integer): integer;
    procedure BSort(L, R: integer);
  public
    procedure Sort; override;
    property SortDir: integer read FSortDir write FSortDir default 0;
  end;

{ TNewStringList }
function TNewStringList.CompareFileDates(Idx1, Idx2: integer): integer;
begin
  if integer(Objects[Idx1]) > integer(Objects[Idx2]) then
    Result := 1
  else if integer(Objects[Idx1]) < integer(Objects[Idx2]) then
    Result := -1
  else
    Result := 0;
end;

{It's not the fastest sorting algorithm but I couldn't get
the quicksort to function with it at the moment}
procedure TNewStringList.BSort(L, R: integer);
var
  I, P : integer;
begin
  if SortDir = 0 then // ascending
  begin
    repeat
      P := L;
      for I := L to R do
        if CompareFileDates( I, P ) > 0 then
          P := I;
      if P <> R then
        Exchange(P, R);
      Dec(R);
    until R <= L;
  end
  else // descending
  begin
    repeat
      P := L;
      for I := L to R do
        if CompareFileDates( I, P ) < 0 then
          P := I;
      if P <> R then
        Exchange(P, R);
      Dec(R);
    until R <= L
  end;
end;

procedure TNewStringList.Sort;
begin
  if not Sorted and (Count > 1) then
  begin
    Changing;
    BSort(0, Count - 1);
    Changed;
  end;
end;

procedure GetAllFiles(Items: TStrings; SearchSpecs: string; Attr: word);
var
  SearchRec: TSearchRec;
begin
  if FindFirst(SearchSpecs, faAnyFile, SearchRec)=0 then
    repeat
      if (SearchRec.Name <> '.') and
         (SearchRec.Name <> '..') and
         ((SearchRec.Attr and Attr) <> 0) then
        Items.AddObject(SearchRec.Name, TObject(SearchRec.Time));
    until FindNext(SearchRec) <> 0;
  FindClose(SearchRec);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Cnt : integer;
  FileList : TNewStringList;
  ADateTime : TDateTime;
begin
  FileList := TNewStringList.Create;
  try
    GetAllFiles(FileList, '*.*', faArchive);
    FileList.SortDir := 1; // 0=ascending 1=descending
    FileList.Sort;

    Memo1.Clear;
    for Cnt := 0 to FileList.Count-1 do
    begin
      ADateTime := FileDateToDateTime(integer(FileList.Objects[Cnt]));
      Memo1.Lines.Add(
        Format('%-20s %20s', [FileList[Cnt],
FormatDateTime('c',ADateTime)]));
    end;
  finally
    FileList.Free;
  end;
end;


Saludos
Responder Con Cita