Форум: "Прочее";
Текущий архив: 2006.06.04;
Скачать: [xml.tar.bz2];
Вниз
Есть ли функция удаления всех комментариев? Найти похожие ветки
← →
KilkennyCat © (2006-05-08 19:04) [80]Но у меня шустрее всех работать будет.
← →
Palladin © (2006-05-08 19:06) [81]
> Пусик © (08.05.06 19:02) [78]
Поверь, это пока не самая важная задача :) Ну установлю я SetLength(Result,Length(s))
посчитаю сколько я там наназначал резалту, ну обрежу, смысл?
← →
Пусик © (2006-05-08 19:08) [82]
> Palladin © (08.05.06 19:06) [81]
А как насчет постоянных вызовов Copy?
← →
KilkennyCat © (2006-05-08 19:10) [83]
function RemComm(Data : String) : string;
var
l, i : integer;
fsString, fsSlash, fsDir, fsFig, fsScob : boolean;
begin
result := "";
i := 0;
l := length(data);
fsString := false;
fsSlash := false;
fsFig := false;
fsScob := false;
fsDir := false;
repeat
inc(i);
case data[i] of
"""" : begin
if fsString then result := result + data[i];
fsString := not fsString;
end;
"/" : if not fsString then if i < l then if data[i+1] = "/" then fsSlash := true;
"{" : if not fsString then if data[i+1] <> "$" then fsFig := true else fsDir := true;
"}" : if not fsString then begin
if fsDir then result := result + data[i];
fsFig := false;
fsDir := false;
Continue;
end;
"(" : if not fsString then if data[i+1] = "*" then fsScob := true;
")" : if not fsString then if data[i-1] = "*" then begin
fsScob := false;
continue;
end;
else
if ord(data[i]) = 13 then fsslash := false;
end;
if fsString then result := result + data[i] else if not fsSlash and not fsFig and not fsScob then result := result + data[i];
until i = l;
end;
с учетом директив, кроме хитрой.
← →
Marser © (2006-05-08 19:28) [84]Пусик, респект! Красивый код :-)
> [66] KilkennyCat © (08.05.06 17:58)
>
> > это будет нечестно, имхо, ты уже в курсе всех "подводных
>
> > камней"
>
>
> я изначально был в курсе.
> К тому же, я занимался парсингом, это плюс.
> К тому же, мне неизвестны конечные автоматы, это, наверное,
> минус.
Хм... После того как я два года назад познакомился с конечными автоматами, а в прошлом году изучал их в универе, выстраивая автоматы Милли и Мура на триггерах, я себе смутно представляю хороший парсер без их использования.
← →
Palladin © (2006-05-08 19:34) [85]
> Пусик © (08.05.06 19:08) [82]
А что Copy? CompareMem устроит?
← →
TUser © (2006-05-08 19:36) [86]В 16:30 ждете, хе, я только сечас Ваш пост прочитал, так что звиняйте.
← →
ECM © (2006-05-08 19:57) [87]> Есть ли функция удаления всех комментариев?
http://www.zeitungsjunge.de
DIPP is a Pascal Preprocessor. The purpose of DIPP is to manipulate Pascal source code files.
DIPP can
remove comments
process compiler directives and switches
remove compiler conditionals by wild card masks
remove compiler directives by wild card masks
insert, read, or skip include files by wild card masks
extract units" interface sections
Сам пользуюсь - иногда очень полезная весЧь
← →
TUser © (2006-05-08 20:31) [88]
program RemRem.dpr;
{$apptype console}
uses Classes;
{
started at 19:40
finished at 20:32
}
type
TState = (stNone, stFigStarted, stFig, stAstStarted, stAst, stAstEnded, stLineStarted, stLine, stApstr, stString);
var Txt: TStrings;
var Comms: array of
array [0..1] of integer;
procedure Add (B, E: integer);
begin
if B <= 0 then exit;
SetLength (Comms, length (Comms) + 1);
Comms [high(Comms)][0] := B;
Comms [high(Comms)][1] := E;
end;
procedure Preprocess;
var i: integer;
s: TState;
started: integer;
begin
s := stNone; started := -1;
//for i := 1 to length (Txt.Text) do
i:=1;
while i <= length (Txt.Text) do begin
case s of
stNone:
begin
case Txt.Text[i] of
"{":
begin
s:=stFigStarted;
started := i;
end;
"/":
begin
s:=stLineStarted;
started := i;
end;
"(":
begin
s:=stAstStarted;
started := i;
end;
"""": s:=stString;
end;
end;
stFigStarted:
begin
case Txt.Text[i] of
"$":
begin
started := -1;
s := stFig;
end;
"}":
begin
s := stNone;
Add (started, i);
end;
else
s := stFig;
end;
end;
stFig:
begin
case Txt.Text[i] of
"}":
begin
s := stNone;
Add (Started, i);
end;
end;
end;
stAstStarted:
begin
case Txt.Text[i] of
"*":
s := stAst;
else
begin
s := stNone;
dec (i);
end;
end;
end;
stAst:
begin
case Txt.Text[i] of
"*":
s := stAstEnded;
end;
end;
stAstEnded:
begin
case Txt.Text[i] of
")":
begin
s := stNone;
Add (started, i);
end;
else
s := stAst;
end;
end;
stLineStarted:
begin
case Txt.Text[i] of
"/":
s := stLine;
else
begin
s := stNone;
dec (i);
end;
end;
end;
stLine:
begin
case Txt.Text[i] of
#10, #13:
begin
s := stNone;
Add (started, i - 1);
end;
end;
end;
stString:
begin
case Txt.Text[i] of
"""":
s := stApstr;
#10, #13:
s := stNone; // unterminated string;
end;
end;
stApstr:
begin
case Txt.Text[i] of
"""":
s := stString;
else
s := stNone; // possible untstr
end;
end;
end;
inc (i);
end;
end;
procedure Print;
var i, j , k: integer;
begin
i := 0;
for j := 0 to high (Comms) do begin
for k := i + 1 to Comms[j][0] - 1 do
write (Txt.Text[k]);
i := Comms[j][1];
end;
for k := i + 1 to length (Txt.Text) do
write (Txt.Text[k]);
end;
begin
Txt := TStringList.Create;
Txt.LoadFromFile (ParamStr(1));
Preprocess;
Print;
Txt.Free;
end.
← →
TUser © (2006-05-08 20:36) [89]Сразу честно признаюсь, что предыдущие решения и комментарии к ним я не читал, код долбать надо было )
И дабы ненужные подозрения сразу пресечь - приведенный в [88] хронометраж абсолютно правильный, а раньше я не постил не потому, почему некоторые может быть подумали, а потому что приглашения Юрия не видел.
← →
Юрий Зотов © (2006-05-08 20:39) [90]> All
Просто мне как-то довелось писать нечто подобное. Сама задача была, конечно, куда более сложной, но подзадача выделения комментариев была ее составной частью. Тоже сначала подумал, что это - ерунда, раз плюнуть, но когда начал писать, то убедился, что не все уж так совсем просто, как это показалось с первого взгляда. Хотя и несложно, конечно.
Думаю, мы в этом убедились - все же с первого захода никто не привел полностью рабочего варианта. Обязательно что-то или не обрабатывалось, или обрабатывалось как-то не так, или еще какие-то глюки. А ведь программа правит святая святых - сырцы. Здесь цена ошибки может быть ОЧЕНЬ высокой и поэтому она должна работать безукоризненно. Отсюда и выползает время, которое надо на нее потратить.
← →
vertal © (2006-05-08 20:42) [91]Видать мне тоже делать нечего. Сделал такой вариант за 50 минут (Кроме функции GetFileText - это из старого кода):
program COmmentCutter;
{$APPTYPE CONSOLE}
{$O-}
uses
SysUtils;
type
TLexemType = (ltMainContent, ltString, ltDirective, ltComment, ltSingleLineComment);
function CutAllComments(const s: string): string;
var
CurPos, CurLength: Integer;
CurLexemType: TLexemType;
procedure DoComment(const CommentStart, CommentEnd: string);
var
EndOfComment: PChar;
begin
EndOfComment := StrPos(@s[CurPos + Length(CommentStart)], PChar(CommentEnd));
if EndOfComment = nil then
raise Exception.CreateFmt("Unterminated comment at pos %u:"#13#10"%s", [CurPos, Copy(s, CurPos, 100)]);
if (CurLexemType = ltComment) and (s[CurPos + Length(CommentStart)] = "$") then
CurLexemType := ltDirective;
if (CurLexemType = ltSingleLineComment) then
Dec(EndOfComment, Length(CommentEnd));
CurLength := (EndOfComment - PChar(s) + 1) - CurPos + Length(CommentEnd);
end;
function GetNextLexem: Boolean;
begin
Inc(CurPos, CurLength);
if Length(s) < CurPos then
begin
Result := False;
Exit;
end;
Result := True;
case s[CurPos] of
"{":
begin
CurLexemType := ltComment;
DoComment("{", "}");
Exit;
end;
"""":
begin
CurLexemType := ltString;
DoComment("""", """");
Exit;
end;
"(":
begin
if (Length(s) >= CurPos + 1) and (s[CurPos + 1] = "*") then
begin
CurLexemType := ltComment;
DoComment("(*", "*)");
Exit;
end;
end;
"/":
begin
if (Length(s) >= CurPos + 1) and (s[CurPos + 1] = "/") then
begin
CurLexemType := ltSingleLineComment;
DoComment("//", #13#10);
Exit;
end;
end;
end;//case s[CurPos]
CurLength := 1;
CurLexemType := ltMainContent;
end;
procedure WriteCurLexem;
begin
Result := Result + Copy(s, CurPos, CurLength);
end;
begin
Result := "";
CurPos := 1;
CurLength := 0;
while GetNextLexem do
if not (CurLexemType in [ltComment, ltSIngleLineComment]) then
WriteCurLexem;
end;
function GetFileText(const FileName: string): string;
var
f: file;
LastMode: Integer;
begin
LastMode := FileMode;
FileMode := fmOpenRead;
try
assign(f, FileName);
reset(f, 1);
try
SetLength(Result, FileSize(f));
BlockRead(f, PChar(Result)^, Length(Result));
finally
close(f);
end;
finally
FileMode := LastMode;
end;
end;
procedure WriteUsageInfoAndExit;
begin
writeln("This program cuts all comments from Delphi source file");
writeln("Usage: ThisProgram.exe SrcFle > DestFile");
Halt;
end;
begin
if ParamCount <> 1 then
WriteUsageInfoAndExit;
writeln(CutAllComments(GetFileText(ParamStr(1))));
end.
← →
TUser © (2006-05-08 20:42) [92]> все же с первого захода никто не привел полностью рабочего варианта.
Как насчет [88]?
← →
Юрий Зотов © (2006-05-08 20:49) [93]> TUser © (08.05.06 20:42) [92]
Удаляет директивы компилятора вида (*$директива*).
← →
TUser © (2006-05-08 20:58) [94]Не знал, что такие бывают. Высылаю пиво :(
http://monkey.belozersky.msu.ru/~evgeniy/remrem.dpr
← →
jack128 © (2006-05-08 21:45) [95]
procedure RemoveComments(var S: string);
var
CharIndex: Integer;
procedure RemoveFromCurrent(const LimitStr: string);
var
Temp: Integer;
begin
Temp := PosEx(LimitStr, S, CharIndex);
if Temp <= 0 then Exit;
S := Copy(S, 1, CharIndex - 1) + Copy(S, Temp + Length(LimitStr), MaxInt);
end;
procedure SkipLiteralString;
begin
Inc(CharIndex);
while CharIndex <= Length(S) do
begin
if S[CharIndex] = """" then
begin
Inc(CharIndex);
if S[CharIndex + 1] <> """" then
Exit;
end;
Inc(CharIndex);
end;
end;
begin
CharIndex := 1;
while CharIndex <= Length(S) - 1 do
begin
case S[CharIndex] of
"/":
if S[CharIndex + 1] = "/" then
RemoveFromCurrent(#13#10)
else
Inc(CharIndex);
"(":
if (S[CharIndex + 1] = "*") and (S[CharIndex + 2] <> "$")then
RemoveFromCurrent("*)")
else
Inc(CharIndex);
"{":
if S[CharIndex + 1] <> "$" then
RemoveFromCurrent("}")
else
Inc(CharIndex);
"""":
SkipLiteralString;
else
Inc(CharIndex);
end;
end;
end;
Криво и тормознуто, конечно, но вроде работает.. За 1 час написано..
← →
programania © (2006-05-08 23:24) [96]в php удаление коментариев полезнее
ведь они при каждом выполнении читаются
хотя и бесполезны ведь на сервере их никто не видит
поэтому сделал для php а может даже и для C и javы
и заодно лишние пробелы удаляются
{$B-}
procedure RemoveComments(var S: string);
var
r: string;
k,k1,k2,kk,p2: boolean;
i: integer;
c: char;
begin
r:="";
k:=false; k1:=false; k2:=false; kk:=false;
for i:=1 to length(s) do begin
c:=s[i];
if not k and not kk and (i>1) then begin
if (c=""") and k2 and not k1 and ((s[i-1])<>"\") then k2:=false else
if (c=""") and not k2 and not k1 then k2:=true;
if (c="""") and k1 and not k2 and ((s[i-1])<>"\") then k1:=false else
if (c="""") and not k1 and not k2 then k1:=true;
end;
if not k1 and not k2 and (i<length(s)) then begin
if (c="/") and (s[i+1]="/") and not kk and not k then k:=true;
if (c="/") and (s[i+1]="*") and not k and not k then kk:=true;
if (i>2) and (s[i-2]="*") and (s[i-1]="/") and kk and not k then kk:=false;
if c<" " then k:=false;
end;
p2:=(c=" ") and (i>1) and (s[i-1]<=" ") and not k2 and not k1;
if not k and not kk and not p2 then r:=r+s[i];
end;
s:=r;
end;
← →
Игорь Шевченко © (2006-05-08 23:37) [97]А lex незаслуженно забыт ? :)
← →
Пусик © (2006-05-09 00:11) [98]
> Вовчик (08.05.06 17:07) [39]
>
> рад приветствовать еще одну женщину-программистку
Спасибо, конечно. А ты себя к мужчинам-программистам причисляешь?
Ссылочку на твои вопросы/ответы дашь? Чтобы заценить?
← →
Джо © (2006-05-09 00:37) [99]> [98] Пусик © (09.05.06 00:11)
> Ссылочку на твои вопросы/ответы дашь? Чтобы заценить?
Пока у Вовчика один вопрос: "Фотку вышлешь?", да и тот остается без ответа :)
← →
Пусик © (2006-05-09 00:43) [100]
> Джо © (09.05.06 00:37) [99]
Ну фотку можно. Но только за приличный код;)
← →
Gero © (2006-05-09 00:44) [101]> [100] Пусик © (09.05.06 00:43)
5 баллов!
← →
sniknik © (2006-05-09 01:04) [102]приличный код, только за неприличную фотку! ;)
← →
Джо © (2006-05-09 01:10) [103]> [102] sniknik © (09.05.06 01:04)
> приличный код, только за неприличную фотку! ;)
Тут уже на 5+ тянет :)
← →
Левчик (2006-05-09 09:23) [104]Удалено модератором
← →
Левчик (2006-05-09 09:29) [105]Удалено модератором
Примечание: п. 5.
← →
Вовчик (2006-05-09 09:35) [106]Удалено модератором
Примечание: п. 5.
← →
TUser © (2006-05-09 09:50) [107]> А lex незаслуженно забыт ? :)
Надо чтобы он был под рукой, а также уметь им пользоваться. А когда секундомер тикает учиться как-то не хочется - кнопки жать надо. А так конечно, lexx, yacc, GOLD и кто там еще полезны были бы.
> дициметрах?
Как такое отношение может измеряться в дециметрах?
← →
programania © (2006-05-09 12:18) [108]
procedure RemoveComments(var S: string);
const
q=4;
z: array[1..q,1..5] of string=(
( "//", #0, #13#10, "", #13#10 ),
( "{", "{$", "}", "", " " ),
( "(*", "(*$", "*)", "", "" ),
( """", #0, """", "1", """" ));
var
r: string;
i,j,n: integer;
begin
r:="";
i:=1;
s:=s+" ";
while i<=length(s) do begin
n:=i;
for j:=1 to q do
if (s[i]=z[j,1][1]) and (copy(s,i,length(z[j,1]))= z[j,1])
and (copy(s,i,length(z[j,2]))<>z[j,2])
then begin
while (i<=length(s)) and
((copy(s,i,length(z[j,3]))<> z[j,3]) or (i=n)) do
begin
if z[j,4]<>"" then r:=r+s[i];
inc(i);
end;
r:=r+z[j,5];
inc(i,length(z[j,3])-1);
break;
end;
if n=i then r:=r+s[i];
inc(i);
end;
s:=copy(r,1,length(r)-3);
end;
Эта же процедура может работать для html php java
а может и для всех языков и для lex тоже
если заменить константы
q=3; //html
z: array[1..q,1..5] of string=(
( "<!--", #0, "-->", "", "" ),
( """", #0, """", "1", """" ),
( """, #0, """, "1", """ ));
q=4; //php java
z: array[1..q,1..5] of string=(
( "//", #0, #13#10, "", #13#10 ),
( "/*", #0, "*/", "", "" ),
( """", #0, """", "1", """" ),
( """, #0, """, "1", """ ));
Предлагю проверить еще случай
begin i:=1{коментарий}end;
У меня оставляет пробел.
И есть более тяжелый случай когда после правильного удаления
коментариев программа не компилируется
потому что delphi удаляет методы form если в них ничего нет
а их присвоение не удаляет
← →
TUser © (2006-05-09 13:54) [109]
> И есть более тяжелый случай когда после правильного удаления
> коментариев программа не компилируется
> потому что delphi удаляет методы form если в них ничего
> нет а их присвоение не удаляет
Все он удаляет что надо. И в IDE, и в консоли компилируется.
← →
Alx2 © (2006-05-09 14:02) [110]>TUser © (09.05.06 13:54) [109]
Я сейчас не проверял сам.
что если в тексте программы где-то имеет место присваивание
SomeObject.OnCick := SomeMethod;
А потом SomeMethod "исчезнет" вышеописанным способом?
← →
Gero © (2006-05-09 14:03) [111]> TUser © (09.05.06 13:54)
Иммется ввиду следующее:
procedure TForm1.Button1Click(Sender: TObject);
begin
//
end;
Button1.OnClick := Button1Click;
Скомпилируется ли программа после удаления всех комментариев?
← →
TUser © (2006-05-09 14:20) [112]> Скомпилируется ли программа после удаления всех комментариев?
Да, на таком примере и проверял. dcc32 Project1.exe - нормально компилируется! Только IDE вольничает, но то ж для "удобства".
Зы. Именно поэтому тут кто-то рекомендовал не вставлять пустого комментария, а писать например {Do nothing}.
← →
Gero © (2006-05-09 14:23) [113]> Зы. Именно поэтому тут кто-то рекомендовал не вставлять
> пустого комментария, а писать например {Do nothing}.
В данном случае разницы-то нет, удаляются все комментарии.
← →
TUser © (2006-05-09 14:26) [114]Это да, только редко ставится задача удалить все комментарии. Чаще ставится обратная задача - написать их :(
{$warnings off}
{$Do nothing :}
{$warnings on}
← →
Alx2 © (2006-05-09 14:41) [115]>Это да, только редко ставится задача удалить все комментарии
Здесь как раз тот редкий случай. :)
Страницы: 1 2 3 вся ветка
Форум: "Прочее";
Текущий архив: 2006.06.04;
Скачать: [xml.tar.bz2];
Память: 0.7 MB
Время: 0.046 c
