diff --git a/components/systools/examples/text/EXTEXT.lpi b/components/systools/examples/text/EXTEXT.lpi
new file mode 100644
index 000000000..65a37d901
--- /dev/null
+++ b/components/systools/examples/text/EXTEXT.lpi
@@ -0,0 +1,85 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/systools/examples/text/EXTEXT.lpr b/components/systools/examples/text/EXTEXT.lpr
new file mode 100644
index 000000000..34a13af7a
--- /dev/null
+++ b/components/systools/examples/text/EXTEXT.lpr
@@ -0,0 +1,42 @@
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is TurboPower SysTools
+ *
+ * The Initial Developer of the Original Code is
+ * TurboPower Software
+ *
+ * Portions created by the Initial Developer are Copyright (C) 1996-2002
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+program Extext;
+
+uses
+ Forms, Interfaces, LclVersion,
+ ExTextU in 'ExTextU.pas' {STDlg};
+
+{$R *.res}
+
+begin
+ Application.Scaled := True;
+ {$IF lcl_fullversion >= 1080000}
+ Application.Scaled := True;
+ {$ENDIF}
+ Application.Initialize;
+ Application.CreateForm(TSTDlg, STDlg);
+ Application.Run;
+end.
diff --git a/components/systools/examples/text/ExTextU.lfm b/components/systools/examples/text/ExTextU.lfm
new file mode 100644
index 000000000..f50d5ac1c
--- /dev/null
+++ b/components/systools/examples/text/ExTextU.lfm
@@ -0,0 +1,127 @@
+object STDlg: TSTDlg
+ Left = 254
+ Height = 274
+ Top = 164
+ Width = 428
+ ActiveControl = LoadBtn
+ Caption = 'StText Example'
+ ClientHeight = 274
+ ClientWidth = 428
+ Color = clBtnFace
+ Font.Color = clBlack
+ OnClose = FormClose
+ OnCreate = FormCreate
+ LCLVersion = '1.9.0.0'
+ object Label1: TLabel
+ Left = 6
+ Height = 15
+ Top = 16
+ Width = 32
+ Caption = 'Name'
+ ParentColor = False
+ end
+ object Label2: TLabel
+ Left = 208
+ Height = 15
+ Top = 16
+ Width = 23
+ Caption = 'Size:'
+ ParentColor = False
+ end
+ object Label3: TLabel
+ Left = 320
+ Height = 15
+ Top = 16
+ Width = 44
+ Caption = 'Cur. Pos'
+ ParentColor = False
+ end
+ object Memo1: TMemo
+ Left = 90
+ Height = 217
+ Top = 48
+ Width = 329
+ HideSelection = False
+ OnKeyUp = Memo1KeyUp
+ OnMouseUp = Memo1MouseUp
+ ReadOnly = True
+ ScrollBars = ssVertical
+ TabOrder = 8
+ TabStop = False
+ end
+ object LoadBtn: TButton
+ Left = 8
+ Height = 33
+ Top = 48
+ Width = 75
+ Caption = 'Load'
+ Default = True
+ OnClick = LoadBtnClick
+ TabOrder = 0
+ end
+ object SeekBtn: TButton
+ Left = 8
+ Height = 33
+ Top = 170
+ Width = 75
+ Caption = 'Seek'
+ OnClick = SeekBtnClick
+ TabOrder = 3
+ end
+ object FlushBtn: TButton
+ Left = 8
+ Height = 33
+ Top = 232
+ Width = 75
+ Caption = 'Flush'
+ OnClick = FlushBtnClick
+ TabOrder = 4
+ end
+ object Edit1: TEdit
+ Left = 40
+ Height = 23
+ Top = 12
+ Width = 159
+ ReadOnly = True
+ TabOrder = 5
+ end
+ object Edit2: TEdit
+ Left = 236
+ Height = 23
+ Top = 12
+ Width = 53
+ ReadOnly = True
+ TabOrder = 6
+ end
+ object Edit3: TEdit
+ Left = 366
+ Height = 23
+ Top = 12
+ Width = 53
+ ReadOnly = True
+ TabOrder = 7
+ end
+ object Edit4: TEdit
+ Left = 14
+ Height = 23
+ Top = 136
+ Width = 65
+ TabOrder = 2
+ end
+ object CloseFBtn: TButton
+ Left = 8
+ Height = 33
+ Top = 90
+ Width = 75
+ Caption = 'Close File'
+ OnClick = CloseFBtnClick
+ TabOrder = 1
+ end
+ object OD1: TOpenDialog
+ DefaultExt = '.TXT'
+ Filter = '*.txt (Text files)|*.txt|*.* (All files)|*.*'
+ Options = [ofOverwritePrompt]
+ left = 152
+ top = 86
+ end
+end
diff --git a/components/systools/examples/text/ExTextU.pas b/components/systools/examples/text/ExTextU.pas
new file mode 100644
index 000000000..49cfd63be
--- /dev/null
+++ b/components/systools/examples/text/ExTextU.pas
@@ -0,0 +1,230 @@
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is TurboPower SysTools
+ *
+ * The Initial Developer of the Original Code is
+ * TurboPower Software
+ *
+ * Portions created by the Initial Developer are Copyright (C) 1996-2002
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit ExTextU;
+
+{$IFDEF FPC}
+ {$mode DELPHI}
+{$ENDIF}
+
+interface
+
+uses
+ {$IFNDEF FPC}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Graphics, Controls,
+ Forms, Dialogs, StdCtrls;
+
+type
+ TSTDlg = class(TForm)
+ Memo1: TMemo;
+ OD1: TOpenDialog;
+ LoadBtn: TButton;
+ SeekBtn: TButton;
+ FlushBtn: TButton;
+ Label1: TLabel;
+ Edit1: TEdit;
+ Label2: TLabel;
+ Edit2: TEdit;
+ Label3: TLabel;
+ Edit3: TEdit;
+ Edit4: TEdit;
+ CloseFBtn: TButton;
+ procedure LoadBtnClick(Sender: TObject);
+ procedure SeekBtnClick(Sender: TObject);
+ procedure Memo1KeyUp(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ procedure Memo1MouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+ procedure FlushBtnClick(Sender: TObject);
+ procedure CloseFBtnClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ procedure UpdatePos;
+ procedure UpdateButtons(FOK : Boolean);
+ end;
+
+var
+ STDlg: TSTDlg;
+
+implementation
+
+{$R *.lfm}
+
+uses
+ StConst,
+ StBase,
+ StText;
+
+
+var
+ F : TextFile;
+ AFO : Boolean;
+
+
+procedure TSTDlg.UpdateButtons(FOK : Boolean);
+begin
+ CloseFBtn.Enabled := FOK;
+ SeekBtn.Enabled := FOK;
+ FlushBtn.Enabled := FOK;
+end;
+
+procedure TSTDlg.FormCreate(Sender: TObject);
+begin
+ UpdateButtons(False);
+ AFO := False;
+end;
+
+procedure TSTDlg.LoadBtnClick(Sender: TObject);
+var
+ S : string;
+// hC : HCursor;
+begin
+ if (OD1.Execute) then
+ begin
+ if (AFO) then
+ CloseFile(F);
+ AFO := False;
+
+ AssignFile(F, OD1.FileName);
+ Reset(F);
+
+ Memo1.Enabled := True;
+ Memo1.Lines.BeginUpdate;
+ Screen.Cursor := crHourglass;
+ try
+// Memo1.Perform(WM_SETREDRAW,0,0);
+// hC := SetCursor(LoadCursor(0,IDC_WAIT));
+
+ while NOT EOF(F) do
+ begin
+ Readln(F,S);
+ Memo1.Lines.Add(S);
+ end;
+
+ finally
+ Screen.Cursor := crDefault;
+ Memo1.Lines.EndUpdate;
+ end;
+// Memo1.Perform(WM_SETREDRAW,1,0);
+// Memo1.Update;
+ Memo1.SelStart := 0;
+ Memo1.SelLength := 0;
+
+ Reset(F);
+
+ Edit1.Text := OD1.FileName;
+ Edit2.Text := IntToStr(TextFileSize(F));
+ Edit3.Text := IntToStr(TextPos(F));
+
+// SetCursor(hC);
+ Memo1.SetFocus;
+ AFO := True;
+ end;
+ UpdateButtons(AFO);
+end;
+
+procedure TSTDlg.CloseFBtnClick(Sender: TObject);
+begin
+ CloseFile(F);
+ Memo1.Clear;
+ AFO := False;
+ UpdateButtons(False);
+end;
+
+
+procedure TSTDlg.SeekBtnClick(Sender: TObject);
+var
+ NP : LongInt;
+begin
+ NP := StrToInt(Edit4.Text);
+ Memo1.SetFocus;
+ if (NP < 0) OR (NP >= TextFileSize(F)) then
+ begin
+ ShowMessage('Value out of range');
+ Exit;
+ end;
+
+ if TextSeek(F,NP) then
+ begin
+ NP := TextPos(F);
+ Memo1.SelStart := NP;
+ Memo1.SelLength := 0;
+ Edit3.Text := IntToStr(NP);
+ end else
+ begin
+ ShowMessage('Unable to seek to position');
+ Memo1.SetFocus;
+ end;
+end;
+
+procedure TSTDlg.Memo1KeyUp(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ UpdatePos;
+end;
+
+procedure TSTDlg.Memo1MouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+begin
+ UpdatePos;
+end;
+
+
+procedure TSTDlg.UpdatePos;
+var
+ CP : LongInt;
+begin
+ CP := Memo1.SelStart;
+
+ if NOT TextSeek(F,CP) then
+ begin
+ ShowMessage('Unable to update file pointer');
+ Exit;
+ end;
+
+ Edit3.Text := IntToStr(TextPos(F));
+end;
+
+procedure TSTDlg.FlushBtnClick(Sender: TObject);
+begin
+ if NOT (TextFlush(F)) then
+ begin
+ ShowMessage('Unable to flush file');
+ end;
+ Memo1.SetFocus;
+end;
+
+procedure TSTDlg.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ if AFO then CloseFile(F);
+end;
+
+end.
diff --git a/components/systools/laz_systools.lpk b/components/systools/laz_systools.lpk
index de9982599..fed87e6a9 100644
--- a/components/systools/laz_systools.lpk
+++ b/components/systools/laz_systools.lpk
@@ -16,7 +16,7 @@
-
+
@@ -253,6 +253,10 @@
+
+
+
+
diff --git a/components/systools/laz_systools.pas b/components/systools/laz_systools.pas
index 5039f861f..c9ae9afea 100644
--- a/components/systools/laz_systools.pas
+++ b/components/systools/laz_systools.pas
@@ -14,7 +14,8 @@ uses
StAstro, StEclpse, StList, StMerc, StAstroP, StVenus, StMars, StJup,
StSaturn, StUranus, StNeptun, StPluto, StJupsat, StBits, StColl, StDQue,
StVArr, StPQueue, StTree, StNVCont, StNVTree, StNVBits, StNVColl, StNVDict,
- StNVDQ, StNVLAry, StNVList, StNVLMat, StNVSCol, StPtrns, StMerge, StTxtDat;
+ StNVDQ, StNVLAry, StNVList, StNVLMat, StNVSCol, StPtrns, StMerge, StTxtDat,
+ StText;
implementation
diff --git a/components/systools/source/run/sttext.pas b/components/systools/source/run/sttext.pas
new file mode 100644
index 000000000..d0c355cc3
--- /dev/null
+++ b/components/systools/source/run/sttext.pas
@@ -0,0 +1,181 @@
+// Upgraded to Delphi 2009: Sebastian Zierer
+
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is TurboPower SysTools
+ *
+ * The Initial Developer of the Original Code is
+ * TurboPower Software
+ *
+ * Portions created by the Initial Developer are Copyright (C) 1996-2002
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+{ adapts changes by Tom Lisjac
+ Tom Lisjac http://theseus.sf.net }
+
+{*********************************************************}
+{* SysTools: StText.pas 4.04 *}
+{*********************************************************}
+{* SysTools: Routines for manipulating Delphi Text files *}
+{*********************************************************}
+
+{$I StDefine.inc}
+
+unit StText;
+
+interface
+
+uses
+// Windows,
+ SysUtils, STConst, StBase; //, StSystem;
+
+function TextSeek(var F : TextFile; Target : LongInt) : Boolean;
+ {-Seek to the specified position in a text file opened for input}
+
+function TextFileSize(var F : TextFile) : LongInt;
+ {-Return the size of a text file}
+
+function TextPos(var F : TextFile) : LongInt;
+ {-Return the current position of the logical file pointer (that is,
+ the position of the physical file pointer, adjusted to account for
+ buffering)}
+
+function TextFlush(var F : TextFile) : Boolean;
+ {-Flush the buffer(s) for a text file}
+
+
+implementation
+
+const
+ FILE_BEGIN = 0;
+ FILE_CURRENT = 1;
+ FILE_END = 2;
+
+function TextSeek(var F : TextFile; Target : LongInt) : Boolean;
+ {-Do a Seek for a text file opened for input. Returns False in case of I/O
+ error.}
+var
+ Pos : LongInt;
+begin
+ with TTextRec(F) do begin
+ {assume failure}
+ Result := False;
+ {check for file opened for input}
+ if Mode <> fmInput then Exit;
+ Pos := FileSeek(Handle, 0, FILE_CURRENT);
+ if Pos = -1 then Exit;
+ Dec(Pos, BufEnd);
+ {see if the Target is within the buffer}
+ Pos := Target-Pos;
+ if (Pos >= 0) and (Pos < LongInt(BufEnd)) then
+ {it is--just move the buffer pointer}
+ BufPos := Pos
+ else begin
+ if FileSeek(Handle, Target, FILE_BEGIN) = -1 then Exit;
+ {tell Delphi its buffer is empty}
+ BufEnd := 0;
+ BufPos := 0;
+ end;
+ end;
+ {if we get to here we succeeded}
+ Result := True;
+end;
+
+function TextFileSize(var F : TextFile) : LongInt;
+ {-Return the size of text file F. Returns -1 in case of I/O error.}
+var
+ Old : LongInt;
+ Res : LongInt;
+begin
+ Result := -1;
+ with TTextRec(F) do begin
+ {check for open file}
+ if Mode = fmClosed then Exit;
+ {get/save current pos of the file pointer}
+ Old := FileSeek(Handle, 0, FILE_CURRENT);
+ if Old = -1 then Exit;
+ {have OS move to end-of-file}
+ Res := FileSeek(Handle, 0, FILE_END);
+ if Res = -1 then Exit;
+ {reset the old position of the file pointer}
+ if FileSeek(Handle, Old, FILE_BEGIN) = - 1 then Exit;
+ end;
+ Result := Res;
+end;
+
+function TextPos(var F : TextFile) : LongInt;
+ {-Return the current position of the logical file pointer (that is,
+ the position of the physical file pointer, adjusted to account for
+ buffering). Returns -1 in case of I/O error.}
+var
+ Position : LongInt;
+begin
+ Result := -1;
+ with TTextRec(F) do begin
+ {check for open file}
+ if Mode = fmClosed then Exit;
+ Position := FileSeek(Handle, 0, FILE_CURRENT);
+ if Position = -1 then Exit;
+ end;
+ with TTextRec(F) do
+ if Mode = fmOutput then {writing}
+ Inc(Position, BufPos)
+ else if BufEnd <> 0 then {reading}
+ Dec(Position, BufEnd-BufPos);
+ {return the calculated position}
+ Result := Position;
+end;
+
+function TextFlush(var F : TextFile) : Boolean;
+ {-Flush the buffer(s) for a text file. Returns False in case of I/O error.}
+var
+ Position : LongInt;
+ Code : Integer;
+begin
+ Result := False;
+ with TTextRec(F) do begin
+ {check for open file}
+ if Mode = fmClosed then Exit;
+ {see if file is opened for reading or writing}
+ if Mode = fmInput then begin
+ {get current position of the logical file pointer}
+ Position := TextPos(F);
+ {exit in case of I/O error}
+ if Position = -1 then Exit;
+ if FileSeek(Handle, Position, FILE_BEGIN) = - 1 then Exit;
+ end
+ else begin
+ {write the current contents of the buffer, if any}
+ if BufPos <> 0 then begin
+ Code := FileWrite(Handle, BufPtr^, BufPos);
+ if Code = -1 {<> 0} then Exit;
+ end;
+ {flush OS's buffers}
+ //if not FlushOsBuffers(Handle) then Exit;
+ System.Flush(F);
+ end;
+ {tell Delphi its buffer is empty}
+ BufEnd := 0;
+ BufPos := 0;
+ end;
+ {if we get to here we succeeded}
+ Result := True;
+end;
+
+
+end.