1unit Comments; 2interface 3procedure ClearComments(nesting:longbool;__buf:pointer;size:longint); 4implementation 5procedure ClearComments(nesting:longbool;__buf:pointer;size:longint); 6 type 7 tat=array[1..2]of char; 8 pat=^tat; 9 pblock=^tblock; 10 tblock=record 11 next:pblock; 12 _begin,_end:longint; 13 end; 14 type 15 str255=string[255]; 16 var 17 CommLevel:longint; 18 buf:pat absolute __buf; 19 i,j:longint; 20 comm:pblock; 21 function TwoChars(const s):str255; 22 var 23 d:tat absolute s; 24 ii:longint; 25 begin 26 TwoChars:=' '; 27 if succ(i)>=size then 28 TwoChars:='' 29 else 30 begin 31 ii:=2; 32 TwoChars[1]:=d[1]; 33 TwoChars[ii]:=d[ii]; 34 end; 35 end; 36 function FindFrom(position:longint;const Origin:str255):longint; 37 var 38 j,k:longint; 39 begin 40 FindFrom:=size; 41 for j:=position to Size-length(Origin)do 42 begin 43 for k:=1 to length(Origin)do 44 begin 45 if buf^[j+k-1]<>Origin[k]then 46 break 47 else if k=length(Origin)then 48 begin 49 FindFrom:=j; 50 exit; 51 end; 52 end; 53 end; 54 end; 55 procedure BeginComment(i:longint); 56 var 57 c:pBlock; 58 begin 59 new(c); 60 c^.next:=comm; 61 c^._begin:=i; 62 c^._end:=size; 63 comm:=c; 64 CommLevel:=1; 65 end; 66 procedure EndComment(i:longint); 67 begin 68 if comm<>nil then 69 comm^._end:=i; 70 dec(CommLevel); 71 end; 72 procedure DeleteComments; 73 var 74 i:longint; 75 c,cc:pblock; 76 begin 77 c:=comm; 78 while c<>nil do 79 begin 80 for i:=c^._begin to c^._end do 81 buf^[i]:=#32; 82 cc:=c; 83 c:=c^.next; 84 dispose(cc); 85 end; 86 end; 87 begin 88 commLevel:=0; 89 comm:=nil; 90 i:=1; 91 while i<size do 92 begin 93 if commlevel=0 then 94 begin 95 if buf^[i]=''''then 96 i:=FindFrom(succ(i),''''); 97 if TwoChars(buf^[i])='//'then 98 begin 99 BeginComment(i); 100 j:=FindFrom(succ(i),#13); 101 if j=size then 102 j:=FindFrom(succ(i),'#10'); 103 i:=j; 104 EndComment(i); 105 end; 106 if(buf^[i]='{')or(TwoChars(buf^[i])='(*')then 107 BeginComment(i); 108 end 109 else 110 begin 111 if(buf^[i]='{')or(TwoChars(buf^[i])='(*')then 112 begin 113 if nesting then 114 inc(CommLevel); 115 end; 116 if(buf^[i]='}')or(TwoChars(buf^[i])='*)')then 117 EndComment(succ(i)); 118 end; 119 inc(i); 120 end; 121 DeleteComments; 122 end; 123end. 124