Помогите с Pascale

[skilk]

Помогите пожалуйста, надо прогу написать которая бы сжимала текстовой файл методом замены всех повторяющихся знаков (где ссс будет равно с(3) ).

Надо или на TurboPascale или на Delphi.

Заранее благодарен.

[Сергей Плоткин]

function CharCompress(Str:String):String;constChars='qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNMйцукенгшщзхъфывапролджэячсмитьбюЙЦУКЕНГШЩЗХЪФЫВАПРОЛДЖЭЯЧСМИТЬБЮ';var I,I2,Num,P,Count:Integer;begin for i := 1 to Length(Chars) do   begin     While Pos(Chars[i]+Chars[i], Str)>0 do       begin         Num:=Pos(Chars[i]+Chars[i], Str);         Count:=1;         For I2 := Num+1 to Length(Str) do           begin             P:=Length(Str);             If Str[i2]<>Chars[i] then               begin                 P:=I2-1;                 Break;               end else Count:=Count+1;           end;         Delete(Str, Num, P-Num+1);         Insert(Chars[i]+'('+IntToStr(Count)+')', Str, Num);       end;   end; Result:=Str;end;

Держи.

Изменено 2 мая, 2005 пользователем Сергей Плоткин

[skilk]

Спасибо за ответ.

Если не трудно, помогите с такой же программкой только наоборот, то есть с(3) равно ссс.

Изменено 6 мая, 2005 пользователем Сергей Плоткин

[Kuzmich]

Это называется не помогите, а напишите за меня...

[Сергей Плоткин]

Kuzmich:

Да, ладно - меня это даже прикалывает. :)

skilk:

function CharDecompress(Str:String):String;varChars : set of char;Nums : set of char;P1,P2:Integer;I,I2:Integer;NewStr:String;Dobav:Boolean;CharPart:String;ContinueCount:Integer;beginChars:=['q', 'w', 'e', 'r', 't', 'y', 'u', 'i', 'o', 'p','a', 's', 'd', 'f', 'g', 'h', 'j', 'k', 'l', 'z','x', 'c', 'v', 'b', 'n', 'm', 'Q', 'W', 'E', 'R','T', 'Y', 'U', 'I', 'O', 'P', 'A', 'S', 'D', 'F','G', 'H', 'J', 'K', 'L', 'Z', 'X', 'C', 'V', 'B','N', 'M', 'й', 'ц', 'у', 'к', 'е', 'н', 'г', 'ш','щ', 'з', 'х', 'ъ', 'ф', 'ы', 'в', 'а', 'п', 'р','о', 'л', 'д', 'ж', 'э', 'я', 'ч', 'с', 'м', 'и','т', 'ь', 'б', 'ю', 'Й', 'Ц', 'У', 'К', 'Е', 'Н','Г', 'Ш', 'Щ', 'З', 'Х', 'Ъ', 'Ф', 'Ы', 'В', 'А','П', 'Р', 'О', 'Л', 'Д', 'Ж', 'Э', 'Я', 'Ч', 'С','М', 'И', 'Т', 'Ь', 'Б', 'Ю'];Nums := ['0','1','2','3','4','5','6','7','8','9'];ContinueCount:=0;NewStr:='';For I := 1 to Length(Str) do  begin    If ContinueCount>0 then      begin        ContinueCount:=ContinueCount-1;        Continue;      end;    Dobav:=True;    If (Str[i] in Chars) and (I+3<=Length(Str)) and (Str[i+1]='(') then      begin        P1:=0;        P2:=0;        For I2 := I+2 to Length(Str) do          begin            If I2>I+5 then Break;            if (Str[i2] in Nums) AND (P1=0) then              begin                P1:=I2;              end else if Str[i2]=')' then                begin                  if I2=I+2 then                  Break else                    begin                      P2:=I2;                      Break;                    end;                end;          end;        If (P1>0) and (P2>0) then          begin            CharPart:='';            For I2 := 1 to StrToInt(Copy(Str, P1, P2-P1)) do            CharPart:=CharPart+Str[i];            Dobav:=False;            NewStr:=NewStr+CharPart;            ContinueCount:=(P2-P1)+2;          end;        If Dobav=True then        NewStr:=NewStr+Str[i];      end else      begin        NewStr:=NewStr+Str[i];      end;  end;Result:=NewStr;end;

А вообще, рекоммендую на сайте http://www.regexpstudio.com скачать класс TRegExpr, для работы в Delphi с регулярными выражениями. Очень классная и удобная штука, с использованием которой этот код и многие другие работающие с текстом коды можно сократить до пары строк. Действительно, рекоммендую сесть и разобраться.

[skilk]

ВСЕМ СПАСИБО.