Code:

{ **** UBPFD *********** by kladovka.net  ****

>> Получение параметра из строки по его индексу, а также получение общего числа параметров в строке

 

В юните представлены две функции, одна из которых, GetParamFromString, позволяет получить параметр из строки, по индексу этого параметра (индексация начинается с 1). Параметров в строке, я называю части строк, разделённые каким-нибудь оговорённым разделителем, например символом ";".

К пример строка "fex;9x-1;code" имеет три параметра:

fex

9x-1

code.

 

Описание аргументов функции GetParamFromString:

SourceStr - строка, содержащая в себе параметры;

Delimiter - разделитель параметров в строке;

Ind - индекс запрашиваемого параметра.

 

Функция GetParamsCount просто возвращает количество параметров в строке.

Описание аргументов функции GetParamsCount:

SourceStr - строка, содержащая в себе параметры;

Delimiter - разделитель параметров в строке;

 

Зависимости: Windows

Автор: VID, ICQ:132234868, Махачкала

Copyright: (c) не моё

 

********************************************** }

 

unit getstrparam;

 

interface

 

uses Windows;

 

function GetParamsCount (const SourceStr, Delimiter:String): integer;

function GetParamFromString(const SourceStr,Delimiter:String; Ind:integer):string;

 

implementation

 

function GetDTextItem(DText,delimeter:pchar;var idx:integer):Pchar;

var nextpos:Pchar;i,len, p:integer;

begin

result:=DText;

len:=length(delimeter);

if (len=0) or (DText='') then exit;

i:=1;

while TRUE do

begin

p:=pos(delimeter,result);

if (p<>0) then

nextpos:=pointer(integer(result)+p-1)

else nextpos:=pointer(integer(result)+length(result));

if (i=idx) or (p=0) then break;

result:=pointer(integer(nextpos)+len);

inc(i);

end;

if i=idx then byte(nextpos^):=0else byte(result^):=0;

end;

 

function GetDTextCount(DText,delimeter:pchar):integer;

var subpos:Pchar;i,len:integer;

begin

result:=0;

len:=length(delimeter);

if (len=0) or (DText='') then exit;

subpos:=DText;

i:=pos(delimeter,subpos);

while i<>0do

begin

inc(result);

subpos:=pointer(integer(subpos)+i+len-1);

i:=pos(delimeter,subpos);

end;

if (byte(subpos^))<>0then inc(result);

end;

 

function GetParamsCount (const SourceStr, Delimiter:String): integer;

begin

Result:=GetDTextCount(PChar(SourceStr), PChar(Delimiter));

end;

 

function GetParamFromString(const SourceStr,Delimiter:String; Ind:integer):string;

var TmpS, TmpRes:PChar;

LRes:integer;

begin

GetMem (Tmps, Length(SourceStr)+1);

try

CopyMemory(Tmps, PChar(SourceStr), Length(SourceStr));

Byte(Pointer(Integer(Tmps)+Length(SourceStr))^):=0;

TmpRes:=GetDTextItem(TmpS, PChar(Delimiter), Ind);

LRes:=Length(TmpRes);

SetLength(Result,LRes);

CopyMemory(@Result[1], TmpRes, LRes);

finally

FreeMem(TmpS);

end;

end;

 

end.

 

 

 

Пример использования:

Code:

showmessage(GetParamFromString('1;2a;3;4', ';',2));

showmessage(inttostr(GetParamsCount('1;2;3;4', ';')));

 

Code:

function GetAnsistringRefcount(const S: string): Cardinal;

asm

or eax, eax

jz @done

sub eax, 8

mov eax, dword ptr [eax]

@done:

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var

S1, S2: string;

begin

memo1.lines.Add(Format('Refcount at start: %d',

[GetAnsistringRefcount(S1)]));

S1 := StringOfChar('A', 10);

memo1.lines.Add(Format('Refcount after assignment: %d',

[GetAnsistringRefcount(S1)]));

S2 := S1;

memo1.lines.Add(Format('Refcount after S2:=S1: %d',

[GetAnsistringRefcount(S1)]));

S2 := S1 + S2;

memo1.lines.Add(Format('Refcount after S2:=S1+S2: %d',

[GetAnsistringRefcount(S1)]));

end;

Code:

{ **** UBPFD *********** by kladovka.net u ****

>> Расстояние (разность) между двумя строками. Функция Левенштейна

 

Зависимости: System

Автор: Андрей aka wicked, Этот адрес электронной почты защищён от спам-ботов. У вас должен быть включен JavaScript для просмотра., ICQ:92356239, Тернополь

Copyright: описание алгоритма взято с https://www.merriampark com / ld.htm, реализация моя

 

********************************************** }

 

const cuthalf = 100; // константа, ограничивающая макс. длину

// обрабатываемых строк

 

var buf: array [0..((cuthalf * 2) - 1)] of integer; // рабочий буффер, заменяет

// матрицу, представленную

// в описании

 

function min3(a, b, c: integer): integer; // вспомогательная функция

begin

Result := a;

if b < Result then Result := b;

if c < Result then Result := c;

end;

 

// реализация функции в принципе соответствует описанию с одной оговоркой:

// матрица из описания заменена статическим буффером, длина которого

// равна удвоенной максимальной длине строк

// это сделано для 1) экономии памяти и во избежание её перераспределений

// 2) повышения быстродействия (у меня функция работает

// в обработчике onfilterRecord)

// таким образом, в реализации половинами буффера представлены только

// две последние строки матрицы, которые меняются местами каждую

// итерацию внешнего цикла (по i)... для определения того, какая из половин

// буффера является "нижней строкой", служит переменная flip

// т. е. при flip = false первая половина буффера является предпоследней

// строкой, а вторая - последней; при flip = true наоборот,

// первая половина - последняя строка, вторая половина - предпоследняя

 

function LeveDist(s, t: string): integer;

var i, j, m, n: integer;

cost: integer;

flip: boolean;

begin

s := copy(s, 1, cuthalf - 1);

t := copy(t, 1, cuthalf - 1);

m := length(s);

n := length(t);

if m = 0then Result := n

elseif n = 0then Result := m

elsebegin

flip := false;

for i := 0to n do buf[i] := i;

for i := 1to m dobegin

if flip then buf[0] := i

else buf[cuthalf] := i;

for j := 1to n dobegin

if s[i] = t[j] then cost := 0

else cost := 1;

if flip then

buf[j] := min3((buf[cuthalf + j] + 1),

(buf[j - 1] + 1),

(buf[cuthalf + j - 1] + cost))

else

buf[cuthalf + j] := min3((buf[j] + 1),

(buf[cuthalf + j - 1] + 1),

(buf[j - 1] + cost));

end;

flip := not flip;

end;

if flip then Result := buf[cuthalf + n]

else Result := buf[n];

end;

end;

 

 

 

 

Пример использования:

Code:

// на форме имеются поля Edit1 и Edit2, метка Label1

.....

Label1.Caption := IntToStr(LeveDist(Edit1.Text, Edit2.Text));

.....

Code:

{ **** UBPFD *********** by delphibase.endimus  ****

>> Проверка значения строки

 

Функция предназначена дла проверки значения строки.

 

Зависимости: нет

Автор: Separator, vilgelm @ mail.kz, Алматы

Copyright: Сергей Вильгельм

 

***************************************************** }

 

type

TTypeStr = (tsString, tsDate, tsNumber);

 

function CheckString(const Value: string): TTypeStr;

begin

if StrToDateTimeDef(Value, 0) = 0then

if StrToIntDef(Value, 0) = 0then

Result := tsString

else

Result := tsNumber

else

Result := tsDate

end;

Code:

const

vlist = 'первый, второй, третий';

 

var

Values: TStringList;

 

procedure SetValues(VL : TStringList; S: String);

var

I : Integer;

begin

VL.CommaText := S;

for I := 0to CL.Count-1do

VL.Objects[I] := Pointer(I);

VL.Sorted := True;

end;

 

function GetValueIndex(VL : TStringList; Match: String): Integer;

begin

Result := VL.IndexOf(Match);

if Result >= 0then

Result := Integer(VL.Objects[Result]);

end;

 

procedure TForm1.Button1Click(Sender: TObject);

begin

case GetValueIndex(Values, Edit1.Text) of

-1: {не найден} ;

0: Caption := '0';

1: Caption := '1';

2: Caption := '2';

end;

end;

 

initialization

VL := TStringList.Create;

SetValues(VL, vlist);

 

finalization

VL.Free;