home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
C!T ROM 2
/
ctrom_ii_b.zip
/
ctrom_ii_b
/
PROGRAM
/
PASCAL
/
PAS_0593
/
TEXTUNIT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-05-30
|
10KB
|
278 lines
{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg : 346 of 411
From : Norbert Igl 2:2402/300.3 15 May 93 14:10
To : Raphael Vanney 2:320/7.0
Subj : Pardon if repeat
────────────────────────────────────────────────────────────────────────────────
Hello Raphael!
One of these days, Raphael Vanney wrote to Matt Giwer:
RV> One cannot seek in a text file...
hmmmmm.... sorry for the german remarks....}
{
TEXTEXT.PAS
von Bernhard Arnold
PFEFFER@DUISSY.ZER
1.4.93
Seek, Filesize, FilePos, Blockread
und Blockwrite auch fuer Textdateien
und (neu!) ein relativer Seek
und (neu!) ein echtes eof()
Files vom Typ text haben den grossen Vorteil, dass Turbopascal bereits
eine wunderbare Bufferung vornimmt. Dieser Buffer ist standardmaessig
128 Bytes gross, sodass sich eine Vergroesserung mittels SetTextbuf sehr
empfiehlt. Leider haben die Herren Borland aus mir unerfindlichen
Gruenden den Zugriff auf text-Files auf Zeilen- oder Byteweises
sequentielles lesen/schreiben beschraenkt - obwohl die Bufferung
text-Files eigentlich sehr attraktiv machen. Mit dieser Unit werden
alel Vorteile aller Filetypen vereint indem die folgende Funktionen
auch fuer Textfiles zugaenglich gemacht werden:
FilePos,
FileSize,
Seek,
BlockRead sowie
Blockwrite.
Damit nicht genug: Um die laestige Dateiendekennung $1A zu umgehen,
habe habe ich BinEof hinzugefuegt, das wirklich nur dann eof anzeigt,
wenn die Datei tatsaechlich am Ende ist.
Zuguterletzt noch eine letze Funktion: TextSeekRel.
Der relative Seek ist so einfach und schnell, und seine Umschreibung
TextSeek(f, TextFilePos(f)+Pos) ist so umstaendlich und Zeitaufwendig,
dass ich einfach nicht widerstehen konnte
Diese Idee dieser Unit stammt urspruenglich aus einer c't, welche
genau, weiss ich nicht mehr. Die Unit musste komplett ueberarbytet werden,
sie war extrem baufaellig.
Ich finde das ganze hochgenial und benutze es u.a. fuer ZNetz-Puffer:
Den Nachrichtenkopf kann ich bequem mit Read- und Writeln einlesen
bzw. ausgeben, den Inhalt mit den neuen TextBlockread und -write
lesen und schreiben bzw. mit TextSeekRel ueberspringen.
Einer ausgiebigen Nutzung steht nichts im Wege. Dieser Source ist
PD, wer was dran aendert, schickt mir bitte ne Kopie.
Meine E-Mail-Adresse lautet PFEFFER@DUISSY.zer.sub.org.
Die, die die Unit nutzen, und besonders die, die damit Geld machen,
und alle anderen, die mir ne Freude machen wollen, bitte ich,
mir was zu ueberweisen auf das Konto Bernhard Arnold, Essen,
Nr. 46 109 528 bei der Stadtsparkasse Essen, BLZ: 360 501 05.
Ich denk da an ca. 5-25 DM, mehr ist aber wie immer willkommen. Je
nachdem wieviel Geld ihr mit Eurem Programm macht.
Viel Spass !
}
unit TextUnit;
interface
{$B-,D-,E-,I-,L-,N-,X+}
uses dos;
function TextFilePos(var andle:text):LongInt; { wie FilePos }
function TextFileSize(var andle:text):LongInt; { wie FileSize }
procedure TextSeek(var andle:text;Pos:LongInt); { wie Seek }
procedure TextBlockread(var andle:text; var buf; { wie Blockread }
count:word; var result:word);
procedure TextBlockwrite(var andle:text; var buf; { wie Blockwrite }
count:word; var result:word);
function BinEof(var andle:text):boolean; { eof ohne $1a }
function TextSeekRel(var andle:text; Count:Longint):longint;
{ Relativer Seek }
{ Gibt *manchmal* die tatsaechliche Position nach dem Seek }
{ zurueck, naemlich immer dann, wenn count negativ war oder }
{ die gesuchte Position nicht innerhalb des Buffers lag. }
{ Sonst gibt sie maxlongint zurueck. }
{ So ist sie am optimiertesten. }
implementation
const
ab_anfang=0; { Konstanten fuer "wie" von DosSeek }
ab_jetzig=1;
ab_ende=2;
function DosSeek(Handle:word; Pos:LongInt; wie:byte):longint;
type dword=array[0..1] of word; { Ruft die Filepositionierungs- }
var Regs:Registers; { routine von Int 21h auf. }
erg:longint;
begin
with Regs do begin
ah:=$42;
al:=wie;
bx:=Handle; { DOS-Handle }
cx:=dword(Pos)[1]; { Hi-Word der Position }
dx:=dword(Pos)[0]; { Lo-Word der Position }
MSDOS(Regs);
if Flags and fCarry<>0 then begin
InOutRes:=ax;
erg:=0
end
else erg:=regs.ax+regs.dx*65536;
end;
DosSeek:=erg;
end;
function TextFilePos(var andle:text):LongInt;
var erg:longint;
begin
erg:=DosSeek(Textrec(andle).Handle, 0, ab_jetzig) { Liefert Position }
-TextRec(andle).BufEnd { Buffer beachten }
+TextRec(andle).BufPos;
Textfilepos:=erg;
end;
function TextFileSize(var andle:text):LongInt;
var TempPtr, erg:LongInt;
begin
case TextRec(andle).Mode of
fmInput:with Textrec(andle) do begin
TempPtr:=DosSeek(Handle, 0, ab_jetzig); { Aktuelle merken }
erg:=DosSeek(Handle, 0, ab_ende); { einmal ans Ende }
DosSeek(Handle, TempPtr, ab_anfang); { und wieder zurueck }
end;
fmOutput:erg:=TextFilePos(andle); { Immer am Ende }
else begin
erg:=0; { Fehlerbehandlung }
InOutRes:=1;
end;
end;
TextFileSize:=erg;
end;
procedure TextSeek(var andle:text; Pos:LongInt);
var aktpos:longint;
begin
aktpos:=TextFilePos(andle);
if aktpos<>pos then with Textrec(andle) do begin
if Mode=fmOutput then flush(andle);
with Textrec(andle) do begin
if (aktpos+(bufend-bufpos)<Pos) or (aktpos>Pos) then
begin { Wenn gewuenschte Pos nicht innerhalb des Buffers liegt }
bufpos:=0; {TP-Puffer}
bufend:=0; {zuruecksetzen}
DosSeek(Textrec(andle).Handle, pos, ab_anfang);
end
else begin
inc(bufpos, pos-aktpos); { vielleicht kann man auch noch ein- }
end; { if (aktpos... } { bauen, dass beim zurueckseeken der }
end; { Buffer genutzt wird, weiss aber }
end; { nicht, ob das sicher ist und }
end; { brauch es (noch) nicht. }
procedure TextBlockread(var andle:text; var buf; count:word; var result:word);
var R:Registers;
noch, ausbuf:word;
posintextbuf:pointer;
begin
if Textrec(andle).Mode<>fmInput then InOutRes:=1
else begin
with Textrec(andle) do
begin
noch:=bufend-bufpos; { Anzahl Zeichen noch im Buffer }
if noch<>0 then
begin { noch was im Buffer }
if noch<count then ausbuf:=noch else ausbuf:=count;
{ reicht der Buffer ? }
posintextbuf:=pointer(longint(bufptr)+bufpos);
move(posintextbuf^, buf, ausbuf);
inc(bufpos, ausbuf);
end;
end;
if noch<count then with r do { noch nicht alles ? }
begin
ds:=Seg(buf); { wohin soll }
dx:=Ofs(Buf)+noch; { gelesen werden }
ah:=$3f; { Datei lesen }
bx:=Textrec(andle).Handle; { DOS-Handle }
cx:=count-noch; { Rest }
MsDos(R); { INT 21 aufrufen }
if Flags and fCarry<>0
then InOutRes:=ax { Fehler }
else result:=ax+noch; { Anzahl gelesener }
end { if noch<count }
else result:=count;
end; { if Mode=input }
end;
procedure TextBlockwrite(var andle:text; var buf; count:word;var result:word);
var r:registers;
posintextbuf:pointer;
begin
if Textrec(andle).Mode<>fmOutput then InOutRes:=1
else begin
with Textrec(andle) do begin
if (bufsize-bufpos)>count then { noch Platz im Buffer ? }
begin
posintextbuf:=pointer(longint(bufptr)+bufpos);
move(buf, posintextbuf^, count);
inc(bufpos, count);
end
else begin
flush(andle); { Puffer leeren }
with r do begin
ah:=$40; { Datei schreiben }
cx:=count; { Wieviel }
ds:=seg(buf); { Was }
dx:=ofs(buf);
bx:=Handle; { Welche Datei }
MsDos(r); { Abschuss }
if Flags and fCarry<>0 then InOutRes:=ax { Feeler }
else Result:=ax; { Anz. geschrieben }
end; { with r }
end; { if Platz im Buffer else }
end; { with Textrec }
end;
end;
function TextSeekRel(var andle:text; count:longint):longint;
var ziel, erg:longint;
begin
with Textrec(andle) do begin
if Mode=fmOutput then begin InOutRes:=1; exit; end;
if (count<0) then
begin
ziel:=TextFilePos(andle)+count;
if ziel<0 then ziel:=0;
TextSeek(andle, ziel);
erg:=ziel;
end
else if ((bufend-bufpos)<Count) then
begin
ziel:=count-(bufend-bufpos);
if ziel<0 then ziel:=0;
erg:=DosSeek(Textrec(andle).Handle, ziel, ab_jetzig);
bufpos:=0; bufend:=0;
end
else begin
inc(bufpos, count); { Maximale Geschwindigkeit }
erg:=maxlongint;
end;
TextSeekRel:=erg;
end;
end;
function BinEof(var andle:text):boolean; { eof ohne $1a }
var e:boolean;
begin
e:=eof(andle);
{$R-} { Array ist nicht begrenzt }
with textrec(andle) do
BinEof:=e and (bufptr^[bufpos]<>#$1a);
{$R+}
end;
end.