Category : Pascal Source Code
Archive   : TPDB311.ZIP
Filename : TPDBSORT.PAS

Unit TPDBSORT;


INTERFACE

Uses Crt,TPDB,TPDBSrtS,TPDBSrtL,TPDBStr;

TYPE
SortingFunction = FUNCTION : DBKey;
ProcPtr = ^BYTE;

VAR
SortFile : DataObject;
SortFunc : SortingFunction;

PROCEDURE SortOn(Operation : SortingFunction;Source,Dest : FileName);

IMPLEMENTATION

CONST
EOFMarker : Char = #26;

TYPE
SortRecord = RECORD
KeyStr : DBKey;
RecNum : LONGINT;
END;

VAR
SortRec : SortRecord;
OutFile : File;
SortResult,LSortResult : Integer;
SortFileName : FileName;


{$F+}


PROCEDURE ReadRecs;
VAR
RecNum : LONGINT;
BEGIN
RecNum := 1;
REPEAT
SortFile^.GetDBRec(RecNum);
SortRec.KeyStr := SortFunc;
SortRec.RecNum := RecNum;
SortRelease(SortRec);
INC(RecNum);
UNTIL SortFile^.DBEOF;
END;

FUNCTION LessRecs(VAR x,y : SortRecord) : BOOLEAN;
BEGIN
LessRecs := x.KeyStr < y.KeyStr;
END;

PROCEDURE WriteRecs;
VAR
X : LONGINT;
Buffer : DBType;
FNo : BYTE;
BEGIN
Assign(OutFile,SortFileName);
ReWrite(OutFile,1);
BlockWrite(OutFile,SortFile^.Header^,32,ErrCode);
For FNo := 1 to SortFile^.NumFields do
BlockWrite(OutFile,SortFile^.Fields^[FNo],32,ErrCode);
SortFile^.Header^.Terminator := Chr(Ord($0D));
BlockWrite(OutFile,SortFile^.Header^.Terminator,1,ErrCode);
X := 1;
REPEAT
SortReturn(SortRec);
SortFile^.GetDBRec(SortRec.RecNum);
{Move(SortFile^.DBRecord^,Buffer,SortFile^.Header^.RecordLen);}
BlockWrite(OutFile,SortFile^.DBRecord^,SortFile^.Header^.RecordLen);
UNTIL SortEOS;
Close(OutFile);
END;

PROCEDURE LReadRecs;
VAR
RecNum : LONGINT;
BEGIN
RecNum := 1;
REPEAT
SortFile^.GetDBRec(RecNum);
SortRec.KeyStr := SortFunc;
SortRec.RecNum := RecNum;
SortRelease(SortRec);
INC(RecNum);
UNTIL SortFile^.DBEOF;
END;

FUNCTION LLessRecs(VAR x,y : SortRecord) : BOOLEAN;
BEGIN
LLessRecs := x.KeyStr < y.KeyStr;
END;

PROCEDURE LWriteRecs;
VAR
X : LONGINT;
Buffer : DBType;
FNo : BYTE;
BEGIN
Assign(OutFile,SortFileName);
ReWrite(OutFile,1);
BlockWrite(OutFile,SortFile^.Header^,32,ErrCode);
For FNo := 1 to SortFile^.NumFields do
BlockWrite(OutFile,SortFile^.Fields^[FNo],32,ErrCode);
SortFile^.Header^.Terminator := Chr(Ord($0D));
BlockWrite(OutFile,SortFile^.Header^.Terminator,1,ErrCode);
X := 1;
REPEAT
SortReturn(SortRec);
SortFile^.GetDBRec(SortRec.RecNum);
Move(SortFile^.DBRecord^,Buffer,SortFile^.Header^.RecordLen);
BlockWrite(OutFile,Buffer,SortFile^.Header^.RecordLen);
UNTIL SortEOS;
BlockWrite(OutFile,EOFMarker,1);
Close(OutFile);
END;
{$F-}

PROCEDURE SortOn(Operation : SortingFunction;Source,Dest : FileName);
BEGIN
NEW(SortFile,Init(Source));
SortFileName := Dest;
IF SortFile^.TotalRecs <= 32767 THEN
SortResult := SmallTPDBSort(SizeOf(SortRec),@ReadRecs,@LessRecs,@WriteRecs)
ELSE
LSortResult := LargeTPDBSort(SizeOf(SortRec),@LReadRecs,@LLessRecs,@LWriteRecs);
DISPOSE(SortFile,Done);
END;

BEGIN
END.