tpsystools_4.04/source/StText.pas

// 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 ***** *)

{*********************************************************}
{* 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

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;
    end;
    {tell Delphi its buffer is empty}
    BufEnd := 0;
    BufPos := 0;
  end;
  {if we get to here we succeeded}
  Result := True;
end;


end.
1	// Upgraded to Delphi 2009: Sebastian Zierer
2
3	(* *** BEGIN LICENSE BLOCK ***
4	* Version: MPL 1.1
5	*
6	* The contents of this file are subject to the Mozilla Public License Version
7	* 1.1 (the "License"); you may not use this file except in compliance with
8	* the License. You may obtain a copy of the License at
9	* http://www.mozilla.org/MPL/
10	*
11	* Software distributed under the License is distributed on an "AS IS" basis,
12	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
13	* for the specific language governing rights and limitations under the
14	* License.
15	*
16	* The Original Code is TurboPower SysTools
17	*
18	* The Initial Developer of the Original Code is
19	* TurboPower Software
20	*
21	* Portions created by the Initial Developer are Copyright (C) 1996-2002
22	* the Initial Developer. All Rights Reserved.
23	*
24	* Contributor(s):
25	*
26	* *** END LICENSE BLOCK *** *)
27
28	{*********************************************************}
29	{* SysTools: StText.pas 4.04 *}
30	{*********************************************************}
31	{* SysTools: Routines for manipulating Delphi Text files *}
32	{*********************************************************}
33
34	{$I StDefine.inc}
35
36	unit StText;
37
38	interface
39
40	uses
41	Windows,
42	SysUtils, STConst, StBase, StSystem;
43
44	function TextSeek(var F : TextFile; Target : LongInt) : Boolean;
45	{-Seek to the specified position in a text file opened for input}
46
47	function TextFileSize(var F : TextFile) : LongInt;
48	{-Return the size of a text file}
49
50	function TextPos(var F : TextFile) : LongInt;
51	{-Return the current position of the logical file pointer (that is,
52	the position of the physical file pointer, adjusted to account for
53	buffering)}
54
55	function TextFlush(var F : TextFile) : Boolean;
56	{-Flush the buffer(s) for a text file}
57
58	implementation
59
60	function TextSeek(var F : TextFile; Target : LongInt) : Boolean;
61	{-Do a Seek for a text file opened for input. Returns False in case of I/O
62	error.}
63	var
64	Pos : LongInt;
65	begin
66	with TTextRec(F) do begin
67	{assume failure}
68	Result := False;
69	{check for file opened for input}
70	if Mode <> fmInput then Exit;
71	Pos := FileSeek(Handle, 0, FILE_CURRENT);
72	if Pos = -1 then Exit;
73	Dec(Pos, BufEnd);
74	{see if the Target is within the buffer}
75	Pos := Target-Pos;
76	if (Pos >= 0) and (Pos < LongInt(BufEnd)) then
77	{it is--just move the buffer pointer}
78	BufPos := Pos
79	else begin
80	if FileSeek(Handle, Target, FILE_BEGIN) = -1 then Exit;
81	{tell Delphi its buffer is empty}
82	BufEnd := 0;
83	BufPos := 0;
84	end;
85	end;
86	{if we get to here we succeeded}
87	Result := True;
88	end;
89
90	function TextFileSize(var F : TextFile) : LongInt;
91	{-Return the size of text file F. Returns -1 in case of I/O error.}
92	var
93	Old : LongInt;
94	Res : LongInt;
95	begin
96	Result := -1;
97	with TTextRec(F) do begin
98	{check for open file}
99	if Mode = fmClosed then Exit;
100	{get/save current pos of the file pointer}
101	Old := FileSeek(Handle, 0, FILE_CURRENT);
102	if Old = -1 then Exit;
103	{have OS move to end-of-file}
104	Res := FileSeek(Handle, 0, FILE_END);
105	if Res = -1 then Exit;
106	{reset the old position of the file pointer}
107	if FileSeek(Handle, Old, FILE_BEGIN) = - 1 then Exit;
108	end;
109	Result := Res;
110	end;
111
112	function TextPos(var F : TextFile) : LongInt;
113	{-Return the current position of the logical file pointer (that is,
114	the position of the physical file pointer, adjusted to account for
115	buffering). Returns -1 in case of I/O error.}
116	var
117	Position : LongInt;
118	begin
119	Result := -1;
120	with TTextRec(F) do begin
121	{check for open file}
122	if Mode = fmClosed then Exit;
123	Position := FileSeek(Handle, 0, FILE_CURRENT);
124	if Position = -1 then Exit;
125	end;
126	with TTextRec(F) do
127	if Mode = fmOutput then {writing}
128	Inc(Position, BufPos)
129	else if BufEnd <> 0 then {reading}
130	Dec(Position, BufEnd-BufPos);
131	{return the calculated position}
132	Result := Position;
133	end;
134
135	function TextFlush(var F : TextFile) : Boolean;
136	{-Flush the buffer(s) for a text file. Returns False in case of I/O error.}
137	var
138	Position : LongInt;
139	Code : Integer;
140	begin
141	Result := False;
142	with TTextRec(F) do begin
143	{check for open file}
144	if Mode = fmClosed then Exit;
145	{see if file is opened for reading or writing}
146	if Mode = fmInput then begin
147	{get current position of the logical file pointer}
148	Position := TextPos(F);
149	{exit in case of I/O error}
150	if Position = -1 then Exit;
151	if FileSeek(Handle, Position, FILE_BEGIN) = - 1 then Exit;
152	end
153	else begin
154	{write the current contents of the buffer, if any}
155	if BufPos <> 0 then begin
156	Code := FileWrite(Handle, BufPtr^, BufPos);
157	if Code = -1 {<> 0} then Exit;
158	end;
159	{flush OS's buffers}
160	if not FlushOsBuffers(Handle) then Exit;
161	end;
162	{tell Delphi its buffer is empty}
163	BufEnd := 0;
164	BufPos := 0;
165	end;
166	{if we get to here we succeeded}
167	Result := True;
168	end;
169
170
171	end.