Здравствуйте, Посетитель - 395363!

Текст с комментариями приведён ниже.

Общие замечания
1) Вы не указали прямо надо ли создавать модуль или
реализовывать всё в одной программе. Т.к. второй путь уж больно
громоздок и несуразен, я сделал модуль str1.pas. К нему написана
головная программа str1main.pas, демонстрирующая использование string1.
2) InitStr производит только _начальную_ инициализацию. Чтобы
корректно и безопасно изменять физический размер требуется
отдельная процедура. Раз она не предусмотрена в списке, значит
исхожу из однократной инициальзации строки.
3) В я предполагаю, что вы знаете, как устроен стандартный
паскалевский string.
4) Поскольку string1 явно вводится, как аналог string, то и
поведение Delete, Insert и Copy я задал по аналогии. Т.е.
неверно заданные Index и Count не считаются ошибкой, а тихо
исправляются. Может быть надо было иначе.
5) В имени процедуры SrtSet вероятно есть опечатка. Но я
исправлять не стал.

str1.pas
[code h=200]unit str1;

interface

Const {определение исключительных ситуаций}
STRING1_NO_ERROR = 0; // Нет ошибок
STRING1_TOO_LONG = 1; // Запрос слишком большого количества памяти при инициализации
STRING1_EXCEED_PASCAL_STRING = 2; // размер превышает пределы паскалевской строки
STRING1_TOO_SHORT = 3; // Недостаточно выделеннной памяти

maxN=65520; // максимальный размер выделяемой памяти

Type St=array[1..65520] of char;

String1=record
p_st:^st;{указатель на строку}
max:word;{максимальное количество символов в строке, определяется при инициализации}
N:word {динамическая длина строки}
End;


Procedure InitStr(var st:string1; n:word);
Procedure WriteToStr(var st:string1;s:string);
Procedure WriteFromStr(var s:string;st:string1);
Procedure InputStr(var st:string1);
Procedure OutputStr(const st:string1);
Function Comp(s1,s2:string1;var fl:shortint):boolean;
Procedure Delete(var S:String1;Index,Count:word);
Procedure Insert(Subs:String1;var S:String1;Index:word);
Procedure Concat( const S1, S2:string1;var srez:string1);
Procedure Copy(S:String1;Index,Count:Word; var Subs:string1);
Function Length(S: String1): word;
Function Pos(SubS, S: String1): word;
Var StrError: byte;{тип переменной ошибки}
procedure SrtSet(var s:string1;n,l:word;c:char);

implementation

Procedure InitStr(var st:string1; n:word);
begin
if n>maxN // если запрашивается слишком много памяти
then StrError:=STRING1_TOO_LONG
else begin
GetMem(st.p_st,n*sizeof(char)); // выделяется память и инициализируются поля
st.N:=0;
st.max:=n;
StrError:=STRING1_NO_ERROR;
end;
end;

Procedure WriteToStr(var st:string1;s:string);
var i:byte;
begin
if byte(s[0])>st.max // если размер записываемой (паскалевской) строки превышает
then StrError:=STRING1_TOO_SHORT // выделенный объём памяти
else if StrError=STRING1_NO_ERROR
then begin
st.N:=byte(s[0]);
for i:=1 to st.N do // поэлементное копирование
st.p_st^[i]:=s[i];
end;

end;

Procedure WriteFromStr(var s:string;st:string1);
var i:byte;
begin
if st.N > 255
then StrError:=STRING1_EXCEED_PASCAL_STRING
else begin
byte(s[0]):=st.N;
for i:=1 to st.N do // поэлементное копирование
s[i]:=st.p_st^[i];
end;
end;

Procedure InputStr(var st:string1);
var c:char;
begin
st.N:=0; // сначала строка устанавливается пустой
read(c); // чтение первого символа
while (c<>#13) and (st.N<st.max) do
begin // пока не прочитали конец строки и не превысили максимальное количество символов
inc(st.N); // увеличиваем динамический размер
st.p_st^[st.N]:=c; // и вписываем символ
read(c); // читаем следующий
end;
end;

Procedure OutputStr(const st:string1);
var i:word;
begin
for i:=1 to st.N do // поэлементный вывод на экран
write(st.p_st^[i]);
end;

Function Comp(s1,s2:string1;var fl:shortint):boolean;
var i:word;
begin
i:=1;
// индекс пробегает по строкам пока не кончится одна из них
// или не найдётся отличающаяся пара
while (i<=s1.N) and (i<=s2.N) and (s1.p_st^[i]=s2.p_st^[i]) do
inc(i);
// индекс вышел сразу за оба размера, но различия не найдены
// строки совпадают
if (i>s1.N) and (i>s2.N) then fl:=0;
// индекс вышел только за размер s1 и различия не найдены
// например, s1='qwe' s2='qwert'
if (i>s1.N) and (i<=s2.N) then fl:=-1;
// обратная ситуация
if (i<=s1.N) and (i>s2.N) then fl:=1;
// в i-м элементе найдено различие
if (i<=s1.N) and (i<=s2.N) then
if s1.p_st^[i]<s2.p_st^[i]
then fl:=-1
else fl:=1;
Comp:= fl=0;
end;

// Дополнительная утилита
// исправляет индекс если он подан вне диапазона строки
Procedure FixIndex(S:string1;var Index:word);
begin
if Index>S.N
then Index:=S.N+1; // в конец строки
if Index<1
then Index:=1; // в начало строки
end;

// Дополнительная утилита
// исправляет отступ от индекса выходит за диапазон строки
Procedure FixCount(S:string1;Index:word;var Count:word);
begin
if Index+Count > S.N
then Count:=S.N - Index + 1; // до конца строки
end;

Procedure Delete(var S:String1;Index,Count:word);
var i:word;
begin
FixIndex(S,Index);
FixCount(S,Index,Count);
for i:=Index+Count to S.N do // сдвигается часть строки после
S.p_st^[i-Count]:=S.p_st^[i]; // удаляемого фрагмента
dec(S.N,Count); // уменьшается динамический размер
end;

Procedure Insert(Subs:String1;var S:String1;Index:word);
var i:word;
begin
if S.N+Subs.N > S.max
then StrError:=STRING1_TOO_SHORT
else begin
FixIndex(S,Index);
S.N:=S.N+Subs.N;
for i:=S.N downto Index+Subs.N do // сдвигается часть строки после
S.p_st^[i]:=S.p_st^[i-Subs.N]; // места вставки
for i:=1 to Subs.N do // сама вставка
S.p_st^[Index+i-1]:=Subs.p_st^[i];
end;
end;

Procedure Concat( const S1, S2:string1;var srez:string1);
var i:word;
begin
if S1.N+S2.N>srez.max
then StrError:=STRING1_TOO_SHORT
else begin
srez.N:=S1.N+S2.N;
for i:=1 to S1.N do // поэлементное копирование первой строки
srez.p_st^[i]:=S1.p_st^[i];
for i:=1 to S2.N do // поэлементное копирование первой строки
srez.p_st^[S1.N+i]:=S2.p_st^[i];
end;
end;

Procedure Copy(S:String1;Index,Count:Word; var Subs:string1);
var i:word;
begin
FixIndex(S,Index);
FixCount(S,Index,Count);
if Count>Subs.max
then StrError:=STRING1_TOO_SHORT
else begin
for i:=1 to Count do // поэлементное копирование фрагмпервой строки
Subs.p_st^[i]:=S.p_st^[Index+i-1];
end;
end;

Function Length(S: String1): word;
begin
Length:=S.N;
end;

Function Pos(SubS, S: String1): word;
var i,j,p:word;
begin
// реализован стандартный алгоритм линейного поиска в строке
i:=1;p:=0;
// перебираем позицию в строке S
while (i<=S.N-Subs.N+1) and (p=0) do
begin
j:=1;
// перебираем и сравниваем элементы в заданных строках
// в Subs от начала, в S от i
while (j<=Subs.N) and (Subs.p_st^[j]=S.p_st^[i+j-1]) do
inc(j);
if j>Subs.N // индекс вышел за пределы строки Subs
then p:=i; // значит различий не найдено. i -- результат
inc(i);
end;
Pos:=p;
end;

procedure SrtSet(var s:string1;n,l:word;c:char);
var i:word;
begin
FixIndex(S,n);
FixCount(S,n,l);
for i:=n to n+l-1 do
s.p_st^[i]:=c;
end;

end.
[/code]

str1main.pas
[code h=200]uses str1;

var s1,s2,s3:string1;
st:string;
f:shortint;
p:word;

begin
writeln('>> Checking WriteToStr(s1,''qwertasd'') <<');
InitStr(s1,10);
WriteToStr(s1,'qwertasd');
if StrError=0
then begin
write('s1: ');
OutputStr(s1);
end
else write('Error');
writeln;
readln;

writeln('>> Checking WriteFromStr(st,s1); <<');
WriteFromStr(st,s1);
write('s1: ');
OutputStr(s1);
writeln;
write('st: ');
writeln(st);
readln;

writeln('>> Checking InputStr(s2); <<');
InitStr(s2,10);
write('Enter some string:');
InputStr(s2);
readln;
write('s2: ');
OutputStr(s2);
writeln;
readln;

writeln('>> Checking Comp(s1,s2,f) <<');
write('s1: ');
OutputStr(s1);
writeln;
write('s2: ');
OutputStr(s2);
writeln;
if Comp(s1,s2,f)
then writeln('s1 = s2')
else if f<0
then writeln('s1 < s2')
else writeln('s1 > s2');
readln;

writeln('>> Checking Delete(s1,3,5); <<');
write('s1: ');
OutputStr(s1);
writeln;
Delete(s1,3,5);
write('s1: ');
OutputStr(s1);
writeln;
readln;

writeln('>> Checking Insert(s1,s2,3); <<');
write('s1: ');
OutputStr(s1);
writeln;
write('s2: ');
OutputStr(s2);
writeln;
Insert(s1,s2,3);
write('s2: ');
OutputStr(s2);
writeln;
readln;

writeln('>> Checking Concat(s1,s2,s3); <<');
InitStr(s3,20);
write('s1: ');
OutputStr(s1);
writeln;
write('s2: ');
OutputStr(s2);
writeln;
Concat(s1,s2,s3);
if StrError=0
then begin
write('s3: ');
OutputStr(s3);
writeln;
write('Length(s3) = ',Length(s3));
end
else write('Error');
writeln;
readln;

writeln('>> Checking Copy(s3,5,3,s1); <<');
Copy(s3,5,3,s1);
write('s3: ');
OutputStr(s3);
writeln;
write('s1: ');
OutputStr(s1);
writeln;
readln;

writeln('>> Checking Pos(s1,s3); <<');
p:=Pos(s1,s3);
write('s1: ');
OutputStr(s1);
writeln;
write('s3: ');
OutputStr(s3);
writeln;
if p<>0
then writeln('s1 is found at ',p,' position of s3')
else writeln('s1 is not found in s3');
writeln('>Changing s1');
s1.p_st^[2]:='1';
write('s1: ');
OutputStr(s1);
writeln;
write('s3: ');
OutputStr(s3);
writeln;
p:=Pos(s1,s3);
if p<>0
then writeln('s1 is found at ',p,' position of s3')
else writeln('s1 is not found in s3');
readln;

writeln('>> Checking SrtSet(s3,3,6,''*''); <<');
SrtSet(s3,3,6,'*');
write('s3: ');
OutputStr(s3);
writeln;
readln;
end.
[/code]