function UnicodeToASCII(ansi: AnsiString):string;
var
ws:WideString;
i:Integer;
rs:string;
begin
ws := ansi;
for i:=1 to Length(ws) do
begin
if PByte(Integer(@ws[i])+1)^ = 0 then
rs := rs+ws[i]
else
rs := rs+'&#'+IntToStr(PWord(@ws[i])^)+';';
end;
Result := rs;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo2.Text := UnicodeToASCII(Memo1.Text);
end;