C!T ROM 2/ctrom_ii_b.zip/ctrom_ii_b/PROGRAM/PASCAL/TPDB32/TPDBSTR.PAS

Pascal/Delphi Source File | 1991-10-28 | 6KB | 215 lines

unit TPDBStr;

                           (***********************************)
                           (*               TPDB              *)
                           (***********************************)
                           (*         Object -Oriented        *)
                           (*     Turbo Pascal 6.0 Units      *)
                           (*    for Accessing dBASE III      *)
                           (*             files.              *)
                           (*        Copyright 1991           *)
                           (*          Brian Corll            *)
                           (*       All Rights Reserved       *)
                           (*     dBASE is a registered       *)
                           (* trademark of Ashton-Tate, Inc.  *)
                           (*   Version 3.20  October, 1991   *)
                           (***********************************)
                           (*   Portions Copyright 1984,1991  *)
                           (*    Borland International Corp.  *)
                           (***********************************)

interface

const
{Tables for translating foreign characters into English
    characters during sorting and indexing.}
    ForTable = 'ÇüéâäàåçêëèïîìÄÅÉæÆôöòùÿÖ܃íóúñÑ';
    EngTable = 'CueaaaaceeeiiiAAEefooouyOUfiounN';

type
    TslTable = string;
    DBKey = string [254];

function For2Eng(StrToConvert: string; TslTable1, TslTable2: TslTable): DBKey;
{Translates any string using a specified translation table.
    Intended for use with ForTable and EngTable, declared above, for
    translating extended ASCII characters to normal alphabetic characters
    for indexin and sorting, but will work with any user-defined
    translation tables.}

function Substr(BigStr: string; Start, Len: byte): string;
{Same as dBASE's Substr function.}

function ReverseStr(StrToReverse: string): string;
{Reverses the order of characters in a string.}

function JustL(InpStr: string; FieldLen: integer): string;
{Left justify a string.}

function Lower(InpStr: string): string;

function LTrim(InpStr: string): string;
{Trim leading blanks from a string.}

function PadL(InpStr: string; FieldLen: integer): string;
{Pad a string with blanks on the left.}

function PadR(InpStr: string; FieldLen: integer): string;
{Pad a string with blanks on the right.}

function Replicate(Ch: char; Count: word): string;
{Create a string of a specified number of a character.}

function RTrim(InpStr: string): string;
{Trim trailing blanks from a string.}


function Upper(InpStr: string): string;
{Convert a string to upper case.}

implementation
{$F+}
{All string functions are far calls for use in indexing and sorting.}

function For2Eng(StrToConvert: string; TslTable1, TslTable2: TslTable): DBKey;

var
    OutStr: string;
    I: byte;
    OutChar: char;

procedure ScanTable;

var
    J: byte;

begin
    for J := 1 to Length(TslTable1) do
        if StrToConvert[I] = TslTable1[J] then begin
            OutChar := TslTable2[J];
            Exit;
        end else
            OutChar := StrToConvert[I];
end;

begin
    OutStr := '';
    for I := 1 to Length(StrToConvert) do begin
        ScanTable;
        OutStr := OutStr + OutChar;
    end;
    For2Eng := OutStr;
end;

function Substr(BigStr: string; Start, Len: byte): string;

var
    OutStr: string;

begin
    OutStr := Copy(BigStr, Start, Len);
    Substr := OutStr;
end;

function ReverseStr(StrToReverse: string): string;

var
    OutStr: string;
    I: byte;

begin
    OutStr := '';
    for I := Length(StrToReverse) downto 1 do
        OutStr := OutStr + StrToReverse[I];
    ReverseStr := OutStr;
end;



function JustL(InpStr: string; FieldLen: integer): string;

begin
    JustL := PadR(LTrim(InpStr), FieldLen)
end;

function LTrim(InpStr: string): string;

var
    i, len: integer;

begin
    len := Length(InpStr);
    i := 1;
    while (i <= len) and (InpStr[i] = ' ') do
        i := i + 1;
    LTrim := Copy(InpStr, i, len - i + 1)
end;


function PadL(InpStr: string; FieldLen: integer): string;

var
    STemp: string;
    i: integer;

begin
    if FieldLen >= SizeOf(InpStr) then
        FieldLen := SizeOf(InpStr) - 1;
    if Length(InpStr) > FieldLen then
        PadL := Copy(InpStr, 1, FieldLen)
    else begin
        STemp := InpStr;
        for i := Length(STemp) + 1 to FieldLen do
            Insert(' ', STemp, 1);
        PadL := STemp
    end
end;                                                        {PadL}

function PadR(InpStr: string; FieldLen: integer): string;

var
    STemp: string;
    i: integer;

begin
    if FieldLen >= SizeOf(InpStr) then
        FieldLen := SizeOf(InpStr) - 1;
    if Length(InpStr) > FieldLen then
        PadR := Copy(InpStr, 1, FieldLen)
    else begin
        STemp := InpStr;
        for i := Length(STemp) + 1 to FieldLen do
            STemp := STemp + ' ';
        PadR := STemp
    end
end;                                                        {PadR}

{$L tpdb.obj}

function Lower;
external;

function Replicate;
external;

function Upper;
external;


function RTrim(InpStr: string): string;

var
    i: integer;

begin
    i := Length(InpStr);
    while (i >= 1) and (InpStr[i] = ' ') do
        i := i - 1;
    RTrim := Copy(InpStr, 1, i)
end;                                                        {RTrim}

{$F-}

begin
end.