| [17] | 1 | Unit ACLStringUtility;
 | 
|---|
 | 2 | 
 | 
|---|
 | 3 | Interface
 | 
|---|
 | 4 | 
 | 
|---|
 | 5 | Uses
 | 
|---|
 | 6 |   Classes;
 | 
|---|
 | 7 | 
 | 
|---|
 | 8 | const
 | 
|---|
 | 9 |   EndLine= chr(13)+chr(10);
 | 
|---|
 | 10 |   TwoEndLines= chr(13)+chr(10)+chr(13)+chr(10);
 | 
|---|
 | 11 |   Quote = '''';
 | 
|---|
 | 12 |   DoubleQuote = '"';
 | 
|---|
 | 13 | 
 | 
|---|
 | 14 | // ----------- Character testing functions -----------------------
 | 
|---|
 | 15 | 
 | 
|---|
 | 16 | type
 | 
|---|
 | 17 |   TCharMatchFunction = function( const a: char ): boolean;
 | 
|---|
 | 18 | 
 | 
|---|
 | 19 | // Returns true if c is a digit 0..9
 | 
|---|
 | 20 | Function IsDigit( const c: char ): boolean;
 | 
|---|
 | 21 | 
 | 
|---|
 | 22 | // Returns true if c is not a digit
 | 
|---|
 | 23 | Function IsNonDigit( const c: char ): boolean;
 | 
|---|
 | 24 | 
 | 
|---|
 | 25 | // Returns true if c is an alphabetic character a..z A..Z
 | 
|---|
 | 26 | Function IsAlpha( const c: char ): boolean;
 | 
|---|
 | 27 | 
 | 
|---|
 | 28 | // Returns true if s is only spaces (or empty)
 | 
|---|
 | 29 | Function IsSpaces( const s: string ): boolean;
 | 
|---|
 | 30 | 
 | 
|---|
 | 31 | // ---------------------- Numeric conversions ---------------------------------------
 | 
|---|
 | 32 | 
 | 
|---|
 | 33 | // Converts a hex string to a longint
 | 
|---|
 | 34 | // May be upper or lower case
 | 
|---|
 | 35 | // Does not allow a sign
 | 
|---|
 | 36 | // Is not forgiving as StrToInt: all characters
 | 
|---|
 | 37 | // must be valid hex chars.
 | 
|---|
 | 38 | function HexToInt( s: string ): longint;
 | 
|---|
 | 39 | 
 | 
|---|
 | 40 | // Given a string with a number on the end, increments that
 | 
|---|
 | 41 | // number by one.
 | 
|---|
 | 42 | // If there is no number it adds a one.
 | 
|---|
 | 43 | // If the number is left zero padded then the result is similarly
 | 
|---|
 | 44 | // padded
 | 
|---|
 | 45 | Function IncrementNumberedString( StartString: string ): string;
 | 
|---|
 | 46 | 
 | 
|---|
 | 47 | // ---------------------- Pascal String Utilities ---------------------------------------
 | 
|---|
 | 48 | 
 | 
|---|
 | 49 | {$ifdef os2}
 | 
|---|
 | 50 | Function CaseInsensitivePos( const a: string;
 | 
|---|
 | 51 |                              const b: string ): longint;
 | 
|---|
 | 52 | {$else}
 | 
|---|
 | 53 | Function CaseInsensitivePos( const a: string;
 | 
|---|
 | 54 |                              const b: string ): longint;
 | 
|---|
 | 55 | {$endif}
 | 
|---|
 | 56 | 
 | 
|---|
 | 57 | // Looks for occurrences of QuoteChar and inserts a duplicate
 | 
|---|
 | 58 | Function InsertDuplicateChars( const S: string;
 | 
|---|
 | 59 |                                const QuoteChar: char ): string;
 | 
|---|
 | 60 | 
 | 
|---|
 | 61 | // Returns index of SubString in S, case-insensitve
 | 
|---|
 | 62 | Function FindSubstring( const SubString: string;
 | 
|---|
 | 63 |                         const S: string ): integer;
 | 
|---|
 | 64 | 
 | 
|---|
 | 65 | // Returns characters at the front of S that match according
 | 
|---|
 | 66 | // to a given function... for example, IsDigit, IsNonDigit, IsAlpha
 | 
|---|
 | 67 | Function MatchLeadingChars(
 | 
|---|
 | 68 |            const S: string;
 | 
|---|
 | 69 |            MatchFunction: TCharMatchFunction ): string;
 | 
|---|
 | 70 | 
 | 
|---|
 | 71 | // Same as MatchLeadingChars, but removes the matching chars from S
 | 
|---|
 | 72 | Function ExtractLeadingChars(
 | 
|---|
 | 73 |            Var S: string;
 | 
|---|
 | 74 |            MatchFunction: TCharMatchFunction ): string;
 | 
|---|
 | 75 | 
 | 
|---|
 | 76 | // Case insensitive compare
 | 
|---|
 | 77 | Function StringsSame( const a, b: string ): boolean;
 | 
|---|
 | 78 | 
 | 
|---|
 | 79 | // Quoting
 | 
|---|
 | 80 | 
 | 
|---|
 | 81 | // Note: these functions do not check for existing quotes within
 | 
|---|
 | 82 | // the string, they only add or delete characters at the end.
 | 
|---|
 | 83 | 
 | 
|---|
 | 84 | // Returns S in single quotes
 | 
|---|
 | 85 | Function StrQuote( const s: string ): string;
 | 
|---|
 | 86 | 
 | 
|---|
 | 87 | // Returns S without single quotes
 | 
|---|
 | 88 | Function StrUnQuote( const s: string ): string;
 | 
|---|
 | 89 | 
 | 
|---|
 | 90 | // Returns S in double quotes
 | 
|---|
 | 91 | Function StrDoubleQuote( const s: string ): string;
 | 
|---|
 | 92 | 
 | 
|---|
 | 93 | // Returns S in double quotes,
 | 
|---|
 | 94 | // with any double quotes in S duplicated
 | 
|---|
 | 95 | Function StrFullDoubleQuote( const s: string ): string;
 | 
|---|
 | 96 | 
 | 
|---|
 | 97 | // Returns S without double quotes
 | 
|---|
 | 98 | Function StrUnDoubleQuote( const s: string ): string;
 | 
|---|
 | 99 | 
 | 
|---|
 | 100 | //
 | 
|---|
 | 101 | 
 | 
|---|
 | 102 | // Substitutes given character
 | 
|---|
 | 103 | Function SubstituteChar( const S: string; const Find: Char; const Replace: Char ): string;
 | 
|---|
 | 104 | 
 | 
|---|
 | 105 | // Returns the count rightmost chars of S
 | 
|---|
 | 106 | Function StrRight( const S:string; const count:integer ):string;
 | 
|---|
 | 107 | 
 | 
|---|
 | 108 | // Returns the remainder of S starting at start
 | 
|---|
 | 109 | Function StrRightFrom( const S:string; const start:integer ):string;
 | 
|---|
 | 110 | 
 | 
|---|
 | 111 | // Returns the count leftmost chars of S
 | 
|---|
 | 112 | Function StrLeft( const S:string; const count:integer ):string;
 | 
|---|
 | 113 | 
 | 
|---|
 | 114 | // Returns S minus count characters from the right
 | 
|---|
 | 115 | Function StrLeftWithout( const S:string; const count:integer ):string;
 | 
|---|
 | 116 | 
 | 
|---|
 | 117 | // Returns S with leftCount chars removed from the left and
 | 
|---|
 | 118 | // rightCount chars removed from the right.
 | 
|---|
 | 119 | Function StrRemoveEnds( const S:string; const leftCount:integer; const rightCount:integer ):string;
 | 
|---|
 | 120 | 
 | 
|---|
 | 121 | // Produces a string from n padded on the left with 0's
 | 
|---|
 | 122 | // to width chars
 | 
|---|
 | 123 | Function StrLeft0Pad( const n: integer; const width: integer ): string;
 | 
|---|
 | 124 | 
 | 
|---|
 | 125 | // Returns true if s starts with start (case insensitive)
 | 
|---|
 | 126 | Function StrStarts( const start: string; const s: string ): boolean;
 | 
|---|
 | 127 | 
 | 
|---|
 | 128 | // Returns true if s ends with endstr (case insensitive)
 | 
|---|
 | 129 | Function StrEnds( const endStr: string; const s: string ): boolean;
 | 
|---|
 | 130 | 
 | 
|---|
 | 131 | // Returns first word from S
 | 
|---|
 | 132 | Function StrFirstWord( const S: String ): string;
 | 
|---|
 | 133 | 
 | 
|---|
 | 134 | // Finds the last position of C within s. Returns zero if no match
 | 
|---|
 | 135 | function FindCharFromEnd( const s: string;
 | 
|---|
 | 136 |                           const c: char ): longint;
 | 
|---|
 | 137 | 
 | 
|---|
 | 138 | // ------------ PString (pointer to Pascal string) utilities ------
 | 
|---|
 | 139 | 
 | 
|---|
 | 140 | {$ifdef os2}
 | 
|---|
 | 141 | procedure GetMemString( p: pointer;
 | 
|---|
 | 142 |                         Var s: string;
 | 
|---|
 | 143 |                         Size: byte );
 | 
|---|
 | 144 | 
 | 
|---|
 | 145 | function NewPStringLen( const Length: longint ): PString;
 | 
|---|
 | 146 | 
 | 
|---|
 | 147 | function NewPString( const s: string ): PString;
 | 
|---|
 | 148 | 
 | 
|---|
 | 149 | procedure FreePString( Var ps: PString );
 | 
|---|
 | 150 | {$endif}
 | 
|---|
 | 151 | 
 | 
|---|
 | 152 | // ------------ Seperated value utilities ---------------------
 | 
|---|
 | 153 | 
 | 
|---|
 | 154 | // Returns the next item starting at Index. Spaces are the separator,
 | 
|---|
 | 155 | // unless the item is quoted with QuoteChar, in which case it looks for
 | 
|---|
 | 156 | // a closing quote. Occurrences of the QuoteChar in the item itself,
 | 
|---|
 | 157 | // can be escaped with a duplicate, e.g. "He said ""bok"""
 | 
|---|
 | 158 | Procedure GetNextQuotedValue(
 | 
|---|
 | 159 |            const S: string;
 | 
|---|
 | 160 |            var Index: longint;
 | 
|---|
 | 161 |            var Value: string;
 | 
|---|
 | 162 |            const QuoteChar: char );
 | 
|---|
 | 163 | 
 | 
|---|
 | 164 | procedure GetNextValue(
 | 
|---|
 | 165 |            const S: String;
 | 
|---|
 | 166 |            var Index: longint;
 | 
|---|
 | 167 |            var Value: string;
 | 
|---|
 | 168 |            const Seperator: char );
 | 
|---|
 | 169 | 
 | 
|---|
 | 170 | // Removes and returns the first value in a separated
 | 
|---|
 | 171 | // value list (removes quotes if found)
 | 
|---|
 | 172 | Function ExtractNextValue(
 | 
|---|
 | 173 |           var S: string;
 | 
|---|
 | 174 |           const Separator: string ): string;
 | 
|---|
 | 175 | 
 | 
|---|
 | 176 | Function ExtractNextValueNoTrim(
 | 
|---|
 | 177 |            var S: string;
 | 
|---|
 | 178 |            const Separator: string ): string;
 | 
|---|
 | 179 | 
 | 
|---|
 | 180 | 
 | 
|---|
 | 181 | // Parses a line of the form
 | 
|---|
 | 182 | // key = value into it's components
 | 
|---|
 | 183 | Procedure ParseConfigLine( const S: string;
 | 
|---|
 | 184 |                            var KeyName: string;
 | 
|---|
 | 185 |                            var KeyValue: string );
 | 
|---|
 | 186 | 
 | 
|---|
 | 187 | // Removes spaces around the separator in the given string
 | 
|---|
 | 188 | Procedure RemoveSeparatorSpaces( var S: string;
 | 
|---|
 | 189 |                                  const Separator:string );
 | 
|---|
 | 190 | 
 | 
|---|
 | 191 | {$ifdef os2}
 | 
|---|
 | 192 | // ------------ Ansi String utilities ------------------------
 | 
|---|
 | 193 | 
 | 
|---|
 | 194 | // Right & left trim that works with AnsiStrings.
 | 
|---|
 | 195 | Function AnsiTrim( const S: AnsiString ): AnsiString;
 | 
|---|
 | 196 | 
 | 
|---|
 | 197 | Procedure AnsiParseConfigLine( const S: Ansistring;
 | 
|---|
 | 198 |                                var keyName: Ansistring;
 | 
|---|
 | 199 |                                var keyValue: Ansistring );
 | 
|---|
 | 200 | 
 | 
|---|
 | 201 | Function AnsiExtractNextValue( var CSVString: AnsiString;
 | 
|---|
 | 202 |                                const Separator: AnsiString ): AnsiString;
 | 
|---|
 | 203 | 
 | 
|---|
 | 204 | {$endif}
 | 
|---|
 | 205 | 
 | 
|---|
 | 206 | // ------------- Lists of strings, and strings as lists -----------
 | 
|---|
 | 207 | 
 | 
|---|
 | 208 | // Adds NewValue to S as a separated list
 | 
|---|
 | 209 | Procedure AddToListString( Var S: string;
 | 
|---|
 | 210 |                            const NewValue: string;
 | 
|---|
 | 211 |                            const Separator: string );
 | 
|---|
 | 212 | 
 | 
|---|
 | 213 | Function ListToString( List: TStrings;
 | 
|---|
 | 214 |                        const Separator: string ): string;
 | 
|---|
 | 215 | 
 | 
|---|
 | 216 | procedure StringToList( S: String;
 | 
|---|
 | 217 |                         List: TStrings;
 | 
|---|
 | 218 |                         const Separator: string );
 | 
|---|
 | 219 | 
 | 
|---|
 | 220 | // Reverse the given list. It must be set to not sorted
 | 
|---|
 | 221 | Procedure ReverseList( TheList: TStrings );
 | 
|---|
 | 222 | 
 | 
|---|
 | 223 | // Sort the given list into reverse alphabetical order
 | 
|---|
 | 224 | //Procedure ReverseSortList( TheList: TStringList );
 | 
|---|
 | 225 | 
 | 
|---|
 | 226 | // Find the given string in the given list, using
 | 
|---|
 | 227 | // case insensitive searching (and trimming)
 | 
|---|
 | 228 | // returns -1 if not found
 | 
|---|
 | 229 | Function FindStringInList( const TheString: string;
 | 
|---|
 | 230 |                            TheList:TStrings ):longint;
 | 
|---|
 | 231 | 
 | 
|---|
 | 232 | Procedure MergeStringLists( Dest: TStringList;
 | 
|---|
 | 233 |                             AdditionalList: TStringList );
 | 
|---|
 | 234 | 
 | 
|---|
 | 235 | // ---------------------- PCHAR Utilities ---------------------------------------
 | 
|---|
 | 236 | 
 | 
|---|
 | 237 | function StrNPas( const ps: PChar; const Length: integer ): String;
 | 
|---|
 | 238 | 
 | 
|---|
 | 239 | // Returns a - b
 | 
|---|
 | 240 | Function PCharDiff( const a: PChar; const b: Pchar ): longword;
 | 
|---|
 | 241 | 
 | 
|---|
 | 242 | // trims spaces and carriage returns of the end of Text
 | 
|---|
 | 243 | procedure TrimWhitespace( Text: PChar );
 | 
|---|
 | 244 | 
 | 
|---|
 | 245 | type
 | 
|---|
 | 246 |   TSetOfChars = set of char;
 | 
|---|
 | 247 | 
 | 
|---|
 | 248 | function TrimChars( const s: string;
 | 
|---|
 | 249 |                     chars: TSetOfChars ): string;
 | 
|---|
 | 250 | 
 | 
|---|
 | 251 | // Concatenates a pascal string onto a PCHar string
 | 
|---|
 | 252 | // Resizes if needed
 | 
|---|
 | 253 | procedure StrPCat( Var Dest: PChar;
 | 
|---|
 | 254 |                    const StringToAdd: string );
 | 
|---|
 | 255 | 
 | 
|---|
 | 256 | // Trim endlines (#10 or #13) off the end of
 | 
|---|
 | 257 | // the given string.
 | 
|---|
 | 258 | Procedure TrimEndLines( const S: PChar );
 | 
|---|
 | 259 | 
 | 
|---|
 | 260 | // Allocates enough memory for a copy of s as a PChar
 | 
|---|
 | 261 | // and copies s to it.
 | 
|---|
 | 262 | Function StrDupPas( const s: string ): PChar;
 | 
|---|
 | 263 | 
 | 
|---|
 | 264 | // Returns a copy of the first n chars of s
 | 
|---|
 | 265 | Function StrNDup( const s: PChar; const n: integer ): PChar;
 | 
|---|
 | 266 | 
 | 
|---|
 | 267 | // Returns a copy of the first line starting at lineStart
 | 
|---|
 | 268 | Function CopyFirstLine( const lineStart: PChar ): PChar;
 | 
|---|
 | 269 | 
 | 
|---|
 | 270 | // Returns next line p points to
 | 
|---|
 | 271 | Function NextLine( const p: PChar): PChar;
 | 
|---|
 | 272 | 
 | 
|---|
 | 273 | // Concatentate AddText to Text. Reallocate and expand
 | 
|---|
 | 274 | // Text if necessary. This is a size-safe StrCat
 | 
|---|
 | 275 | Procedure AddAndResize( Var Text: PChar;
 | 
|---|
 | 276 |                         const AddText: PChar );
 | 
|---|
 | 277 | 
 | 
|---|
 | 278 | // Copy Source to Dest. Reallocate and expand
 | 
|---|
 | 279 | // Dest if necessary. This is a size-safe StrCopy
 | 
|---|
 | 280 | Procedure StrCopyAndResize( Var Dest: PChar;
 | 
|---|
 | 281 |                             const Source: PChar );
 | 
|---|
 | 282 | 
 | 
|---|
 | 283 | // Return "True" or "False"
 | 
|---|
 | 284 | Function BoolToStr( const b: boolean ): string;
 | 
|---|
 | 285 | 
 | 
|---|
 | 286 | 
 | 
|---|
 | 287 | Implementation
 | 
|---|
 | 288 | 
 | 
|---|
 | 289 | Uses
 | 
|---|
 | 290 |   SysUtils, ACLUtility;
 | 
|---|
 | 291 | 
 | 
|---|
 | 292 | // ---------------------- Pascal String Utilities ---------------------------------------
 | 
|---|
 | 293 | 
 | 
|---|
 | 294 | Procedure SkipChar( const S: string;
 | 
|---|
 | 295 |                     Var index: longint;
 | 
|---|
 | 296 |                     const C: Char );
 | 
|---|
 | 297 | begin
 | 
|---|
 | 298 |   while Index <= Length( S ) do
 | 
|---|
 | 299 |   begin
 | 
|---|
 | 300 |     if S[ Index ] <> C then
 | 
|---|
 | 301 |      break;
 | 
|---|
 | 302 |     inc( Index );
 | 
|---|
 | 303 |   end;
 | 
|---|
 | 304 | end;
 | 
|---|
 | 305 | 
 | 
|---|
 | 306 | 
 | 
|---|
 | 307 | Procedure GetNextQuotedValue(
 | 
|---|
 | 308 |            const S: string;
 | 
|---|
 | 309 |            var Index: longint;
 | 
|---|
 | 310 |            var Value: string;
 | 
|---|
 | 311 |            const QuoteChar: char );
 | 
|---|
 | 312 | begin
 | 
|---|
 | 313 |   Value := '';
 | 
|---|
 | 314 |   SkipChar( S, Index, ' ' );
 | 
|---|
 | 315 |   if Index > Length( S ) then
 | 
|---|
 | 316 |     exit;
 | 
|---|
 | 317 | 
 | 
|---|
 | 318 |   if S[ Index ] <> QuoteChar then
 | 
|---|
 | 319 |   begin
 | 
|---|
 | 320 |     // not quoted, go to next space
 | 
|---|
 | 321 |     while Index <= Length( S ) do
 | 
|---|
 | 322 |     begin
 | 
|---|
 | 323 |       if S[ Index ] = ' ' then
 | 
|---|
 | 324 |         break;
 | 
|---|
 | 325 |       Value := Value + S[ Index ];
 | 
|---|
 | 326 |       inc( Index );
 | 
|---|
 | 327 |     end;
 | 
|---|
 | 328 |     // skip following spaces
 | 
|---|
 | 329 |     SkipChar( S, Index, ' ' );
 | 
|---|
 | 330 |     exit;
 | 
|---|
 | 331 |   end;
 | 
|---|
 | 332 | 
 | 
|---|
 | 333 |   // quoted string
 | 
|---|
 | 334 |   inc( Index ); // skip opening quote
 | 
|---|
 | 335 | 
 | 
|---|
 | 336 |   while Index <= Length( S ) do
 | 
|---|
 | 337 |   begin
 | 
|---|
 | 338 |     if S[ Index ] = QuoteChar then
 | 
|---|
 | 339 |     begin
 | 
|---|
 | 340 |       inc( index ); // skip closing quote
 | 
|---|
 | 341 |       if Index > Length( S ) then
 | 
|---|
 | 342 |         break; // done
 | 
|---|
 | 343 |       if S[ Index ] <> QuoteChar then
 | 
|---|
 | 344 |         break; // done
 | 
|---|
 | 345 | 
 | 
|---|
 | 346 |       // escaped quote e.g "" so we do want it.
 | 
|---|
 | 347 |     end;
 | 
|---|
 | 348 |     Value := Value + S[ Index ];
 | 
|---|
 | 349 |     inc( Index );
 | 
|---|
 | 350 |   end;
 | 
|---|
 | 351 | 
 | 
|---|
 | 352 |   SkipChar( S, Index, ' ' );
 | 
|---|
 | 353 | 
 | 
|---|
 | 354 | end;
 | 
|---|
 | 355 | 
 | 
|---|
 | 356 | Function InsertDuplicateChars( const S: string;
 | 
|---|
 | 357 |                                const QuoteChar: char ): string;
 | 
|---|
 | 358 | var
 | 
|---|
 | 359 |   i: integer;
 | 
|---|
 | 360 | begin
 | 
|---|
 | 361 |   Result := '';
 | 
|---|
 | 362 |   for i := 1 to Length( S ) do
 | 
|---|
 | 363 |   begin
 | 
|---|
 | 364 |     Result := Result + S[ i ];
 | 
|---|
 | 365 |     if S[ i ] = QuoteChar then
 | 
|---|
 | 366 |       Result := Result + QuoteChar; // insert duplicate
 | 
|---|
 | 367 |   end;
 | 
|---|
 | 368 | end;
 | 
|---|
 | 369 | 
 | 
|---|
 | 370 | Function FindSubstring( const SubString: string;
 | 
|---|
 | 371 |                         const S: string ): integer;
 | 
|---|
 | 372 | begin
 | 
|---|
 | 373 |   Result := Pos( Uppercase( SubString ),
 | 
|---|
 | 374 |                  Uppercase( S ) );
 | 
|---|
 | 375 | end;
 | 
|---|
 | 376 | 
 | 
|---|
 | 377 | Function MatchLeadingChars(
 | 
|---|
 | 378 |            const S: string;
 | 
|---|
 | 379 |            MatchFunction: TCharMatchFunction ): string;
 | 
|---|
 | 380 | var
 | 
|---|
 | 381 |   i: integer;
 | 
|---|
 | 382 |   TheChar: char;
 | 
|---|
 | 383 | begin
 | 
|---|
 | 384 |   Result:= '';
 | 
|---|
 | 385 |   i := 1;
 | 
|---|
 | 386 |   while i <= Length( S ) do
 | 
|---|
 | 387 |   begin
 | 
|---|
 | 388 |     TheChar:= S[ i ];
 | 
|---|
 | 389 |     if not MatchFunction( TheChar ) then
 | 
|---|
 | 390 |       // found a non matching char. Stop looking
 | 
|---|
 | 391 |       break;
 | 
|---|
 | 392 |     Result:= Result + TheChar;
 | 
|---|
 | 393 |     inc( i );
 | 
|---|
 | 394 |   end;
 | 
|---|
 | 395 | end;
 | 
|---|
 | 396 | 
 | 
|---|
 | 397 | Function ExtractLeadingChars(
 | 
|---|
 | 398 |            Var S: string;
 | 
|---|
 | 399 |            MatchFunction: TCharMatchFunction ): string;
 | 
|---|
 | 400 | begin
 | 
|---|
 | 401 |   Result := MatchLeadingChars( s, MatchFunction );
 | 
|---|
 | 402 |   if Length( Result ) > 0 then
 | 
|---|
 | 403 |     // remove matching section from string
 | 
|---|
 | 404 |     Delete( S, 1, Length( Result ) );
 | 
|---|
 | 405 | end;
 | 
|---|
 | 406 | 
 | 
|---|
 | 407 | // Hex conversion: sheer extravagance. Conversion from
 | 
|---|
 | 408 | // a hex digit char to int is done by creating a lookup table
 | 
|---|
 | 409 | // in advance.
 | 
|---|
 | 410 | var
 | 
|---|
 | 411 |   MapHexDigitToInt: array[ Chr( 0 ) .. Chr( 255 ) ] of longint;
 | 
|---|
 | 412 | 
 | 
|---|
 | 413 | procedure InitHexDigitMap;
 | 
|---|
 | 414 | var
 | 
|---|
 | 415 |   c: char;
 | 
|---|
 | 416 |   IntValue: longint;
 | 
|---|
 | 417 | begin
 | 
|---|
 | 418 |   for c := Chr( 0 ) to Chr( 255 ) do
 | 
|---|
 | 419 |   begin
 | 
|---|
 | 420 |     IntValue := -1;
 | 
|---|
 | 421 |     if ( c >= '0' )
 | 
|---|
 | 422 |        and ( c <= '9' ) then
 | 
|---|
 | 423 |       IntValue := Ord( c ) - Ord( '0' );
 | 
|---|
 | 424 | 
 | 
|---|
 | 425 |     if ( Upcase( c ) >= 'A' )
 | 
|---|
 | 426 |        and ( Upcase( c ) <= 'F' ) then
 | 
|---|
 | 427 |       IntValue := 10 + Ord( Upcase( c ) ) - Ord( 'A' );
 | 
|---|
 | 428 | 
 | 
|---|
 | 429 |     MapHexDigitToInt[ c ] := IntValue;
 | 
|---|
 | 430 |   end;
 | 
|---|
 | 431 | end;
 | 
|---|
 | 432 | 
 | 
|---|
 | 433 | function HexDigitToInt( c: char ): longint;
 | 
|---|
 | 434 | begin
 | 
|---|
 | 435 |   Result := MapHexDigitToInt[ c ];
 | 
|---|
 | 436 |   if Result = -1 then
 | 
|---|
 | 437 |     raise EConvertError.Create( 'Invalid hex char: ' + c );
 | 
|---|
 | 438 | end;
 | 
|---|
 | 439 | 
 | 
|---|
 | 440 | function HexToInt( s: string ): longint;
 | 
|---|
 | 441 | var
 | 
|---|
 | 442 |   i: integer;
 | 
|---|
 | 443 | begin
 | 
|---|
 | 444 |   if Length( s ) = 0 then
 | 
|---|
 | 445 |     raise EConvertError.Create( 'No chars in hex string' );
 | 
|---|
 | 446 |   Result := 0;
 | 
|---|
 | 447 |   for i:= 1 to Length( s ) do
 | 
|---|
 | 448 |   begin
 | 
|---|
 | 449 |     Result := Result shl 4;
 | 
|---|
 | 450 |     inc( Result, HexDigitToInt( s[ i ] ) );
 | 
|---|
 | 451 |   end;
 | 
|---|
 | 452 | end;
 | 
|---|
 | 453 | 
 | 
|---|
 | 454 | {$ifdef os2}
 | 
|---|
 | 455 | procedure GetMemString( p: pointer;
 | 
|---|
 | 456 |                         Var s: string;
 | 
|---|
 | 457 |                         Size: byte );
 | 
|---|
 | 458 | begin
 | 
|---|
 | 459 |   S[ 0 ]:= char( size );
 | 
|---|
 | 460 |   MemCopy( p, Addr( S[ 1 ] ), Size );
 | 
|---|
 | 461 | end;
 | 
|---|
 | 462 | 
 | 
|---|
 | 463 | procedure FreePString( Var ps: PString );
 | 
|---|
 | 464 | begin
 | 
|---|
 | 465 |   if ps = nil then
 | 
|---|
 | 466 |     exit;
 | 
|---|
 | 467 | 
 | 
|---|
 | 468 |   FreeMem( ps, Length( ps^ ) + 1 );
 | 
|---|
 | 469 |   ps:= nil;
 | 
|---|
 | 470 | end;
 | 
|---|
 | 471 | 
 | 
|---|
 | 472 | function NewPStringLen( const Length: longint ): PString;
 | 
|---|
 | 473 | begin
 | 
|---|
 | 474 |   GetMem( Result, Length + 1 );
 | 
|---|
 | 475 | end;
 | 
|---|
 | 476 | 
 | 
|---|
 | 477 | function NewPString( const s: string ): PString;
 | 
|---|
 | 478 | begin
 | 
|---|
 | 479 |   GetMem( Result, Length( S ) + 1 );
 | 
|---|
 | 480 |   Result^:= S;
 | 
|---|
 | 481 | end;
 | 
|---|
 | 482 | {$endif}
 | 
|---|
 | 483 | 
 | 
|---|
 | 484 | Function StringsSame( const a, b: string ): boolean;
 | 
|---|
 | 485 | begin
 | 
|---|
 | 486 |   Result:= CompareText( a, b ) = 0;
 | 
|---|
 | 487 | end;
 | 
|---|
 | 488 | 
 | 
|---|
 | 489 | // Returns S in single quotes
 | 
|---|
 | 490 | Function StrQuote( const s: string ): string;
 | 
|---|
 | 491 | begin
 | 
|---|
 | 492 |   Result := Quote + s + Quote;
 | 
|---|
 | 493 | end;
 | 
|---|
 | 494 | 
 | 
|---|
 | 495 | // Returns S without double quotes
 | 
|---|
 | 496 | Function StrUnQuote( const s: string ): string;
 | 
|---|
 | 497 | begin
 | 
|---|
 | 498 |   Result := S;
 | 
|---|
 | 499 |   if S = '' then
 | 
|---|
 | 500 |     exit;
 | 
|---|
 | 501 | 
 | 
|---|
 | 502 |   if Result[ 1 ] = Quote then
 | 
|---|
 | 503 |     Delete( Result, 1, 1 );
 | 
|---|
 | 504 | 
 | 
|---|
 | 505 |   if Result = '' then
 | 
|---|
 | 506 |     exit;
 | 
|---|
 | 507 | 
 | 
|---|
 | 508 |   if Result[ Length( Result ) ] = Quote then
 | 
|---|
 | 509 |     Delete( Result, Length( Result ), 1 );
 | 
|---|
 | 510 | end;
 | 
|---|
 | 511 | 
 | 
|---|
 | 512 | Function StrDoubleQuote( const s: string ): string;
 | 
|---|
 | 513 | begin
 | 
|---|
 | 514 |   Result := DoubleQuote + s + DoubleQuote;
 | 
|---|
 | 515 | end;
 | 
|---|
 | 516 | 
 | 
|---|
 | 517 | Function StrFullDoubleQuote( const s: string ): string;
 | 
|---|
 | 518 | begin
 | 
|---|
 | 519 |   Result := DoubleQuote
 | 
|---|
 | 520 |             + InsertDuplicateChars( s, '"' )
 | 
|---|
 | 521 |             + DoubleQuote;
 | 
|---|
 | 522 | end;
 | 
|---|
 | 523 | 
 | 
|---|
 | 524 | // Returns S without double quotes
 | 
|---|
 | 525 | Function StrUnDoubleQuote( const s: string ): string;
 | 
|---|
 | 526 | begin
 | 
|---|
 | 527 |   Result := S;
 | 
|---|
 | 528 |   if S = '' then
 | 
|---|
 | 529 |     exit;
 | 
|---|
 | 530 | 
 | 
|---|
 | 531 |   if Result[ 1 ] = DoubleQuote then
 | 
|---|
 | 532 |     Delete( Result, 1, 1 );
 | 
|---|
 | 533 | 
 | 
|---|
 | 534 |   if Result = '' then
 | 
|---|
 | 535 |     exit;
 | 
|---|
 | 536 | 
 | 
|---|
 | 537 |   if Result[ Length( Result ) ] = DoubleQuote then
 | 
|---|
 | 538 |     Delete( Result, Length( Result ), 1 );
 | 
|---|
 | 539 | end;
 | 
|---|
 | 540 | 
 | 
|---|
 | 541 | Function SubstituteChar( const S: string; const Find: Char; const Replace: Char ): string;
 | 
|---|
 | 542 | Var
 | 
|---|
 | 543 |   i: longint;
 | 
|---|
 | 544 | Begin
 | 
|---|
 | 545 |   Result:= S;
 | 
|---|
 | 546 |   for i:=1 to length( S ) do
 | 
|---|
 | 547 |     if Result[ i ] = Find then
 | 
|---|
 | 548 |       Result[ i ]:= Replace;
 | 
|---|
 | 549 | End;
 | 
|---|
 | 550 | 
 | 
|---|
 | 551 | Function StrRight( const S:string; const count:integer ):string;
 | 
|---|
 | 552 | Begin
 | 
|---|
 | 553 |   if count>=length(s) then
 | 
|---|
 | 554 |   begin
 | 
|---|
 | 555 |     Result:=S;
 | 
|---|
 | 556 |   end
 | 
|---|
 | 557 |   else
 | 
|---|
 | 558 |   begin
 | 
|---|
 | 559 |     Result:=copy( S, length( s )-count+1, count );
 | 
|---|
 | 560 |   end;
 | 
|---|
 | 561 | end;
 | 
|---|
 | 562 | 
 | 
|---|
 | 563 | Function StrLeft( const S:string; const count:integer ):string;
 | 
|---|
 | 564 | Begin
 | 
|---|
 | 565 |   if count>=length(s) then
 | 
|---|
 | 566 |     Result:=S
 | 
|---|
 | 567 |   else
 | 
|---|
 | 568 |     Result:=copy( S, 1, count );
 | 
|---|
 | 569 | end;
 | 
|---|
 | 570 | 
 | 
|---|
 | 571 | // Returns S minus count characters from the right
 | 
|---|
 | 572 | Function StrLeftWithout( const S:string; const count:integer ):string;
 | 
|---|
 | 573 | Begin
 | 
|---|
 | 574 |   Result:= copy( S, 1, length( S )-count );
 | 
|---|
 | 575 | End;
 | 
|---|
 | 576 | 
 | 
|---|
 | 577 | Function StrRemoveEnds( const S:string; const leftCount:integer; const rightCount:integer ):string;
 | 
|---|
 | 578 | Begin
 | 
|---|
 | 579 |   Result:= S;
 | 
|---|
 | 580 |   Delete( Result, 1, leftCount );
 | 
|---|
 | 581 |   Delete( Result, length( S )-rightCount, rightCount );
 | 
|---|
 | 582 | End;
 | 
|---|
 | 583 | 
 | 
|---|
 | 584 | Function StrRightFrom( const S:string; const start:integer ):string;
 | 
|---|
 | 585 | Begin
 | 
|---|
 | 586 |   Result:= copy( S, start, length( S )-start+1 );
 | 
|---|
 | 587 | end;
 | 
|---|
 | 588 | 
 | 
|---|
 | 589 | Procedure ParseConfigLine( const S: string;
 | 
|---|
 | 590 |                            var keyName: string;
 | 
|---|
 | 591 |                            var keyValue: string );
 | 
|---|
 | 592 | Var
 | 
|---|
 | 593 |   line: String;
 | 
|---|
 | 594 |   EqualsPos: longint;
 | 
|---|
 | 595 | Begin
 | 
|---|
 | 596 |   KeyName:= '';
 | 
|---|
 | 597 |   KeyValue:= '';
 | 
|---|
 | 598 | 
 | 
|---|
 | 599 |   line:= trim( S );
 | 
|---|
 | 600 |   EqualsPos:= Pos( '=', line );
 | 
|---|
 | 601 | 
 | 
|---|
 | 602 |   if ( EqualsPos>0 ) then
 | 
|---|
 | 603 |   begin
 | 
|---|
 | 604 |     KeyName:= line;
 | 
|---|
 | 605 |     Delete( KeyName, EqualsPos, length( KeyName )-EqualsPos+1 );
 | 
|---|
 | 606 |     KeyName:= Trim( KeyName );
 | 
|---|
 | 607 | 
 | 
|---|
 | 608 |     KeyValue:= line;
 | 
|---|
 | 609 |     Delete( KeyValue, 1, EqualsPos );
 | 
|---|
 | 610 |     KeyValue:= Trim( KeyValue );
 | 
|---|
 | 611 |   end;
 | 
|---|
 | 612 | end;
 | 
|---|
 | 613 | 
 | 
|---|
 | 614 | Function ExtractNextValueNoTrim( var S: string;
 | 
|---|
 | 615 |                                  const Separator: string ): string;
 | 
|---|
 | 616 | Var
 | 
|---|
 | 617 |   SeparatorPos: integer;
 | 
|---|
 | 618 | Begin
 | 
|---|
 | 619 |   SeparatorPos := Pos( Separator, S );
 | 
|---|
 | 620 |   if SeparatorPos > 0 then
 | 
|---|
 | 621 |   begin
 | 
|---|
 | 622 |     Result := Copy( S, 1, SeparatorPos-1 );
 | 
|---|
 | 623 |     Delete( S, 1, SeparatorPos + length( Separator ) - 1 );
 | 
|---|
 | 624 |   end
 | 
|---|
 | 625 |   else
 | 
|---|
 | 626 |   begin
 | 
|---|
 | 627 |     Result := S;
 | 
|---|
 | 628 |     S := '';
 | 
|---|
 | 629 |   end;
 | 
|---|
 | 630 | end;
 | 
|---|
 | 631 | 
 | 
|---|
 | 632 | Function ExtractNextValue( var S: string;
 | 
|---|
 | 633 |                            const Separator: string ): string;
 | 
|---|
 | 634 | begin
 | 
|---|
 | 635 |   Result := ExtractNextValueNoTrim( S, Separator );
 | 
|---|
 | 636 |   Result := trim( Result );
 | 
|---|
 | 637 | 
 | 
|---|
 | 638 |   // Remove quotes if present
 | 
|---|
 | 639 |   if Result <> '' then
 | 
|---|
 | 640 |     if Result[ 1 ] = DoubleQuote then
 | 
|---|
 | 641 |       Delete( Result, 1, 1 );
 | 
|---|
 | 642 | 
 | 
|---|
 | 643 |   if Result <> '' then
 | 
|---|
 | 644 |     if Result[ length( Result ) ] = DoubleQuote then
 | 
|---|
 | 645 |       Delete( Result, length( Result ), 1 );
 | 
|---|
 | 646 | end;
 | 
|---|
 | 647 | 
 | 
|---|
 | 648 | procedure GetNextValue( const S: String;
 | 
|---|
 | 649 |                         Var Index: longint;
 | 
|---|
 | 650 |                         Var Value: String;
 | 
|---|
 | 651 |                         const Seperator: Char );
 | 
|---|
 | 652 | var
 | 
|---|
 | 653 |   NextSeperatorPosition: longint;
 | 
|---|
 | 654 |   StringLen: longint;
 | 
|---|
 | 655 | begin
 | 
|---|
 | 656 |   Value := '';
 | 
|---|
 | 657 |   StringLen := Length( S );
 | 
|---|
 | 658 |   if Index > StringLen then
 | 
|---|
 | 659 |     exit;
 | 
|---|
 | 660 |   NextSeperatorPosition := Index;
 | 
|---|
 | 661 |   while NextSeperatorPosition < StringLen do
 | 
|---|
 | 662 |   begin
 | 
|---|
 | 663 |     if S[ NextSeperatorPosition ] = Seperator then
 | 
|---|
 | 664 |       break;
 | 
|---|
 | 665 |     inc( NextSeperatorPosition );
 | 
|---|
 | 666 |   end;
 | 
|---|
 | 667 | 
 | 
|---|
 | 668 |   if NextSeperatorPosition < StringLen then
 | 
|---|
 | 669 |   begin
 | 
|---|
 | 670 |     Value := Copy( S,
 | 
|---|
 | 671 |                    Index,
 | 
|---|
 | 672 |                    NextSeperatorPosition - Index );
 | 
|---|
 | 673 |     Index := NextSeperatorPosition + 1;
 | 
|---|
 | 674 |   end
 | 
|---|
 | 675 |   else
 | 
|---|
 | 676 |   begin
 | 
|---|
 | 677 |     Value := Copy( S,
 | 
|---|
 | 678 |                    Index,
 | 
|---|
 | 679 |                    StringLen - Index + 1 );
 | 
|---|
 | 680 |     Index := StringLen + 1;
 | 
|---|
 | 681 |   end;
 | 
|---|
 | 682 |   TrimRight( Value );
 | 
|---|
 | 683 | end;
 | 
|---|
 | 684 | 
 | 
|---|
 | 685 | Function IsDigit( const c: char ): boolean;
 | 
|---|
 | 686 | Begin
 | 
|---|
 | 687 |   Result:=( c>='0' ) and ( c<='9' );
 | 
|---|
 | 688 | End;
 | 
|---|
 | 689 | 
 | 
|---|
 | 690 | Function IsNonDigit( const c: char ): boolean;
 | 
|---|
 | 691 | Begin
 | 
|---|
 | 692 |   Result:=( c<'0' ) or ( c>'9' );
 | 
|---|
 | 693 | End;
 | 
|---|
 | 694 | 
 | 
|---|
 | 695 | Function IsAlpha( const c: char ): boolean;
 | 
|---|
 | 696 | var
 | 
|---|
 | 697 |   UppercaseC: char;
 | 
|---|
 | 698 | Begin
 | 
|---|
 | 699 |   UppercaseC := UpCase( c );
 | 
|---|
 | 700 |   Result := ( UppercaseC >= 'A' ) and ( UppercaseC <= 'Z' );
 | 
|---|
 | 701 | end;
 | 
|---|
 | 702 | 
 | 
|---|
 | 703 | {$ifdef os2}
 | 
|---|
 | 704 | // Returns true if s is only spaces (or empty)
 | 
|---|
 | 705 | Function IsSpaces( const s: string ): boolean;
 | 
|---|
 | 706 | Begin
 | 
|---|
 | 707 |   Asm
 | 
|---|
 | 708 |   MOV ESI,s   // get address of s into ESI
 | 
|---|
 | 709 |   MOV CL,[ESI]     // get length of s
 | 
|---|
 | 710 |   MOVZX ECX, CL      // widen CL
 | 
|---|
 | 711 |   INC ECX
 | 
|---|
 | 712 | 
 | 
|---|
 | 713 | !IsSpacesLoop:
 | 
|---|
 | 714 |   INC ESI   // move to next char
 | 
|---|
 | 715 |   DEC ECX
 | 
|---|
 | 716 |   JE !IsSpacesTrue
 | 
|---|
 | 717 | 
 | 
|---|
 | 718 |   MOV AL,[ESI] // load character
 | 
|---|
 | 719 |   CMP AL,32  // is it a space?
 | 
|---|
 | 720 |   JE !IsSpacesLoop // yes, go to next
 | 
|---|
 | 721 | 
 | 
|---|
 | 722 |   // no, return false
 | 
|---|
 | 723 |   MOV EAX, 0
 | 
|---|
 | 724 |   JMP !IsSpacesDone
 | 
|---|
 | 725 | 
 | 
|---|
 | 726 | !IsSpacesTrue:
 | 
|---|
 | 727 |   MOV EAX, 1
 | 
|---|
 | 728 | 
 | 
|---|
 | 729 | !IsSpacesDone:
 | 
|---|
 | 730 |   LEAVE
 | 
|---|
 | 731 |   RETN32 4
 | 
|---|
 | 732 |   End;
 | 
|---|
 | 733 | 
 | 
|---|
 | 734 | End;
 | 
|---|
 | 735 | {$else}
 | 
|---|
 | 736 | // Returns true if s is only spaces (or empty)
 | 
|---|
 | 737 | Function IsSpaces( const s: string ): boolean;
 | 
|---|
 | 738 | var
 | 
|---|
 | 739 |   i: longint;
 | 
|---|
 | 740 | Begin
 | 
|---|
 | 741 |   for i := 1 to length( s ) do
 | 
|---|
 | 742 |   begin
 | 
|---|
 | 743 |     if s[ i ] <> ' ' then
 | 
|---|
 | 744 |     begin
 | 
|---|
 | 745 |       result := false;
 | 
|---|
 | 746 |       exit;
 | 
|---|
 | 747 |     end;
 | 
|---|
 | 748 |   end;
 | 
|---|
 | 749 |   result := true;
 | 
|---|
 | 750 | end;
 | 
|---|
 | 751 | {$endif}
 | 
|---|
 | 752 | 
 | 
|---|
 | 753 | Function StrLeft0Pad( const n: integer; const width: integer ): string;
 | 
|---|
 | 754 | Begin
 | 
|---|
 | 755 |   Result:= IntToStr( n );
 | 
|---|
 | 756 |   while length( Result )<width do
 | 
|---|
 | 757 |     Result:= '0' +Result;
 | 
|---|
 | 758 | End;
 | 
|---|
 | 759 | 
 | 
|---|
 | 760 | // Returns true if s starts with start
 | 
|---|
 | 761 | {$ifdef win32}
 | 
|---|
 | 762 | Function StrStarts( const start: string; const s: string ): boolean;
 | 
|---|
 | 763 | Var
 | 
|---|
 | 764 |   i: integer;
 | 
|---|
 | 765 | Begin
 | 
|---|
 | 766 |   Result:= false;
 | 
|---|
 | 767 |   if length( start ) > length( s ) then
 | 
|---|
 | 768 |     exit;
 | 
|---|
 | 769 |   for i:= 1 to length( start ) do
 | 
|---|
 | 770 |     if UpCase( s[ i ] ) <> UpCase( start[ i ] ) then
 | 
|---|
 | 771 |       exit;
 | 
|---|
 | 772 |   Result:= true;
 | 
|---|
 | 773 | End;
 | 
|---|
 | 774 | 
 | 
|---|
 | 775 | {$else}
 | 
|---|
 | 776 | 
 | 
|---|
 | 777 | Function StrStarts( const start: string; const s: string ): boolean;
 | 
|---|
 | 778 | Begin
 | 
|---|
 | 779 |   Asm
 | 
|---|
 | 780 |   //Locals:
 | 
|---|
 | 781 |   //START at [EBP+12]
 | 
|---|
 | 782 |   //S at [EBP+8]
 | 
|---|
 | 783 | 
 | 
|---|
 | 784 |   // First get and check lengths
 | 
|---|
 | 785 |   MOV ESI,[EBP+12]   // get address of start into ESI
 | 
|---|
 | 786 |   MOV CL,[ESI]     // get length of start (set remainder of CL to zero)
 | 
|---|
 | 787 |   MOV EDI,[EBP+8]    // get address of s into EDI
 | 
|---|
 | 788 |   MOV DL,[EDI]       // get length of s
 | 
|---|
 | 789 |   CMP CL,DL
 | 
|---|
 | 790 |   JBE !StartLengthOK
 | 
|---|
 | 791 | 
 | 
|---|
 | 792 |   // start longer than s so false
 | 
|---|
 | 793 |   MOV EAX, 0
 | 
|---|
 | 794 |   LEAVE
 | 
|---|
 | 795 |   RETN32 8
 | 
|---|
 | 796 | 
 | 
|---|
 | 797 | !StartLengthOK:
 | 
|---|
 | 798 |   INC ESI            // skip ESI past length byte of start string
 | 
|---|
 | 799 | 
 | 
|---|
 | 800 |   // get ending address of start into EDX
 | 
|---|
 | 801 |   MOV EDX, ESI
 | 
|---|
 | 802 | 
 | 
|---|
 | 803 |   MOVZX ECX, CL      // widen CL
 | 
|---|
 | 804 |   ADD EDX, ECX       // ecx is length of start, add to edx
 | 
|---|
 | 805 | 
 | 
|---|
 | 806 |   // get starting address of s
 | 
|---|
 | 807 |   INC EDI            // skip EDI past length byte of s
 | 
|---|
 | 808 | 
 | 
|---|
 | 809 |   JMP !StartsLoop
 | 
|---|
 | 810 | 
 | 
|---|
 | 811 | !StartsLoopStart:
 | 
|---|
 | 812 |   MOV AL, [ESI] // get next char of start string
 | 
|---|
 | 813 |   MOV BL, [EDI] // get next char of string
 | 
|---|
 | 814 | 
 | 
|---|
 | 815 |   // Convert chars to uppercase
 | 
|---|
 | 816 |   CMP AL,97
 | 
|---|
 | 817 |   JB !Upcase1
 | 
|---|
 | 818 |   CMP AL,122
 | 
|---|
 | 819 |   JA !Upcase1
 | 
|---|
 | 820 |   SUB AL,32 // convert lower to upper
 | 
|---|
 | 821 | !Upcase1:
 | 
|---|
 | 822 | 
 | 
|---|
 | 823 |   CMP BL,97
 | 
|---|
 | 824 |   JB !Upcase2
 | 
|---|
 | 825 |   CMP BL,122
 | 
|---|
 | 826 |   JA !Upcase2
 | 
|---|
 | 827 |   SUB BL,32 // convert lower to upper
 | 
|---|
 | 828 | !Upcase2:
 | 
|---|
 | 829 | 
 | 
|---|
 | 830 |   // Compare uppercased chars
 | 
|---|
 | 831 |   CMP AL,BL
 | 
|---|
 | 832 |   JE !StartsCharMatch
 | 
|---|
 | 833 |   // different.
 | 
|---|
 | 834 |   MOV EAX, 0
 | 
|---|
 | 835 |   LEAVE
 | 
|---|
 | 836 |   RETN32 8
 | 
|---|
 | 837 | 
 | 
|---|
 | 838 | !StartsCharMatch:
 | 
|---|
 | 839 |   INC ESI
 | 
|---|
 | 840 |   INC EDI
 | 
|---|
 | 841 | 
 | 
|---|
 | 842 | !StartsLoop:
 | 
|---|
 | 843 |   CMP ESI, EDX        // have we reached the end (EDX) of start string
 | 
|---|
 | 844 |   JB !StartsLoopStart
 | 
|---|
 | 845 | 
 | 
|---|
 | 846 |   // Match, return true
 | 
|---|
 | 847 |   MOV EAX, 1
 | 
|---|
 | 848 |   LEAVE
 | 
|---|
 | 849 |   RETN32 8
 | 
|---|
 | 850 |   End;
 | 
|---|
 | 851 | end;
 | 
|---|
 | 852 | {$endif}
 | 
|---|
 | 853 | 
 | 
|---|
 | 854 | // Returns true if s ends with endstr (case insensitive)
 | 
|---|
 | 855 | Function StrEnds( const endStr: string; const s: string ): boolean;
 | 
|---|
 | 856 | Var
 | 
|---|
 | 857 |   i, j: integer;
 | 
|---|
 | 858 | Begin
 | 
|---|
 | 859 |   Result:= false;
 | 
|---|
 | 860 |   if Length( s ) < length( endStr ) then
 | 
|---|
 | 861 |     exit;
 | 
|---|
 | 862 |   j:= Length( s );
 | 
|---|
 | 863 |   for i:= length( endstr ) downto 1 do
 | 
|---|
 | 864 |   begin
 | 
|---|
 | 865 |     if UpCase( s[ j ] ) <> UpCase( endStr[ i ] ) then
 | 
|---|
 | 866 |       exit;
 | 
|---|
 | 867 |     dec( j );
 | 
|---|
 | 868 |   end;
 | 
|---|
 | 869 |   Result:= true;
 | 
|---|
 | 870 | End;
 | 
|---|
 | 871 | 
 | 
|---|
 | 872 | Procedure RemoveSeparatorSpaces( var S: string;
 | 
|---|
 | 873 |                                  const Separator:string );
 | 
|---|
 | 874 | Var
 | 
|---|
 | 875 |   SeparatorPos:integer;
 | 
|---|
 | 876 |   NewString: string;
 | 
|---|
 | 877 | Begin
 | 
|---|
 | 878 |   NewString := '';
 | 
|---|
 | 879 |   while S <> '' do
 | 
|---|
 | 880 |   begin
 | 
|---|
 | 881 |     SeparatorPos := pos( Separator, S );
 | 
|---|
 | 882 |     if SeparatorPos > 0 then
 | 
|---|
 | 883 |     begin
 | 
|---|
 | 884 |       NewString := NewString
 | 
|---|
 | 885 |                    + trim( copy( S, 1, SeparatorPos - 1 ) )
 | 
|---|
 | 886 |                    + Separator;
 | 
|---|
 | 887 |       Delete( S, 1, SeparatorPos );
 | 
|---|
 | 888 |     end
 | 
|---|
 | 889 |     else
 | 
|---|
 | 890 |     begin
 | 
|---|
 | 891 |       NewString := NewString + trim( S );
 | 
|---|
 | 892 |       S := '';
 | 
|---|
 | 893 |     end;
 | 
|---|
 | 894 |   end;
 | 
|---|
 | 895 |   S := NewString;
 | 
|---|
 | 896 | End;
 | 
|---|
 | 897 | 
 | 
|---|
 | 898 | Procedure AddToListString( Var S: string;
 | 
|---|
 | 899 |                            const NewValue: string;
 | 
|---|
 | 900 |                            const Separator: string );
 | 
|---|
 | 901 | Begin
 | 
|---|
 | 902 |   if trim( S )<>'' then
 | 
|---|
 | 903 |     S:=S+Separator;
 | 
|---|
 | 904 |   S:=S+NewValue;
 | 
|---|
 | 905 | End;
 | 
|---|
 | 906 | 
 | 
|---|
 | 907 | Function ListToString( List: TStrings;
 | 
|---|
 | 908 |                        const Separator: string ): string;
 | 
|---|
 | 909 | Var
 | 
|---|
 | 910 |   i: longint;
 | 
|---|
 | 911 | Begin
 | 
|---|
 | 912 |   Result:= '';
 | 
|---|
 | 913 |   for i:= 0 to List.Count - 1 do
 | 
|---|
 | 914 |     AddToListString( Result, List[ i ], Separator );
 | 
|---|
 | 915 | End;
 | 
|---|
 | 916 | 
 | 
|---|
 | 917 | procedure StringToList( S: String;
 | 
|---|
 | 918 |                         List: TStrings;
 | 
|---|
 | 919 |                         const Separator: string );
 | 
|---|
 | 920 | var
 | 
|---|
 | 921 |   Item: string;
 | 
|---|
 | 922 | begin
 | 
|---|
 | 923 |   List.Clear;
 | 
|---|
 | 924 |   while S <> '' do
 | 
|---|
 | 925 |   begin
 | 
|---|
 | 926 |     Item:= ExtractNextValue( S, Separator );
 | 
|---|
 | 927 |     List.Add( Item );
 | 
|---|
 | 928 |   end;
 | 
|---|
 | 929 | end;
 | 
|---|
 | 930 | 
 | 
|---|
 | 931 | Function StrFirstWord( const S: String ): string;
 | 
|---|
 | 932 | Var
 | 
|---|
 | 933 |   SpacePos: longint;
 | 
|---|
 | 934 |   temp: string;
 | 
|---|
 | 935 | Begin
 | 
|---|
 | 936 |   temp:= trimleft( S );
 | 
|---|
 | 937 |   SpacePos:= pos( ' ', temp );
 | 
|---|
 | 938 |   if SpacePos>0 then
 | 
|---|
 | 939 |     Result:= Copy( temp, 1, SpacePos-1 )
 | 
|---|
 | 940 |   else
 | 
|---|
 | 941 |     Result:= temp;
 | 
|---|
 | 942 | End;
 | 
|---|
 | 943 | 
 | 
|---|
 | 944 | function FindCharFromEnd( const s: string;
 | 
|---|
 | 945 |                           const c: char ): longint;
 | 
|---|
 | 946 | var
 | 
|---|
 | 947 |   i: longint;
 | 
|---|
 | 948 | begin
 | 
|---|
 | 949 |   i := Length( s );
 | 
|---|
 | 950 |   while i > 0 do
 | 
|---|
 | 951 |   begin
 | 
|---|
 | 952 |     if s[ i ] = c then
 | 
|---|
 | 953 |     begin
 | 
|---|
 | 954 |       Result := i;
 | 
|---|
 | 955 |       exit;
 | 
|---|
 | 956 |     end;
 | 
|---|
 | 957 |     dec( i );
 | 
|---|
 | 958 |   end;
 | 
|---|
 | 959 |   result := 0;
 | 
|---|
 | 960 | end;
 | 
|---|
 | 961 | 
 | 
|---|
 | 962 | Function IncrementNumberedString( StartString: string ): string;
 | 
|---|
 | 963 | Var
 | 
|---|
 | 964 |   Number: string;
 | 
|---|
 | 965 |   NewNumber: string;
 | 
|---|
 | 966 |   i: integer;
 | 
|---|
 | 967 | begin
 | 
|---|
 | 968 |   // Extract any digits at the end of the string
 | 
|---|
 | 969 |   i:= length( StartString );
 | 
|---|
 | 970 |   Number:= '';
 | 
|---|
 | 971 |   while i>0 do
 | 
|---|
 | 972 |   begin
 | 
|---|
 | 973 |     if isDigit( StartString[i] ) then
 | 
|---|
 | 974 |     begin
 | 
|---|
 | 975 |        Number:= StartString[i] + Number;
 | 
|---|
 | 976 |        i:= i - 1;
 | 
|---|
 | 977 |     end
 | 
|---|
 | 978 |     else
 | 
|---|
 | 979 |       break;
 | 
|---|
 | 980 |   end;
 | 
|---|
 | 981 | 
 | 
|---|
 | 982 |   if Number<>'' then
 | 
|---|
 | 983 |   begin
 | 
|---|
 | 984 |     // Found a numeric bit to play with
 | 
|---|
 | 985 |     // Copy the first part
 | 
|---|
 | 986 |     Result:= StrLeftWithout( StartString, length( Number ) );
 | 
|---|
 | 987 |     NewNumber:= StrLeft0Pad( StrToInt( Number ) + 1,
 | 
|---|
 | 988 |                                length( Number ) );
 | 
|---|
 | 989 |     Result:= Result + NewNumber;
 | 
|---|
 | 990 |   end
 | 
|---|
 | 991 |   else
 | 
|---|
 | 992 |     // No build number, add a 1
 | 
|---|
 | 993 |     Result:= StartString + '1';
 | 
|---|
 | 994 | end;
 | 
|---|
 | 995 | 
 | 
|---|
 | 996 | {$ifdef OS2}
 | 
|---|
 | 997 | 
 | 
|---|
 | 998 | Function AnsiTrim( const S: AnsiString ): AnsiString;
 | 
|---|
 | 999 | Var
 | 
|---|
 | 1000 |   i: longint;
 | 
|---|
 | 1001 | Begin
 | 
|---|
 | 1002 |   i:= 1;
 | 
|---|
 | 1003 |   while i<length( S) do
 | 
|---|
 | 1004 |   begin
 | 
|---|
 | 1005 |     if S[ i ]<>' ' then
 | 
|---|
 | 1006 |       break;
 | 
|---|
 | 1007 |     inc( i );
 | 
|---|
 | 1008 |   end;
 | 
|---|
 | 1009 |   Result:= S;
 | 
|---|
 | 1010 |   if i>1 then
 | 
|---|
 | 1011 |     AnsiDelete( Result, 1, i-1 );
 | 
|---|
 | 1012 |   i:= length( Result );
 | 
|---|
 | 1013 |   while i>=1 do
 | 
|---|
 | 1014 |   begin
 | 
|---|
 | 1015 |     if S[ i ]<>' ' then
 | 
|---|
 | 1016 |       break;
 | 
|---|
 | 1017 |     dec( i );
 | 
|---|
 | 1018 |   end;
 | 
|---|
 | 1019 |   AnsiSetLength( Result, i );
 | 
|---|
 | 1020 | End;
 | 
|---|
 | 1021 | 
 | 
|---|
 | 1022 | Procedure AnsiParseConfigLine( const S: Ansistring;
 | 
|---|
 | 1023 |                                var keyName: Ansistring;
 | 
|---|
 | 1024 |                                var keyValue: Ansistring );
 | 
|---|
 | 1025 | Var
 | 
|---|
 | 1026 |   line: AnsiString;
 | 
|---|
 | 1027 |   EqualsPos: longint;
 | 
|---|
 | 1028 | Begin
 | 
|---|
 | 1029 |   KeyName:= '';
 | 
|---|
 | 1030 |   KeyValue:= '';
 | 
|---|
 | 1031 | 
 | 
|---|
 | 1032 |   line:= AnsiTrim( S );
 | 
|---|
 | 1033 |   EqualsPos:= AnsiPos( '=', line );
 | 
|---|
 | 1034 | 
 | 
|---|
 | 1035 |   if ( EqualsPos>0 ) then
 | 
|---|
 | 1036 |   begin
 | 
|---|
 | 1037 |     KeyName:= AnsiCopy( line, 1, EqualsPos-1 );
 | 
|---|
 | 1038 |     KeyName:= AnsiTrim( KeyName );
 | 
|---|
 | 1039 | 
 | 
|---|
 | 1040 |     KeyValue:= AnsiCopy( line, EqualsPos+1, length( line )-EqualsPos );
 | 
|---|
 | 1041 |     KeyValue:= AnsiTrim( KeyValue );
 | 
|---|
 | 1042 |   end;
 | 
|---|
 | 1043 | end;
 | 
|---|
 | 1044 | 
 | 
|---|
 | 1045 | Function AnsiExtractNextValue( var CSVString: AnsiString;
 | 
|---|
 | 1046 |                                const Separator: AnsiString ): AnsiString;
 | 
|---|
 | 1047 | Var
 | 
|---|
 | 1048 |   SeparatorPos: integer;
 | 
|---|
 | 1049 | Begin
 | 
|---|
 | 1050 |   SeparatorPos:= AnsiPos( Separator, CSVString );
 | 
|---|
 | 1051 |   if SeparatorPos>0 then
 | 
|---|
 | 1052 |   begin
 | 
|---|
 | 1053 |     Result:= AnsiCopy( CSVString, 1, SeparatorPos-1 );
 | 
|---|
 | 1054 |     AnsiDelete( CSVString, 1, SeparatorPos + length( Separator ) - 1 );
 | 
|---|
 | 1055 |   end
 | 
|---|
 | 1056 |   else
 | 
|---|
 | 1057 |   begin
 | 
|---|
 | 1058 |     Result:= CSVString;
 | 
|---|
 | 1059 |     CSVString:= '';
 | 
|---|
 | 1060 |   end;
 | 
|---|
 | 1061 |   Result:= AnsiTrim( Result );
 | 
|---|
 | 1062 |   // Remove qyotes if present
 | 
|---|
 | 1063 |   if ( Result[1] = chr(34) )
 | 
|---|
 | 1064 |      and ( Result[ length(Result) ] = chr(34) ) then
 | 
|---|
 | 1065 |   begin
 | 
|---|
 | 1066 |     AnsiDelete( Result, 1, 1 );
 | 
|---|
 | 1067 |     AnsiDelete( Result, length( Result ), 1 );
 | 
|---|
 | 1068 |     Result:= AnsiTrim( Result );
 | 
|---|
 | 1069 |   end;
 | 
|---|
 | 1070 | end;
 | 
|---|
 | 1071 | {$Endif}
 | 
|---|
 | 1072 | 
 | 
|---|
 | 1073 | Procedure ReverseList( TheList:TStrings );
 | 
|---|
 | 1074 | Var
 | 
|---|
 | 1075 |   TempList: TStringList;
 | 
|---|
 | 1076 |   i: integer;
 | 
|---|
 | 1077 | Begin
 | 
|---|
 | 1078 |   TempList:= TStringList.Create;
 | 
|---|
 | 1079 |   for i:=TheList.count-1 downto 0 do
 | 
|---|
 | 1080 |   begin
 | 
|---|
 | 1081 |     TempList.AddObject( TheList.Strings[i],
 | 
|---|
 | 1082 |                         TheList.Objects[i] );
 | 
|---|
 | 1083 |   end;
 | 
|---|
 | 1084 |   TheList.Assign( TempList );
 | 
|---|
 | 1085 |   TempList.Destroy;
 | 
|---|
 | 1086 | end;
 | 
|---|
 | 1087 | 
 | 
|---|
 | 1088 | Function FindStringInList( const TheString: string;
 | 
|---|
 | 1089 |                            TheList:TStrings ): longint;
 | 
|---|
 | 1090 | Var
 | 
|---|
 | 1091 |   i: longint;
 | 
|---|
 | 1092 | Begin
 | 
|---|
 | 1093 |   for i:=0 to TheList.count-1 do
 | 
|---|
 | 1094 |   begin
 | 
|---|
 | 1095 |     if StringsSame( TheString, TheList[ i ] ) then
 | 
|---|
 | 1096 |     begin
 | 
|---|
 | 1097 |       // found
 | 
|---|
 | 1098 |       Result:=i;
 | 
|---|
 | 1099 |       exit;
 | 
|---|
 | 1100 |     end;
 | 
|---|
 | 1101 |   end;
 | 
|---|
 | 1102 |   Result:=-1;
 | 
|---|
 | 1103 | End;
 | 
|---|
 | 1104 | 
 | 
|---|
 | 1105 | Procedure MergeStringLists( Dest: TStringList;
 | 
|---|
 | 1106 |                             AdditionalList: TStringList );
 | 
|---|
 | 1107 | var
 | 
|---|
 | 1108 |   i: integer;
 | 
|---|
 | 1109 |   s: string;
 | 
|---|
 | 1110 | begin
 | 
|---|
 | 1111 |   for i:= 0 to AdditionalList.Count - 1 do
 | 
|---|
 | 1112 |   begin
 | 
|---|
 | 1113 |     s:= AdditionalList[ i ];
 | 
|---|
 | 1114 |     if FindStringInList( s, Dest ) = -1 then
 | 
|---|
 | 1115 |       Dest.AddObject( s, AdditionalList.Objects[ i ] );
 | 
|---|
 | 1116 |   end;
 | 
|---|
 | 1117 | end;
 | 
|---|
 | 1118 | 
 | 
|---|
 | 1119 | // ---------------------- PCHAR Utilities ---------------------------------------
 | 
|---|
 | 1120 | 
 | 
|---|
 | 1121 | function StrNPas( const Ps: PChar; const Length: integer ): String;
 | 
|---|
 | 1122 | var
 | 
|---|
 | 1123 |   i: integer;
 | 
|---|
 | 1124 | begin
 | 
|---|
 | 1125 |   Result:= '';
 | 
|---|
 | 1126 |   i:= 0;
 | 
|---|
 | 1127 |   while ( Ps[ i ] <> #0 ) and ( i < Length ) do
 | 
|---|
 | 1128 |   begin
 | 
|---|
 | 1129 |     Result:= Result + Ps[ i ];
 | 
|---|
 | 1130 |     inc( i );
 | 
|---|
 | 1131 |   end;
 | 
|---|
 | 1132 | end;
 | 
|---|
 | 1133 | 
 | 
|---|
 | 1134 | Function PCharDiff( const a: PChar; const b: Pchar ): longword;
 | 
|---|
 | 1135 | begin
 | 
|---|
 | 1136 |   Result:= longword( a ) - longword( b );
 | 
|---|
 | 1137 | end;
 | 
|---|
 | 1138 | 
 | 
|---|
 | 1139 | Procedure CheckPCharSize( Var Text: PChar;
 | 
|---|
 | 1140 |                           const NeededSize: longword );
 | 
|---|
 | 1141 | var
 | 
|---|
 | 1142 |   temp: PChar;
 | 
|---|
 | 1143 |   NewBufferSize: longword;
 | 
|---|
 | 1144 | begin
 | 
|---|
 | 1145 |   if   ( NeededSize + 1 ) // + 1 to allow for null terminator
 | 
|---|
 | 1146 |      > StrBufSize( Text ) then
 | 
|---|
 | 1147 |   begin
 | 
|---|
 | 1148 |     // allocate new buffer, double the size...
 | 
|---|
 | 1149 |     NewBufferSize:= StrBufSize( Text ) * 2;
 | 
|---|
 | 1150 |     // or if that's not enough...
 | 
|---|
 | 1151 |     if NewBufferSize < ( NeededSize + 1 ) then
 | 
|---|
 | 1152 |       // double what we are going to need
 | 
|---|
 | 1153 |       NewBufferSize:= NeededSize * 2;
 | 
|---|
 | 1154 |     temp:= StrAlloc( NewBufferSize );
 | 
|---|
 | 1155 | 
 | 
|---|
 | 1156 |     // copy string to new buffer
 | 
|---|
 | 1157 |     StrCopy( temp, Text );
 | 
|---|
 | 1158 |     StrDispose( Text );
 | 
|---|
 | 1159 |     Text:= temp;
 | 
|---|
 | 1160 |   end;
 | 
|---|
 | 1161 | end;
 | 
|---|
 | 1162 | 
 | 
|---|
 | 1163 | Procedure AddAndResize( Var Text: PChar;
 | 
|---|
 | 1164 |                         const AddText: PChar );
 | 
|---|
 | 1165 | begin
 | 
|---|
 | 1166 |   CheckPCharSize( Text,
 | 
|---|
 | 1167 |                   strlen( Text )
 | 
|---|
 | 1168 |                   + strlen( AddText ) );
 | 
|---|
 | 1169 |   StrCat( Text, AddText );
 | 
|---|
 | 1170 | end;
 | 
|---|
 | 1171 | 
 | 
|---|
 | 1172 | Procedure StrCopyAndResize( Var Dest: PChar;
 | 
|---|
 | 1173 |                             const Source: PChar );
 | 
|---|
 | 1174 | begin
 | 
|---|
 | 1175 |   CheckPCharSize( Dest, StrLen( Source ) );
 | 
|---|
 | 1176 |   StrCopy( Dest, Source );
 | 
|---|
 | 1177 | end;
 | 
|---|
 | 1178 | 
 | 
|---|
 | 1179 | // trims spaces and carriage returns of the end of Text
 | 
|---|
 | 1180 | procedure TrimWhitespace( Text: PChar );
 | 
|---|
 | 1181 | var
 | 
|---|
 | 1182 |   P: PChar;
 | 
|---|
 | 1183 |   IsWhitespace: boolean;
 | 
|---|
 | 1184 |   TheChar: Char;
 | 
|---|
 | 1185 | begin
 | 
|---|
 | 1186 |   P:= Text + StrLen( Text );
 | 
|---|
 | 1187 |   while P > Text do
 | 
|---|
 | 1188 |   begin
 | 
|---|
 | 1189 |     dec( P );
 | 
|---|
 | 1190 |     TheChar:= P^;
 | 
|---|
 | 1191 |     IsWhitespace:= TheChar in [ ' ', #13, #10, #9 ];
 | 
|---|
 | 1192 |     if not IsWhiteSpace then
 | 
|---|
 | 1193 |       // done
 | 
|---|
 | 1194 |       break;
 | 
|---|
 | 1195 |     P[ 0 ]:= #0; // Do no use P^ :=
 | 
|---|
 | 1196 |   end;
 | 
|---|
 | 1197 | end;
 | 
|---|
 | 1198 | 
 | 
|---|
 | 1199 | function TrimChars( const s: string;
 | 
|---|
 | 1200 |                     chars: TSetOfChars ): string;
 | 
|---|
 | 1201 | var
 | 
|---|
 | 1202 |   i: longint;
 | 
|---|
 | 1203 |   j: longint;
 | 
|---|
 | 1204 | begin
 | 
|---|
 | 1205 |   i := 1;
 | 
|---|
 | 1206 |   while i < Length( s ) do
 | 
|---|
 | 1207 |     if s[ i ] in chars then
 | 
|---|
 | 1208 |       inc( i )
 | 
|---|
 | 1209 |     else
 | 
|---|
 | 1210 |       break;
 | 
|---|
 | 1211 | 
 | 
|---|
 | 1212 |   j := Length( s );
 | 
|---|
 | 1213 |   while j > i do
 | 
|---|
 | 1214 |     if s[ j ] in chars then
 | 
|---|
 | 1215 |       dec( j )
 | 
|---|
 | 1216 |     else
 | 
|---|
 | 1217 |       break;
 | 
|---|
 | 1218 | 
 | 
|---|
 | 1219 |   result := Copy( s, i, j - i + 1 );
 | 
|---|
 | 1220 | end;
 | 
|---|
 | 1221 | 
 | 
|---|
 | 1222 | procedure StrPCat( Var Dest: PChar;
 | 
|---|
 | 1223 |                    const StringToAdd: string );
 | 
|---|
 | 1224 | var
 | 
|---|
 | 1225 |   Index: longint;
 | 
|---|
 | 1226 |   DestP: PChar;
 | 
|---|
 | 1227 | begin
 | 
|---|
 | 1228 |   CheckPCharSize( Dest,
 | 
|---|
 | 1229 |                   StrLen( Dest )
 | 
|---|
 | 1230 |                   + longword( Length( StringToAdd ) ) );
 | 
|---|
 | 1231 |   DestP:= Dest + StrLen( Dest );
 | 
|---|
 | 1232 |   for Index:= 1 to Length( StringToAdd ) do
 | 
|---|
 | 1233 |   begin
 | 
|---|
 | 1234 |     DestP[ 0 ]:= StringToAdd[ Index ]; // do not use DestP^ :=
 | 
|---|
 | 1235 |     inc( DestP );
 | 
|---|
 | 1236 |   end;
 | 
|---|
 | 1237 |   DestP[ 0 ]:= #0; // Do not use DestP^ := #0; Under Sibyl at least, this writes *** 2 NULL BYTES!!! ***
 | 
|---|
 | 1238 | end;
 | 
|---|
 | 1239 | 
 | 
|---|
 | 1240 | Procedure TrimEndLines( const S: PChar );
 | 
|---|
 | 1241 | var
 | 
|---|
 | 1242 |   StringIndex: integer;
 | 
|---|
 | 1243 | {$ifdef os2}
 | 
|---|
 | 1244 |   p: pchar;
 | 
|---|
 | 1245 | {$endif}
 | 
|---|
 | 1246 | begin
 | 
|---|
 | 1247 |   StringIndex:= strlen( S );
 | 
|---|
 | 1248 |   while StringIndex > 0 do
 | 
|---|
 | 1249 |   begin
 | 
|---|
 | 1250 |     dec( StringIndex );
 | 
|---|
 | 1251 |     if S[ StringIndex ] in [ #10, #13 ] then
 | 
|---|
 | 1252 |     begin
 | 
|---|
 | 1253 | {$ifdef win32}
 | 
|---|
 | 1254 |       S[ StringIndex ]:= #0
 | 
|---|
 | 1255 | {$else}
 | 
|---|
 | 1256 |       p := S;
 | 
|---|
 | 1257 |       p[ StringIndex ] := #0;
 | 
|---|
 | 1258 | {$endif}
 | 
|---|
 | 1259 |     end
 | 
|---|
 | 1260 |     else
 | 
|---|
 | 1261 |       break;
 | 
|---|
 | 1262 |   end;
 | 
|---|
 | 1263 | end;
 | 
|---|
 | 1264 | 
 | 
|---|
 | 1265 | Function StrDupPas( const s: string ): PChar;
 | 
|---|
 | 1266 | Begin
 | 
|---|
 | 1267 |   Result:=StrAlloc( length( s )+1 );
 | 
|---|
 | 1268 |   StrPCopy( Result, S );
 | 
|---|
 | 1269 | //  Result^:=s;
 | 
|---|
 | 1270 | End;
 | 
|---|
 | 1271 | 
 | 
|---|
 | 1272 | // Returns a copy of the first n chars of s
 | 
|---|
 | 1273 | Function StrNDup( const s: PChar; const n: integer ): PChar;
 | 
|---|
 | 1274 | Begin
 | 
|---|
 | 1275 |   Result:= StrAlloc( n+1 );
 | 
|---|
 | 1276 |   Result[ n ]:= '6';
 | 
|---|
 | 1277 |   StrLCopy( Result, s, n );
 | 
|---|
 | 1278 | End;
 | 
|---|
 | 1279 | 
 | 
|---|
 | 1280 | // Returns a copy of the first line starting at lineStart
 | 
|---|
 | 1281 | Function CopyFirstLine( const lineStart: PChar ): PChar;
 | 
|---|
 | 1282 | Var
 | 
|---|
 | 1283 |   lineEnd: PChar;
 | 
|---|
 | 1284 |   lineLength: integer;
 | 
|---|
 | 1285 | Begin
 | 
|---|
 | 1286 |   // look for an end of line
 | 
|---|
 | 1287 |   lineEnd:= strpos( lineStart, EndLine );
 | 
|---|
 | 1288 |   if lineEnd <> nil then
 | 
|---|
 | 1289 |   begin
 | 
|---|
 | 1290 |     // found, line length is difference between line end position and start of line
 | 
|---|
 | 1291 |     lineLength:= longword( lineEnd )-longword( lineStart ); // ugly but how else can it be done?
 | 
|---|
 | 1292 |     Result:= StrNDup( lineStart, lineLength );
 | 
|---|
 | 1293 |     exit;
 | 
|---|
 | 1294 |   end;
 | 
|---|
 | 1295 | 
 | 
|---|
 | 1296 |   // no eol found, return copy of remainder of string
 | 
|---|
 | 1297 |   Result:= StrNew( lineStart );
 | 
|---|
 | 1298 | end;
 | 
|---|
 | 1299 | 
 | 
|---|
 | 1300 | // Returns next line p points to
 | 
|---|
 | 1301 | Function NextLine( const p: PChar): PChar;
 | 
|---|
 | 1302 | Var
 | 
|---|
 | 1303 |   lineEnd: PChar;
 | 
|---|
 | 1304 | Begin
 | 
|---|
 | 1305 |   // look for an end of line
 | 
|---|
 | 1306 |   lineEnd:=strpos( p, EndLine );
 | 
|---|
 | 1307 |   if lineEnd<>nil then
 | 
|---|
 | 1308 |   begin
 | 
|---|
 | 1309 |     // Advance the linestart over the eol
 | 
|---|
 | 1310 |     Result:=lineEnd+length( EndLine );
 | 
|---|
 | 1311 |     exit;
 | 
|---|
 | 1312 |   end;
 | 
|---|
 | 1313 | 
 | 
|---|
 | 1314 |   // no eol found, return pointer to null term
 | 
|---|
 | 1315 |   Result:=p+strlen( p );
 | 
|---|
 | 1316 | end;
 | 
|---|
 | 1317 | 
 | 
|---|
 | 1318 | {$ifdef os2}
 | 
|---|
 | 1319 | Function CaseInsensitivePos( const a: string;
 | 
|---|
 | 1320 |                              const b: string ): longint;
 | 
|---|
 | 1321 | var
 | 
|---|
 | 1322 |   EndOfA: longword;
 | 
|---|
 | 1323 | Begin
 | 
|---|
 | 1324 |   Asm
 | 
|---|
 | 1325 |   //Locals:
 | 
|---|
 | 1326 |   //a at [EBP+12]
 | 
|---|
 | 1327 |   //b at [EBP+8]
 | 
|---|
 | 1328 | 
 | 
|---|
 | 1329 |   // First get and check lengths
 | 
|---|
 | 1330 |   MOV   ESI, a         // get address of a into ESI
 | 
|---|
 | 1331 |   MOV   CL,  [ESI]     // get length of a
 | 
|---|
 | 1332 |   MOV   EDI, b         // get address of b into EDI
 | 
|---|
 | 1333 |   MOV   DL,  [EDI]     // get length of b
 | 
|---|
 | 1334 |   CMP   CL,  DL
 | 
|---|
 | 1335 |   JBE   !CIP_AFitsInB
 | 
|---|
 | 1336 | 
 | 
|---|
 | 1337 |   // a longer than b so a can't be in b
 | 
|---|
 | 1338 | 
 | 
|---|
 | 1339 | !CIP_NoMatch:
 | 
|---|
 | 1340 |   MOV   EAX, 0
 | 
|---|
 | 1341 |   LEAVE
 | 
|---|
 | 1342 |   RETN32 8
 | 
|---|
 | 1343 | 
 | 
|---|
 | 1344 | !CIP_AFitsInB:
 | 
|---|
 | 1345 | 
 | 
|---|
 | 1346 |   INC   ESI            // skip length byte in a
 | 
|---|
 | 1347 |   INC   EDI            // skip length byte of b
 | 
|---|
 | 1348 | 
 | 
|---|
 | 1349 |   // get ending address of b into EDX
 | 
|---|
 | 1350 |   MOVZX EDX, DL        // widen DL
 | 
|---|
 | 1351 |   ADD   EDX, EDI       // add start of b
 | 
|---|
 | 1352 | 
 | 
|---|
 | 1353 |   // get ending address of a into EndOfA
 | 
|---|
 | 1354 |   MOVZX ECX, CL        // widen CL
 | 
|---|
 | 1355 |   ADD   ECX, ESI       // add start of a
 | 
|---|
 | 1356 |   MOV   EndOfA, ECX    // store to EndOfA
 | 
|---|
 | 1357 | 
 | 
|---|
 | 1358 |   MOV   ECX, EDI       // set start of current match to start of b
 | 
|---|
 | 1359 | 
 | 
|---|
 | 1360 |   // ESI: current search point in a
 | 
|---|
 | 1361 |   // EDI: current search point in b
 | 
|---|
 | 1362 |   // EDX: end of b
 | 
|---|
 | 1363 |   // ECX: start of current match
 | 
|---|
 | 1364 |   // available: eax, ebx
 | 
|---|
 | 1365 | 
 | 
|---|
 | 1366 |   JMP   !CIP_Loop
 | 
|---|
 | 1367 | 
 | 
|---|
 | 1368 | !CIP_LoopStart:
 | 
|---|
 | 1369 |   CMP   EDI, EDX
 | 
|---|
 | 1370 |   JE    !CIP_NoMatch   // run out of b
 | 
|---|
 | 1371 | 
 | 
|---|
 | 1372 |   MOV   AL,  [ESI]     // get next char of a
 | 
|---|
 | 1373 |   INC   ESI            // next in a
 | 
|---|
 | 1374 | 
 | 
|---|
 | 1375 |   MOV   BL,  [EDI]     // get next char of b
 | 
|---|
 | 1376 |   INC   EDI            // next in b
 | 
|---|
 | 1377 | 
 | 
|---|
 | 1378 |   // Convert chars to uppercase
 | 
|---|
 | 1379 | 
 | 
|---|
 | 1380 |   CMP   AL,  97
 | 
|---|
 | 1381 |   JB    !CIP_Upcase1
 | 
|---|
 | 1382 |   CMP   AL,  122
 | 
|---|
 | 1383 |   JA    !CIP_Upcase1
 | 
|---|
 | 1384 |   SUB   AL,  32         // convert lower to upper
 | 
|---|
 | 1385 | !CIP_Upcase1:
 | 
|---|
 | 1386 | 
 | 
|---|
 | 1387 |   CMP   BL,97
 | 
|---|
 | 1388 |   JB    !CIP_Upcase2
 | 
|---|
 | 1389 |   CMP   BL,122
 | 
|---|
 | 1390 |   JA    !CIP_Upcase2
 | 
|---|
 | 1391 |   SUB   BL,32          // convert lower to upper
 | 
|---|
 | 1392 | !CIP_Upcase2:
 | 
|---|
 | 1393 | 
 | 
|---|
 | 1394 |   // Compare uppercased chars
 | 
|---|
 | 1395 |   CMP   AL,BL
 | 
|---|
 | 1396 |   JE    !CIP_Loop
 | 
|---|
 | 1397 | 
 | 
|---|
 | 1398 |   // different.
 | 
|---|
 | 1399 | 
 | 
|---|
 | 1400 |   // Back to start of match + 1
 | 
|---|
 | 1401 |   INC   ECX            // inc start of match
 | 
|---|
 | 1402 |   MOV   EDI, ECX       // back to start of match in b
 | 
|---|
 | 1403 |   MOV   ESI, a         // back to start of a
 | 
|---|
 | 1404 |   INC   ESI            // skip length
 | 
|---|
 | 1405 |   JMP   !CIP_LoopStart
 | 
|---|
 | 1406 | 
 | 
|---|
 | 1407 | !CIP_Loop:
 | 
|---|
 | 1408 |   // same
 | 
|---|
 | 1409 | 
 | 
|---|
 | 1410 |   CMP   ESI, EndOfA    // have we reached the end of a
 | 
|---|
 | 1411 |   JB    !CIP_LoopStart
 | 
|---|
 | 1412 | 
 | 
|---|
 | 1413 |   // Match, return position
 | 
|---|
 | 1414 |   SUB   ECX, [EBP+8]   // position = ( start of match ) - ( start of b ) + 1
 | 
|---|
 | 1415 |   MOV   EAX, ECX
 | 
|---|
 | 1416 |   LEAVE
 | 
|---|
 | 1417 |   RETN32 8
 | 
|---|
 | 1418 |   End;
 | 
|---|
 | 1419 | end;
 | 
|---|
 | 1420 | {$else}
 | 
|---|
 | 1421 | Function CaseInsensitivePos( const a: string;
 | 
|---|
 | 1422 |                              const b: string ): longint;
 | 
|---|
 | 1423 | begin
 | 
|---|
 | 1424 |   Result := Pos( UpperCase( a ), Uppercase( b ) );
 | 
|---|
 | 1425 | end;
 | 
|---|
 | 1426 | 
 | 
|---|
 | 1427 | {$endif}
 | 
|---|
 | 1428 | 
 | 
|---|
 | 1429 | Function BoolToStr( const b: boolean ): string;
 | 
|---|
 | 1430 | begin
 | 
|---|
 | 1431 |   if b then
 | 
|---|
 | 1432 |     Result := 'True'
 | 
|---|
 | 1433 |   else
 | 
|---|
 | 1434 |     Result := 'False';
 | 
|---|
 | 1435 | end;
 | 
|---|
 | 1436 | 
 | 
|---|
 | 1437 | Initialization
 | 
|---|
 | 1438 |   InitHexDigitMap;
 | 
|---|
 | 1439 | End.
 | 
|---|