Type TTextListRec =
Record
Start: Int64;
Length: Integer;
TextStart:
String[11];
// 11+1 = 12 Byte ... insgesammt 24 Byte pro Zeile
End;
TTextList =
Array of TTextListRec;
Function FilePos(
Var InFile: TextFile): Int64;
Begin
LARGE_INTEGER(Result).HighPart := 0;
LARGE_INTEGER(Result).LowPart := SetFilePointer(TTextRec(InFile).Handle,
0, @LARGE_INTEGER(Result).HighPart, FILE_CURRENT) - (TTextRec(InFile).BufEnd - TTextRec(InFile).BufPos);
End;
Procedure FileSeek(
Var InFile: TextFile; Pos: Int64);
Begin
TTextRec(InFile).BufPos := 0;
TTextRec(InFile).BufEnd := 0;
SetFilePointer(TTextRec(InFile).Handle,
LARGE_INTEGER(Pos).LowPart, @LARGE_INTEGER(Pos).HighPart, FILE_BEGIN);
End;
Function GetFullLine(
Var InFile: TextFile;
Const List: TTextList;
Index: Integer): AnsiString;
Begin
If (
Index < 0)
or (
Index >= Length(List))
Then
Raise Exception.Create('
index out of range');
FileSeek(InFile, List[
Index].Start);
ReadLn(InFile, Result);
End;
Var InFile, OutFile: TextFile;
List: TTextList;
i, i2: Integer;
S: AnsiString;
Temp: TTextListRec;
Begin
AssignFile(InFile, '
Unit1.pas');
Reset(InFile);
AssignFile(OutFile, '
Unit1_.pas');
Rewrite(OutFile);
// einlesen
i := 0;
While not EoF(InFile)
do Begin
ReadLn(InFile, S);
Inc(i);
End;
SetLength(List, i);
FileSeek(InFile, 0);
i := 0;
While not EoF(InFile)
do Begin
List[i].Start := FilePos(InFile);
ReadLn(InFile, S);
List[i].Length := Length(S);
List[i].TextStart := S;
Inc(i);
End;
// sortieren
For i := 0
to High(List) - 1
do
For i2 := i + 1
to High(List)
do
If (List[i].TextStart > List[i2].TextStart)
or ((List[i].TextStart = List[i2].TextStart)
and (GetFullLine(InFile, List, i) > GetFullLine(InFile, List, i2)))
Then Begin
Temp := List[i];
List[i] := List[i2];
List[i2] := Temp;
End;
// sortiertes speichern
For i := 0
to High(List)
do
WriteLn(OutFile, GetFullLine(InFile, List, i));
CloseFile(OutFile);
CloseFile(InFile);
End;