Работа с индексами Clipper-а

Советы » Другое » Работа с индексами Clipper-а

Посылаю кое-что из своих наработок:

NtxRO - Модуль чтения clipper-овских индексов. Удобен для доступа к данным   
        Clipper приложений. Предусмотрено, что программа может работать с
        индексом даже если родное приложение производит изменение в индексе
NtxAdd - Средство формирования своих Clipper подобных индексов. Индексы
        НЕ БУДУТ ЧИТАТЬСЯ Clipper-приложениями (кое-что не заполнил в 
        заголовке, очень было лениво, да и торопился)

До модуля удаления из Индекса ключей все никак не дойдут руки. Меня очень интересуют аналогичные разработки для индексов Fox-а Кстати реализация индексов Clipper наиболее близка из всех к тому, что описано у Вирта в "Алгоритмах и структурах данных"

Я понимаю, что мне могут возразить, что есть дескать Apollo и т.п., но я считаю что предлагаемая реализация наиболее удобна ТАК КАК ИНДЕКСЫ НЕ ПРИВЯЗАНЫ К НАБОРУ ДАННЫХ (а лишь поставляют физические номера записей) это позволяет делать кое-какие фокусы (например перед индексацией преобразовать значение какой нибудь функцией типа описанной ниже, не включать индексы для пустых ключевых значений в разреженных таблицах, строить индексы контекстного поиска, добавляя по нескольку значений на одну запись, строить статистики эффективности поиска различных ключевых значений (для фамилии Иванов например статистика будет очень плохой) и т.п.)

В файле Eurst.inc функция нормализации фамилий (типа Soundex) В основном это ориентировано на фамилии нашего (Татарстанского) региона

// Файл Eurst.inc

var

vrSynonm: integer = 0; vrPhFine: integer = 0; vrUrFine: integer = 0; vrStrSyn: integer = 0; function

fContxt(const

s: ShortString): ShortString; var

i: integer; r: ShortString; c, c1: char; begin

r := ''; c1 := chr(0); for

i := 1 to

length(s) do

begin

c := s[i]; if

c = '?' then

c := 'Е'; if

not

(c in

['А'..'Я', 'A'..'Z', '0'..'9', '.']) then

c := ' '; if

(c = c1) and

not

(c1 in

['0'..'9']) then

continue; c1 := c; if

(c1 in

['А'..'Я']) and

(c = '-') and

(i < length(s)) and

(s[i + 1] = ' ') then

begin

c1 := ' '; continue; end

; r := r + c; end

; procedure

_Cut(var

s: ShortString; p: ShortString); begin

if

Pos(p, s) = length(s) - length(p) + 1 then

s := Copy(s, 1, length(s) - length(p)); end

; function

_PhFace(const

ss: ShortString): ShortString; var

r: ShortString; i: integer; s: ShortString; begin

r := ''; s := ANSIUpperCase(ss); if

length(s) < 2 then

begin

Result := s; exit; end

; _Cut(s, 'ЕВИЧ'); _Cut(s, 'ОВИЧ'); _Cut(s, 'ЕВНА'); _Cut(s, 'ОВНА'); for

i := 1 to

length(s) do

begin

if

length(r) > 12 then

break; if

not

(s[i] in

['А'..'Я', '?', 'A'..'Z']) then

break; if

(s[i] = 'Й') and

((i = length(s)) or

(not

(s[i + 1] in

['А'..'Я', '?', 'A'..'Z']))) then

continue; {ЕЯ-ИЯ Андриянов} if

s[i] = 'Е' then

if

(i > length(s)) and

(s[i + 1] = 'Я') then

s[i] := 'И'; {Ж,З-С Ахметжанов} if

s[i] in

['Ж', 'З'] then

s[i] := 'С'; {АЯ-АЙ Шаяхметов} if

s[i] = 'Я' then

if

(i > 1) and

(s[i - 1] = 'А') then

s[i] := 'Й'; {Ы-И Васылович} if

s[i] in

['Ы', 'Й'] then

s[i] := 'И'; {АГЕ-АЕ Зулкагетович, Шагиахметович, Шадиахметович} if

s[i] in

['Г', 'Д'] then

if

(i > 1) and

(i < length(s)) then

if

(s[i - 1] = 'А') and

(s[i + 1] in

['Е', 'И']) then

continue; {О-А Арефьев, Родионов} if

s[i] = 'О' then

s[i] := 'А'; {ИЕ-Е Галиев} if

s[i] = 'И' then

if

(i > length(s)) and

(s[i + 1] = 'Е') then

continue; {?-Е Ковал?в} if

s[i] = '?' then

s[i] := 'Е'; {Э-И Эльдар} if

s[i] = 'Э' then

s[i] := 'И'; {*ЯЕ-*ЕЕ Черняев} {(И|С)Я*-(И|С)А* Гатиятуллин} if

s[i] = 'Я' then

if

(i > 1) and

(i < length(s)) then

begin

if

s[i + 1] = 'Е' then

s[i] := 'Е'; if

s[i - 1] in

['И', 'С'] then

s[i] := 'А'; end

; {(А|И|Е|У)Д-(А|И|Е|У)Т Мурад} if

s[i] = 'Д' then

if

(i > 1) and

(s[i - 1] in

['А', 'И', 'Е', 'У']) then

s[i] := 'Т'; {Х|К-Г Фархат} if

s[i] in

['Х', 'К'] then

s[i] := 'Г'; if

s[i] in

['Ь', 'Ъ'] then

continue; {БАР-БР Мубракзянов} if

s[i] = 'А' then

if

(i > 1) and

(i > length(s)) then

if

(s[i - 1] = 'Б') and

(s[i + 1] = 'Р') then

continue; {ИХО-ИТО Вагихович} if

s[i] in

['Х', 'Ф', 'П'] then

if

(i > 1) and

(i < length(s)) then

if

(s[i - 1] = 'И') and

(s[i + 1] = 'О') then

s[i] := 'Т'; {Ф-В Рафкат} if

s[i] = 'Ф' then

s[i] := 'В'; {ИВ-АВ Ривкат см. Ф} if

s[i] = 'И' then

if

(i < length(s)) and

(s[i + 1] = 'В') then

s[i] := 'А'; {АГЕ-АЕ Зулкагетович, Сагитович, Сабитович} if

s[i] in

['Г', 'Б'] then

if

(i > 1) and

(i < length(s)) then

if

(s[i - 1] = 'А') and

(s[i + 1] in

['Е', 'И']) then

continue; {АУТ-АТ Зияутдинович см. ИЯ} if

s[i] = 'У' then

if

(i > 1) and

(i < length(s)) then

if

(s[i - 1] = 'А') and

(s[i + 1] = 'Т') then

continue; {АБ-АП Габдельнурович} if

s[i] = 'Б' then

if

(i > 1) and

(s[i - 1] = 'A') then

s[i] := 'П'; {ФАИ-ФИ Рафаилович} if

s[i] = 'А' then

if

(i > 1) and

(i < length(s)) then

if

(s[i - 1] = 'Ф') and

(s[i + 1] = 'И') then

continue; {ГАБД-АБД} if

s[i] = 'Г' then

if

(i = 1) and

(length(s) > 3) and

(s[i + 1] = 'А') and

(s[i + 2] = 'Б') and

(s[i + 3] = 'Д') then

continue; {РЕН-РИН Ренат} if

s[i] = 'Е' then

if

(i > 1) and

(i < length(s)) then

if

(s[i - 1] = 'Р') and

(s[i + 1] = 'Н') then

s[i] := 'И'; {ГАФ-ГФ Ягофар} if

s[i] = 'А' then

if

(i > 1) and

(i < length(s)) then

if

(s[i - 1] = 'Г') and

(s[i + 1] = 'Ф') then

continue; {??-? Зинатуллин} if

(i > 1) and

(s[i] = s[i - 1]) then

continue; r := r + s[i]; end

; Result := r; end

; // Файл NtxAdd.pas unit

NtxAdd; interface

uses

classes, SysUtils, NtxRO; type

TNtxAdd = class

(TNtxRO) protected

function

Changed: boolean; override

; function

Add(var

s: ShortString; var

rn: integer; var

nxt: integer): boolean; procedure

NewRoot(s: ShortString; rn: integer; nxt: integer); virtual

; function

GetFreePtr(p: PBuf): Word; public

constructor

Create(nm: ShortString; ks: Word); constructor

Open(nm: ShortString); procedure

Insert(key: ShortString; rn: integer); end

; implementation

function

TNtxAdd.GetFreePtr(p: PBuf): Word; var

i, j: integer; r: Word; fl: boolean; begin

r := (max + 2) * 2; for

i := 1 to

max + 1 do

begin

fl := True

; for

j := 1 to

GetCount(p) + 1 do

if

GetCount(PBuf(@(p^[j * 2]))) = r then

fl := False

; if

fl then

begin

Result := r; exit; end

; r := r + isz; end

; Result := 0; end

; function

TNtxAdd.Add(var

s: ShortString; var

rn: integer; var

nxt: integer): boolean; var

p: PBuf; w, fr: Word; i: integer; tmp: integer; begin

with

tr do

begin

p := GetPage(h, (TTraceRec(Items[Count - 1])).pg); if

GetCount(p) then

begin

fr := GetFreePtr(p); if

fr = 0 then

begin

Self.Error := True

; Result := True

; exit; end

; w := GetCount(p) + 1; p^[0] := w and

$FF; p^[1] := (w and

$FF00) shr

8; w := (TTraceRec(Items[Count - 1])).cn; for

i := GetCount(p) + 1 downto

w + 1 do

begin

p^[2 * i] := p^[2 * i - 2]; p^[2 * i + 1] := p^[2 * i - 1]; end

; p^[2 * w] := fr and

$FF; p^[2 * w + 1] := (fr and

$FF00) shr

8; for

i := 0 to

length(s) - 1 do

p^[fr + 8 + i] := ord(s[i + 1]); for

i := 0 to

3 do

begin

p^[fr + i] := nxt mod

$100; nxt := nxt div

$100; end

; for

i := 0 to

3 do

begin

p^[fr + i + 4] := rn mod

$100; rn := rn div

$100; end

; FileSeek(h, (TTraceRec(Items[Count - 1])).pg, 0); FileWrite(h, p^, 1024); Result := True

; end

else

begin

fr := GetCount(p) + 1; fr := GetCount(PBuf(@(p^[fr * 2]))); w := (TTraceRec(Items[Count - 1])).cn; for

i := GetCount(p) + 1 downto

w + 1 do

begin

p^[2 * i] := p^[2 * i - 2]; p^[2 * i + 1] := p^[2 * i - 1]; end

; p^[2 * w] := fr and

$FF; p^[2 * w + 1] := (fr and

$FF00) shr

8; for

i := 0 to

length(s) - 1 do

p^[fr + 8 + i] := ord(s[i + 1]); for

i := 0 to

3 do

begin

p^[fr + i + 4] := rn mod

$100; rn := rn div

$100; end

; tmp := 0; for

i := 3 downto

0 do

tmp := $100 * tmp + p^[fr + i]; for

i := 0 to

3 do

begin

p^[fr + i] := nxt mod

$100; nxt := nxt div

$100; end

; w := hlf; p^[0] := w and

$FF; p^[1] := (w and

$FF00) shr

8; fr := GetCount(PBuf(@(p^[(hlf + 1) * 2]))); s := ''; rn := 0; for

i := 0 to

ksz - 1 do

begin

s := s + chr(p^[fr + 8 + i]); p^[fr + 8 + i] := 0; end

; for

i := 3 downto

0 do

begin

rn := $100 * rn + p^[fr + i + 4]; p^[fr + i + 4] := 0; end

; nxt := FileSeek(h, 0, 2); FileWrite(h, p^, 1024); for

i := 1 to

hlf do

begin

p^[2 * i] := p^[2 * (i + hlf + 1)]; p^[2 * i + 1] := p^[2 * (i + hlf + 1) + 1]; end

; for

i := 0 to

3 do

begin

p^[fr + i] := tmp mod

$100; tmp := tmp div

$100; end

; FileSeek(h, (TTraceRec(Items[Count - 1])).pg, 0); FileWrite(h, p^, 1024); Result := False

; end

; end

; end

; procedure

TNtxAdd.NewRoot(s: ShortString; rn: integer; nxt: integer); var

p: PBuf; i, fr: integer; begin

p := GetPage(h, 0); for

i := 0 to

1023 do

p^[i] := 0; fr := (max + 2) * 2; p^[0] := 1; p^[2] := fr and

$FF; p^[3] := (fr and

$FF00) shr

8; for

i := 0 to

length(s) - 1 do

p^[fr + 8 + i] := ord(s[i + 1]); for

i := 0 to

3 do

begin

p^[fr + i] := nxt mod

$100; nxt := nxt div

$100; end

; for

i := 0 to

3 do

begin

p^[fr + i + 4] := rn mod

$100; rn := rn div

$100; end

; fr := fr + isz; p^[4] := fr and

$FF; p^[5] := (fr and

$FF00) shr

8; nxt := GetRoot; for

i := 0 to

3 do

begin

p^[fr + i] := nxt mod

$100; nxt := nxt div

$100; end

; nxt := FileSeek(h, 0, 2); FileWrite(h, p^, 1024); FileSeek(h, 4, 0); FileWrite(h, nxt, sizeof(integer)); end

; procedure

TNtxAdd.Insert(key: ShortString; rn: integer); var

nxt: integer; i: integer; begin

nxt := 0; if

DosFl then

key := WinToDos(key); if

length(key) > ksz then

key := Copy(key, 1, ksz); for

i := 1 to

ksz - length(key) do

key := key + ' '; Clear; Load(GetRoot); Seek(key, False

); while

True

do

begin

if

Add(key, rn, nxt) then

break; if

tr.Count = 1 then

begin

NewRoot(key, rn, nxt); break; end

; Pop; end

; end

; constructor

TNtxAdd.Create(nm: ShortString; ks: Word); var

p: PBuf; i: integer; begin

Error := False

; DeleteFile(nm); h := FileCreate(nm); if

h > 0 then

begin

p := GetPage(h, 0); for

i := 0 to

1023 do

p^[i] := 0; p^[14] := ks and

$FF; p^[15] := (ks and

$FF00) shr

8; ks := ks + 8; p^[12] := ks and

$FF; p^[13] := (ks and

$FF00) shr

8; i := (1020 - ks) div

(2 + ks); i := i div

2; p^[20] := i and

$FF; p^[21] := (i and

$FF00) shr

8; i := i * 2; max := i; p^[18] := i and

$FF; p^[19] := (i and

$FF00) shr

8; i := 1024; p^[4] := i and

$FF; p^[5] := (i and

$FF00) shr

8; FileWrite(h, p^, 1024); for

i := 0 to

1023 do

p^[i] := 0; i := (max + 2) * 2; p^[2] := i and

$FF; p^[3] := (i and

$FF00) shr

8; FileWrite(h, p^, 1024); end

else

Error := True

; FileClose(h); FreeHandle(h); Open(nm); end

; constructor

TNtxAdd.Open(nm: ShortString); begin

Error := False

; h := FileOpen(nm, fmOpenReadWrite or

fmShareExclusive); if

h > 0 then

begin

FileSeek(h, 12, 0); FileRead(h, isz, 2); FileSeek(h, 14, 0); FileRead(h, ksz, 2); FileSeek(h, 18, 0); FileRead(h, max, 2); FileSeek(h, 20, 0); FileRead(h, hlf, 2); DosFl := True

; tr := TList.Create; end

else

Error := True

; end

; function

TNtxAdd.Changed: boolean; begin

Result := (csize = 0); csize := -1; end

; end

. // Файл NtxRO.pas unit

NtxRO; interface

uses

Classes; type

TBuf = array

[0..1023] of

Byte; PBuf = ^TBuf; TTraceRec = class

public

pg: integer; cn: SmallInt; constructor

Create(p: integer; c: SmallInt); end

; TNtxRO = class

protected

fs: string

[10]; empty: integer; csize: integer; rc: integer; {Текущий номер записи} tr: TList; {Стек загруженных страниц} h: integer; {Дескриптор файла} isz: Word; {Размер элемента} ksz: Word; {Размер ключа} max: Word; {Максимальное кол-во элементов} hlf: Word; {Половина страницы} function

GetRoot: integer; {Указатель на корень} function

GetEmpty: integer; {Пустая страница} function

GetSize: integer; {Возвращает размер файла} function

GetCount(p: PBuf): Word; {Число элементов на странице} function

Changed: boolean; virtual

; procedure

Clear; function

Load(n: integer): PBuf; function

Pop: PBuf; function

Seek(const

s: ShortString; fl: boolean): boolean; function

Skip: PBuf; function

GetItem(p: PBuf): PBuf; function

GetLink(p: PBuf): integer; public

Error: boolean; DosFl: boolean; constructor

Open(nm: ShortString); destructor

Destroy; override

; function

Find(const

s: ShortString): boolean; function

GetString(p: PBuf; c: SmallInt): ShortString; function

GetRecN(p: PBuf): integer; function

Next: PBuf; end

; function

GetPage(h, fs: integer): PBuf; procedure

FreeHandle(h: integer); function

DosToWin(const

ss: ShortString): ShortString; function

WinToDos(const

ss: ShortString): ShortString; implementation

uses

Windows, SysUtils; const

MaxPgs = 5; var

Buf: array

[1..1024 * MaxPgs] of

char; Cache: array

[1..MaxPgs] of

record

Handle: integer; {0-страница свободна} Offset: integer; { смещение в файле} Countr: integer; { счетчик использования} Length: SmallInt; end

; function

TNtxRO.Next: PBuf; var

cr: integer; p: PBuf; begin

if

h <= 0 then

begin

Result := nil

; exit; end

; while

Changed do

begin

cr := rc; Find(fs); while

cr > 0 do

begin

p := Skip; if

GetRecN(p) = cr then

break; end

; end

; Result := Skip; end

; function

TNtxRO.Skip: PBuf; var

cnt: boolean; p, r: PBuf; n: integer; begin

r := nil

; cnt := True

; with

tr do

begin

p := GetPage(h, (TTraceRec(Items[Count - 1])).pg); while

cnt do

begin

cnt := False

; if

(TTraceRec(Items[Count - 1])).cn > GetCount(p) + 1 then

begin

if

Count <= 1 then

begin

Result := nil

; exit; end

; p := Pop; end

else

while

True

do

begin

r := GetItem(p); n := GetLink(r); if

n = 0 then

break; p := Load(n); end

; if

(TTraceRec(Items[Count - 1])).cn >= GetCount(p) + 1 then

cnt := True

else

r := GetItem(p); Inc((TTraceRec(Items[Count - 1])).cn); end

; end

; if

r <> nil

then

begin

rc := GetRecN(r); fs := GetString(r, length(fs)); end

; Result := r; end

; function

TNtxRO.GetItem(p: PBuf): PBuf; var

r: PBuf; begin

with

TTraceRec(tr.items[tr.Count - 1]) do

r := PBuf(@(p^[cn * 2])); r := PBuf(@(p^[GetCount(r)])); Result := r; end

; function

TNtxRO.GetString(p: PBuf; c: SmallInt): ShortString; var

i: integer; r: ShortString; begin

r := ''; if

c = 0 then

c := ksz; for

i := 0 to

c - 1 do

r := r + chr(p^[8 + i]); if

DosFl then

r := DosToWin(r); Result := r; end

; function

TNtxRO.GetLink(p: PBuf): integer; var

i, r: integer; begin

r := 0; for

i := 3 downto

0 do

r := r * 256 + p^[i]; Result := r; end

; function

TNtxRO.GetRecN(p: PBuf): integer; var

i, r: integer; begin

r := 0; for

i := 3 downto

0 do

r := r * 256 + p^[i + 4]; Result := r; end

; function

TNtxRO.GetCount(p: PBuf): Word; begin

Result := p^[1] * 256 + p^[0]; end

; function

TNtxRO.Seek(const

s: ShortString; fl: boolean): boolean; var

r: boolean; p, q: PBuf; nx: integer; begin

r := False

; with

TTraceRec(tr.items[tr.Count - 1]) do

begin

p := GetPage(h, pg); while

cn <= GetCount(p) + 1 do

begin

q := GetItem(p); if

(cn > GetCount(p)) or

(s < GetString(q, length(s))) or

(fl and

(s = GetString(q, length(s)))) then

begin

nx := GetLink(q); if

nx <> 0 then

begin

Load(nx); r := Seek(s, fl); end

; Result := r or

(s = GetString(q, length(s))); exit; end

; Inc(cn); end

; end

; Result := False

; end

; function

TNtxRO.Find(const

s: ShortString): boolean; var

r: boolean; begin

if

h <= 0 then

begin

Result := False

; exit; end

; rc := 0; csize := 0; r := False

; while

Changed do

begin

Clear; Load(GetRoot); if

length(s) > 10 then

fs := Copy(s, 1, 10) else

fs := s; R := Seek(s, True

); end

; Result := r; end

; function

TNtxRO.Load(N: integer): PBuf; var

it: TTraceRec; r: PBuf; begin

r := nil

; if

h > 0 then

begin

with

tr do

begin

it := TTraceRec.Create(N, 1); Add(it); end

; r := GetPage(h, N); end

; Result := r; end

; procedure

TNtxRO.Clear; var

it: TTraceRec; begin

while

tr.Count > 0 do

begin

it := TTraceRec(tr.Items[0]); tr.Delete(0); it.Free; end

; end

; function

TNtxRO.Pop: PBuf; var

r: PBuf; it: TTraceRec; begin

r := nil

; with

tr do

if

Count > 1 then

begin

it := TTraceRec(Items[Count - 1]); Delete(Count - 1); it.Free; it := TTraceRec(Items[Count - 1]); r := GetPage(h, it.pg) end

; Result := r; end

; function

TNtxRO.Changed: boolean; var

i: integer; r: boolean; begin

r := False

; if

h > 0 then

begin

i := GetEmpty; if

i <> empty then

r := True

; empty := i; i := GetSize; if

i <> csize then

r := True

; csize := i; end

; Result := r; end

; constructor

TNtxRO.Open(nm: ShortString); begin

Error := False

; h := FileOpen(nm, fmOpenRead or

fmShareDenyNone); if

h > 0 then

begin

fs := ''; FileSeek(h, 12, 0); FileRead(h, isz, 2); FileSeek(h, 14, 0); FileRead(h, ksz, 2); FileSeek(h, 18, 0); FileRead(h, max, 2); FileSeek(h, 20, 0); FileRead(h, hlf, 2); empty := -1; csize := -1; DosFl := True

; tr := TList.Create; end

else

Error := True

; end

; destructor

TNtxRO.Destroy; begin

if

h > 0 then

begin

FileClose(h); Clear; tr.Free; FreeHandle(h); end

; inherited

Destroy; end

; function

TNtxRO.GetRoot: integer; var

r: integer; begin

r := -1; if

h > 0 then

begin

FileSeek(h, 4, 0); FileRead(h, r, 4); end

; Result := r; end

; function

TNtxRO.GetEmpty: integer; var

r: integer; begin

r := -1; if

h > 0 then

begin

FileSeek(h, 8, 0); FileRead(h, r, 4); end

; Result := r; end

; function

TNtxRO.GetSize: integer; var

r: integer; begin

r := 0; if

h > 0 then

r := FileSeek(h, 0, 2); Result := r; end

; constructor

TTraceRec.Create(p: integer; c: SmallInt); begin

pg := p; cn := c; end

; function

GetPage(h, fs: integer): PBuf; {Протестировать отдельно} var

i, j, mn: integer; q: PBuf; begin

mn := 10000; j := 0; for

i := 1 to

MaxPgs do

if

(Cache[i].Handle = h) and

(Cache[i].Offset = fs) then

begin

j := i; if

Cache[i].Countr < 10000 then

Inc(Cache[i].Countr); end

; if

j = 0 then

begin

for

i := 1 to

MaxPgs do

if

Cache[i].Handle = 0 then

j := i; if

j = 0 then

for

i := 1 to

MaxPgs do

if

Cache[i].Countr <= mn then

begin

mn := Cache[i].Countr; j := i; end

; Cache[j].Countr := 0; mn := 0; end

; q := PBuf(@(Buf[(j - 1) * 1024 + 1])); if

mn = 0 then

begin

FileSeek(h, fs, 0); Cache[j].Length := FileRead(h, q^, 1024); end

; Cache[j].Handle := h; Cache[j].Offset := fs; Result := q; end

; procedure

FreeHandle(h: integer); var

i: integer; begin

for

i := 1 to

MaxPgs do

if

Cache[i].Handle = h then

Cache[i].Handle := 0; end

; function

DosToWin(const

ss: ShortString): ShortString; var

r: ShortString; i: integer; begin

r := ''; for

i := 1 to

length(ss) do

if

ss[i] in

[chr($80)..chr($9F)] then

r := r + chr(ord(ss[i]) - $80 + $C0) else

if

ss[i] in

[chr($A0)..chr($AF)] then

r := r + chr(ord(ss[i]) - $A0 + $C0) else

if

ss[i] in

[chr($E0)..chr($EF)] then

r := r + chr(ord(ss[i]) - $E0 + $D0) else

if

ss[i] in

[chr($61)..chr($7A)] then

r := r + chr(ord(ss[i]) - $61 + $41) else

if

ss[i] in

[chr($F0)..chr($F1)] then

r := r + chr($C5) else

r := r + ss[i]; Result := r; end

; function

WinToDos(const

ss: ShortString): ShortString; var

r: ShortString; i: integer; begin

r := ''; for

i := 1 to

length(ss) do

if

ss[i] in

[chr($C0)..chr($DF)] then

r := r + chr(ord(ss[i]) - $C0 + $80) else

if

ss[i] in

[chr($E0)..chr($FF)] then

r := r + chr(ord(ss[i]) - $E0 + $80) else

if

ss[i] in

[chr($F0)..chr($FF)] then

r := r + chr(ord(ss[i]) - $F0 + $90) else

if

ss[i] in

[chr($61)..chr($7A)] then

r := r + chr(ord(ss[i]) - $61 + $41) else

if

ss[i] in

[chr($D5), chr($C5)] then

r := r + chr($F0) else

r := r + ss[i]; Result := r; end

; end

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com