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	torben	2671	// 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.