Помогите переделать и проверьте

[Mokriy]

(1) Вывести те слова заданной строки, которые отличаются от последнего слова, и удовлетворяет условие. Каждая буква входит в слово не меньше 2 раз.
вот вроде текст проверьте плиз

uses crt;
var st,st1:string;

function Copyslova(s:string):string;
var i,k:integer;
begin
i:=1;
while i<=length(s) do
begin
if pos(' ',s[i])<>0 then k:=i;
i:=i+1;
end;
copyslova:=copy(s,k+1,length(s)-k);
end;

procedure obr(st4:string);
var i,k:integer;
begin
k:=0;
for i:=2 to length(st4) do
if st4[1]=st4[i] then writeln(st4);
if k<>0 then k:=k+1;
end;

procedure text_podil(st:string; var st1:string);
var i,k:integer; st3,st4:string;
begin
i:=1; st3:=copyslova(st);
repeat
k:=1;
while(i<=length(st))and (st[i]<>' ')do
begin
i:=i+1;
k:=k+1;
end;
st4:=copy(st,i-(k-1),k-1);
if (st4<>st3) then Obr(st4);
i:=i+1;
until i>length(st);
end;

{-----------main------------}
begin
clrscr;
writeln('vvedity ryadok');
readln(st);
text_podil(st,st1);
writeln(st1);
readln;
End.

(2)заполнить и вывести матрицу после вывести номер столбица с минимальным значением умноженых елементов.
Оказалось что нужно делать только через процедуры-функцыи
как вот такую лабу переделать?

Program matriza;
Uses crt;
Const
N=5;
M=5;
Var
A:array [1..N,1..M] of integer;
Pro:array [1..M] of integer;
num, k,i,j,Min:integer;

Begin
ClrScr;
Randomize;
writeln('Isxodnii massiv: ');
For i:=1 to N do
Begin
For j:=1 to M do
Begin
A[i,j]:=random(15)-3;
write(A[i,j]:3);
End;
writeln;
End;
writeln;
writeln('Proizvedenie v stolbzax: ');

For j:=1 to M do
Begin
For i:=1 to N do
Begin
if i=1 then Pro[j]:=A[i, j] else Pro[j]:=Pro[j]*A[i,j];
End;
write(pro[j],' ');
End;
Min:=pro[1];
num := 1;
writeln;
For j:=2 to M do
Begin
If Min>pro[j] then begin
min:=pro[j];
num := j
end;
End;
write('num = ', num, ' Znachenie = ', min);
readln;
End.

[puporev]

По второй задаче.
По условию нужно только вывести номер столбца с мимимальным
произведением, поэтому все лишнее выкинул, а заданный вопрос решается одной функцией.

Program matriza;
Uses crt;
Const
N=5;
M=5;
Var
A:array [1..N,1..M] of integer;
num,min,i,j:integer;
pr:extended;   //произведение может быть очень большим, поэтому такой тип
Function NumStb:integer;
var num,min:integer;
begin
min:=maxint;num:=1; //за мин принимаем самое большое Integer
For j:=1 to M do
     Begin
	 pr:=1; //произведение=1
       For i:=1 to N do
         Begin
           pr:=pr*A[i,j];//перемножаем столбец
	   end;
       if pr<min then
         begin
           min:=pr;
           num:=j;  //находим номер столбца
          end;		   
      End;
NumStb:=num;
end;
Begin
ClrScr;
Randomize;
writeln('Isxodnii massiv: ');
For i:=1 to N do
    Begin
      For j:=1 to M do
        Begin
          A[i,j]:=random(5)+1;//нужно взять без ноля, иначе всегда с нолями=мин
          write(A[i,j]:3);//лучше вообще взять тип Real, а не Integer, тогда нолей не будет
        End;
      writeln;
    End;
writeln;
writeln('num = ', NumStb);
readln;
End.

[Cannibal]

uses crt;
var st,st1:string;

function Copyslova(s:string):string;
var i,k:integer;
begin
i:=1;
while i<=length(s) do
begin
if pos(' ',s[i])<>0 then k:=i;
i:=i+1;
end;
copyslova:=copy(s,k+1,length(s)-k);
end;

procedure obr(st4:string);
var i,k,flag:integer;
begin
k:=0;
flag:=0;
for j:=1 to length (st4)-1 do
for i:=j to length(st4) do
if st4[j]=st4[i] then flag:=flag+1;
if flag <>0 then write (st4);
if k<>0 then k:=k+1;
end;

procedure text_podil(st:string; var st1:string);
var i,k:integer; st3,st4:string;
begin
i:=1; st3:=copyslova(st);
repeat
k:=1;
while(i<=length(st))and (st[i]<>' ')do
begin
i:=i+1;
k:=k+1;
end;
st4:=copy(st,i-(k-1),k-1);
if (st4<>st3) then Obr(st4);
i:=i+1;
until i>length(st);
end;

{-----------main------------}
begin
clrscr;
writeln('vvedity ryadok');
readln(st);
text_podil(st,st1);
writeln(st1);
readln;
End.

[Mokriy]

огромное спасибо вы меня несказано выручили