unit uParam; interface uses Classes; Type TParamType = (Literal, Reference, List, Undefined); TParamMult = class private mName: String; mMultiple: NameValueCollection; protected function GetCount: Integer; function GetFirst: String; function GetLast: String; function GetMultiple(index: String): string; procedure SetMultiple(index, value: string); public property Name: String read mName write mName; property Count: Integer read GetCount; property First: String read GetFirst; property Last: String read GetLast; property Self[index: string] read GetMultiple write SetMultiple; end; TParamRecord = class private mValue: String; mPType: TParamType; mMult: TParamMult; public property Value: String read mValue write mValue; property PType: TParamType read mPType write mPType; property Mult: TParamMult read mMult write mMult; end; TParam = class private mParameters: TList; protected procedure SetParameter(index: Integer; parameter: TParamRecord); function GetParameter(index: Integer): TParamRecord; public Constructor Create; overload; Constructor Create(rpcParams: String); overload; procedure Clear; property ParamRecord[index: Integer]: TParam read GetParameter write SetParameter; property Count: Integer read GetCount; end; implementation // Thes classes are ported from Delphi and have hardly been tested. // Use them at your own discression. /// /// Summary description for Param. /// procedure TParam.Clear; var i: Integer; begin for i:=0 to Pred(mParameters.Count) do mParameters[i] := nil; mParameters.Clear; end; procedure TParam.Assign(source: TParam) begin Clear; for i:=0 to Pred(source.Count) do begin Self[i].Value := source[i].Value; Self[i].PType := source[i].PType; Self[i].Mult.Assign(source[i].Mult); end; end; Constructor TParam.Create; begin mParameters := TList.Create; end; /// /// This Param constructor takes a string and splits it into ParamRecords /// /// Constructor TParam.Create(rpcParams: String) var i, curStart, lengthOfRpcParams, EndOfSegment: Integer; aRef, aVal: String; ParamRecord: TParamRecord; begin const // kSEP_FS: char = 28; kSEP_GS: char = 29; kSEP_US: char = 30; kSEP_RS: char = 31; mParameters := TList.Create; if (rpcParams <> nil) then begin curStart := 0; i:= 0; lengthOfrpcParams := Length(rpcParams); while (curStart < lengthOfrpcParams-1) begin paramRecord := Self[i]; case (rpcParams[curStart]) of 'L' : paramRecord.PType := ParamType.Literal; 'R' : paramRecord.PType := ParamType.Reference; 'M' : paramRecord.PType := ParamType.List; else : paramRecord.PType := ParamType.Undefined; end; curStart := CurStart + 2; if (Self[i].PType = ParamType.List) then begin endOfSegment := 0; while (rpcParams[curStart] <> kSEP_GS) do begin endOfSegment := PosNext(kSEP_US,curStart,lengthOfrpcParams,rpcParams); aRef := rpcParams.Substring(curStart,endOfSegment - curStart); curStart := endOfSegment + 1; endOfSegment := PosNext(kSEP_RS,curStart,lengthOfrpcParams,rpcParams); aVal := rpcParams.Substring(curStart,endOfSegment - curStart); curStart := endOfSegment + 1; Self[i].Mult[aRef] := aVal; end; if (endOfSegment = 0) then begin endOfSegment := PosNext(kSEP_GS,curStart,lengthOfrpcParams,rpcParams); curStart := endOfSegment + 1; end else begin endOfSegment := PosNext(kSEP_GS,curStart,lengthOfrpcParams,rpcParams); Self[i].Value := rpcParams.Substring(curStart,endOfSegment-curStart); curStart := endOfSegment + 1; end; Inc(i); end; end else begin // The user of this routine should always pass in a valid string Assert(false); end; end; Destructor TParam.Destroy; begin Clear; mParameters.Free; end; // Private Methods function TParam.GetCount: Integer; begin Result := mParameters.Count; end; function TParam.GetParameter(int index): ParamRecord; begin if (index >= mParameters.Count) then begin while (mParameters.Count <:= index) do // Setup placehoders mParameters.Add(nil); end; if (mParameters[index] = nil) begin Result := TParamRecord.Create(); mParameters[index] := result; end else Result := TParamRecord(mParameters[index]); end; procedure TParam.SetParameter(index: Integer; parameter: ParamRecord); begin if (index >= mParameters.Count) then while (mParameters.Count <= index) do // Set up placeholders mParameters.Add(nil); if (mParameters[index] = nil) then mParameters[index] := parameter; end; function TParam.PosNext(aChar: char; startPos, lengthOfRpcParams: Integer; rpcParams: String): Integer; begin Assert(rpcParams <> nil); Result := 0; while (result = 0) and (startPos < lengthOfRpcParams) do begin if(rpcParams[startPos] = aChar) Result := startPos; Inc(startPos); end; end; Constructor TParamRecord.Create; begin mMult := new ParamMult(); mMult.Name := ParamMult.kMultNameDefault; mValue := nil; mPType := ParamType.Undefined; end; Destructor TParamRecord.Destroy; begin if(mMult <> nil) begin mMult := nil; end; end; // The ParamMult class uses a NameValueCollection dictionary/hashtable as opposted to a string list // like in Delphi. I think I have ported this properly preserving the desired functionality // I think the NameValueCollection is the right answer here, but there may be some // nuances that have been missed. // Also, an enumerator should be created (provide by NameValueCollection) if the // list is to be iterated over a lot between changes (for read only access). This // will provided enhanced performance. const kMultInstanceNameDefault: string := 'Mult_instance'; const kMultNameDefault: string := 'Mult'; // Public Methods Constructor TParamMult.Create; begin mMultiple := TNameValueCollection.Create; mName := ''; end; Destructor TParamMult.Destroy; begin ClearAll; mMultiple.Free; mMultiple := nil; mName := nil; end; function TParamMult.Position(subscript: string): Integer; var i: Integer; begin Result := -1; for i:=0 to Pred(mMultiple.Count) do begin if (mMultiple.GetKey(i) = subscript) begin Result := i; break; end; end; end; function TParamMult.Subscript(position: Integer): String; begin if(position > -1 && position < Count) then result := mMultiple.GetKey(position); end; /// /// In Assign all of the items from source object are copied one by one into the /// target. So if the source is later destroyed, target object will continue /// to hold the copy of all elements, completely unaffected. /// The source can only be a NameValueCollection or else it with throw an exception. /// /// { public void Assign(object source) begin ClearAll(); if (source is ParamMult) mMultiple.Add((NameValueCollection)source); else throw(new ParamMultException('Invalid source type'+ source.GetType()+' in method Assign')); end; } /// /// Order returns the subscript string of the next or previous element from the /// StartSubscript. This is very similar to the $O function available in M. /// nil string ('') is returned when reaching beyong the first or last /// element, or when list is empty. Note: A major difference between the M $O /// and this function is that in this function StartSubscript must identify a valid subscript /// in the list. /// /// /// /// function TParamMult.Order(startSubscript: String; direction: Integer): String; var index: Integer; begin if (startSubscript = '') then begin if(direction > 0) then result := First else result := Last; end else begin index := Position(startSubscript); if(index > -1) then begin if (index < (Count -1)) and (direction > 0) then result := mMultiple[index+1] else result := mMultiple[index-1]; end; end; end; { public class ParamMultException : Exception begin public ParamMultException(string errorString) :base(kParamMultExceptionLabel + errorString)beginend; private const string kParamMultExceptionLabel := 'ParamMult Exeption: '; end; } procedure TParamMult.ClearAll; begin mMultiple.Clear(); end; function TParamMult.GetCount: Integer; begin Result := mMultiple.Count; end; function TParamMult.GetFirst: String; begin Result := ''; if (mMultiple.Count > 0) then Result := mMultiple[0]; end; function TParamMult.GetLast: String; begin Result := ''; if (mMultiple.Count > 0) then Result := mMultiple[mMultiple.Count-1]; end; /// /// GetMultiple Returns the VALUE of the element whose subscript is passed. /// /// /// function TParamMult.GetMultiple(index: String): String; var TryResult: String; StrError: String; begin tryResult := ''; try begin tryResult := mMultiple[index]; end; // The requested string might not be in the string array in which case IndexOf will // return a -1 so lets handle this through an IndexOutOfRangeException // catch (ArgumentOutOfRangeException) except begin if (Name <> '') then StrError :=Name else StrError := kMultInstanceNameDefault; strError +:= StrError + '[' + index + ']'#0D#0A' is undefined'; // There was a complicated way to attempt to find this data on exception // in the Delphi unit trpcb.pas in the broker project under // TMult.GetFMultiple. I did not understand this so I will throw an // exception here. -Travis // throw( new ParamMultException(strError)); end; finally begin result := tryResult; end; end; /// /// SetMultiple Stores a new element in the multiple. mMultiple (StringCollection) is the /// structure, which is used to hold the subscript and value pair. Subscript is stored as /// the String, value is stored as an object of the string. /// /// /// procedure TParamMult.SetMultiple(index, newElement: String): begin mMultiple.Set(index,newElement); end; end.