program Project1;
Uses SysUtils, Classes, StrUtils;
Type
TrimSpaces=(enmLeft, enmRight, enmBoth);
Var
Source1:String='strict protected procedure Erase (const AConfigName : string ; var f: file ;AValue :Integer = 0 ) ; cdecl; overload ;';
Source2:String='protected procedure TLazLoggerLogGroupList.Remove ( const AConfigName : string ) ; virtual;';
Source3:String='Function SomeFunc : String; Overload ; ';
Source4:String='Operator := ( ALeft:String; ARight : String ) : TSomeThing ; Overload ;';
Source5:String='Procedure DoSomething ; Overload ; cdecl;';
Source6:String='Strict Private Property SomeProperty[i : integer ] : TSomeType Read FSomeProp Write FSomeProp ; default ; ';
Source7:String='Public Property SomeProp2 [x : String ] : TSomeOtherType ; default; ';
Source8:String='Published Property SomeProp3 ; ';
Source9:String='generic procedure printTArr <T , Y , Z> ( sarr: array of T ) ;';
Source10:String='generic Function GenFunc <X , T > ( GenArr: array of T ) : T ;';
Source11:String='generic Function GenFunc <T > : T ;';
Source12:String='generic procedure printTArr <T > ;';
MyChar:String='';
MyParam:String='';
MyGenericList:String='';
MyResult:String='';
MyClass:String='';
MyMethod:String='';
MyParamArray:TStringArray;
MyGenericArray:TStringArray;
MyLeadModifiers:TStringArray;
MyTrailModifiers:TStringArray;
i:Integer;
Const
Colon=':';
Semicolon=';';
CloseParanthesis=')';
OpenParanthesis='(';
CloseIndex=']';
OpenIndex='[';
CloseGeneric='>';
OpenGeneric='<';
ReadS=' read ';
WriteS=' write ';
Comma=',';
Equal='=';
Dot='.';
Blank=' ';
Function CleanUp2(Const ASource:String;Const OldValue:TStringArray;Const ATrimType:TrimSpaces):String;
Var
i:Integer;
a:String;
s:String;
Function InternalReplace:String;
Begin
Result:=s.Replace(a,OldValue[i],[rfReplaceAll]);
end;
Begin
s:=ASource;
i:=Low(OldValue);
Repeat
Case ATrimType Of
enmLeft: Begin
a:=Blank+OldValue[i];
s:=InternalReplace;
end;
enmRight: Begin
a:=OldValue[i]+Blank;
s:=InternalReplace;
end;
enmBoth: Begin
a:=Blank+OldValue[i];
s:=InternalReplace;
a:=OldValue[i]+Blank;
s:=InternalReplace;
end;
End;
Inc(i);
Until i>High(OldValue);
Result:=s;
End;
Function Min(AValue:Array Of Integer):Integer;
Var
i:Integer;
Begin
Result:=High(Integer);
If Low(AValue)=High(AValue) Then Exit(AValue[0]); //Error. Only one Element. Return Value
For i:=Low(AValue) To High(AValue) Do
If (AValue[i]>0) And (AValue[i]<Result) Then
Result:=AValue[i];
end;
Function GetFuncHeaderParamsR(Var ASource:String;
Var AParamArray:TStringArray;
Var AParamList:String;
Var AGenericList:String;
Var AGenericArray:TStringArray;
Var AResultType:String;
Var AClassName:String;
Var AMethod:String;
Var ALeadModifiers:TStringArray;
Var ATrailModifiers:TStringArray):String;
Var
i:Integer;
l:Integer; //For Length of ASource
sc:Integer; //For Semicolon
sc1:Integer; //Save-Variable for old position of Semicolon
co:Integer; //For Colon
cp:Integer; //For closing Paranthesis
op:Integer; //For opening Paranthesis
oi:Integer; //For opening Index
ci:Integer; //For closing Index
r:Integer; //For read modifier
w:Integer; //For write modifier.
og:Integer; //For open generic
cg:Integer; //For close generic
dt:Integer; //For Dot
bl:Integer; //For Blank
bl1:Integer; //Save-Variable for old position of Blank
//temp. Variables
t:Integer;
t1:String;
t2:String;
cc:String;
oo:String;
pc:Integer;
po:Integer;
Function InternalGetResultType:String;
Begin
t1:=Copy(ASource,co,l-co+1);
t1:=CleanUp2(t1,[Colon,SemiColon],enmBoth);
t2:=Copy(ASource,1,co-1);
AResultType:=Copy(t1,2,Pos(SemiColon,t1)-2);
Result:=t2+t1;
End;
Begin
//Remove leading/trailing Whitespace and remove duplicate spaces
ASource:=DelSpace1(Trim(ASource));
//We're starting from the right looking for ';', ':' and ')'
//----------------------------------------------------------
//Should return Length(ASource) --> Sanity-Check
l:=Length(ASource);
sc:=RPosEx(Semicolon,ASource,l);
If sc<l Then Exit(''); //ERROR! Missing last ';'
co:=RPosEx(Colon,ASource,l);
//If cp=0 then no Parameter-List. op MUST also be 0.
//If cp>0 then op MUST also be >0.
//In case of cp>0 And op>0, co>cp MUST represent Function-Result (Colon right of closing Paranthesis)
//otherwise colon is inside Parameter-List, and it's a Procedure (No Result)
//If ci=0 Then no Index. oi MUST also be 0
//If ci>0 then oi MUST also be >0.
//In case of ci>0 and oi>0 it's a Property. cp and op MUST be 0. co>ci MUST represent the Type
//otherwise the colon is inside the Index, and we have an Error
//For Properties there must be 1 colon for the Type, and Optional a second colon if there is an Index
//If cg=0 then not a Generic. og MUST be 0
//If cg>0, og MUST also be >0
op:=RPosEx(OpenParanthesis,ASource,l);
cp:=RPosEx(CloseParanthesis,ASource,l);
oi:=RPosEx(OpenIndex,ASource,l);
ci:=RPosEx(CloseIndex,ASource,l);
og:=RPosEx(OpenGeneric,ASource,l);
cg:=RPosEx(CloseGeneric,ASource,l);
If (cp=0) And (op>0) Then Exit(''); //ERROR
If (cp>0) And (op=0) Then Exit(''); //ERROR
If (ci=0) And (oi>0) Then Exit(''); //ERROR
If (ci>0) And (oi=0) Then Exit(''); //ERROR
If (og>0) And (cg=0) Then Exit(''); //ERROR
If (og=0) And (cg>0) Then Exit(''); //ERROR
//we're looking for the left most semicolon
Repeat
sc1:=sc; //Save the prior position of semicolon
sc:=RPosEx(Semicolon,ASource,sc-1);
until (sc<=cp) Or (sc<=co) Or (sc<=ci) Or (sc<=cg); //If no Parameter-List, no Generic-List Or Index and no Result, sc can return 0
//------------------------------------------------------------
//We've reached either a colon, a closing Paranthesis, a closing Index, a closing Generic or the beginning of the line.
//sc1 represents the last position of Semicolon. Everything right of it are trailing modifiers
//Getting trailing modifiers. "cdecl", "Overload", "Virtual", "default" etc.
If sc1<l then
Begin
t1:=Copy(ASource,sc1,l-sc1+1);
t1:=CleanUp2(t1,[SemiColon],enmBoth);
t2:=Copy(ASource,1,sc1-1);
ASource:=t2+t1;
ATrailModifiers:=t1.Split([SemiColon],TStringSplitOptions.ExcludeEmpty);
l:=Length(ASource);
End;
//End of getting trailing modifiers
//------------------------------------------------------------
//Getting Result-Type
//The following If-Conditions are mutually exclusive
//It's a function with Parameter-List, Generic-List or an operator
If co>0 Then
//We have a Parameter-List, or Generic-List without Parameter
If ((cp>0) And (co>cp)) xor ((cg>0) And (co>cg) And (cp=0)) Then
Begin
ASource:=InternalGetResultType;
l:=Length(ASource);
end
//It's a Property with an Index. Checking for "Read"/"Write"-Modifiers
Else If (ci>0) And (co>ci) Then
Begin
t1:=Copy(ASource,co,l-co);
t1:=CleanUp2(t1,[SemiColon,Colon],enmBoth);
t2:=Copy(ASource,1,co-1);
ASource:=T2+t1;
l:=Length(ASource);
sc:=RPosEx(SemiColon,ASource,sc1);
If (sc>0) And (sc<=sc1) Then sc1:=sc;
r:=RPosEx(LowerCase(ReadS),LowerCase(ASource),l);
w:=RPosEx(LowerCase(WriteS),LowerCase(ASource),l);
t:=Min([r,w]); //Which is the most left?
If t>0 Then //t=0 indicates no "read" and "write" modifier
AResultType:=Copy(ASource,co+1,t-co-1)
Else
AResultType:=Copy(ASource,co+1,sc1-co-1);
End
//It's a function without Parameter-List and without Generics.
//Can't be an Operator
//It's a Property without Index
//There can't be any more colons
Else If (cp=0) And (ci=0) And (cg=0) Then
Begin
ASource:=CleanUp2(InternalGetResultType,[Colon],enmBoth);
l:=Length(ASource);
end;
//End of Getting Result-Type
//------------------------------------------------------------
//Getting Parameter-List. It doesn't matter if Operator, Procedure or Function
//If it's an Index of a Property, we're using [] instead of ()
If (cp>0) Or (ci>0) Then //It has Index or Parameter-List
Begin
If cp>0 Then
Begin
cc:=CloseParanthesis;
oo:=OpenParanthesis;
pc:=cp;
po:=op;
end
Else If ci>0 Then
Begin
cc:=CloseIndex;
oo:=OpenIndex;
pc:=ci;
po:=oi;
End;
t1:=Copy(ASource,pc,l-pc+1);
t1:=CleanUp2(t1,[cc,Colon,SemiColon],enmBoth);
t2:=Copy(ASource,1,pc-1);
ASource:=t2+t1;
l:=Length(ASource);
t1:=Copy(ASource,po,l-po+1);
t1:=CleanUp2(t1,[oo,cc,Colon,SemiColon,Equal],enmBoth);
t2:=Copy(ASource,1,po-1);
AParamList:=Copy(t1,2,Pos(cc,t1)-2);
AParamArray:=AParamList.Split([SemiColon],TStringSplitOptions.ExcludeEmpty);
ASource:=CleanUp2(t2+t1,[cc,oo],enmBoth);
l:=Length(ASource);
end;
//If it's a Generic, we have to check if it's with or without Parameter-list following
If cg>0 Then //We have Generics
Begin
t1:=Copy(ASource,cg,l-cg+1);
t1:=CleanUp2(t1,[CloseGeneric,Colon,Semicolon,OpenParanthesis],enmBoth); //Closing Generic is followed optionally by opening Paranthesis
t2:=Copy(ASource,1,cg-1);
ASource:=t2+t1;
l:=Length(ASource);
t1:=Copy(ASource,og,l-og+1);
t1:=CleanUp2(t1,[OpenGeneric,CloseGeneric,Colon,Semicolon,Comma],enmBoth);
t2:=Copy(ASource,1,og-1);
AGenericList:=Copy(t1,2,Pos(CloseGeneric,t1)-2);
AGenericArray:=AGenericList.Split([Comma],TStringSplitOptions.ExcludeEmpty);
ASource:=CleanUp2(t2+t1,[OpenGeneric,CloseGeneric],enmBoth);
l:=Length(ASource);
end;
//End of Getting Parameter-List
//------------------------------------------------------------
//It's a Procedure without Parameter-List or a Published Property
//Semicolon is the only legal Delimiter here
//There can't be anymore semicolons left of sc1
//Just cleaning up
If (co=0) And (cp=0) And (ci=0) Then
ASource:=CleanUp2(ASource,[SemiColon],enmBoth);
//------------------------------------------------------------
//Getting Method-Name
l:=Length(ASource);
sc:=RPosEx(SemiColon,ASource,sc1);
sc1:=sc;
cp:=RPosEx(CloseParanthesis,ASource,cp);
op:=RPosEx(OpenParanthesis,ASource,op);
ci:=RPosEx(CloseIndex,ASource,ci);
oi:=RPosEx(OpenIndex,ASource,oi);
co:=RPosEx(Colon,ASource,co);
og:=RPosEx(OpenGeneric,ASource,og);
cg:=RPosEx(CloseGeneric,ASource,cg);
//get the most left Position of either colon, open Paranthesis, open Index or Semicolon
t:=Min([sc1,op,oi,co,og]);
If (t=0) Or (t>l) Then Exit('Ooops. Something went wrong'); //ERROR. There is something wrong
//Checking for a dot '.' if Method is part of a Class, Record, Object
//There can only be one Dot
dt:=RPosEx(Dot,ASource,t);
bl:=RPosEx(Blank,ASource,t);
If bl=0 Then Exit(''); //ERROR. "Procedure" etc. Missing
//THE NAME OF THE METHOD
If (dt>0) And (bl>0) And (bl<dt) Then //It's part of a class, record, object
Begin
Result:=Copy(ASource,dt+1,t-dt-1);
AClassName:=Copy(ASource,bl+1,dt-bl-1);
end
Else If (bl>0) And (dt=0) Then
Result:=Copy(ASource,bl+1,t-bl-1);
//End of Getting Method-Name
//------------------------------------------------------------
//Getting the Method. "Procedure", "Function" etc.
If bl>0 Then bl1:=bl; //Save the last Position of blank
//Check for next blank to the left
bl:=RPosEx(Blank,ASource,bl-1);
//Get Method
AMethod:=Copy(ASource,bl+1,bl1-bl-1);
//End of getting Method
//------------------------------------------------------------
//Getting leading modifiers
//If bl is >0 here then we have leading modifiers
If bl>0 Then
Begin
t1:=Copy(ASource,1,bl-1);
ALeadModifiers:=t1.Split([Blank],TStringSplitOptions.ExcludeEmpty);
End;
//End of getting leading modifiers
End;
begin
MyChar:=GetFuncHeaderParamsR(Source12,MyParamArray,MyParam,MyGenericList,MyGenericArray,MyResult,MyClass,MyMethod,MyLeadModifiers,MyTrailModifiers);
Writeln('Function-Name: ',MyChar);
Writeln('Generic-List: ',MyGenericList);
If Length(MyGenericArray)>0 Then For i:=low(MyGenericArray) to High(MyGenericArray) Do Writeln('Generic ',i,': ',MyGenericArray[i]);
Writeln('Parameter-List: ',MyParam);
If Length(MyParamArray)>0 Then For i:=low(MyParamArray) to High(MyParamArray) Do Writeln('Parameter ',i,': ',MyParamArray[i]);
Writeln('Resulttype: ',MyResult);
Writeln('Classname: ',MyClass);
Writeln('Method is a: ',MyMethod);
If Length(MyLeadModifiers)>0 Then For i:=Low(MyLeadModifiers) To High(MyLeadModifiers) Do Writeln('Lead Modifier ',i,': ',MyLeadModifiers[i]);
If Length(MyTrailModifiers)>0 Then For i:=Low(MyTrailModifiers) To High(MyTrailModifiers) Do Writeln('Trail Modifier ',i,': ',MyTrailModifiers[i]);
end.
Recent
