Написать программу, формирующую строку, состоящую из символов, входящих одновременно в обе заданные строки

uses strings;
var
  s, res: pchar;
  st1, st2: string;
  i, k: integer;
  q: set of char;
  ch: char;
 
begin
  st1 := '12345';
  st2 := '45678';
  q := [];
  st1 := Concat(st1, st2);
  writeln(st1);
  s := stralloc(length(st1) + 1);
  StrPCopy(s, st1);
  res := stralloc(length(st1) + 1);
  res^ := #0;
  k := -1;
  for i := 0 to strlen(s) - 1 do
    if (strscan(s, s[i]) <> strrscan(s, s[i])) and not (s[i] in q) then
    begin
      include(q, s[i]);
      inc(k);
      res[k] := s[i];
    end;
  writeln(res);
  strdispose(res);
  strdispose(s);
  readln;
end.

var
  s: array [0..255] of Char;
  p: PChar;
  a, b: set of Char;
  c: Char;
begin
  Write('Строка 1: '); ReadLn(s); p:=s; while p^<>#0 do begin Include(a,p^); Inc(p); end;
  Write('Строка 2: '); ReadLn(s); p:=s; while p^<>#0 do begin Include(b,p^); Inc(p); end;
  a:=a*b; p:=s; for c:=#1 to #255 do if c in a then begin p^:=c; Inc(p); end; p^:=#0;
  WriteLn('Результат: ',s);
end.

  a:=a*b; p:=s; for c in a do begin p^:=c; Inc(p); end; p^:=#0;

function Min(a, b: Integer): Integer;
begin
  if a<=b then Min:=a else Min:=b;
end;
var
  s: array [0..255] of Char;
  a, b: array [#1..#255] of Integer;
  p: PChar;
  i: Integer;
  c: Char;
begin
  Write('Строка 1: '); ReadLn(s); p:=s; while p^<>#0 do begin Inc(a[p^]); Inc(p); end;
  Write('Строка 2: '); ReadLn(s); p:=s; while p^<>#0 do begin Inc(b[p^]); Inc(p); end;
  p:=s; for c:=#1 to #255 do for i:=1 to Min(a[c],b[c]) do begin p^:=c; Inc(p); end; p^:=#0;
  WriteLn('Результат: ',s);
end.

uses Strings;
var
  s1, s2, s: array [0..255] of Char;
  p, q, r: PChar;
begin
  Write('Строка 1: '); ReadLn(s);
  Write('Строка 2: '); ReadLn(s);
  p:=s1; r:=s;
  while p^<>#0 do begin
    q:=StrScan(s2,p^);
    if q<>nil then begin
      q^:=#1; r^:=p^; Inc(r);
    end;
    Inc(p);
  end; r^:=#0;
  WriteLn('Результат: ',s);
end.

var
  s: array [0..255] of Char;
  a: array [#1..#255] of Integer;
  p, r: PChar;
begin
  Write('Строка 1: '); ReadLn(s); p:=s; while p^<>#0 do begin Inc(a[p^]); Inc(p); end;
  Write('Строка 2: '); ReadLn(s);
  p:=s; r:=s;
  while p^<>#0 do begin
    if a[p^]>0 then begin
      Dec(a[p^]); r^:=p^; Inc(r);
    end;
    Inc(p);
  end; r^:=#0;
  WriteLn('Результат: ',s);
end.