source: cprs/branches/tmg-cprs/BDK32/Source/Mfunstr.pas@ 1641

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 2.6 KB
RevLine 
[453]1{ **************************************************************
2 Package: XWB - Kernel RPCBroker
3 Date Created: Sept 18, 1997 (Version 1.1)
4 Site Name: Oakland, OI Field Office, Dept of Veteran Affairs
5 Developers: Danila Manapsal, Don Craven, Joel Ivey
6 Description: Functions that emulate MUMPS functions.
7 Current Release: Version 1.1 Patch 40 (January 7, 2005))
8*************************************************************** }
9
10unit MFunStr;
11
12interface
13
14uses SysUtils, Dialogs;
15
16{procedure and function prototypes}
17function Piece(x: string; del: string; piece1: integer = 1; piece2: integer=0): string;
18function Translate(passedString, identifier, associator: string): string;
19
20const
21 U: string = '^';
22
23implementation
24
25function Translate(passedString, identifier, associator: string): string;
26{TRANSLATE(string,identifier,associator)
27Performs a character-for-character replacement within a string.}
28var
29 index, position: integer;
30 newString: string;
31 substring: string;
32
33begin
34 newString := ''; {initialize NewString}
35 for index := 1 to length(passedString) do begin
36 substring := copy(passedString,index,1);
37 position := pos(substring,identifier);
38 if position > 0 then
39 newString := newString + copy(associator,position,1)
40 else
41 newString := newString + copy(passedString,index,1)
42 end;
43 result := newString;
44end;
45
46
47function Piece(x: string; del: string; piece1: integer = 1; piece2: integer=0) : string;
48{PIECE(string,delimiter,piece number)
49Returns a field within a string using the specified delimiter.}
50var
51 delIndex,pieceNumber: integer;
52 Resval: String;
53 Str: String;
54begin
55 {initialize variables}
56 pieceNumber := 1;
57 Str := x;
58 {delIndex :=1;}
59 if piece2 = 0 then
60 piece2 := piece1;
61 Resval := '';
62 repeat
63 delIndex := Pos(del,Str);
64 if (delIndex > 0) or ((pieceNumber > Pred(piece1)) and (pieceNumber < (piece2+1))) then begin
65 if (pieceNumber > Pred(piece1)) and (pieceNumber < (piece2+1)) then
66 begin
67 if (pieceNumber > piece1) and (Str <> '') then
68 Resval := Resval + del;
69 if delIndex > 0 then
70 begin
71 Resval := Resval + Copy(Str,1,delIndex-1);
72 Str := Copy(Str,delIndex+Length(del),Length(Str));
73 end
74 else
75 begin
76 Resval := Resval + Str;
77 Str := '';
78 end;
79 end
80 else
81 Str := Copy(Str,delIndex+Length(del),Length(Str));
82 end
83 else if Str <> '' then
84 Str := '';
85 inc(pieceNumber);
86 until (pieceNumber > piece2);
87 Result := Resval;
88end;
89end.
Note: See TracBrowser for help on using the repository browser.