home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 9 Archive / 09-Archive.zip / lxlt121s.zip / lxLite_src / common / StrOp.pas < prev    next >
Pascal/Delphi Source File  |  1997-08-17  |  39KB  |  1,391 lines
  1. {&AlignCode-,AlignData-,AlignRec-,G3+,Speed-,Frame-,Delphi+}
  2. {&define OS_MAP_CASE}
  3. {$P+}
  4. Unit strOp;
  5.  
  6. Interface uses use32;
  7.  
  8. const
  9. {keywords separator for 'Keyword', 'KeywordSpc', 'GetKeyword'}
  10.      keywordSep = '';
  11.  
  12. type
  13.      Str2       = String[2];
  14.      Str4       = String[4];
  15.      Str8       = String[8];
  16.      Str10      = String[10];
  17.      Str16      = String[16];
  18. {$ifDef OS_MAP_CASE}
  19. var
  20.      uCaseMap,
  21.      lCaseMap   : array[Char] of Char;
  22. {$endIf OS_MAP_CASE}
  23.  
  24. {Convert a string to lower case}
  25.  Procedure LowStr(var S : String);
  26.  
  27. {Convert a string to upper case}
  28.  Procedure UpStr(var S : String);
  29.  
  30. {Return the lowercase string of argument}
  31.  Function  LowStrg(S : String) : String;
  32.  
  33. {Return the uppercase string of argument}
  34.  Function  UpStrg(S : String) : String;
  35.  
  36. {Return hexadecimal representation of a number}
  37.  Function  Hex8(A : Longint) : Str8;
  38.  Function  Hex4(A : Word) : Str4;
  39.  Function  Hex2(A : Byte) : Str2;
  40.  
  41. {Return binary representation of a number}
  42.  Function  Bin16(a : Word) : Str16;
  43.  Function  Bin8(a : Byte) : Str8;
  44.  
  45. {Extract from a string a hexadecimal number. Cuts out the number from string}
  46.  Function  HexVal(var s : String) : Longint;
  47.  
  48. {Same as HexVal but decimal. Example: DecVal('123 test') returns 123 and S = ' test' }
  49.  Function  DecVal(var s : String) : Longint;
  50.  
  51. {FormatStr is the same as in Borland`s DRIVERS unit}
  52. {$ifdef VER70} {$P-} {$endif}
  53.  Procedure FormatStr(var Result: String; const Format: String; var Params);
  54. {$ifdef VER70} {$P+} {$endif}
  55.  
  56. {Return decimal representation of A right-justified in N positions filled with Ch}
  57.  Function  SStr(a : Longint; n : Byte; ch : Char) : String;
  58.  
  59. {Return left N characters from a string}
  60.  Function Left(const S : string; N : Integer) : string;
  61. {Return right N characters from a string}
  62.  Function Right(const S : string; N : Integer) : string;
  63. {Returns string S centered in a string of N chars Fill}
  64.  Function Center(const S : string; N : Integer; Fill : Char) : string;
  65.  
  66. {Converts a longint to string (decimal)}
  67.  Function  long2str(L : Longint) : String;
  68.  
  69. {Signed version of long2str: Returns '+###', '-###' or ' 0'}
  70.  Function  signStr(L : Longint) : String;
  71.  
  72. {Remove starting spaces and tabs from a string}
  73.  Procedure DelStartSpaces(var S : String);
  74.  
  75. {Remove trailing blanks and tabs from a string}
  76.  Procedure DelTrailingSpaces(var S : String);
  77.  
  78. {Extract directory from a full file name}
  79.  Function extractDir(const fName : string) : String;
  80. {Extract filename from a full file name}
  81.  Function extractName(const fName : string) : String;
  82. {Extract last file extension from a full file name}
  83.  Function extractExt(const fName : string) : String;
  84.  
  85. {Get string number No from a structure of type:}
  86. { dd length-of-entire-structure}
  87. { db 'string-number-one',0 }
  88. { db 'string-number-two',0 etc. }
  89.  Function  GetASCIIZ(var Text; No : Longint) : String;
  90. {The same but returns pChar to that string}
  91.  Function  GetASCIIZptr(var Text; No : Longint) : pChar;
  92. {Count ASCIIZ strings in above structure}
  93.  Function  CountASCIIZ(var Text) : Longint;
  94.  
  95. {Strip off all blanks and tabs from a string}
  96.  Function  StripBlanks(const S : String) : String;
  97.  
  98. {Return a string which represents percental relation of Val to Max with nFrac decimals}
  99.  Function  StrPercent(Val,Max : Longint; NFrac : Byte) : String;
  100.  
  101. {Convert fixed-point float to string; Base is fixed-point unit (ONE);}
  102. {nFrac is number of decimals. Example: StrFloat(8,16,3) = 0.500}
  103.  Function  StrFloat(Val,Base : Longint; NFrac : Byte) : String;
  104.  
  105. {Return a roman number A = 0..2000}
  106.  Function  RomanNumber(A : Word) : string;
  107.  
  108. {Return `short` version of pathName which fits into width W}
  109.  Function  Short(const pathName : String; W : Byte) : String;
  110.  
  111. {Return a string containing Num characters Ch}
  112. {&SAVES eax,ebx,edx,esi}
  113.  Function  Strg(Ch : Char; Num : Integer) : String;
  114.  
  115. {Return position of first occurence of character Ch in string S}
  116. {&SAVES ebx,esi}
  117.  Function  First(ch : Char; const S : String) : Byte;
  118.  
  119. {Return position of last occurence of character Ch in string S}
  120. {&SAVES ebx,esi}
  121.  Function  Last(ch : Char; const S : String) : Byte;
  122.  
  123. {Return position of Nth occurence of character Ch in string S counting from head}
  124. {&SAVES esi}
  125.  Function  ScanFwd(ch : Char; const S : String; N : Byte) : Byte;
  126.  
  127. {Return position of Nth occurence of character Ch in string S counting from tail}
  128. {&SAVES ebx,esi}
  129.  Function  ScanBwd(ch : Char; const S : String; N : Byte) : Byte;
  130.  
  131. {Count occurences of character Ch in string S}
  132. {&SAVES ebx,esi}
  133.  Function  CharCount(ch : Char; const S : String) : Byte;
  134.  
  135. {Exclude from string S all characters Ch and return it}
  136. {&SAVES edx}
  137.  Function  Exclude(const S : String; Ch : Char) : String;
  138.  
  139. {Search for a keyword in string S and return its ordinal number.}
  140. {Keyword definitions is an array of structure:}
  141. {db 'keyword1keyword2keyword3[...]',0}
  142. {If keyword is recognized it is cut out from input string}
  143. {&SAVES none}
  144.  Function  Keyword(var S : String; var Keyword) : Byte;
  145.  
  146. {The same as `Keyword` but after keyword must come a space or tab}
  147. {(`Keyword` recognize even keywords in environments like 'keyword1thisis')}
  148. {&SAVES none}
  149.  Function  KeywordSpc(var S : String; var Keyword) : Byte;
  150.  
  151. {Return keyword number `No` from structure Keyword (same as above)}
  152. {&SAVES edx}
  153.  Function  GetKeyword(var Keyword; No : Word) : String;
  154.  
  155. {Return upper case of character C}
  156. {&SAVES eax,ecx,edx,esi,edi}
  157.  Function  UpCase(C : Char) : Char;
  158.  
  159. {Return lower case of character C}
  160. {&SAVES eax,ecx,edx,esi,edi}
  161.  Function  LowCase(C : Char) : Char;
  162.  
  163. {Return hexadecimal representation of lower nubble of A}
  164. {&SAVES all}
  165.  Function  HexChar(A : Byte) : Char;
  166.  
  167. Implementation uses miscUtil {$IfDef OS2}, os2base {$EndIf};
  168.  
  169. {&SAVES ebx,esi,edi}
  170.  
  171. Function HexChar; assembler;
  172. asm             mov     al,a
  173.                 and     al,0Fh
  174.                 add     al,'0'
  175.                 cmp     al,58
  176.                 jc      @loc1
  177.                 add     al,7
  178. @Loc1:
  179. end;
  180.  
  181. Function Hex2;
  182. begin
  183.  Hex2 := HexChar(a shr 4) + HexChar(a);
  184. end;
  185.  
  186. Function Hex4;
  187. begin
  188.  Hex4 := HexChar(Hi(a) shr 4) + HexChar(Hi(a))+
  189.          HexChar(Lo(a) shr 4) + HexChar(Lo(a));
  190. end;
  191.  
  192. Function Hex8;
  193. begin
  194.  Hex8 := Hex4(a shr 16) + Hex4(a);
  195. end;
  196.  
  197. Function Bin16;
  198. var s : Str16;
  199.     i : Byte;
  200. begin
  201.  s := '';
  202.  for i:=0 to 15 do
  203.   begin
  204.    asm rol a,1 end;
  205.    s:=s + Char(48+(a and 1));
  206.   end;
  207.  Bin16 := s;
  208. end;
  209.  
  210. Function Bin8;
  211. var s : Str8;
  212.     i : Byte;
  213. begin
  214.  s := '';
  215.  for i := 0 to 7 do
  216.   begin
  217.    asm rol a,1 end;
  218.    s := s + Char(48 + (a and 1));
  219.   end;
  220.  Bin8 := s;
  221. end;
  222.  
  223. {$ifDef OS_MAP_CASE}
  224. Function upCase; assembler;
  225. asm             mov     al,&C
  226.                 lea     ebx,uCaseMap
  227.                 xlat
  228. end;
  229.  
  230. Function lowCase; assembler;
  231. asm             mov     al,&C
  232.                 lea     ebx,lCaseMap
  233.                 xlat
  234. end;
  235. {$else}
  236. Function upCase; assembler;
  237. asm             mov     al,&C
  238.                 cmp     al,'a'
  239.                 jb      @@ok
  240.                 cmp     al,'z'
  241.                 jbe     @@lo
  242.                 cmp     al,'á'
  243.                 jb      @@ok
  244.                 cmp     al,'»'
  245.                 jbe     @@lo
  246.                 cmp     al,'α'
  247.                 jb      @@ok
  248.                 cmp     al,'∩'
  249.                 ja      @@ok
  250.                 sub     al,80-32
  251. @@lo:           sub     al,20h
  252. @@ok:
  253. end;
  254.  
  255. Function lowCase; assembler;
  256. asm             mov     al,&C
  257.                 cmp     al,'A'
  258.                 jb      @@ok
  259.                 cmp     al,'Z'
  260.                 jbe     @@up
  261.                 cmp     al,'Ç'
  262.                 jb      @@ok
  263.                 cmp     al,'Å'
  264.                 jbe     @@up
  265.                 cmp     al,'É'
  266.                 jb      @@ok
  267.                 cmp     al,'ƒ'
  268.                 ja      @@ok
  269.                 add     al,80-32
  270. @@up:           add     al,20h
  271. @@ok:
  272. end;
  273. {$endIf}
  274.  
  275. procedure LowStr;
  276. var i : byte;
  277. begin
  278.  for i:=1 to length(s) do s[i]:=LowCase(s[i]);
  279. end;
  280.  
  281. Function LowStrg;
  282. begin
  283.  LowStr(s); LowStrg := s;
  284. end;
  285.  
  286. Procedure UpStr;
  287. var i : byte;
  288. begin
  289.  for i:=1 to length(s) do s[i]:=UpCase(s[i]);
  290. end;
  291.  
  292. Function UpStrg;
  293. begin
  294.  UpStr(s); UpStrg := s;
  295. end;
  296.  
  297. Function SStr;
  298. var s : String;
  299.     i : Byte;
  300. begin
  301.  Str(a:n,s);
  302.  for i := 1 to n do if s[i] = ' ' then s[i] := ch else break;
  303.  SStr := s;
  304. end;
  305.  
  306. Function left;
  307. begin
  308.  left := Copy(S, 1, N);
  309. end;
  310.  
  311. Function right;
  312. begin
  313.  right := Copy(S, succ(length(S) - N), N);
  314. end;
  315.  
  316. Function Center(const S : string; N : Integer; Fill : Char) : string;
  317. var
  318.  tS    : string;
  319.  l,f,c : Integer;
  320. begin
  321.  c := length(S); l := (N - c) div 2;
  322.  if l < 1
  323.   then begin f := -l+2; l := 1; end
  324.   else f := 1;
  325.  if f + c > N then c := succ(N - f);
  326.  tS := Strg(Fill, N);
  327.  Move(S[f], tS[l], c);
  328.  Center := tS;
  329. end;
  330.  
  331. {$ifDef use32}
  332. { A generalized string formatting routine. Given a string in Format     }
  333. { that includes format specifiers and a list of parameters in Params,   }
  334. { FormatStr produces a formatted output string in Result.               }
  335. { Format specifiers are of the form %[-][nnn]X, where                   }
  336. {   % indicates the beginning of a format specifier                     }
  337. {  [-] is an optional minus sign (-) indicating the parameter is to be  }
  338. {      left-justified (by default, parameters are right-justified)      }
  339. { [nnn] is an optional, decimal-number width specifier in the range     }
  340. {      0..255 (0 indicates no width specified, and non-zero means to    }
  341. {      display in a field of nnn characters)                            }
  342. {   X  is a format character:                                           }
  343. {   's' means the parameter is a pointer to a string.                   }
  344. {   'd' means the parameter is a Longint to be displayed in decimal.    }
  345. {   'c' means the low byte of the parameter is a character.             }
  346. {   'x' means the parameter is a Longint to be displayed in hexadecimal.}
  347. {   '#' sets the parameter index to nnn.                                }
  348. {$V+}
  349. procedure FormatStr(var Result: String; const Format: String; var Params);
  350.   assembler; {&USES ebx,esi,edi} {&FRAME+}
  351. var ParOfs    : Longint;
  352.     Buffer    : array [1..12] of Byte;
  353. const
  354.     HexDigits : array [0..15] of Char = '0123456789ABCDEF';
  355.  
  356. { Convert next parameter to string              }
  357. { EXPECTS:      al    = Conversion character    }
  358. { RETURNS:      esi   = Pointer to string       }
  359. {               ecx   = String length           }
  360.  
  361. procedure Convert; assembler; {$USES None} {$FRAME-}
  362. asm
  363.                 mov     edx,eax
  364.                 mov     esi,Params
  365.                 lodsd
  366.                 mov     Params,esi
  367.                 xor     ecx,ecx
  368.                 lea     esi,Buffer[TYPE Buffer]
  369.                 and     dl,0DFh         { UpCase(ConversionChar) }
  370.                 cmp     dl,'C'
  371.                 je      @@ConvertChar
  372.                 cmp     dl,'S'
  373.                 je      @@ConvertStr
  374.                 cmp     dl,'D'
  375.                 je      @@ConvertDec
  376.                 cmp     dl,'X'
  377.                 jne     @@Done
  378. { ConvertHex }
  379. @@1:            mov     edx,eax
  380.                 and     edx,0Fh
  381.                 mov     dl,HexDigits.Byte[edx]
  382.                 dec     esi
  383.                 inc     ecx
  384.                 mov     [esi],dl
  385.                 shr     eax,4
  386.                 jnz     @@1
  387.                 jmp     @@Done
  388.  
  389. @@ConvertDec:   push    esi
  390.                 mov     ebx,eax
  391.                 mov     ecx,10
  392.                 test    eax,eax
  393.                 jns     @@2
  394.                 neg     eax
  395. @@2:            xor     edx,edx
  396.                 dec     esi
  397.                 div     ecx
  398.                 add     dl,'0'
  399.                 mov     [esi],dl
  400.                 test    eax,eax
  401.                 jnz     @@2
  402.                 pop     ecx
  403.                 sub     ecx,esi
  404.                 test    ebx,ebx
  405.                 jns     @@Done
  406.                 mov     al,'-'
  407. @@ConvertChar:  inc     ecx
  408.                 dec     esi
  409.                 mov     [esi],al
  410.                 jmp     @@Done
  411. @@ConvertStr:   test    eax,eax
  412.                 jz      @@Done
  413.                 mov     esi,eax
  414.                 lodsb
  415.                 mov     cl,al
  416. @@Done:
  417. end;
  418.  
  419. { FormatStr body }
  420. asm
  421.                 mov     eax,Params
  422.                 mov     ParOfs,eax
  423.                 xor     eax,eax
  424.                 mov     esi,Format
  425.                 mov     edi,Result
  426.                 inc     edi
  427.                 cld
  428.                 lodsb
  429.                 mov     ecx,eax
  430. @@1:            jecxz   @@9
  431.                 lodsb
  432.                 dec     ecx
  433.                 cmp     al,'%'
  434.                 je      @@3
  435. @@2:            stosb
  436.                 jmp     @@1
  437. @@3:            jecxz   @@9
  438.                 lodsb
  439.                 dec     ecx
  440.                 cmp     al,'%'
  441.                 je      @@2             { bh = Justify (0:right, 1:left) }
  442.                 mov     ebx,' '         { bl = Filler character          }
  443.                 xor     edx,edx         { edx = Field width (0:no width) }
  444.                 cmp     al,'0'
  445.                 jne     @@4
  446.                 mov     bl,al
  447. @@4:            cmp     al,'-'
  448.                 jne     @@5
  449.                 inc     bh
  450.                 jecxz   @@9
  451.                 lodsb
  452.                 dec     ecx
  453. @@5:            cmp     al,'0'
  454.                 jb      @@6
  455.                 cmp     al,'9'
  456.                 ja      @@6
  457.                 sub     al,'0'
  458.                 xchg    eax,edx
  459.                 mov     ah,10
  460.                 mul     ah
  461.                 add     al,dl
  462.                 xchg    eax,edx
  463.                 jecxz   @@9
  464.                 lodsb
  465.                 dec     ecx
  466.                 jmp     @@5
  467. @@6:            cmp     al,'#'
  468.                 jne     @@10
  469.                 shl     edx,2
  470.                 add     edx,ParOfs
  471.                 mov     Params,edx
  472.                 jmp     @@1
  473. @@9:            mov     eax,Result
  474.                 mov     ecx,edi
  475.                 sub     ecx,eax
  476.                 dec     ecx
  477.                 mov     [eax],cl
  478.                 jmp     @@Done
  479. @@10:           push    esi
  480.                 push    ecx
  481.                 push    edx
  482.                 push    ebx
  483.                 Call    Convert
  484.                 pop     ebx
  485.                 pop     edx
  486.                 test    edx,edx
  487.                 jz      @@12
  488.                 sub     edx,ecx
  489.                 jae     @@12
  490.                 test    bh,bh
  491.                 jnz     @@11
  492.                 sub     esi,edx
  493. @@11:           add     ecx,edx
  494.                 xor     edx,edx
  495. @@12:           test    bh,bh
  496.                 jz      @@13
  497.                 rep     movsb           { Copy formated parm (left-justified)}
  498. @@13:           xchg    ecx,edx
  499.                 mov     al,bl
  500.                 rep     stosb           { Fill unused space }
  501.                 xchg    ecx,edx
  502.                 rep     movsb           { Copy formated parm (right-justified)}
  503.                 pop     ecx
  504.                 pop     esi
  505.                 jmp     @@1
  506. @@Done:
  507. end; {&FRAME-}
  508.  
  509. Function Strg; assembler;
  510. asm             cld
  511.                 mov     edi,@result
  512.                 mov     ecx,Num
  513.                 cmp     cx,255
  514.                 jbe     @@lenOK
  515.                 xor     ecx,ecx
  516. @@lenOK:        mov     al,cl
  517.                 stosb
  518.                 mov     al,&Ch
  519.                 mov     ah,al
  520.                 shr     ecx,1
  521.                 rep     stosw
  522.                 adc     cl,cl
  523.                 rep     stosb
  524. end;
  525.  
  526. {&SAVES ebx,edx,esi,edi}
  527. Function SetUpCase(var c : Char) : boolean; assembler;
  528. asm             mov     ecx,&c
  529.                 mov     al,[ecx]
  530.                 cmp     al,'a'
  531.                 jb      @E1
  532.                 cmp     al,'z'
  533.                 ja      @E1
  534.                 and     al,0DFh
  535.                 mov     [ecx],al
  536. @E1:            mov     ah,0
  537.                 cmp     al,'0'
  538.                 jb      @E3
  539.                 cmp     al,'F'
  540.                 ja      @E3
  541.                 cmp     al,'9'
  542.                 jbe     @E2
  543.                 cmp     al,'A'
  544.                 jb      @E3
  545. @E2:            mov     ah,1
  546. @E3:            mov     al,ah
  547. end;
  548. {&SAVES ebx,esi,edi}
  549.  
  550. {$else}
  551.  
  552. Function Strg; assembler;
  553. asm             cld
  554.                 les     di,@result
  555.                 mov     cx,Num
  556.                 cmp     cx,255
  557.                 jbe     @@lenOK
  558.                 xor     cx,cx
  559. @@lenOK:        mov     al,cl
  560.                 stosb
  561.                 mov     al,&Ch
  562.                 mov     ah,al
  563.                 shr     cx,1
  564.                 rep     stosw
  565.                 adc     cl,cl
  566.                 rep     stosb
  567. end;
  568.  
  569. Function SetUpCase(var c : Char) : boolean; assembler;
  570. asm             les     si,c
  571.                 mov     al,es:[si]
  572.                 cmp     al,'a'
  573.                 jb      @E1
  574.                 cmp     al,'z'
  575.                 ja      @E1
  576.                 and     al,$5F
  577.                 mov     es:[si],al
  578. @E1:            mov     ah,0
  579.                 cmp     al,'0'
  580.                 jb      @E3
  581.                 cmp     al,'F'
  582.                 ja      @E3
  583.                 cmp     al,'9'
  584.                 jbe     @E2
  585.                 cmp     al,'A'
  586.                 jb      @E3
  587. @E2:            mov     ah,1
  588. @E3:            mov     al,ah
  589. end;
  590.  
  591. {$endIf}
  592.  
  593. Function HexVal;
  594. var i,j : Byte;
  595.     k   : LongInt;
  596. begin
  597.  k:=0;i:=1;
  598.  While SetUpCase(s[i]) and (i<=Length(s)) and (i<9) do
  599.   begin
  600.    j:=Byte(UpCase(s[i]))-48;if j>9 then Dec(j,7);
  601.    k:=(k shl 4) or j;Inc(i);
  602.   end;
  603.  HexVal:=k;Delete(s,1,i-1);
  604. end;
  605.  
  606. Function DecVal;
  607. var i : Byte;
  608.     k : LongInt;
  609.     m : Boolean;
  610. begin
  611.  k := 0; i:=1;
  612.  m := False;
  613.  case s[1] of
  614.   '-' : begin m := TRUE; Inc(i); end;
  615.   '+' : Inc(i);
  616.  end;
  617.  While (i <= Length(s)) and (i < 11) and (UpCase(s[i]) in ['0'..'9']) do
  618.   begin
  619.    k := (k * 10) + (Byte(UpCase(s[i])) - 48);
  620.    Inc(i);
  621.   end;
  622.  if m
  623.   then DecVal := -k
  624.   else DecVal := k;
  625.  Delete(s, 1, i - 1);
  626. end;
  627.  
  628. {$ifDef use32}
  629. Function First; assembler;
  630. asm             cld
  631.                 mov     edi,S
  632.                 movzx   ecx,[edi].byte
  633.                 mov     edx,ecx
  634.                 inc     edi
  635.                 mov     al,&ch
  636.                 jecxz   @@NO
  637.                 repne   scasb
  638.                 je      @@OK
  639. @@NO:           mov     al,0
  640.                 jmp     @@locEx
  641. @@OK:           sub     edx,ecx
  642.                 mov     al,dl
  643. @@locEx:
  644. end;
  645.  
  646. Function Last; assembler;
  647. asm             std
  648.                 mov     edi,S
  649.                 movzx   ecx,[edi].byte
  650.                 mov     edx,ecx
  651.                 add     edi,ecx
  652.                 mov     al,&Ch
  653.                 jecxz   @@NO
  654.                 repne   scasb
  655.                 je      @@OK
  656. @@NO:           mov     al,0
  657.                 jmp     @@LocEx
  658. @@OK:           mov     eax,edx
  659.                 sub     edx,ecx
  660.                 sub     eax,edx
  661.                 inc     al
  662. @@LocEx:        cld
  663. end;
  664.  
  665. Function ScanFwd; assembler;
  666. asm             cld
  667.                 mov     edi,S
  668.                 mov     dh,N
  669.                 or      dh,dh
  670.                 je      @@NO
  671.                 movzx   ecx,[edi].byte
  672.                 mov     ebx,ecx
  673.                 inc     edi
  674.                 mov     al,&Ch
  675. @@NS:           jecxz   @@NO
  676.                 repne   scasb
  677.                 je      @@OK
  678. @@NO:           mov     al,0
  679.                 jmp     @@LocEx
  680. @@OK:           dec     dh
  681.                 jne     @@NS
  682.                 sub     ebx,ecx
  683.                 mov     al,bl
  684. @@LocEx:
  685. end;
  686.  
  687. Function ScanBwd; assembler;
  688. asm             std
  689.                 mov     edi,S
  690.                 mov     dh,N
  691.                 or      dh,dh
  692.                 je      @@NO
  693.                 movzx   ecx,[edi].byte
  694.                 add     edi,ecx
  695.                 mov     al,&Ch
  696. @@NS:           jecxz   @@NO
  697.                 repne   scasb
  698.                 je      @@OK
  699. @@NO:           mov     al,0
  700.                 jmp     @@LocEx
  701. @@OK:           dec     dh
  702.                 jne     @@NS
  703.                 mov     eax,ecx
  704.                 inc     al
  705. @@LocEx:        cld
  706. end;
  707.  
  708. Function CharCount; assembler;
  709. asm             cld
  710.                 mov     edi,S
  711.                 mov     dh,0
  712.                 movzx   ecx,[edi].byte
  713.                 mov     edx,ecx
  714.                 inc     edi
  715.                 mov     al,&Ch
  716. @@next:         jecxz   @@done
  717.                 repne   scasb
  718.                 jne     @@done
  719.                 inc     dh
  720.                 jmp     @@next
  721. @@done:         mov     al,dh
  722. end;
  723.  
  724. Function Exclude; assembler;
  725. asm             cld
  726.                 mov     esi,S
  727.                 mov     edi,@result
  728.                 inc     edi
  729.                 lodsb
  730.                 mov     cl,al
  731.                 mov     ebx,edi
  732.                 test    al,al
  733.                 je      @@done
  734.                 mov     ah,&ch
  735. @@nextCh:       lodsb
  736.                 cmp     al,ah
  737.                 je      @@skip
  738.                 stosb
  739. @@skip:         dec     cl
  740.                 jne     @@nextCh
  741. @@done:         sub     edi,ebx
  742.                 mov     eax,edi
  743.                 mov     [ebx-1],al
  744. end;
  745.  
  746. Function Keyword; assembler;
  747. asm             cld
  748.                 mov     esi,S
  749.                 lodsb
  750.                 movzx   ecx,al
  751.                 mov     bx,100h
  752.                 mov     edi,Keyword
  753. @@1:            push    esi
  754.                 push    ecx
  755. @@2:            mov     al,[edi]
  756.                 inc     edi
  757.                 push    ebx
  758.                 push    eax
  759.                 call    UpCase
  760.                 pop     ebx
  761.                 or      al,al
  762.                 je      @@5
  763.                 mov     ah,al
  764.                 lodsb
  765.                 push    ebx
  766.                 push    eax
  767.                 call    upCase
  768.                 pop     ebx
  769.                 cmp     ah,keywordSep
  770.                 je      @@4
  771.                 inc     bl
  772.                 cmp     al,ah
  773.                 loope   @@2
  774.                 je      @@36
  775. @@3:            mov     bl,0
  776.                 inc     bh
  777. @@35:           mov     al,[edi]
  778.                 inc     edi
  779.                 or      al,al
  780.                 je      @@5
  781.                 cmp     al,keywordSep
  782.                 jne     @@35
  783.                 pop     ecx
  784.                 pop     esi
  785.                 jmp     @@1
  786. @@36:           cmp     [edi].byte,keywordSep
  787.                 jne     @@3
  788. @@4:            pop     ecx
  789.                 pop     esi
  790.                 mov     al,bh
  791.                 movzx   ebx,bl
  792.                 sub     [esi-1],bl
  793.                 sub     cl,bl
  794.                 mov     edi,esi
  795.                 add     esi,ebx
  796.                 rep     movsb
  797.                 jmp     @@6
  798. @@5:            mov     al,0
  799.                 pop     ecx
  800.                 pop     esi
  801. @@6:
  802. end;
  803.  
  804. Function KeywordSpc; assembler;
  805. asm             cld
  806.                 mov     esi,S
  807.                 lodsb
  808.                 movzx   ecx,al
  809.                 mov     bx,100h
  810.                 mov     edi,Keyword
  811. @@1:            push    esi
  812.                 push    ecx
  813. @@2:            mov     al,[edi]
  814.                 inc     edi
  815.                 push    ebx
  816.                 push    eax
  817.                 call    UpCase
  818.                 pop     ebx
  819.                 or      al,al
  820.                 je      @@5
  821.                 mov     ah,al
  822.                 lodsb
  823.                 push    ebx
  824.                 push    eax
  825.                 call    upCase
  826.                 pop     ebx
  827.                 cmp     ah,keywordSep
  828.                 je      @@36
  829.                 inc     bl
  830.                 cmp     al,ah
  831.                 loope   @@2
  832.                 je      @@4
  833. @@34:           mov     bl,0
  834.                 inc     bh
  835. @@35:           mov     al,[edi]
  836.                 inc     edi
  837.                 or      al,al
  838.                 je      @@5
  839.                 cmp     al,keywordSep
  840.                 jne     @@35
  841.                 pop     ecx
  842.                 pop     esi
  843.                 jmp     @@1
  844. @@36:           dec     edi
  845.                 cmp     [esi-1].byte,' '
  846.                 ja      @@34
  847. @@4:            cmp     [edi].byte,keywordSep
  848.                 jne     @@34
  849.                 pop     ecx
  850.                 pop     esi
  851.                 mov     al,bh
  852.                 movzx   ebx,bl
  853.                 sub     [esi-1],bl
  854.                 sub     cl,bl
  855.                 mov     edi,esi
  856.                 add     esi,ebx
  857.                 rep     movsb
  858.                 jmp     @@6
  859. @@5:            mov     al,0
  860.                 pop     ecx
  861.                 pop     esi
  862. @@6:
  863. end;
  864.  
  865. Function GetKeyword; assembler;
  866. asm             cld
  867.                 mov     esi,Keyword
  868.                 mov     edi,@result
  869.                 mov     ecx,No
  870. @@nextWord:     dec     ecx
  871.                 jz      @@done
  872. @@scan:         lodsb
  873.                 test    al,al
  874.                 jz      @@notFound
  875.                 cmp     al,keywordSep
  876.                 jne     @@scan
  877.                 jmp     @@nextWord
  878. @@done:         mov     ah,0
  879.                 mov     ebx,edi
  880.                 inc     edi
  881. @@copyWord:     lodsb
  882.                 cmp     al,keywordSep
  883.                 je      @@end
  884.                 stosb
  885.                 jmp     @@copyWord
  886. @@end:          mov     al,ah
  887.                 mov     edi,ebx
  888. @@notFound:     stosb
  889. end;
  890.  
  891. {$else}
  892. { String formatting routines }
  893. procedure FormatStr; external {FORMAT};
  894. {$L FORMAT.OBJ}
  895.  
  896. Function First(ch : Char; const S : String) : Byte; assembler;
  897. asm             cld
  898.                 les     di,S
  899.                 mov     cl,es:[di]
  900.                 mov     ch,0
  901.                 mov     bx,cx
  902.                 inc     di
  903.                 mov     al,&Ch
  904.                 jcxz    @@NO
  905.                 repne   scasb
  906.                 je      @@OK
  907. @@NO:           mov     al,0
  908.                 jmp     @@LocEx
  909. @@OK:           sub     bx,cx
  910.                 mov     ax,bx
  911. @@LocEx:
  912. end;
  913.  
  914. Function Last(ch : Char; const S : String) : Byte; assembler;
  915. asm             std
  916.                 les     di,S
  917.                 mov     cl,es:[di]
  918.                 mov     ch,0
  919.                 mov     bx,cx
  920.                 add     di,cx
  921.                 mov     al,&Ch
  922.                 jcxz    @@NO
  923.                 repne   scasb
  924.                 je      @@OK
  925. @@NO:           mov     al,0
  926.                 jmp     @@LocEx
  927. @@OK:           mov     ax,bx
  928.                 sub     bx,cx
  929.                 sub     ax,bx
  930.                 inc     ax
  931. @@LocEx:        cld
  932. end;
  933.  
  934. Function ScanFwd(ch : Char; const S : String; N : Byte) : Byte; assembler;
  935. asm             cld
  936.                 les     di,S
  937.                 mov     dh,N
  938.                 or      dh,dh
  939.                 je      @@NO
  940.                 mov     cl,es:[di]
  941.                 mov     ch,0
  942.                 mov     bx,cx
  943.                 inc     di
  944.                 mov     al,&Ch
  945. @@NS:           jcxz    @@NO
  946.                 repne   scasb
  947.                 je      @@OK
  948. @@NO:           mov     al,0
  949.                 jmp     @@LocEx
  950. @@OK:           dec     dh
  951.                 jne     @@NS
  952.                 sub     bx,cx
  953.                 mov     ax,bx
  954. @@LocEx:
  955. end;
  956.  
  957. Function ScanBwd(ch : Char; const S : String; N : Byte) : Byte; assembler;
  958. asm             std
  959.                 les     di,S
  960.                 mov     dh,N
  961.                 or      dh,dh
  962.                 je      @@NO
  963.                 mov     cl,es:[di]
  964.                 mov     ch,0
  965.                 mov     bx,cx
  966.                 add     di,cx
  967.                 mov     al,&Ch
  968. @@NS:           jcxz    @@NO
  969.                 repne   scasb
  970.                 je      @@OK
  971. @@NO:           mov     al,0
  972.                 jmp     @@LocEx
  973. @@OK:           dec     dh
  974.                 jne     @@NS
  975.                 mov     ax,bx
  976.                 sub     bx,cx
  977.                 sub     ax,bx
  978.                 inc     ax
  979. @@LocEx:        cld
  980. end;
  981.  
  982. Function CharCount(ch : Char; const S : String) : Byte; assembler;
  983. asm             cld
  984.                 les     di,S
  985.                 xor     dh,dh
  986.                 mov     cl,es:[di]
  987.                 mov     ch,0
  988.                 mov     bx,cx
  989.                 inc     di
  990.                 mov     al,&Ch
  991. @@NS:           jcxz    @@NO
  992.                 repne   scasb
  993.                 je      @@OK
  994. @@NO:           mov     al,dh
  995.                 jmp     @@LocEx
  996. @@OK:           inc     dh
  997.                 jmp     @@NS
  998. @@LocEx:
  999. end;
  1000.  
  1001. Function Keyword(var S : String; var Keyword) : Byte; assembler;
  1002. asm             cld
  1003.                 push    ds
  1004.                 lds     si,S
  1005.                 lodsb
  1006.                 mov     cl,al
  1007.                 mov     ch,0
  1008.                 mov     bx,100h
  1009.                 les     di,Keyword
  1010. @@1:            push    si
  1011.                 push    cx
  1012. @@2:            mov     al,es:[di]
  1013.                 inc     di
  1014.                 call    @@loCase
  1015.                 mov     ah,al
  1016.                 lodsb
  1017.                 call    @@loCase
  1018.                 or      ah,ah
  1019.                 je      @@5
  1020.                 cmp     ah,keywordSep
  1021.                 je      @@4
  1022.                 inc     bl
  1023.                 cmp     al,ah
  1024.                 loope   @@2
  1025.                 je      @@36
  1026. @@34:           mov     bl,0
  1027.                 inc     bh
  1028. @@35:           mov     al,es:[di]
  1029.                 inc     di
  1030.                 or      al,al
  1031.                 je      @@5
  1032.                 cmp     al,keywordSep
  1033.                 jne     @@35
  1034.                 pop     cx
  1035.                 pop     si
  1036.                 jmp     @@1
  1037. @@36:           cmp     es:[di].byte,keywordSep
  1038.                 jne     @@34
  1039. @@4:            pop     cx
  1040.                 pop     si
  1041.                 mov     al,bh
  1042.                 sub     ds:[si-1],bl
  1043.                 sub     cl,bl
  1044.                 mov     bh,0
  1045.                 mov     di,si
  1046.                 add     si,bx
  1047.                 push    ds
  1048.                 pop     es
  1049.                 rep     movsb
  1050.                 jmp     @@6
  1051.  
  1052. @@loCase:       cmp     al,'A'
  1053.                 jb      @@lcEx
  1054.                 cmp     al,'Z'
  1055.                 ja      @@lcEx
  1056.                 or      al,20h
  1057. @@lcEx:         retn
  1058.  
  1059. @@5:            mov     al,0
  1060.                 pop     cx
  1061.                 pop     si
  1062. @@6:            pop     ds
  1063. end;
  1064.  
  1065. Function KeywordSpc(var S : String; var Keyword) : Byte; assembler;
  1066. asm             cld
  1067.                 push    ds
  1068.                 lds     si,S
  1069.                 lodsb
  1070.                 mov     cl,al
  1071.                 mov     ch,0
  1072.                 mov     bx,100h
  1073.                 les     di,Keyword
  1074. @@1:            push    si
  1075.                 push    cx
  1076. @@2:            mov     al,es:[di]
  1077.                 inc     di
  1078.                 call    @@loCase
  1079.                 mov     ah,al
  1080.                 lodsb
  1081.                 call    @@loCase
  1082.                 or      ah,ah
  1083.                 je      @@5
  1084.                 cmp     ah,keywordSep
  1085.                 je      @@36
  1086.                 inc     bl
  1087.                 cmp     al,ah
  1088.                 loope   @@2
  1089.                 je      @@4
  1090. @@34:           mov     bl,0
  1091.                 inc     bh
  1092. @@35:           mov     al,es:[di]
  1093.                 inc     di
  1094.                 or      al,al
  1095.                 je      @@5
  1096.                 cmp     al,keywordSep
  1097.                 jne     @@35
  1098.                 pop     cx
  1099.                 pop     si
  1100.                 jmp     @@1
  1101. @@36:           dec     di
  1102.                 cmp     ds:[si-1].byte,' '
  1103.                 ja      @@34
  1104. @@4:            cmp     es:[di].byte,keywordSep
  1105.                 jne     @@34
  1106.                 pop     cx
  1107.                 pop     si
  1108.                 mov     al,bh
  1109.                 sub     ds:[si-1],bl
  1110.                 sub     cl,bl
  1111.                 mov     bh,0
  1112.                 mov     di,si
  1113.                 add     si,bx
  1114.                 push    ds
  1115.                 pop     es
  1116.                 rep     movsb
  1117.                 jmp     @@6
  1118.  
  1119. @@loCase:       cmp     al,'A'
  1120.                 jb      @@lcEx
  1121.                 cmp     al,'Z'
  1122.                 ja      @@lcEx
  1123.                 or      al,20h
  1124. @@lcEx:         retn
  1125.  
  1126. @@5:            mov     al,0
  1127.                 pop     cx
  1128.                 pop     si
  1129. @@6:            pop     ds
  1130. end;
  1131.  
  1132. Function GetKeyword; assembler;
  1133. asm             cld
  1134.                 push    ds
  1135.                 lds     si,Keyword
  1136.                 les     di,@result
  1137.                 mov     cx,No
  1138. @@nextWord:     dec     cx
  1139.                 jz      @@done
  1140. @@scan:         lodsb
  1141.                 test    al,al
  1142.                 jz      @@notFound
  1143.                 cmp     al,keywordSep
  1144.                 jne     @@scan
  1145.                 jmp     @@nextWord
  1146. @@done:         mov     ah,0
  1147.                 mov     bx,di
  1148.                 inc     di
  1149. @@copyWord:     lodsb
  1150.                 cmp     al,keywordSep
  1151.                 je      @@end
  1152.                 inc     ah
  1153.                 stosb
  1154.                 jmp     @@copyWord
  1155. @@end:          mov     al,ah
  1156.                 mov     di,bx
  1157. @@notFound:     stosb
  1158.                 pop     ds
  1159. end;
  1160.  
  1161. Function Exclude; assembler;
  1162. asm             cld
  1163.                 push    ds
  1164.                 lds     si,S
  1165.                 les     di,@result
  1166.                 inc     di
  1167.                 lodsb
  1168.                 mov     cl,al
  1169.                 mov     bx,di
  1170.                 test    al,al
  1171.                 je      @@done
  1172.                 mov     ah,&ch
  1173. @@nextCh:       lodsb
  1174.                 cmp     al,ah
  1175.                 je      @@skip
  1176.                 stosb
  1177. @@skip:         dec     cl
  1178.                 jne     @@nextCh
  1179. @@done:         sub     di,bx
  1180.                 mov     ax,di
  1181.                 mov     es:[bx-1],al
  1182.                 pop     ds
  1183. end;
  1184.  
  1185. {$endIf}
  1186.  
  1187. Procedure DelStartSpaces;
  1188. var I : Integer;
  1189. begin
  1190.  I := 1; While (I <= length(S)) and (S[I] in [' ',#9]) do Inc(I);
  1191.  Delete(S, 1, I - 1);
  1192. end;
  1193.  
  1194. Procedure DelTrailingSpaces;
  1195. begin
  1196.  While S[length(S)] in [' ', #9] do Dec(byte(S[0]));
  1197. end;
  1198.  
  1199. Function extractDir(const fName : string) : String;
  1200. var I : Byte;
  1201. begin
  1202.  I := length(fName);
  1203.  While (I > 0) and (not (fName[I] in ['/', '\', ':'])) do Dec(I);
  1204.  extractDir := Copy(fName, 1, I);
  1205. end;
  1206.  
  1207. Function extractName(const fName : string) : String;
  1208. var I : Byte;
  1209. begin
  1210.  I := length(fName);
  1211.  While (I > 0) and (not (fName[I] in ['/', '\', ':'])) do Dec(I);
  1212.  extractName := Copy(fName, I + byte(I > 0), 255);
  1213. end;
  1214.  
  1215. Function extractExt(const fName : string) : String;
  1216. var I : Byte;
  1217. begin
  1218.  I := length(fName);
  1219.  While (I > 0) and (not (fName[I] in ['.','/', '\', ':'])) do Dec(I);
  1220.  if (I > 0) and (fName[I] = '.')
  1221.   then extractExt := Copy(fName, I, 255)
  1222.   else extractExt := '';
  1223. end;
  1224.  
  1225. Function GetASCIIZ;
  1226. var I : Integer;
  1227.     P : pChar;
  1228.     S : String;
  1229. begin
  1230.  P := GetASCIIZptr(Text, No);
  1231.  S := '';
  1232.  While P^ <> #0 do begin S := S + P^; Inc(P); end;
  1233.  GetASCIIZ := S;
  1234. end;
  1235.  
  1236. Function GetASCIIZptr;
  1237. var I   : Integer;
  1238.     P,F : pChar;
  1239. begin
  1240.  P := @Text;
  1241.  F := P; Inc(F, pLong(F)^);
  1242.  Inc(P, sizeOf(Longint));
  1243.  For I := 2 to No do
  1244.   begin
  1245.    While (P < F) and (P^ <> #0) do Inc(P);
  1246.    if P >= F
  1247.     then begin P := nil; break; end
  1248.     else Inc(P);
  1249.   end;
  1250.  GetASCIIZptr := P;
  1251. end;
  1252.  
  1253. Function CountASCIIZ;
  1254. var C   : Longint;
  1255.     P,F : pChar;
  1256. begin
  1257.  P := @Text; C := 0;
  1258.  F := P; Inc(F, pLong(F)^);
  1259.  Inc(P, sizeOf(Longint));
  1260.  repeat
  1261.   While (P < F) and (P^ <> #0) do Inc(P);
  1262.   Inc(C);
  1263.   if P < F then Inc(P) else break;
  1264.  until FALSE;
  1265.  CountASCIIZ := C;
  1266. end;
  1267.  
  1268. Function StripBlanks(const S : String) : String;
  1269. var RS  : String;
  1270.     I,J : Integer;
  1271. begin
  1272.  J := 0;
  1273.  For I := 1 to length(S) do
  1274.   if not (S[I] in [' ',#9]) then begin Inc(J); RS[J] := S[I]; end;
  1275.  RS[0] := char(J);
  1276.  StripBlanks := RS;
  1277. end;
  1278.  
  1279. Function StrPercent;
  1280. var S : String;
  1281.     P : Longint;
  1282.     I : Integer;
  1283. begin
  1284.  P := 1; For I := 1 to NFrac + 2 do P := P * 10;
  1285.  S := SStr(longint(Val) * P div Max, NFrac + 1, '0');
  1286.  if NFrac > 0 then Insert('.', S, length(S) - NFrac + 1);
  1287.  StrPercent := S;
  1288. end;
  1289.  
  1290. Function StrFloat;
  1291. var S : String;
  1292.     P : Longint;
  1293.     I : Integer;
  1294. begin
  1295.  P := 1; For I := 1 to NFrac do P := P * 10;
  1296.  S := SStr(longint(Val) * P div Base, NFrac + 1, '0');
  1297.  if NFrac > 0 then Insert('.', S, length(S) - NFrac + 1);
  1298.  StrFloat := S;
  1299. end;
  1300.  
  1301. function RomanNumber(A : Word) : string; {0 < A < 2000}
  1302. var S : String[10];
  1303. begin
  1304.  if A >= 1000 then S := 'M' else S := '';
  1305.  A := A mod 1000;
  1306.  if A >= 100
  1307.     then case A div 100 of
  1308.           1..3 : S := S + Strg('C', A div 100);
  1309.           4    : S := S + 'CL';
  1310.           5..8 : S := S + 'L' + Strg('C', A div 100 - 5);
  1311.           9    : S := S + 'CM';
  1312.          end;
  1313.  A := A mod 100;
  1314.  if A >= 10
  1315.     then case A div 10 of
  1316.           1..3 : S := S + Strg('X', A div 10);
  1317.           4    : S := S + 'XL';
  1318.           5..8 : S := S + 'L' + Strg('X', A div 10 - 5);
  1319.           9    : S := S + 'XC';
  1320.          end;
  1321.  A := A mod 10;
  1322.  if A >= 1
  1323.     then case A of
  1324.           1..3 : S := S + Strg('I', A);
  1325.           4    : S := S + 'IV';
  1326.           5..8 : S := S + 'V' + Strg('I', A - 5);
  1327.           9    : S := S + 'IX';
  1328.          end;
  1329.  RomanNumber := S;
  1330. end;
  1331.  
  1332. Function Long2str(L : Longint) : String;
  1333. var A : String;
  1334. begin
  1335.  Str(L, A);
  1336.  Long2str := A;
  1337. end;
  1338.  
  1339. Function SignStr(L : Longint) : String;
  1340. var A : String;
  1341. begin
  1342.  Str(L, A);
  1343.  if L < 0
  1344.   then SignStr := A
  1345.   else
  1346.  if L > 0
  1347.   then SignStr := '+' + A
  1348.   else SignStr := ' ' + A;
  1349. end;
  1350.  
  1351. Function Short;
  1352. var
  1353.  sl,dl,
  1354.  i,j : integer;
  1355.  res : string;
  1356. begin
  1357.  if length(pathName) <= w
  1358.   then begin
  1359.         Short := pathName;
  1360.         exit;
  1361.        end;
  1362.  res := extractDir(pathName);
  1363.  dl := length(res); sl := 1;
  1364.  While (sl < length(res)) and (not (res[sl] in ['/','\'])) do Inc(sl);
  1365.  i := sl;
  1366.  res := pathName;
  1367.  repeat
  1368.   j := succ(i);
  1369.   While (j < dl) and (not (res[j] in ['/','\'])) do Inc(j);
  1370.   Delete(res, i, j-i);
  1371.  until (length(res) <= sl) or (length(res) + 4 <= w);
  1372.  Insert('...\', res, succ(i));
  1373.  Short := Copy(res, 1, w);
  1374. end;
  1375.  
  1376. {$ifDef OS_MAP_CASE}
  1377. var cc : CountryCode;
  1378.     I  : Longint;
  1379.  
  1380. begin
  1381.  FillChar(cc, SizeOf(cc), 0);
  1382.  For I := 0 to 255 do uCaseMap[char(I)] := char(I);
  1383.  lCaseMap := uCaseMap;
  1384.  if DosMapCase(256, cc, @uCaseMap) <> 0 then Halt(1);
  1385.  For I := 0 to 255 do
  1386.   if (uCaseMap[char(I)] <> char(I)) and (lCaseMap[uCaseMap[char(I)]] = uCaseMap[char(I)])
  1387.    then lCaseMap[uCaseMap[char(I)]] := char(I);
  1388. {$endIf}
  1389. end.
  1390.  
  1391.