[BBBCat]

Код:

function FindCharSet(const Data:string):integer;
const
  CodePages: array[0..10] of string = ('windows-1251','utf-8','utf-16','windows-1252',
  'koi8-r','iso-8859-1','iso-8859-2','iso-8859-3','iso-8859-4','iso-8859-5','iso-8859-15');
  ResArray: array[0..10] of Word = (1251,65001,65001,1252,20866,28591,28592,28593,
  28594,28595,28605);

var APos:integer; CharSet:string;
begin
  Result:=Pos('charset=',Data);   
  APos:=PosEx('>',Data,Result);
  CharSet:=Copy(Data, Result,(APos-Result+1));
  if Result > 0 then
    for Result := Length(CodePages)-1 downto 0 do
      if Pos(CodePages[Result],CharSet) > 0 then
        Break;
  Result := ResArray[Result];
end;

Короче пока не получилось...