source: cprs/branches/GUI-config/BDK32/SharedBrokerDebugger/uParam.pas@ 568

Last change on this file since 568 was 476, checked in by Kevin Toppenberg, 16 years ago

New WorldVistA Config Utility

File size: 11.1 KB
Line 
1unit uParam;
2
3interface
4
5uses
6 Classes;
7
8Type
9 TParamType = (Literal, Reference, List, Undefined);
10
11 TParamMult = class
12 private
13 mName: String;
14 mMultiple: NameValueCollection;
15 protected
16 function GetCount: Integer;
17 function GetFirst: String;
18 function GetLast: String;
19 function GetMultiple(index: String): string;
20 procedure SetMultiple(index, value: string);
21 public
22 property Name: String read mName write mName;
23 property Count: Integer read GetCount;
24 property First: String read GetFirst;
25 property Last: String read GetLast;
26 property Self[index: string] read GetMultiple write SetMultiple;
27 end;
28
29 TParamRecord = class
30 private
31 mValue: String;
32 mPType: TParamType;
33 mMult: TParamMult;
34 public
35 property Value: String read mValue write mValue;
36 property PType: TParamType read mPType write mPType;
37 property Mult: TParamMult read mMult write mMult;
38 end;
39
40 TParam = class
41 private
42 mParameters: TList;
43 protected
44 procedure SetParameter(index: Integer; parameter: TParamRecord);
45 function GetParameter(index: Integer): TParamRecord;
46 public
47 Constructor Create; overload;
48 Constructor Create(rpcParams: String); overload;
49 procedure Clear;
50 property ParamRecord[index: Integer]: TParam read GetParameter write SetParameter;
51 property Count: Integer read GetCount;
52 end;
53
54
55implementation
56
57 // Thes classes are ported from Delphi and have hardly been tested.
58 // Use them at your own discression.
59
60 /// <summary>
61 /// Summary description for Param.
62 /// </summary>
63procedure TParam.Clear;
64var
65 i: Integer;
66begin
67 for i:=0 to Pred(mParameters.Count) do
68 mParameters[i] := nil;
69
70 mParameters.Clear;
71end;
72
73procedure TParam.Assign(source: TParam)
74begin
75 Clear;
76 for i:=0 to Pred(source.Count) do
77 begin
78 Self[i].Value := source[i].Value;
79 Self[i].PType := source[i].PType;
80 Self[i].Mult.Assign(source[i].Mult);
81 end;
82end;
83
84
85Constructor TParam.Create;
86begin
87 mParameters := TList.Create;
88end;
89
90 /// <summary>
91 /// This Param constructor takes a string and splits it into ParamRecords
92 /// </summary>
93 /// <param name:='rpcParams'></param>
94Constructor TParam.Create(rpcParams: String)
95var
96 i, curStart, lengthOfRpcParams, EndOfSegment: Integer;
97 aRef, aVal: String;
98 ParamRecord: TParamRecord;
99begin
100
101const
102 // kSEP_FS: char = 28;
103 kSEP_GS: char = 29;
104 kSEP_US: char = 30;
105 kSEP_RS: char = 31;
106
107 mParameters := TList.Create;
108 if (rpcParams <> nil) then
109 begin
110 curStart := 0;
111 i:= 0;
112 lengthOfrpcParams := Length(rpcParams);
113 while (curStart < lengthOfrpcParams-1)
114 begin
115 paramRecord := Self[i];
116 case (rpcParams[curStart]) of
117 'L' : paramRecord.PType := ParamType.Literal;
118 'R' : paramRecord.PType := ParamType.Reference;
119 'M' : paramRecord.PType := ParamType.List;
120 else : paramRecord.PType := ParamType.Undefined;
121 end;
122 curStart := CurStart + 2;
123 if (Self[i].PType = ParamType.List) then
124 begin
125 endOfSegment := 0;
126 while (rpcParams[curStart] <> kSEP_GS) do
127 begin
128 endOfSegment := PosNext(kSEP_US,curStart,lengthOfrpcParams,rpcParams);
129 aRef := rpcParams.Substring(curStart,endOfSegment - curStart);
130 curStart := endOfSegment + 1;
131 endOfSegment := PosNext(kSEP_RS,curStart,lengthOfrpcParams,rpcParams);
132 aVal := rpcParams.Substring(curStart,endOfSegment - curStart);
133 curStart := endOfSegment + 1;
134 Self[i].Mult[aRef] := aVal;
135 end;
136 if (endOfSegment = 0) then
137 begin
138 endOfSegment := PosNext(kSEP_GS,curStart,lengthOfrpcParams,rpcParams);
139 curStart := endOfSegment + 1;
140 end
141 else
142 begin
143 endOfSegment := PosNext(kSEP_GS,curStart,lengthOfrpcParams,rpcParams);
144 Self[i].Value := rpcParams.Substring(curStart,endOfSegment-curStart);
145 curStart := endOfSegment + 1;
146 end;
147 Inc(i);
148 end;
149 end
150 else
151 begin
152 // The user of this routine should always pass in a valid string
153 Assert(false);
154 end;
155end;
156
157Destructor TParam.Destroy;
158begin
159 Clear;
160 mParameters.Free;
161end;
162
163 // Private Methods
164function TParam.GetCount: Integer;
165begin
166 Result := mParameters.Count;
167end;
168
169function TParam.GetParameter(int index): ParamRecord;
170begin
171 if (index >= mParameters.Count) then
172 begin
173 while (mParameters.Count <:= index) do // Setup placehoders
174 mParameters.Add(nil);
175 end;
176 if (mParameters[index] = nil)
177 begin
178 Result := TParamRecord.Create();
179 mParameters[index] := result;
180 end
181 else
182 Result := TParamRecord(mParameters[index]);
183end;
184
185procedure TParam.SetParameter(index: Integer; parameter: ParamRecord);
186begin
187 if (index >= mParameters.Count) then
188 while (mParameters.Count <= index) do // Set up placeholders
189 mParameters.Add(nil);
190
191 if (mParameters[index] = nil) then
192 mParameters[index] := parameter;
193end;
194
195function TParam.PosNext(aChar: char; startPos, lengthOfRpcParams: Integer; rpcParams: String): Integer;
196begin
197 Assert(rpcParams <> nil);
198
199 Result := 0;
200 while (result = 0) and (startPos < lengthOfRpcParams) do
201 begin
202 if(rpcParams[startPos] = aChar)
203 Result := startPos;
204 Inc(startPos);
205 end;
206end;
207
208
209Constructor TParamRecord.Create;
210begin
211 mMult := new ParamMult();
212 mMult.Name := ParamMult.kMultNameDefault;
213 mValue := nil;
214 mPType := ParamType.Undefined;
215end;
216
217Destructor TParamRecord.Destroy;
218begin
219 if(mMult <> nil)
220 begin
221 mMult := nil;
222 end;
223 end;
224
225 // The ParamMult class uses a NameValueCollection dictionary/hashtable as opposted to a string list
226 // like in Delphi. I think I have ported this properly preserving the desired functionality
227 // I think the NameValueCollection is the right answer here, but there may be some
228 // nuances that have been missed.
229 // Also, an enumerator should be created (provide by NameValueCollection) if the
230 // list is to be iterated over a lot between changes (for read only access). This
231 // will provided enhanced performance.
232const kMultInstanceNameDefault: string := 'Mult_instance';
233const kMultNameDefault: string := 'Mult';
234
235 // Public Methods
236Constructor TParamMult.Create;
237begin
238 mMultiple := TNameValueCollection.Create;
239 mName := '';
240end;
241
242
243Destructor TParamMult.Destroy;
244begin
245 ClearAll;
246 mMultiple.Free;
247 mMultiple := nil;
248 mName := nil;
249end;
250
251function TParamMult.Position(subscript: string): Integer;
252var
253 i: Integer;
254begin
255 Result := -1;
256
257 for i:=0 to Pred(mMultiple.Count) do
258 begin
259 if (mMultiple.GetKey(i) = subscript)
260 begin
261 Result := i;
262 break;
263 end;
264 end;
265end;
266
267
268function TParamMult.Subscript(position: Integer): String;
269begin
270 if(position > -1 && position < Count) then
271 result := mMultiple.GetKey(position);
272end;
273 /// <summary>
274 /// In Assign all of the items from source object are copied one by one into the
275 /// target. So if the source is later destroyed, target object will continue
276 /// to hold the copy of all elements, completely unaffected.
277 /// The source can only be a NameValueCollection or else it with throw an exception.
278 /// </summary>
279 /// <param name:='source'></param>
280{
281 public void Assign(object source)
282 begin
283 ClearAll();
284 if (source is ParamMult)
285 mMultiple.Add((NameValueCollection)source);
286 else
287 throw(new ParamMultException('Invalid source type'+ source.GetType()+' in method Assign'));
288 end;
289}
290 /// <summary>
291 /// Order returns the subscript string of the next or previous element from the
292 /// StartSubscript. This is very similar to the $O function available in M.
293 /// nil string ('') is returned when reaching beyong the first or last
294 /// element, or when list is empty. Note: A major difference between the M $O
295 /// and this function is that in this function StartSubscript must identify a valid subscript
296 /// in the list.
297 /// </summary>
298 /// <param name:='startSubscript'></param>
299 /// <param name:='direction'></param>
300 /// <returns></returns>
301function TParamMult.Order(startSubscript: String; direction: Integer): String;
302var
303 index: Integer;
304begin
305 if (startSubscript = '') then
306 begin
307 if(direction > 0) then
308 result := First
309 else
310 result := Last;
311 end
312 else
313 begin
314 index := Position(startSubscript);
315 if(index > -1) then
316 begin
317 if (index < (Count -1)) and (direction > 0) then
318 result := mMultiple[index+1]
319 else
320 result := mMultiple[index-1];
321 end;
322 end;
323end;
324
325{
326 public class ParamMultException : Exception
327 begin
328 public ParamMultException(string errorString)
329 :base(kParamMultExceptionLabel + errorString)beginend;
330 private const string kParamMultExceptionLabel := 'ParamMult Exeption: ';
331 end;
332}
333procedure TParamMult.ClearAll;
334begin
335 mMultiple.Clear();
336end;
337
338
339function TParamMult.GetCount: Integer;
340begin
341 Result := mMultiple.Count;
342end;
343
344
345function TParamMult.GetFirst: String;
346begin
347 Result := '';
348 if (mMultiple.Count > 0) then
349 Result := mMultiple[0];
350end;
351
352
353function TParamMult.GetLast: String;
354begin
355 Result := '';
356 if (mMultiple.Count > 0) then
357 Result := mMultiple[mMultiple.Count-1];
358end;
359
360
361 /// <summary>
362 /// GetMultiple Returns the VALUE of the element whose subscript is passed.
363 /// </summary>
364 /// <param name:='index'></param>
365 /// <returns></returns>
366function TParamMult.GetMultiple(index: String): String;
367var
368 TryResult: String;
369 StrError: String;
370begin
371 tryResult := '';
372 try
373 begin
374 tryResult := mMultiple[index];
375 end;
376 // The requested string might not be in the string array in which case IndexOf will
377 // return a -1 so lets handle this through an IndexOutOfRangeException
378// catch (ArgumentOutOfRangeException)
379 except
380 begin
381 if (Name <> '') then
382 StrError :=Name
383 else
384 StrError := kMultInstanceNameDefault;
385 strError +:= StrError + '[' + index + ']'#0D#0A' is undefined';
386
387 // There was a complicated way to attempt to find this data on exception
388 // in the Delphi unit trpcb.pas in the broker project under
389 // TMult.GetFMultiple. I did not understand this so I will throw an
390 // exception here. -Travis
391
392// throw( new ParamMultException(strError));
393 end;
394 finally
395 begin
396 result := tryResult;
397 end;
398end;
399
400
401 /// <summary>
402 /// SetMultiple Stores a new element in the multiple. mMultiple (StringCollection) is the
403 /// structure, which is used to hold the subscript and value pair. Subscript is stored as
404 /// the String, value is stored as an object of the string.
405 /// </summary>
406 /// <param name:='index'></param>
407 /// <param name:='Value'></param>
408procedure TParamMult.SetMultiple(index, newElement: String):
409begin
410 mMultiple.Set(index,newElement);
411end;
412
413end.
414
Note: See TracBrowser for help on using the repository browser.