16/ADT2PLAY/STRINGIO.PAS

   1 unit StringIO;\r
   2 interface\r
   3 \r
   4 type\r
   5   characters = Set of Char;\r
   6 \r
   7 function Capitalize(str: String): String;\r
   8 function Upper(str: String): String;\r
   9 function Lower(str: String): String;\r
  10 function iCASE(str: String): String;\r
  11 function RotStrL(str1,str2: String; shift: Byte): String;\r
  12 function RotStrR(str1,str2: String; shift: Byte): String;\r
  13 function ExpStrL(str: String; size: Byte; chr: Char): String;\r
  14 function ExpStrR(str: String; size: Byte; chr: Char): String;\r
  15 function DietStr(str: String; size: Byte): String;\r
  16 function CutStr(str: String): String;\r
  17 function FlipStr(str: String): String;\r
  18 function FilterStr(str: String; chr0,chr1: Char): String;\r
  19 function FilterStr2(str: String; chr0: characters; chr1: Char): String;\r
  20 function Num2str(num: Longint; base: Byte): String;\r
  21 function Str2num(str: String; base: Byte): Longint;\r
  22 \r
  23 type\r
  24   tINPUT_STR_SETTING = Record\r
  25                          insert_mode,\r
  26                          replace_enabled,\r
  27                          append_enabled:  Boolean;\r
  28                          character_set,\r
  29                          valid_chars,\r
  30                          word_characters: characters;\r
  31                          terminate_keys:  array[1..50] of Word\r
  32                        end;\r
  33 type\r
  34   tINPUT_STR_ENVIRONMENT = Record\r
  35                              keystroke: Word;\r
  36                              locate_pos: Byte;\r
  37                            end;\r
  38 const\r
  39   is_setting: tINPUT_STR_SETTING =\r
  40     (insert_mode:     TRUE;\r
  41      replace_enabled: TRUE;\r
  42      append_enabled:  TRUE;\r
  43      character_set:   [#$20..#$0ff];\r
  44      valid_chars:     [#$20..#$0ff];\r
  45      word_characters: ['A'..'Z','a'..'z','0'..'9','_'];\r
  46      terminate_keys:  ($011b,$1c0d,$0000,$0000,$0000,\r
  47                        $0000,$0000,$0000,$0000,$0000,\r
  48                        $0000,$0000,$0000,$0000,$0000,\r
  49                        $0000,$0000,$0000,$0000,$0000,\r
  50                        $0000,$0000,$0000,$0000,$0000,\r
  51                        $0000,$0000,$0000,$0000,$0000,\r
  52                        $0000,$0000,$0000,$0000,$0000,\r
  53                        $0000,$0000,$0000,$0000,$0000,\r
  54                        $0000,$0000,$0000,$0000,$0000,\r
  55                        $0000,$0000,$0000,$0000,$0000));\r
  56 var\r
  57   is_environment: tINPUT_STR_ENVIRONMENT;\r
  58 \r
  59 function InputStr(s: String; x,y,ln,ln1: Byte; atr1,atr2: Byte): String;\r
  60 function SameName(str1,str2: String): Boolean;\r
  61 function PathOnly(path: String): String;\r
  62 function NameOnly(path: String): String;\r
  63 function BaseNameOnly(path: String): String;\r
  64 function ExtOnly(path: String): String;\r
  65 \r
  66 implementation\r
  67 \r
  68 uses\r
  69   DOS,TxtScrIO;\r
  70 \r
  71 function Capitalize(str: String): String; assembler;\r
  72 asm\r
  73         mov     esi,[str]\r
  74         mov     edi,@result\r
  75         mov     al,[esi]\r
  76         inc     esi\r
  77         mov     [edi],al\r
  78         inc     edi\r
  79         xor     ecx,ecx\r
  80         mov     cl,al\r
  81         jecxz   @@4\r
  82         mov     al,[esi]\r
  83         inc     esi\r
  84         cmp     al,'a'\r
  85         jb      @@0\r
  86         cmp     al,'z'\r
  87         ja      @@0\r
  88         sub     al,20h\r
  89 @@0:    mov     [edi],al\r
  90         inc     edi\r
  91 @@1:    mov     ah,al\r
  92         mov     al,[esi]\r
  93         inc     esi\r
  94         cmp     ah,' '\r
  95         jnz     @@2\r
  96         cmp     al,'a'\r
  97         jb      @@2\r
  98         cmp     al,'z'\r
  99         ja      @@2\r
 100         sub     al,20h\r
 101         jmp     @@3\r
 102 @@2:    cmp     al,'A'\r
 103         jb      @@3\r
 104         cmp     al,'Z'\r
 105         ja      @@3\r
 106         add     al,20h\r
 107 @@3:    mov     [edi],al\r
 108         inc     edi\r
 109         loop    @@1\r
 110 @@4:\r
 111 end;\r
 112 \r
 113 function Upper(str: String): String; assembler;\r
 114 asm\r
 115         mov     esi,[str]\r
 116         mov     edi,@result\r
 117         mov     al,[esi]\r
 118         inc     esi\r
 119         mov     [edi],al\r
 120         inc     edi\r
 121         xor     ecx,ecx\r
 122         mov     cl,al\r
 123         jecxz   @@3\r
 124 @@1:    mov     al,[esi]\r
 125         inc     esi\r
 126         cmp     al,'a'\r
 127         jb      @@2\r
 128         cmp     al,'z'\r
 129         ja      @@2\r
 130         sub     al,20h\r
 131 @@2:    mov     [edi],al\r
 132         inc     edi\r
 133         loop    @@1\r
 134 @@3:\r
 135 end;\r
 136 \r
 137 function Lower(str: String): String; assembler;\r
 138 asm\r
 139         mov     esi,[str]\r
 140         mov     edi,@result\r
 141         mov     al,[esi]\r
 142         inc     esi\r
 143         mov     [edi],al\r
 144         inc     edi\r
 145         xor     ecx,ecx\r
 146         mov     cl,al\r
 147         jecxz   @@3\r
 148 @@1:    mov     al,[esi]\r
 149         inc     esi\r
 150         cmp     al,'A'\r
 151         jb      @@2\r
 152         cmp     al,'Z'\r
 153         ja      @@2\r
 154         add     al,20h\r
 155 @@2:    mov     [edi],al\r
 156         inc     edi\r
 157         loop    @@1\r
 158 @@3:\r
 159 end;\r
 160 \r
 161 function iCase(str: String): String; assembler;\r
 162 asm\r
 163         mov     esi,[str]\r
 164         mov     edi,@result\r
 165         mov     al,[esi]\r
 166         inc     esi\r
 167         mov     [edi],al\r
 168         inc     edi\r
 169         xor     ecx,ecx\r
 170         mov     cl,al\r
 171         jecxz   @@5\r
 172         push    edi\r
 173         push    ecx\r
 174 @@1:    mov     al,[esi]\r
 175         inc     esi\r
 176         cmp     al,'a'\r
 177         jb      @@2\r
 178         cmp     al,'z'\r
 179         ja      @@2\r
 180         sub     al,20h\r
 181 @@2:    mov     [edi],al\r
 182         inc     edi\r
 183         loop    @@1\r
 184         pop     ecx\r
 185         pop     edi\r
 186 @@3:    mov     al,[edi]\r
 187         cmp     al,'i'-20h\r
 188         jnz     @@4\r
 189         add     al,20h\r
 190 @@4:    mov     [edi],al\r
 191         inc     edi\r
 192         loop    @@3\r
 193 @@5:\r
 194 end;\r
 195 \r
 196 function RotStrL(str1,str2: String; shift: Byte): String;\r
 197 begin\r
 198   RotStrL := Copy(str1,shift+1,Length(str1)-shift)+\r
 199              Copy(str2,1,shift);\r
 200 end;\r
 201 \r
 202 function RotStrR(str1,str2: String; shift: Byte): String;\r
 203 begin\r
 204   RotStrR := Copy(str2,Length(str2)-shift+1,shift)+\r
 205              Copy(str1,1,Length(str1)-shift);\r
 206 end;\r
 207 \r
 208 function ExpStrL(str: String; size: Byte; chr: Char): String; assembler;\r
 209 asm\r
 210         mov     esi,[str]\r
 211         mov     edi,@result\r
 212         cld\r
 213         xor     ecx,ecx\r
 214         lodsb\r
 215         cmp     al,size\r
 216         jge     @@1\r
 217         mov     ah,al\r
 218         mov     al,size\r
 219         stosb\r
 220         mov     al,ah\r
 221         mov     cl,size\r
 222         sub     cl,al\r
 223         mov     al,chr\r
 224         rep     stosb\r
 225         mov     cl,ah\r
 226         rep     movsb\r
 227         jmp     @@2\r
 228 @@1:    stosb\r
 229         mov     cl,al\r
 230         rep     movsb\r
 231 @@2:\r
 232 end;\r
 233 \r
 234 function ExpStrR(str: String; size: Byte; chr: Char): String; assembler;\r
 235 asm\r
 236         mov     esi,[str]\r
 237         mov     edi,@result\r
 238         cld\r
 239         xor     ecx,ecx\r
 240         lodsb\r
 241         cmp     al,size\r
 242         jge     @@1\r
 243         mov     ah,al\r
 244         mov     al,size\r
 245         stosb\r
 246         mov     cl,ah\r
 247         rep     movsb\r
 248         mov     al,ah\r
 249         mov     cl,size\r
 250         sub     cl,al\r
 251         mov     al,chr\r
 252         rep     stosb\r
 253         jmp     @@2\r
 254 @@1:    stosb\r
 255         mov     cl,al\r
 256         rep     movsb\r
 257 @@2:\r
 258 end;\r
 259 \r
 260 function DietStr(str: String; size: Byte): String;\r
 261 begin\r
 262   If (Length(str) <= size) then\r
 263     begin\r
 264       DietStr := str;\r
 265       EXIT;\r
 266     end;\r
 267 \r
 268   Repeat\r
 269     Delete(str,size DIV 2,1)\r
 270   until (Length(str)+3 = size);\r
 271 \r
 272   Insert('...',str,size DIV 2);\r
 273   DietStr := str\r
 274 end;\r
 275 \r
 276 function CutStr(str: String): String;\r
 277 begin\r
 278   While (str[0] <> #0) and (str[1] in [#00,#32]) do Delete(str,1,1);\r
 279   While (str[0] <> #0) and (str[Length(str)] in [#00,#32]) do Delete(str,Length(str),1);\r
 280   CutStr := str;\r
 281 end;\r
 282 \r
 283 function FlipStr(str: String): String; assembler;\r
 284 asm\r
 285         mov     esi,[str]\r
 286         mov     edi,@result\r
 287         mov     al,[esi]\r
 288         inc     esi\r
 289         mov     [edi],al\r
 290         inc     edi\r
 291         dec     edi\r
 292         xor     ecx,ecx\r
 293         mov     cl,al\r
 294         jecxz   @@2\r
 295         add     edi,ecx\r
 296 @@1:    mov     al,[esi]\r
 297         inc     esi\r
 298         mov     [edi],al\r
 299         dec     edi\r
 300         loop    @@1\r
 301 @@2:\r
 302 end;\r
 303 \r
 304 function FilterStr(str: String; chr0,chr1: Char): String; assembler;\r
 305 asm\r
 306         mov     esi,[str]\r
 307         mov     edi,@result\r
 308         mov     al,[esi]\r
 309         inc     esi\r
 310         mov     [edi],al\r
 311         inc     edi\r
 312         xor     ecx,ecx\r
 313         mov     cl,al\r
 314         jecxz   @@3\r
 315 @@1:    mov     al,[esi]\r
 316         inc     esi\r
 317         cmp     al,chr0\r
 318         jnz     @@2\r
 319         mov     al,chr1\r
 320 @@2:    mov     [edi],al\r
 321         inc     edi\r
 322         loop    @@1\r
 323 @@3:\r
 324 end;\r
 325 \r
 326 const\r
 327   _treat_char: array[$80..$a5] of Char =\r
 328     'CueaaaaceeeiiiAAE_AooouuyOU_____aiounN';\r
 329 \r
 330 function FilterStr2(str: String; chr0: characters; chr1: Char): String;\r
 331 \r
 332 var\r
 333   temp: Byte;\r
 334 \r
 335 begin\r
 336   For temp := 1 to Length(str) do\r
 337     If NOT (str[temp] in chr0) then\r
 338       If (str[temp] >= #$80) and (str[temp] <= #$a5) then\r
 339         str[temp] := _treat_char[BYTE(str[temp])]\r
 340       else If (str[temp] = #0) then str[temp] := ' '\r
 341            else str[temp] := chr1;\r
 342   FilterStr2 := str;\r
 343 end;\r
 344 \r
 345 function Num2str(num: Longint; base: Byte): String; assembler;\r
 346 \r
 347 const\r
 348   hexa: array[0..PRED(16)+32] of Char = '0123456789ABCDEF'+\r
 349                                         #0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0;\r
 350 asm\r
 351         xor     eax,eax\r
 352         xor     edx,edx\r
 353         xor     edi,edi\r
 354         xor     esi,esi\r
 355         mov     eax,num\r
 356         xor     ebx,ebx\r
 357         mov     bl,base\r
 358         cmp     bl,2\r
 359         jb      @@3\r
 360         cmp     bl,16\r
 361         ja      @@3\r
 362         mov     edi,32\r
 363 @@1:    dec     edi\r
 364         xor     edx,edx\r
 365         div     ebx\r
 366         mov     esi,edx\r
 367         mov     dl,byte ptr [hexa+esi]\r
 368         mov     byte ptr [hexa+edi+16],dl\r
 369         and     eax,eax\r
 370         jnz     @@1\r
 371         mov     esi,edi\r
 372         mov     ecx,32\r
 373         sub     ecx,edi\r
 374         mov     edi,@result\r
 375         mov     al,cl\r
 376         stosb\r
 377 @@2:    mov     al,byte ptr [hexa+esi+16]\r
 378         stosb\r
 379         inc     esi\r
 380         loop    @@2\r
 381         jmp     @@4\r
 382 @@3:    mov     edi,@result\r
 383         xor     al,al\r
 384         stosb\r
 385 @@4:\r
 386 end;\r
 387 \r
 388 const\r
 389   digits: array[0..35] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';\r
 390 \r
 391 function Digit2index(digit: Char): Byte;\r
 392 \r
 393 var\r
 394   index: Byte;\r
 395 \r
 396 begin\r
 397   digit := UpCase(digit);\r
 398   index := 15;\r
 399   While (index > 0) and (digit <> digits[index]) do Dec(index);\r
 400   Digit2index := Index;\r
 401 end;\r
 402 \r
 403 function position_value(position,base: Byte): Longint;\r
 404 \r
 405 var\r
 406   value: Longint;\r
 407   index: Byte;\r
 408 \r
 409 begin\r
 410   value := 1;\r
 411   For index := 2 to position do value := value*base;\r
 412   position_value := value;\r
 413 end;\r
 414 \r
 415 function Str2num(str: String; base: Byte): Longint;\r
 416 \r
 417 var\r
 418   value: Longint;\r
 419   index: Byte;\r
 420 \r
 421 begin\r
 422   value := 0;\r
 423   For index := 1 to Length(str) do\r
 424     Inc(value,Digit2index(str[index])*\r
 425               position_value(Length(str)-index+1,base));\r
 426   Str2num := value;\r
 427 end;\r
 428 \r
 429 function InputStr(s: String; x,y,ln,ln1: Byte; atr1,atr2: Byte): String;\r
 430 \r
 431 var\r
 432   appn,for1st,qflg,ins: Boolean;\r
 433   cloc,xloc,xint,mx,attr: Byte;\r
 434   key: Word;\r
 435   cur: Longint;\r
 436   s1,s2: String;\r
 437 \r
 438 function LookupKey(key: Word; var table; size: Byte): Boolean; assembler;\r
 439 asm\r
 440         mov     esi,[table]\r
 441         xor     ecx,ecx\r
 442         mov     cl,size\r
 443         mov     al,1\r
 444         jecxz   @@3\r
 445 @@1:    lodsw\r
 446         cmp     ax,key\r
 447         jz      @@2\r
 448         loop    @@1\r
 449 @@2:    xor     al,al\r
 450         jecxz   @@3\r
 451         mov     al,1\r
 452 @@3:\r
 453 end;\r
 454 \r
 455 function more(value1,value2: Byte): Byte; assembler;\r
 456 asm\r
 457         mov     al,value1\r
 458         cmp     al,value2\r
 459         jnb     @@1\r
 460         mov     al,value2\r
 461 @@1:\r
 462 end;\r
 463 \r
 464 begin\r
 465   s := Copy(s,1,ln);\r
 466   If (is_environment.locate_pos > ln1) then\r
 467     is_environment.locate_pos := ln1;\r
 468   If (is_environment.locate_pos > Length(s)+1) then\r
 469     is_environment.locate_pos := Length(s);\r
 470 \r
 471   cloc := is_environment.locate_pos;\r
 472   xloc := is_environment.locate_pos;\r
 473   xint := x;\r
 474   qflg := FALSE;\r
 475   ins  := is_setting.insert_mode;\r
 476   appn := NOT is_setting.append_enabled;\r
 477 \r
 478   Dec(x);\r
 479   cur := GetCursor;\r
 480   If ins then ThinCursor else WideCursor;\r
 481   s1 := s;\r
 482   If (BYTE(s1[0]) > ln1) then s1[0] := CHR(ln1);\r
 483 \r
 484   ShowStr(Ptr(v_seg,v_ofs)^,xint,y,ExpStrR('',ln1,' '),atr1);\r
 485   ShowStr(Ptr(v_seg,v_ofs)^,xint,y,s1,atr2);\r
 486   for1st := TRUE;\r
 487 \r
 488   Repeat\r
 489     s2 := s1;\r
 490     If (xloc = 1) then s1 := Copy(s,cloc,ln1)\r
 491     else s1 := Copy(s,cloc-xloc+1,ln1);\r
 492 \r
 493     If NOT appn then attr := atr2\r
 494     else attr := atr1;\r
 495 \r
 496     If appn and for1st then\r
 497       begin\r
 498         ShowStr(Ptr(v_seg,v_ofs)^,xint,y,ExpStrR(s1,ln1,' '),atr1);\r
 499         for1st := FALSE;\r
 500       end;\r
 501 \r
 502     If (s2 <> s1) then\r
 503       ShowStr(Ptr(v_seg,v_ofs)^,xint,y,ExpStrR(s1,ln1,' '),atr1);\r
 504 \r
 505     If (ln1 < ln) then\r
 506       If (cloc-xloc > 0) and (Length(s) > 0) then\r
 507         ShowStr(Ptr(v_seg,v_ofs)^,xint,y,'\11',(attr AND $0f0)+$0f)\r
 508       else If (cloc-xloc = 0) and (Length(s) <> 0) then\r
 509              ShowStr(Ptr(v_seg,v_ofs)^,xint,y,s[1],attr)\r
 510            else\r
 511              ShowStr(Ptr(v_seg,v_ofs)^,xint,y,' ',atr1);\r
 512 \r
 513     If (ln1 < ln) then\r
 514       If (cloc-xloc+ln1 < Length(s)) then\r
 515         ShowStr(Ptr(v_seg,v_ofs)^,xint+ln1-1,y,'\10',(attr AND $0f0)+$0f)\r
 516       else If (cloc-xloc+ln1 = Length(s)) then\r
 517              ShowStr(Ptr(v_seg,v_ofs)^,xint+ln1-1,y,s[Length(s)],attr)\r
 518            else\r
 519              ShowStr(Ptr(v_seg,v_ofs)^,xint+ln1-1,y,' ',atr1);\r
 520 \r
 521     GotoXY(x+xloc,y);\r
 522     asm xor ah,ah; int 16h; mov key,ax end;\r
 523     If LookupKey(key,is_setting.terminate_keys,50) then qflg := TRUE;\r
 524 \r
 525     If NOT qflg then\r
 526       Case LO(key) of\r
 527         $09: appn := TRUE;\r
 528         $19: begin appn := TRUE; s := ''; cloc := 1; xloc := 1; end;\r
 529 \r
 530         $14: begin\r
 531                appn := TRUE;\r
 532                While (s[cloc] in is_setting.word_characters) and\r
 533                      (cloc <= Length(s)) do Delete(s,cloc,1);\r
 534 \r
 535                While NOT (s[cloc] in is_setting.word_characters) and\r
 536                          (cloc <= Length(s)) do Delete(s,cloc,1);\r
 537              end;\r
 538 \r
 539         $7f: begin\r
 540                appn := TRUE;\r
 541                While (s[cloc-1] in is_setting.word_characters) and\r
 542                      (cloc > 1) do\r
 543                  begin\r
 544                    Dec(cloc); Delete(s,cloc,1);\r
 545                    If (xloc > 1) then Dec(xloc);\r
 546                  end;\r
 547 \r
 548                While NOT (s[cloc-1] in is_setting.word_characters) and\r
 549                          (cloc > 1) do\r
 550                  begin\r
 551                    Dec(cloc); Delete(s,cloc,1);\r
 552                    If (xloc > 1) then Dec(xloc);\r
 553                  end;\r
 554              end;\r
 555 \r
 556         $11: begin appn := TRUE; Delete(s,cloc,Length(s)); end;\r
 557 \r
 558         $08: begin\r
 559                appn := TRUE;\r
 560                If (cloc > 1) then\r
 561                  begin\r
 562                    If (xloc > 1) then Dec(xloc);\r
 563                    Dec(cloc); Delete(s,cloc,1);\r
 564                  end;\r
 565              end;\r
 566 \r
 567         $00: begin\r
 568                If (HI(key) in [$73,$74,$4b,$4d,$52,$47,$4f]) then\r
 569                  appn := TRUE;\r
 570 \r
 571                Case (HI(key)) of\r
 572                  $73: begin\r
 573                         While (s[cloc] in is_setting.word_characters) and\r
 574                               (cloc > 1) do\r
 575                           begin\r
 576                             Dec(cloc);\r
 577                             If (xloc > 1) then Dec(xloc);\r
 578                           end;\r
 579 \r
 580                         While NOT (s[cloc] in is_setting.word_characters) and\r
 581                                   (cloc > 1) do\r
 582                           begin\r
 583                             Dec(cloc);\r
 584                             If (xloc > 1) then Dec(xloc);\r
 585                           end;\r
 586                       end;\r
 587 \r
 588                  $74: begin\r
 589                         While (s[cloc] in is_setting.word_characters) and\r
 590                               (cloc < Length(s)) do\r
 591                           begin\r
 592                             Inc(cloc);\r
 593                             If (xloc < ln1) then Inc(xloc);\r
 594                           end;\r
 595 \r
 596                         While NOT (s[cloc] in is_setting.word_characters) and\r
 597                                   (cloc < Length(s)) do\r
 598                           begin\r
 599                             Inc(cloc);\r
 600                             If (xloc < ln1) then Inc(xloc);\r
 601                           end;\r
 602                       end;\r
 603 \r
 604                  $4b: begin\r
 605                         If (cloc > 1) then Dec(cloc);\r
 606                         If (xloc > 1) then Dec(xloc);\r
 607                       end;\r
 608 \r
 609                  $4d: begin\r
 610                         If (cloc < Length(s)) or ((cloc = Length(s)) and\r
 611                              ((Length(s) < more(ln,ln1)))) then\r
 612                           Inc(cloc);\r
 613                         If (xloc < ln1) and (xloc <= Length(s)) then Inc(xloc);\r
 614                       end;\r
 615 \r
 616                  $53: begin\r
 617                         appn := TRUE;\r
 618                         If (cloc <= Length(s)) then Delete(s,cloc,1);\r
 619                       end;\r
 620 \r
 621                  $52: If is_setting.replace_enabled then\r
 622                         begin\r
 623                           ins := NOT ins;\r
 624                           If ins then ThinCursor else WideCursor;\r
 625                         end;\r
 626 \r
 627                  $47: begin cloc := 1; xloc := 1; end;\r
 628 \r
 629                  $4f: begin\r
 630                         If (Length(s) < more(ln,ln1)) then cloc := Succ(Length(s))\r
 631                         else cloc := Length(s);\r
 632                         If (cloc < ln1) then xloc := cloc else xloc := ln1;\r
 633                       end;\r
 634                end;\r
 635              end;\r
 636 \r
 637         else If NOT (LO(key) in [$09,$19,$0d,$14,$0b,$7f]) and\r
 638                     (CHR(LO(key)) in characters(is_setting.character_set)) then\r
 639                begin\r
 640                  If NOT appn then begin s := ''; cloc := 1; xloc := 1; end;\r
 641                  appn := TRUE;\r
 642                  If ins and (Length(s) < ln) then\r
 643                    begin\r
 644                      Insert(CHR(LO(key)),s,cloc);\r
 645                      s := FilterStr2(s,is_setting.valid_chars,'_');\r
 646                      If (cloc < ln) then Inc(cloc);\r
 647                      If (xloc < ln) and (xloc < ln1) then Inc(xloc)\r
 648                    end\r
 649                  else\r
 650                    If (Length(s) < ln) or NOT ins then\r
 651                      begin\r
 652                        If (cloc > Length(s)) and (Length(s) < ln) then\r
 653                          Inc(BYTE(s[0]));\r
 654 \r
 655                        s[cloc] := CHR(LO(key));\r
 656                        s := FilterStr2(s,is_setting.valid_chars,'_');\r
 657                        If (cloc < ln) then Inc(cloc);\r
 658                        If (xloc < ln) and (xloc < ln1) then Inc(xloc);\r
 659                      end;\r
 660                end;\r
 661       end;\r
 662   until qflg;\r
 663 \r
 664 //  SetCursor(cur);\r
 665   If (cloc = 0) then is_environment.locate_pos := 1\r
 666   else is_environment.locate_pos := cloc;\r
 667   is_environment.keystroke := key;\r
 668   InputStr := s;\r
 669 end;\r
 670 \r
 671 function SameName(str1,str2: String): Boolean; assembler;\r
 672 \r
 673 var\r
 674   LastW: Word;\r
 675 \r
 676 asm\r
 677         xor     eax,eax\r
 678         xor     ecx,ecx\r
 679         mov     esi,[str1]\r
 680         mov     edi,[str2]\r
 681         xor     ah,ah\r
 682         mov     al,[esi]\r
 683         inc     esi\r
 684         mov     cx,ax\r
 685         mov     al,[edi]\r
 686         inc     edi\r
 687         mov     bx,ax\r
 688         or      cx,cx\r
 689         jnz     @@1\r
 690         or      bx,bx\r
 691         jz      @@13\r
 692         jmp     @@14\r
 693         xor     dh,dh\r
 694 @@1:    mov     al,[esi]\r
 695         inc     esi\r
 696         cmp     al,'*'\r
 697         jne     @@2\r
 698         dec     cx\r
 699         jz      @@13\r
 700         mov     dh,1\r
 701         mov     LastW,cx\r
 702         jmp     @@1\r
 703 @@2:    cmp     al,'?'\r
 704         jnz     @@3\r
 705         inc     edi\r
 706         or      bx,bx\r
 707         je      @@12\r
 708         dec     bx\r
 709         jmp     @@12\r
 710 @@3:    or      bx,bx\r
 711         je      @@14\r
 712         cmp     al,'['\r
 713         jne     @@11\r
 714         cmp     word ptr [esi],']?'\r
 715         je      @@9\r
 716         mov     ah,byte ptr [edi]\r
 717         xor     dl,dl\r
 718         cmp     byte ptr [esi],'!'\r
 719         jnz     @@4\r
 720         inc     esi\r
 721         dec     cx\r
 722         jz      @@14\r
 723         inc     dx\r
 724 @@4:    mov     al,[esi]\r
 725         inc     esi\r
 726         dec     cx\r
 727         jz      @@14\r
 728         cmp     al,']'\r
 729         je      @@7\r
 730         cmp     ah,al\r
 731         je      @@6\r
 732         cmp     byte ptr [esi],'-'\r
 733         jne     @@4\r
 734         inc     esi\r
 735         dec     cx\r
 736         jz      @@14\r
 737         cmp     ah,al\r
 738         jae     @@5\r
 739         inc     esi\r
 740         dec     cx\r
 741         jz      @@14\r
 742         jmp     @@4\r
 743 @@5:    mov     al,[esi]\r
 744         inc     esi\r
 745         dec     cx\r
 746         jz      @@14\r
 747         cmp     ah,al\r
 748         ja      @@4\r
 749 @@6:    or      dl,dl\r
 750         jnz     @@14\r
 751         inc     dx\r
 752 @@7:    or      dl,dl\r
 753         jz      @@14\r
 754 @@8:    cmp     al,']'\r
 755         je      @@10\r
 756 @@9:    mov     al,[esi]\r
 757         inc     esi\r
 758         cmp     al,']'\r
 759         loopne  @@9\r
 760         jne     @@14\r
 761 @@10:   dec     bx\r
 762         inc     edi\r
 763         jmp     @@12\r
 764 @@11:   cmp     [edi],al\r
 765         jne     @@14\r
 766         inc     edi\r
 767         dec     bx\r
 768 @@12:   xor     dh,dh\r
 769         dec     cx\r
 770         jnz     @@1\r
 771         or      bx,bx\r
 772         jnz     @@14\r
 773 @@13:   mov     al,1\r
 774         jmp     @@16\r
 775 @@14:   or      dh,dh\r
 776         jz      @@15\r
 777         jecxz   @@15\r
 778         or      bx,bx\r
 779         jz      @@15\r
 780         inc     edi\r
 781         dec     bx\r
 782         jz      @@15\r
 783         mov     ax,LastW\r
 784         sub     ax,cx\r
 785         add     cx,ax\r
 786         sub     esi,eax\r
 787         dec     esi\r
 788         jmp     @@1\r
 789 @@15:   mov     al,0\r
 790 @@16:\r
 791 end;\r
 792 \r
 793 var\r
 794   dir:  DirStr;\r
 795   name: NameStr;\r
 796   ext:  ExtStr;\r
 797 \r
 798 function PathOnly(path: String): String;\r
 799 begin\r
 800   FSplit(path,dir,name,ext);\r
 801   PathOnly := dir;\r
 802 end;\r
 803 \r
 804 function NameOnly(path: String): String;\r
 805 begin\r
 806   FSplit(path,dir,name,ext);\r
 807   NameOnly := name+ext;\r
 808 end;\r
 809 \r
 810 function BaseNameOnly(path: String): String;\r
 811 begin\r
 812   FSplit(path,dir,name,ext);\r
 813   BaseNameOnly := name;\r
 814 end;\r
 815 \r
 816 function ExtOnly(path: String): String;\r
 817 begin\r
 818   FSplit(path,dir,name,ext);\r
 819   Delete(ext,1,1);\r
 820   ExtOnly := ext;\r
 821 end;\r
 822 \r
 823 begin\r
 824   is_environment.locate_pos := 1;\r
 825 end.\r