Код:
Unit STRINGS3;
Interface
Const StrOk=0;
StrOut=1;
StrNotFound=2;
StrBig=3;
StrSmall=4;
Type string1=array[-1..1024] of char;
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;
Implementation
procedure SetLength(var st:string1;l:word);
Begin
if l>1024 then
StrError:=StrOut
else
begin
StrError:=StrOk;
st[-1]:=chr(l shr 8);
st[0]:=chr(l);
end;
End;
function Length(s:string1):word;
var a:word;
Begin
StrError:=StrOk;
a:=ord(s[-1]);
Length:=(a shl 8) OR ord(s[0]);
End;
procedure Copy(s:string1;index,count:word;var subs:string1);
var i:word;
Begin
if (Length(s)<(index+count-1))OR(index<1) then
StrError:=StrOut
else
begin
StrError:=StrOk;
SetLength(subs,count);
for i:=index to index+count-1 do
subs[i-index+1]:=s[i];
end;
End;
procedure Concat(const s1,s2:string1;var srez:string1);
var i:word;
Begin
if (Length(s1)+Length(s2))>1024 then
StrError:=StrOut
else
begin
StrError:=StrOk;
Copy(s1,1,Length(s1),srez);
for i:=1 to Length(s2) do
srez[i+Length(s1)]:=s2[i];
SetLength(srez,Length(s1)+Length(s2));
end;
End;
procedure InputStr(var st:string1);
var i:word;
c:char;
Begin
i:=0;
read(c);
while (ord(c)<>13)OR(i>=1024) do
begin
inc(i);
st[i]:=c;
read(c);
end;
SetLength(st,i);
End;
procedure Insert(subs:string1;var s:string1;index:word);
var i:word;
buf:string1;
Begin
if (Length(s)+Length(subs))>1024 then
StrError:=StrBig
else
if index>Length(s) then
StrError:=StrOut
else
begin
StrError:=StrOk;
Copy(s,index,Length(s)-index+1,buf);
SetLength(s,index-1);
Concat(s,subs,s);
Concat(s,buf,s);
End;
End;
procedure Delete(var s:string1;index,count:word);
var i:word;
buf:string1;
Begin
if Length(s)<index+count-1 then
StrError:=StrSmall
else
begin
StrError:=StrOk;
Copy(s,index+count,Length(s)-count-index+1,buf);
SetLength(s,index-1);
Concat(s,buf,s);
end;
End;
procedure OutputStr(const st:string1);
var i:word;
Begin
for i:=1 to Length(st) do
write(st[i]);
End;
procedure WriteToStr(var st:string1;s:string);
var i:byte;
Begin
StrError:=StrOk;
for i:=1 to ord(s[0]) do
st[i]:=s[i];
SetLength(st,ord(s[0]));
End;
procedure WriteFromStr(var s:string;st:string1);
var i:byte;
Begin
if Length(st)>255 then
StrError:=StrBig
else
begin
StrError:=StrOk;
for i:=1 to Length(st) do
s[i]:=st[i];
end;
s[0]:=chr(Length(st));
End;
function Comp(s1,s2:string1;var fl:shortint):boolean;
var i,l:word;
Begin
i:=1;
if Length(s1)>Length(s2) then
l:=Length(s2)
else
l:=Length(s1);
while (i<=l)AND(s1[i]=s2[i]) do
inc(i);
if (Length(s1)=Length(s2)) then
begin
if i>l then
fl:=0
else if s1[i]>s2[i] then
fl:=1
else if s1[i]<s2[i] then
fl:=-1
end
else
if Length(s1)>Length(s2) then
fl:=1
else
fl:=-1;
Comp:=(fl=0);
End;
function Pos(subs,s:string1):word;
var i,j,p:word;
fl:shortint;
buf:string1;
Begin
i:=0;
j:=0;
p:=0;
while ((i+Length(subs))<=Length(s))AND(p=0) do
begin
inc(i);
Copy(s,i,Length(subs),buf);
if Comp(subs,buf,fl) then
p:=i;
end;
if p=0 then
StrError:=StrNotFound
else
StrError:=StrOk;
Pos:=p;
End;
End.
Помогите на основе этих модулей написать такую процедуру, Copies(var s1,s2:string; n:byte).
Назначение: копирование строки s в строку s1 n раз.
Входные параметры: s1,n.
Выходные параметры: s2.