function SplitTextFileAtEmptyLines(
Handle: THandle;
const aFilename, aDir:
string): integer;
var
sl, sl2, sl3: TStringList;
// sl: Ursprungsdatei, sl2: Teildateien, sl3: Dateiliste
PN:
string;
// Patentnummer für Dateiname
Loop: Integer;
cntFile: Cardinal;
Dir, PartFilename:
string;
s:
string;
// Zeile aus Ursprungsdatei
Filenames, TextFileFilenames:
string;
begin
SetLastError(0);
// sicherstellen, dass der Pfad ohne Backslash endet
Dir := ExcludeTrailingBackslash(aDir);
cntFile := 1;
// Stringlisten erzeugen
sl := TStringList.Create;
sl2 := TStringList.Create;
sl3 := TStringList.Create;
try
// Ursprungsdatei in die SL laden
sl.LoadFromFile(aFilename);
// so lange nicht die letzte Zeile erreicht ist
for Loop := 0
to sl.Count - 1
do
begin
// Zeile lesen und an sl2 anhängen
s := sl.Strings[Loop];
OutputDebugString(PChar(s));
sl2.Add(s);
// wenn s leer oder Ende von Ursprungsdatei erreicht Teildatei speichern
if (s = '
')
or (Loop = sl.Count - 1)
then
begin
// Teildateiname genrieren
PN := copy(sl2.Strings[0], 5, 13);
PN := StringReplace(PN, '
', '
_', [rfReplaceAll]);
PartFilename := BuildPartFilename(Dir + '
\' +PN + '
.txt', cntFile);
// speichern
sl2.SaveToFile(PartFilename);
// sl2 wieder leeren
sl2.Clear;
// Nachricht mit aktuellen Dateinamen an eigenes Fenster schicken
SendMessage(
Handle, M_FILENAME, 0,
Integer(PChar(ExtractFilename(PartFilename))));
// Benutzer hat "Abbrechen" geklickt -> Schleife verlassen
if bCancel <> 0
then
break;
// Zeile für Dateiliste mit Dateinamen erzeugen
Filenames := Filenames + ExtractFilename(ChangeFileExt(PartFilename, '
'))
+ '
';
if cntFile
mod 3 = 0
then // zwei Dateinamen pro Zeile
begin
sl3.Add(Filenames);
Filenames := '
';
end;
// Zählvariable für Teildateinamen erhöhen
Inc(cntFile);
end;
end;
sl3.Add(Filenames);
// Name für Dateiliste erzeugen
TextFileFilenames := aDir + '
\' + ExtractFilename(ChangeFileExt(aFilename,
'
')) + TextFileFilesnamesExt;
sl3.SaveToFile(TextFileFilenames);
finally
// Aufräumen
FreeAndNil(sl);
FreeAndNil(sl2);
FreeAndNil(sl3);
// Fertig -> "Fertig"-Nachricht an eigenes Fenster schicken
SendMessage(
Handle, M_FINISH, 0, 0);
result := GetLastError();
end;
end;