]> 4ch.mooo.com Git - 16.git/blobdiff - 16/ADT2PLAY/STRINGIO.PAS
seriously i want sound!!! bakapee!
[16.git] / 16 / ADT2PLAY / STRINGIO.PAS
diff --git a/16/ADT2PLAY/STRINGIO.PAS b/16/ADT2PLAY/STRINGIO.PAS
new file mode 100644 (file)
index 0000000..6a377d6
--- /dev/null
@@ -0,0 +1,825 @@
+unit StringIO;\r
+interface\r
+\r
+type\r
+  characters = Set of Char;\r
+\r
+function Capitalize(str: String): String;\r
+function Upper(str: String): String;\r
+function Lower(str: String): String;\r
+function iCASE(str: String): String;\r
+function RotStrL(str1,str2: String; shift: Byte): String;\r
+function RotStrR(str1,str2: String; shift: Byte): String;\r
+function ExpStrL(str: String; size: Byte; chr: Char): String;\r
+function ExpStrR(str: String; size: Byte; chr: Char): String;\r
+function DietStr(str: String; size: Byte): String;\r
+function CutStr(str: String): String;\r
+function FlipStr(str: String): String;\r
+function FilterStr(str: String; chr0,chr1: Char): String;\r
+function FilterStr2(str: String; chr0: characters; chr1: Char): String;\r
+function Num2str(num: Longint; base: Byte): String;\r
+function Str2num(str: String; base: Byte): Longint;\r
+\r
+type\r
+  tINPUT_STR_SETTING = Record\r
+                         insert_mode,\r
+                         replace_enabled,\r
+                         append_enabled:  Boolean;\r
+                         character_set,\r
+                         valid_chars,\r
+                         word_characters: characters;\r
+                         terminate_keys:  array[1..50] of Word\r
+                       end;\r
+type\r
+  tINPUT_STR_ENVIRONMENT = Record\r
+                             keystroke: Word;\r
+                             locate_pos: Byte;\r
+                           end;\r
+const\r
+  is_setting: tINPUT_STR_SETTING =\r
+    (insert_mode:     TRUE;\r
+     replace_enabled: TRUE;\r
+     append_enabled:  TRUE;\r
+     character_set:   [#$20..#$0ff];\r
+     valid_chars:     [#$20..#$0ff];\r
+     word_characters: ['A'..'Z','a'..'z','0'..'9','_'];\r
+     terminate_keys:  ($011b,$1c0d,$0000,$0000,$0000,\r
+                       $0000,$0000,$0000,$0000,$0000,\r
+                       $0000,$0000,$0000,$0000,$0000,\r
+                       $0000,$0000,$0000,$0000,$0000,\r
+                       $0000,$0000,$0000,$0000,$0000,\r
+                       $0000,$0000,$0000,$0000,$0000,\r
+                       $0000,$0000,$0000,$0000,$0000,\r
+                       $0000,$0000,$0000,$0000,$0000,\r
+                       $0000,$0000,$0000,$0000,$0000,\r
+                       $0000,$0000,$0000,$0000,$0000));\r
+var\r
+  is_environment: tINPUT_STR_ENVIRONMENT;\r
+\r
+function InputStr(s: String; x,y,ln,ln1: Byte; atr1,atr2: Byte): String;\r
+function SameName(str1,str2: String): Boolean;\r
+function PathOnly(path: String): String;\r
+function NameOnly(path: String): String;\r
+function BaseNameOnly(path: String): String;\r
+function ExtOnly(path: String): String;\r
+\r
+implementation\r
+\r
+uses\r
+  DOS,TxtScrIO;\r
+\r
+function Capitalize(str: String): String; assembler;\r
+asm\r
+        mov     esi,[str]\r
+        mov     edi,@result\r
+        mov     al,[esi]\r
+        inc     esi\r
+        mov     [edi],al\r
+        inc     edi\r
+        xor     ecx,ecx\r
+        mov     cl,al\r
+        jecxz   @@4\r
+        mov     al,[esi]\r
+        inc     esi\r
+        cmp     al,'a'\r
+        jb      @@0\r
+        cmp     al,'z'\r
+        ja      @@0\r
+        sub     al,20h\r
+@@0:    mov     [edi],al\r
+        inc     edi\r
+@@1:    mov     ah,al\r
+        mov     al,[esi]\r
+        inc     esi\r
+        cmp     ah,' '\r
+        jnz     @@2\r
+        cmp     al,'a'\r
+        jb      @@2\r
+        cmp     al,'z'\r
+        ja      @@2\r
+        sub     al,20h\r
+        jmp     @@3\r
+@@2:    cmp     al,'A'\r
+        jb      @@3\r
+        cmp     al,'Z'\r
+        ja      @@3\r
+        add     al,20h\r
+@@3:    mov     [edi],al\r
+        inc     edi\r
+        loop    @@1\r
+@@4:\r
+end;\r
+\r
+function Upper(str: String): String; assembler;\r
+asm\r
+        mov     esi,[str]\r
+        mov     edi,@result\r
+        mov     al,[esi]\r
+        inc     esi\r
+        mov     [edi],al\r
+        inc     edi\r
+        xor     ecx,ecx\r
+        mov     cl,al\r
+        jecxz   @@3\r
+@@1:    mov     al,[esi]\r
+        inc     esi\r
+        cmp     al,'a'\r
+        jb      @@2\r
+        cmp     al,'z'\r
+        ja      @@2\r
+        sub     al,20h\r
+@@2:    mov     [edi],al\r
+        inc     edi\r
+        loop    @@1\r
+@@3:\r
+end;\r
+\r
+function Lower(str: String): String; assembler;\r
+asm\r
+        mov     esi,[str]\r
+        mov     edi,@result\r
+        mov     al,[esi]\r
+        inc     esi\r
+        mov     [edi],al\r
+        inc     edi\r
+        xor     ecx,ecx\r
+        mov     cl,al\r
+        jecxz   @@3\r
+@@1:    mov     al,[esi]\r
+        inc     esi\r
+        cmp     al,'A'\r
+        jb      @@2\r
+        cmp     al,'Z'\r
+        ja      @@2\r
+        add     al,20h\r
+@@2:    mov     [edi],al\r
+        inc     edi\r
+        loop    @@1\r
+@@3:\r
+end;\r
+\r
+function iCase(str: String): String; assembler;\r
+asm\r
+        mov     esi,[str]\r
+        mov     edi,@result\r
+        mov     al,[esi]\r
+        inc     esi\r
+        mov     [edi],al\r
+        inc     edi\r
+        xor     ecx,ecx\r
+        mov     cl,al\r
+        jecxz   @@5\r
+        push    edi\r
+        push    ecx\r
+@@1:    mov     al,[esi]\r
+        inc     esi\r
+        cmp     al,'a'\r
+        jb      @@2\r
+        cmp     al,'z'\r
+        ja      @@2\r
+        sub     al,20h\r
+@@2:    mov     [edi],al\r
+        inc     edi\r
+        loop    @@1\r
+        pop     ecx\r
+        pop     edi\r
+@@3:    mov     al,[edi]\r
+        cmp     al,'i'-20h\r
+        jnz     @@4\r
+        add     al,20h\r
+@@4:    mov     [edi],al\r
+        inc     edi\r
+        loop    @@3\r
+@@5:\r
+end;\r
+\r
+function RotStrL(str1,str2: String; shift: Byte): String;\r
+begin\r
+  RotStrL := Copy(str1,shift+1,Length(str1)-shift)+\r
+             Copy(str2,1,shift);\r
+end;\r
+\r
+function RotStrR(str1,str2: String; shift: Byte): String;\r
+begin\r
+  RotStrR := Copy(str2,Length(str2)-shift+1,shift)+\r
+             Copy(str1,1,Length(str1)-shift);\r
+end;\r
+\r
+function ExpStrL(str: String; size: Byte; chr: Char): String; assembler;\r
+asm\r
+        mov     esi,[str]\r
+        mov     edi,@result\r
+        cld\r
+        xor     ecx,ecx\r
+        lodsb\r
+        cmp     al,size\r
+        jge     @@1\r
+        mov     ah,al\r
+        mov     al,size\r
+        stosb\r
+        mov     al,ah\r
+        mov     cl,size\r
+        sub     cl,al\r
+        mov     al,chr\r
+        rep     stosb\r
+        mov     cl,ah\r
+        rep     movsb\r
+        jmp     @@2\r
+@@1:    stosb\r
+        mov     cl,al\r
+        rep     movsb\r
+@@2:\r
+end;\r
+\r
+function ExpStrR(str: String; size: Byte; chr: Char): String; assembler;\r
+asm\r
+        mov     esi,[str]\r
+        mov     edi,@result\r
+        cld\r
+        xor     ecx,ecx\r
+        lodsb\r
+        cmp     al,size\r
+        jge     @@1\r
+        mov     ah,al\r
+        mov     al,size\r
+        stosb\r
+        mov     cl,ah\r
+        rep     movsb\r
+        mov     al,ah\r
+        mov     cl,size\r
+        sub     cl,al\r
+        mov     al,chr\r
+        rep     stosb\r
+        jmp     @@2\r
+@@1:    stosb\r
+        mov     cl,al\r
+        rep     movsb\r
+@@2:\r
+end;\r
+\r
+function DietStr(str: String; size: Byte): String;\r
+begin\r
+  If (Length(str) <= size) then\r
+    begin\r
+      DietStr := str;\r
+      EXIT;\r
+    end;\r
+\r
+  Repeat\r
+    Delete(str,size DIV 2,1)\r
+  until (Length(str)+3 = size);\r
+\r
+  Insert('...',str,size DIV 2);\r
+  DietStr := str\r
+end;\r
+\r
+function CutStr(str: String): String;\r
+begin\r
+  While (str[0] <> #0) and (str[1] in [#00,#32]) do Delete(str,1,1);\r
+  While (str[0] <> #0) and (str[Length(str)] in [#00,#32]) do Delete(str,Length(str),1);\r
+  CutStr := str;\r
+end;\r
+\r
+function FlipStr(str: String): String; assembler;\r
+asm\r
+        mov     esi,[str]\r
+        mov     edi,@result\r
+        mov     al,[esi]\r
+        inc     esi\r
+        mov     [edi],al\r
+        inc     edi\r
+        dec     edi\r
+        xor     ecx,ecx\r
+        mov     cl,al\r
+        jecxz   @@2\r
+        add     edi,ecx\r
+@@1:    mov     al,[esi]\r
+        inc     esi\r
+        mov     [edi],al\r
+        dec     edi\r
+        loop    @@1\r
+@@2:\r
+end;\r
+\r
+function FilterStr(str: String; chr0,chr1: Char): String; assembler;\r
+asm\r
+        mov     esi,[str]\r
+        mov     edi,@result\r
+        mov     al,[esi]\r
+        inc     esi\r
+        mov     [edi],al\r
+        inc     edi\r
+        xor     ecx,ecx\r
+        mov     cl,al\r
+        jecxz   @@3\r
+@@1:    mov     al,[esi]\r
+        inc     esi\r
+        cmp     al,chr0\r
+        jnz     @@2\r
+        mov     al,chr1\r
+@@2:    mov     [edi],al\r
+        inc     edi\r
+        loop    @@1\r
+@@3:\r
+end;\r
+\r
+const\r
+  _treat_char: array[$80..$a5] of Char =\r
+    'CueaaaaceeeiiiAAE_AooouuyOU_____aiounN';\r
+\r
+function FilterStr2(str: String; chr0: characters; chr1: Char): String;\r
+\r
+var\r
+  temp: Byte;\r
+\r
+begin\r
+  For temp := 1 to Length(str) do\r
+    If NOT (str[temp] in chr0) then\r
+      If (str[temp] >= #$80) and (str[temp] <= #$a5) then\r
+        str[temp] := _treat_char[BYTE(str[temp])]\r
+      else If (str[temp] = #0) then str[temp] := ' '\r
+           else str[temp] := chr1;\r
+  FilterStr2 := str;\r
+end;\r
+\r
+function Num2str(num: Longint; base: Byte): String; assembler;\r
+\r
+const\r
+  hexa: array[0..PRED(16)+32] of Char = '0123456789ABCDEF'+\r
+                                        #0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0;\r
+asm\r
+        xor     eax,eax\r
+        xor     edx,edx\r
+        xor     edi,edi\r
+        xor     esi,esi\r
+        mov     eax,num\r
+        xor     ebx,ebx\r
+        mov     bl,base\r
+        cmp     bl,2\r
+        jb      @@3\r
+        cmp     bl,16\r
+        ja      @@3\r
+        mov     edi,32\r
+@@1:    dec     edi\r
+        xor     edx,edx\r
+        div     ebx\r
+        mov     esi,edx\r
+        mov     dl,byte ptr [hexa+esi]\r
+        mov     byte ptr [hexa+edi+16],dl\r
+        and     eax,eax\r
+        jnz     @@1\r
+        mov     esi,edi\r
+        mov     ecx,32\r
+        sub     ecx,edi\r
+        mov     edi,@result\r
+        mov     al,cl\r
+        stosb\r
+@@2:    mov     al,byte ptr [hexa+esi+16]\r
+        stosb\r
+        inc     esi\r
+        loop    @@2\r
+        jmp     @@4\r
+@@3:    mov     edi,@result\r
+        xor     al,al\r
+        stosb\r
+@@4:\r
+end;\r
+\r
+const\r
+  digits: array[0..35] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';\r
+\r
+function Digit2index(digit: Char): Byte;\r
+\r
+var\r
+  index: Byte;\r
+\r
+begin\r
+  digit := UpCase(digit);\r
+  index := 15;\r
+  While (index > 0) and (digit <> digits[index]) do Dec(index);\r
+  Digit2index := Index;\r
+end;\r
+\r
+function position_value(position,base: Byte): Longint;\r
+\r
+var\r
+  value: Longint;\r
+  index: Byte;\r
+\r
+begin\r
+  value := 1;\r
+  For index := 2 to position do value := value*base;\r
+  position_value := value;\r
+end;\r
+\r
+function Str2num(str: String; base: Byte): Longint;\r
+\r
+var\r
+  value: Longint;\r
+  index: Byte;\r
+\r
+begin\r
+  value := 0;\r
+  For index := 1 to Length(str) do\r
+    Inc(value,Digit2index(str[index])*\r
+              position_value(Length(str)-index+1,base));\r
+  Str2num := value;\r
+end;\r
+\r
+function InputStr(s: String; x,y,ln,ln1: Byte; atr1,atr2: Byte): String;\r
+\r
+var\r
+  appn,for1st,qflg,ins: Boolean;\r
+  cloc,xloc,xint,mx,attr: Byte;\r
+  key: Word;\r
+  cur: Longint;\r
+  s1,s2: String;\r
+\r
+function LookupKey(key: Word; var table; size: Byte): Boolean; assembler;\r
+asm\r
+        mov     esi,[table]\r
+        xor     ecx,ecx\r
+        mov     cl,size\r
+        mov     al,1\r
+        jecxz   @@3\r
+@@1:    lodsw\r
+        cmp     ax,key\r
+        jz      @@2\r
+        loop    @@1\r
+@@2:    xor     al,al\r
+        jecxz   @@3\r
+        mov     al,1\r
+@@3:\r
+end;\r
+\r
+function more(value1,value2: Byte): Byte; assembler;\r
+asm\r
+        mov     al,value1\r
+        cmp     al,value2\r
+        jnb     @@1\r
+        mov     al,value2\r
+@@1:\r
+end;\r
+\r
+begin\r
+  s := Copy(s,1,ln);\r
+  If (is_environment.locate_pos > ln1) then\r
+    is_environment.locate_pos := ln1;\r
+  If (is_environment.locate_pos > Length(s)+1) then\r
+    is_environment.locate_pos := Length(s);\r
+\r
+  cloc := is_environment.locate_pos;\r
+  xloc := is_environment.locate_pos;\r
+  xint := x;\r
+  qflg := FALSE;\r
+  ins  := is_setting.insert_mode;\r
+  appn := NOT is_setting.append_enabled;\r
+\r
+  Dec(x);\r
+  cur := GetCursor;\r
+  If ins then ThinCursor else WideCursor;\r
+  s1 := s;\r
+  If (BYTE(s1[0]) > ln1) then s1[0] := CHR(ln1);\r
+\r
+  ShowStr(Ptr(v_seg,v_ofs)^,xint,y,ExpStrR('',ln1,' '),atr1);\r
+  ShowStr(Ptr(v_seg,v_ofs)^,xint,y,s1,atr2);\r
+  for1st := TRUE;\r
+\r
+  Repeat\r
+    s2 := s1;\r
+    If (xloc = 1) then s1 := Copy(s,cloc,ln1)\r
+    else s1 := Copy(s,cloc-xloc+1,ln1);\r
+\r
+    If NOT appn then attr := atr2\r
+    else attr := atr1;\r
+\r
+    If appn and for1st then\r
+      begin\r
+        ShowStr(Ptr(v_seg,v_ofs)^,xint,y,ExpStrR(s1,ln1,' '),atr1);\r
+        for1st := FALSE;\r
+      end;\r
+\r
+    If (s2 <> s1) then\r
+      ShowStr(Ptr(v_seg,v_ofs)^,xint,y,ExpStrR(s1,ln1,' '),atr1);\r
+\r
+    If (ln1 < ln) then\r
+      If (cloc-xloc > 0) and (Length(s) > 0) then\r
+        ShowStr(Ptr(v_seg,v_ofs)^,xint,y,'\11',(attr AND $0f0)+$0f)\r
+      else If (cloc-xloc = 0) and (Length(s) <> 0) then\r
+             ShowStr(Ptr(v_seg,v_ofs)^,xint,y,s[1],attr)\r
+           else\r
+             ShowStr(Ptr(v_seg,v_ofs)^,xint,y,' ',atr1);\r
+\r
+    If (ln1 < ln) then\r
+      If (cloc-xloc+ln1 < Length(s)) then\r
+        ShowStr(Ptr(v_seg,v_ofs)^,xint+ln1-1,y,'\10',(attr AND $0f0)+$0f)\r
+      else If (cloc-xloc+ln1 = Length(s)) then\r
+             ShowStr(Ptr(v_seg,v_ofs)^,xint+ln1-1,y,s[Length(s)],attr)\r
+           else\r
+             ShowStr(Ptr(v_seg,v_ofs)^,xint+ln1-1,y,' ',atr1);\r
+\r
+    GotoXY(x+xloc,y);\r
+    asm xor ah,ah; int 16h; mov key,ax end;\r
+    If LookupKey(key,is_setting.terminate_keys,50) then qflg := TRUE;\r
+\r
+    If NOT qflg then\r
+      Case LO(key) of\r
+        $09: appn := TRUE;\r
+        $19: begin appn := TRUE; s := ''; cloc := 1; xloc := 1; end;\r
+\r
+        $14: begin\r
+               appn := TRUE;\r
+               While (s[cloc] in is_setting.word_characters) and\r
+                     (cloc <= Length(s)) do Delete(s,cloc,1);\r
+\r
+               While NOT (s[cloc] in is_setting.word_characters) and\r
+                         (cloc <= Length(s)) do Delete(s,cloc,1);\r
+             end;\r
+\r
+        $7f: begin\r
+               appn := TRUE;\r
+               While (s[cloc-1] in is_setting.word_characters) and\r
+                     (cloc > 1) do\r
+                 begin\r
+                   Dec(cloc); Delete(s,cloc,1);\r
+                   If (xloc > 1) then Dec(xloc);\r
+                 end;\r
+\r
+               While NOT (s[cloc-1] in is_setting.word_characters) and\r
+                         (cloc > 1) do\r
+                 begin\r
+                   Dec(cloc); Delete(s,cloc,1);\r
+                   If (xloc > 1) then Dec(xloc);\r
+                 end;\r
+             end;\r
+\r
+        $11: begin appn := TRUE; Delete(s,cloc,Length(s)); end;\r
+\r
+        $08: begin\r
+               appn := TRUE;\r
+               If (cloc > 1) then\r
+                 begin\r
+                   If (xloc > 1) then Dec(xloc);\r
+                   Dec(cloc); Delete(s,cloc,1);\r
+                 end;\r
+             end;\r
+\r
+        $00: begin\r
+               If (HI(key) in [$73,$74,$4b,$4d,$52,$47,$4f]) then\r
+                 appn := TRUE;\r
+\r
+               Case (HI(key)) of\r
+                 $73: begin\r
+                        While (s[cloc] in is_setting.word_characters) and\r
+                              (cloc > 1) do\r
+                          begin\r
+                            Dec(cloc);\r
+                            If (xloc > 1) then Dec(xloc);\r
+                          end;\r
+\r
+                        While NOT (s[cloc] in is_setting.word_characters) and\r
+                                  (cloc > 1) do\r
+                          begin\r
+                            Dec(cloc);\r
+                            If (xloc > 1) then Dec(xloc);\r
+                          end;\r
+                      end;\r
+\r
+                 $74: begin\r
+                        While (s[cloc] in is_setting.word_characters) and\r
+                              (cloc < Length(s)) do\r
+                          begin\r
+                            Inc(cloc);\r
+                            If (xloc < ln1) then Inc(xloc);\r
+                          end;\r
+\r
+                        While NOT (s[cloc] in is_setting.word_characters) and\r
+                                  (cloc < Length(s)) do\r
+                          begin\r
+                            Inc(cloc);\r
+                            If (xloc < ln1) then Inc(xloc);\r
+                          end;\r
+                      end;\r
+\r
+                 $4b: begin\r
+                        If (cloc > 1) then Dec(cloc);\r
+                        If (xloc > 1) then Dec(xloc);\r
+                      end;\r
+\r
+                 $4d: begin\r
+                        If (cloc < Length(s)) or ((cloc = Length(s)) and\r
+                             ((Length(s) < more(ln,ln1)))) then\r
+                          Inc(cloc);\r
+                        If (xloc < ln1) and (xloc <= Length(s)) then Inc(xloc);\r
+                      end;\r
+\r
+                 $53: begin\r
+                        appn := TRUE;\r
+                        If (cloc <= Length(s)) then Delete(s,cloc,1);\r
+                      end;\r
+\r
+                 $52: If is_setting.replace_enabled then\r
+                        begin\r
+                          ins := NOT ins;\r
+                          If ins then ThinCursor else WideCursor;\r
+                        end;\r
+\r
+                 $47: begin cloc := 1; xloc := 1; end;\r
+\r
+                 $4f: begin\r
+                        If (Length(s) < more(ln,ln1)) then cloc := Succ(Length(s))\r
+                        else cloc := Length(s);\r
+                        If (cloc < ln1) then xloc := cloc else xloc := ln1;\r
+                      end;\r
+               end;\r
+             end;\r
+\r
+        else If NOT (LO(key) in [$09,$19,$0d,$14,$0b,$7f]) and\r
+                    (CHR(LO(key)) in characters(is_setting.character_set)) then\r
+               begin\r
+                 If NOT appn then begin s := ''; cloc := 1; xloc := 1; end;\r
+                 appn := TRUE;\r
+                 If ins and (Length(s) < ln) then\r
+                   begin\r
+                     Insert(CHR(LO(key)),s,cloc);\r
+                     s := FilterStr2(s,is_setting.valid_chars,'_');\r
+                     If (cloc < ln) then Inc(cloc);\r
+                     If (xloc < ln) and (xloc < ln1) then Inc(xloc)\r
+                   end\r
+                 else\r
+                   If (Length(s) < ln) or NOT ins then\r
+                     begin\r
+                       If (cloc > Length(s)) and (Length(s) < ln) then\r
+                         Inc(BYTE(s[0]));\r
+\r
+                       s[cloc] := CHR(LO(key));\r
+                       s := FilterStr2(s,is_setting.valid_chars,'_');\r
+                       If (cloc < ln) then Inc(cloc);\r
+                       If (xloc < ln) and (xloc < ln1) then Inc(xloc);\r
+                     end;\r
+               end;\r
+      end;\r
+  until qflg;\r
+\r
+//  SetCursor(cur);\r
+  If (cloc = 0) then is_environment.locate_pos := 1\r
+  else is_environment.locate_pos := cloc;\r
+  is_environment.keystroke := key;\r
+  InputStr := s;\r
+end;\r
+\r
+function SameName(str1,str2: String): Boolean; assembler;\r
+\r
+var\r
+  LastW: Word;\r
+\r
+asm\r
+        xor     eax,eax\r
+        xor     ecx,ecx\r
+        mov     esi,[str1]\r
+        mov     edi,[str2]\r
+        xor     ah,ah\r
+        mov     al,[esi]\r
+        inc     esi\r
+        mov     cx,ax\r
+        mov     al,[edi]\r
+        inc     edi\r
+        mov     bx,ax\r
+        or      cx,cx\r
+        jnz     @@1\r
+        or      bx,bx\r
+        jz      @@13\r
+        jmp     @@14\r
+        xor     dh,dh\r
+@@1:    mov     al,[esi]\r
+        inc     esi\r
+        cmp     al,'*'\r
+        jne     @@2\r
+        dec     cx\r
+        jz      @@13\r
+        mov     dh,1\r
+        mov     LastW,cx\r
+        jmp     @@1\r
+@@2:    cmp     al,'?'\r
+        jnz     @@3\r
+        inc     edi\r
+        or      bx,bx\r
+        je      @@12\r
+        dec     bx\r
+        jmp     @@12\r
+@@3:    or      bx,bx\r
+        je      @@14\r
+        cmp     al,'['\r
+        jne     @@11\r
+        cmp     word ptr [esi],']?'\r
+        je      @@9\r
+        mov     ah,byte ptr [edi]\r
+        xor     dl,dl\r
+        cmp     byte ptr [esi],'!'\r
+        jnz     @@4\r
+        inc     esi\r
+        dec     cx\r
+        jz      @@14\r
+        inc     dx\r
+@@4:    mov     al,[esi]\r
+        inc     esi\r
+        dec     cx\r
+        jz      @@14\r
+        cmp     al,']'\r
+        je      @@7\r
+        cmp     ah,al\r
+        je      @@6\r
+        cmp     byte ptr [esi],'-'\r
+        jne     @@4\r
+        inc     esi\r
+        dec     cx\r
+        jz      @@14\r
+        cmp     ah,al\r
+        jae     @@5\r
+        inc     esi\r
+        dec     cx\r
+        jz      @@14\r
+        jmp     @@4\r
+@@5:    mov     al,[esi]\r
+        inc     esi\r
+        dec     cx\r
+        jz      @@14\r
+        cmp     ah,al\r
+        ja      @@4\r
+@@6:    or      dl,dl\r
+        jnz     @@14\r
+        inc     dx\r
+@@7:    or      dl,dl\r
+        jz      @@14\r
+@@8:    cmp     al,']'\r
+        je      @@10\r
+@@9:    mov     al,[esi]\r
+        inc     esi\r
+        cmp     al,']'\r
+        loopne  @@9\r
+        jne     @@14\r
+@@10:   dec     bx\r
+        inc     edi\r
+        jmp     @@12\r
+@@11:   cmp     [edi],al\r
+        jne     @@14\r
+        inc     edi\r
+        dec     bx\r
+@@12:   xor     dh,dh\r
+        dec     cx\r
+        jnz     @@1\r
+        or      bx,bx\r
+        jnz     @@14\r
+@@13:   mov     al,1\r
+        jmp     @@16\r
+@@14:   or      dh,dh\r
+        jz      @@15\r
+        jecxz   @@15\r
+        or      bx,bx\r
+        jz      @@15\r
+        inc     edi\r
+        dec     bx\r
+        jz      @@15\r
+        mov     ax,LastW\r
+        sub     ax,cx\r
+        add     cx,ax\r
+        sub     esi,eax\r
+        dec     esi\r
+        jmp     @@1\r
+@@15:   mov     al,0\r
+@@16:\r
+end;\r
+\r
+var\r
+  dir:  DirStr;\r
+  name: NameStr;\r
+  ext:  ExtStr;\r
+\r
+function PathOnly(path: String): String;\r
+begin\r
+  FSplit(path,dir,name,ext);\r
+  PathOnly := dir;\r
+end;\r
+\r
+function NameOnly(path: String): String;\r
+begin\r
+  FSplit(path,dir,name,ext);\r
+  NameOnly := name+ext;\r
+end;\r
+\r
+function BaseNameOnly(path: String): String;\r
+begin\r
+  FSplit(path,dir,name,ext);\r
+  BaseNameOnly := name;\r
+end;\r
+\r
+function ExtOnly(path: String): String;\r
+begin\r
+  FSplit(path,dir,name,ext);\r
+  Delete(ext,1,1);\r
+  ExtOnly := ext;\r
+end;\r
+\r
+begin\r
+  is_environment.locate_pos := 1;\r
+end.\r