Показать сообщение отдельно
Старый 24.12.2008, 21:49   #25
abcdef
Знающий
 
Регистрация: 16.09.2008
Сообщений: 299
Написано 71 полезных сообщений
(для 123 пользователей)
Ответ: Сжать текст смс средствами J2me

Phantom_wc - я когда-то делал аналогичный алгоритм, но в MIDletPascal, неохота переписывать на java,.. думаю получилось просто это можно взять за основу, и добавить в алгоритм кодирования обход недопустимых символов..
var
  buf : array[0..4096] of boolean;
  bit : array[0..7] of integer;
  max : integer;
  id_in,id_out,id_dec : integer;
  convCmd : command;


function ansiToUtf(s : string) : string;
var  {rus_ansi to UTF8}
  i,ch : integer;
begin
  for i := 0 to length(s)-1 do
  begin
    ch := ord(getChar(s,i)) and 255;
    if (ch>=192) then  s := setChar(s,chr(ch+848),i);
    if (ch=168)  then  s := setChar(s,chr($0401),i);
    if (ch=184)  then  s := setChar(s,chr($0451),i);
  end;
  ansiToUtf := s;
end;


function utfToAnsi(s : string) : string;
var  {UTF8 to rus_ansi}
  i,ch : integer;
begin
  for i := 0 to length(s)-1 do
  begin
    ch := ord(getChar(s,i));
    if (ch>255) then  s := setChar(s,chr(ch-848),i);
    if (ch=$0401) then  s := setChar(s,chr(168),i);
    if (ch=$0451) then  s := setChar(s,chr(184),i);
  end;
  utfToAnsi := s;
end;


procedure toBits(s : string; maxb : integer);
var
  i,j,b : integer;
begin
  max:=0;
  for i:=0 to 4096 do buf[i]:=false;
  for i:=0 to length(s)-1 do
  begin
    b:=ord(getChar(s,i));
    for j:= maxb{7} downto 0 do
    begin
      if (b and bit[j])<>0 then buf[max]:=true;
      max:=max+1;
    end;
  end;
end;


function fromBits(maxb : integer) : string;
var
  i,j,b : integer;
  s : string;
begin
  i:=0;
  s:='';
  while i<max do
  begin
    b:=0;
    j:=maxb;
    while (i<max) and (j>=0) do
    begin
      if buf[i] then b:=(b or bit[j]);
      i:=i+1;
      j:=j-1;
    end;
    s:=s+chr(b);
  end;
  fromBits:=s;
end;


begin
  bit[0]:=1;
  bit[1]:=2;
  bit[2]:=4;
  bit[3]:=8;
  bit[4]:=16;
  bit[5]:=32;
  bit[6]:=64;
  bit[7]:=128;
  showForm;
  id_in := formAddTextField('IN', 'Привет! это тестовая программка от arT (c). e-mail: [email protected]', 512, TF_ANY);
  convCmd := createCommand('next', CM_OK, 1);
  addCommand(convCmd);
  repeat delay(100); until getClickedCommand=convCmd;
  removeCommand(convCmd);
  //////
  toBits(utfToAnsi(formGetText(id_in)),7);
  id_out := formAddTextField('OUT', fromBits(6), 1024, TF_ANY);
  //////
  toBits(utfToAnsi(formGetText(id_out)),6);
  id_dec := formAddTextField('DECODE', ansiToUtf(fromBits(7)), 512, TF_ANY);
  repeat delay(100); until false;
end.
(Offline)
 
Ответить с цитированием
Сообщение было полезно следующим пользователям:
Phantom (25.12.2008)