home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk14 / rtl70.pak / WINDOS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  26.4 KB  |  1,346 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Runtime Library                    }
  5. {       Windows DOS Interface Unit                      }
  6. {                                                       }
  7. {       Copyright (c) 1991,92 Borland International     }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit WinDos;
  12.  
  13. {$O+,S-,W-}
  14.  
  15. interface
  16.  
  17. { Flags bit masks }
  18.  
  19. const
  20.   fCarry     = $0001;
  21.   fParity    = $0004;
  22.   fAuxiliary = $0010;
  23.   fZero      = $0040;
  24.   fSign      = $0080;
  25.   fOverflow  = $0800;
  26.  
  27. { File mode magic numbers }
  28.  
  29. const
  30.   fmClosed = $D7B0;
  31.   fmInput  = $D7B1;
  32.   fmOutput = $D7B2;
  33.   fmInOut  = $D7B3;
  34.  
  35. { File attribute constants }
  36.  
  37. const
  38.   faReadOnly  = $01;
  39.   faHidden    = $02;
  40.   faSysFile   = $04;
  41.   faVolumeID  = $08;
  42.   faDirectory = $10;
  43.   faArchive   = $20;
  44.   faAnyFile   = $3F;
  45.  
  46. { Maximum file name component string lengths }
  47.  
  48. const
  49.   fsPathName  = 79;
  50.   fsDirectory = 67;
  51.   fsFileName  = 8;
  52.   fsExtension = 4;
  53.  
  54. { FileSplit return flags }
  55.  
  56. const
  57.   fcExtension = $0001;
  58.   fcFileName  = $0002;
  59.   fcDirectory = $0004;
  60.   fcWildcards = $0008;
  61.  
  62. { Registers record used by Intr and MsDos }
  63.  
  64. type
  65.   TRegisters = record
  66.     case Integer of
  67.       0: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Word);
  68.       1: (AL, AH, BL, BH, CL, CH, DL, DH: Byte);
  69.   end;
  70.  
  71. { Typed-file and untyped-file record }
  72.  
  73. type
  74.   TFileRec = record
  75.     Handle: Word;
  76.     Mode: Word;
  77.     RecSize: Word;
  78.     Private: array[1..26] of Byte;
  79.     UserData: array[1..16] of Byte;
  80.     Name: array[0..79] of Char;
  81.   end;
  82.  
  83. { Textfile record }
  84.  
  85. type
  86.   PTextBuf = ^TTextBuf;
  87.   TTextBuf = array[0..127] of Char;
  88.   TTextRec = record
  89.     Handle: Word;
  90.     Mode: Word;
  91.     BufSize: Word;
  92.     Private: Word;
  93.     BufPos: Word;
  94.     BufEnd: Word;
  95.     BufPtr: PTextBuf;
  96.     OpenFunc: Pointer;
  97.     InOutFunc: Pointer;
  98.     FlushFunc: Pointer;
  99.     CloseFunc: Pointer;
  100.     UserData: array[1..16] of Byte;
  101.     Name: array[0..79] of Char;
  102.     Buffer: TTextBuf;
  103.   end;
  104.  
  105. { Search record used by FindFirst and FindNext }
  106.  
  107. type
  108.   TSearchRec = record
  109.     Fill: array[1..21] of Byte;
  110.     Attr: Byte;
  111.     Time: Longint;
  112.     Size: Longint;
  113.     Name: array[0..12] of Char;
  114.   end;
  115.  
  116. { Date and time record used by PackTime and UnpackTime }
  117.  
  118. type
  119.   TDateTime = record
  120.     Year, Month, Day, Hour, Min, Sec: Word;
  121.   end;
  122.  
  123. { Error status variable }
  124.  
  125. var
  126.   DosError: Integer;
  127.  
  128. { DosVersion returns the DOS version number. The low byte of    }
  129. { the result is the major version number, and the high byte is  }
  130. { the minor version number. For example, DOS 3.20 returns 3 in  }
  131. { the low byte, and 20 in the high byte.                        }
  132.  
  133. function DosVersion: Word;
  134.  
  135. { Intr executes a specified software interrupt with a specified }
  136. { TRegisters package. NOTE: To avoid general protection faults  }
  137. { when running in protected mode, always make sure to           }
  138. { initialize the DS and ES fields of the TRegisters record with }
  139. { valid selector values, or set the fields to zero.             }
  140.  
  141. procedure Intr(IntNo: Byte; var Regs: TRegisters);
  142.  
  143. { MsDos invokes the DOS function call handler with a specified  }
  144. { TRegisters package.                                           }
  145.  
  146. procedure MsDos(var Regs: TRegisters);
  147.  
  148. { GetDate returns the current date set in the operating system. }
  149. { Ranges of the values returned are: Year 1980-2099, Month      }
  150. { 1-12, Day 1-31 and DayOfWeek 0-6 (0 corresponds to Sunday).   }
  151.  
  152. procedure GetDate(var Year, Month, Day, DayOfWeek: Word);
  153.  
  154. { SetDate sets the current date in the operating system. Valid  }
  155. { parameter ranges are: Year 1980-2099, Month 1-12 and Day      }
  156. { 1-31. If the date is not valid, the function call is ignored. }
  157.  
  158. procedure SetDate(Year, Month, Day: Word);
  159.  
  160. { GetTime returns the current time set in the operating system. }
  161. { Ranges of the values returned are: Hour 0-23, Minute 0-59,    }
  162. { Second 0-59 and Sec100 (hundredths of seconds) 0-99.          }
  163.  
  164. procedure GetTime(var Hour, Minute, Second, Sec100: Word);
  165.  
  166. { SetTime sets the time in the operating system. Valid          }
  167. { parameter ranges are: Hour 0-23, Minute 0-59, Second 0-59 and }
  168. { Sec100 (hundredths of seconds) 0-99. If the time is not       }
  169. { valid, the function call is ignored.                          }
  170.  
  171. procedure SetTime(Hour, Minute, Second, Sec100: Word);
  172.  
  173. { GetCBreak returns the state of Ctrl-Break checking in DOS.    }
  174. { When off (False), DOS only checks for Ctrl-Break during I/O   }
  175. { to console, printer, or communication devices. When on        }
  176. { (True), checks are made at every system call.                 }
  177.  
  178. procedure GetCBreak(var Break: Boolean);
  179.  
  180. { SetCBreak sets the state of Ctrl-Break checking in DOS.       }
  181.  
  182. procedure SetCBreak(Break: Boolean);
  183.  
  184. { GetVerify returns the state of the verify flag in DOS. When   }
  185. { off (False), disk writes are not verified. When on (True),    }
  186. { all disk writes are verified to insure proper writing.        }
  187.  
  188. procedure GetVerify(var Verify: Boolean);
  189.  
  190. { SetVerify sets the state of the verify flag in DOS.           }
  191.  
  192. procedure SetVerify(Verify: Boolean);
  193.  
  194. { DiskFree returns the number of free bytes on the specified    }
  195. { drive number (0=Default,1=A,2=B,..). DiskFree returns -1 if   }
  196. { the drive number is invalid.                                  }
  197.  
  198. function DiskFree(Drive: Byte): Longint;
  199.  
  200. { DiskSize returns the size in bytes of the specified drive     }
  201. { number (0=Default,1=A,2=B,..). DiskSize returns -1 if the     }
  202. { drive number is invalid.                                      }
  203.  
  204. function DiskSize(Drive: Byte): Longint;
  205.  
  206. { GetFAttr returns the attributes of a file. F must be a file   }
  207. { variable (typed, untyped or textfile) which has been assigned }
  208. { a name. The attributes are examined by ANDing with the        }
  209. { attribute masks defined as constants above. Errors are        }
  210. { reported in DosError.                                         }
  211.  
  212. procedure GetFAttr(var F; var Attr: Word);
  213.  
  214. { SetFAttr sets the attributes of a file. F must be a file      }
  215. { variable (typed, untyped or textfile) which has been assigned }
  216. { a name. The attribute value is formed by adding (or ORing)    }
  217. { the appropriate attribute masks defined as constants above.   }
  218. { Errors are reported in DosError.                              }
  219.  
  220. procedure SetFAttr(var F; Attr: Word);
  221.  
  222. { GetFTime returns the date and time a file was last written.   }
  223. { F must be a file variable (typed, untyped or textfile) which  }
  224. { has been assigned and opened. The Time parameter may be       }
  225. { unpacked throgh a call to UnpackTime. Errors are reported in  }
  226. { DosError.                                                     }
  227.  
  228. procedure GetFTime(var F; var Time: Longint);
  229.  
  230. { SetFTime sets the date and time a file was last written.      }
  231. { F must be a file variable (typed, untyped or textfile) which  }
  232. { has been assigned and opened. The Time parameter may be       }
  233. { created through a call to PackTime. Errors are reported in    }
  234. { DosError.                                                     }
  235.  
  236. procedure SetFTime(var F; Time: Longint);
  237.  
  238. { FindFirst searches the specified (or current) directory for   }
  239. { the first entry that matches the specified filename and       }
  240. { attributes. The result is returned in the specified search    }
  241. { record. Errors (and no files found) are reported in DosError. }
  242.  
  243. procedure FindFirst(Path: PChar; Attr: Word; var F: TSearchRec);
  244.  
  245. { FindNext returs the next entry that matches the name and      }
  246. { attributes specified in a previous call to FindFirst. The     }
  247. { search record must be one passed to FindFirst. Errors (and no }
  248. { more files) are reported in DosError.                         }
  249.  
  250. procedure FindNext(var F: TSearchRec);
  251.  
  252. { UnpackTime converts a 4-byte packed date/time returned by     }
  253. { FindFirst, FindNext or GetFTime into a TDateTime record.      }
  254.  
  255. procedure UnpackTime(P: Longint; var T: TDateTime);
  256.  
  257. { PackTime converts a TDateTime record into a 4-byte packed     }
  258. { date/time used by SetFTime.                                   }
  259.  
  260. procedure PackTime(var T: TDateTime; var P: Longint);
  261.  
  262. { GetIntVec returns the address stored in the specified         }
  263. { interrupt vector.                                             }
  264.  
  265. procedure GetIntVec(IntNo: Byte; var Vector: Pointer);
  266.  
  267. { SetIntVec sets the address in the interrupt vector table for  }
  268. { the specified interrupt.                                      }
  269.  
  270. procedure SetIntVec(IntNo: Byte; Vector: Pointer);
  271.  
  272. { FileSearch searches for the file given by Name in the list of }
  273. { directories given by List. The directory paths in List must   }
  274. { be separated by semicolons. The search always starts with the }
  275. { current directory of the current drive. If the file is found, }
  276. { FileSearch stores a concatenation of the directory path and   }
  277. { the file name in Dest. Otherwise FileSearch stores an empty   }
  278. { string in Dest. The maximum length of the result is defined   }
  279. { by the fsPathName constant. The returned value is Dest.       }
  280.  
  281. function FileSearch(Dest, Name, List: PChar): PChar;
  282.  
  283. { FileExpand fully expands the file name in Name, and stores    }
  284. { the result in Dest. The maximum length of the result is       }
  285. { defined by the fsPathName constant. The result is an all    }
  286. { upper case string consisting of a drive letter, a colon, a    }
  287. { root relative directory path, and a file name. Embedded '.'    }
  288. { and '..' directory references are removed, and all name and    }
  289. { extension components are truncated to 8 and 3 characters. The }
  290. { returned value is Dest.                            }
  291.  
  292. function FileExpand(Dest, Name: PChar): PChar;
  293.  
  294. { FileSplit splits the file name specified by Path into its     }
  295. { three components. Dir is set to the drive and directory path  }
  296. { with any leading and trailing backslashes, Name is set to the }
  297. { file name, and Ext is set to the extension with a preceding   }
  298. { period. If a component string parameter is NIL, the           }
  299. { corresponding part of the path is not stored. If the path     }
  300. { does not contain a given component, the returned component    }
  301. { string is empty. The maximum lengths of the strings returned  }
  302. { in Dir, Name, and Ext are defined by the fsDirectory,         }
  303. { fsFileName, and fsExtension constants. The returned value is  }
  304. { a combination of the fcDirectory, fcFileName, and fcExtension }
  305. { bit masks, indicating which components were present in the    }
  306. { path. If the name or extension contains any wildcard          }
  307. { characters (* or ?), the fcWildcards flag is set in the       }
  308. { returned value.                                               }
  309.  
  310. function FileSplit(Path, Dir, Name, Ext: PChar): Word;
  311.  
  312. { GetCurDir returns the current directory of a specified drive. }
  313. { Drive = 0 indicates the current drive, 1 indicates drive A, 2 }
  314. { indicates drive B, and so on. The string returned in Dir      }
  315. { always starts with a drive letter, a colon, and a backslash.  }
  316. { The maximum length of the resulting string is defined by the  }
  317. { fsDirectory constant. The returned value is Dir. Errors are   }
  318. { reported in DosError.                                         }
  319.  
  320. function GetCurDir(Dir: PChar; Drive: Byte): PChar;
  321.  
  322. { SetCurDir changes the current directory to the path specified }
  323. { by Dir. If Dir specifies a drive letter, the current drive is }
  324. { also changed. Errors are reported in DosError.                }
  325.  
  326. procedure SetCurDir(Dir: PChar);
  327.  
  328. { CreateDir creates a new subdirectory with the path specified  }
  329. { by Dir. Errors are reported in DosError.                      }
  330.  
  331. procedure CreateDir(Dir: PChar);
  332.  
  333. { RemoveDir removes the subdirectory with the path specified by }
  334. { Dir. Errors are reported in DosError.                         }
  335.  
  336. procedure RemoveDir(Dir: PChar);
  337.  
  338. { GetArgCount returns the number of parameters passed to the    }
  339. { program on the command line.                                  }
  340.  
  341. function GetArgCount: Integer;
  342.  
  343. { GetArgStr returns the Index'th parameter from the command     }
  344. { line, or an empty string if Index is less than zero or        }
  345. { greater than GetArgCount. If Index is zero, GetArgStr returns }
  346. { the filename of the current module. The maximum length of the }
  347. { string returned in Dest is given by the MaxLen parameter. The }
  348. { returned value is Dest.                                       }
  349.  
  350. function GetArgStr(Dest: PChar; Index: Integer; MaxLen: Word): PChar;
  351.  
  352. { GetEnvVar returns a pointer to the value of a specified       }
  353. { environment variable, i.e. a pointer to the first character   }
  354. { after the equals sign (=) in the environment entry given by   }
  355. { VarName. VarName is case insensitive. GetEnvVar returns NIL   }
  356. { if the specified environment variable does not exist.         }
  357.  
  358. function GetEnvVar(VarName: PChar): PChar;
  359.  
  360. implementation
  361.  
  362. {$IFDEF Windows}
  363. {$DEFINE ProtectedMode}
  364. {$ENDIF}
  365.  
  366. {$IFDEF DPMI}
  367. {$DEFINE ProtectedMode}
  368. {$ENDIF}
  369.  
  370. {$IFDEF Windows}
  371.  
  372. uses WinTypes, WinProcs, SysUtils;
  373.  
  374. {$ELSE}
  375.  
  376. uses Strings;
  377.  
  378. {$ENDIF}
  379.  
  380. {$IFDEF Windows}
  381.  
  382. procedure AnsiDosFunc; assembler;
  383. var
  384.   TempName: array[0..fsPathName] of Char;
  385. asm
  386.     PUSH    DS
  387.     PUSH    CX
  388.     PUSH    AX
  389.     MOV    SI,DI
  390.     PUSH    ES
  391.     POP    DS
  392.     LEA    DI,TempName
  393.     PUSH    SS
  394.     POP    ES
  395.     MOV    CX,fsPathName
  396.     CLD
  397. @@1:    LODSB
  398.     OR    AL,AL
  399.     JE    @@2
  400.     STOSB
  401.     LOOP    @@1
  402. @@2:    XOR    AL,AL
  403.     STOSB
  404.     LEA    DI,TempName
  405.     PUSH    SS
  406.     PUSH    DI
  407.     PUSH    SS
  408.     PUSH    DI
  409.     CALL    AnsiToOem
  410.     POP    AX
  411.     POP    CX
  412.     LEA    DX,TempName
  413.     PUSH    SS
  414.     POP    DS
  415.     INT    21H
  416.     POP    DS
  417. end;
  418.  
  419. {$ELSE}
  420.  
  421. procedure AnsiDosFunc; assembler;
  422. asm
  423.     PUSH    DS
  424.     MOV    DX,DI
  425.     PUSH    ES
  426.     POP    DS
  427.     INT    21H
  428.     POP    DS
  429. end;
  430.  
  431. {$ENDIF}
  432.  
  433. function DosVersion: Word; assembler;
  434. asm
  435.     MOV    AH,30H
  436.     INT    21H
  437. end;
  438.  
  439. procedure Intr(IntNo: Byte; var Regs: TRegisters); assembler;
  440. asm
  441.     PUSH    DS
  442. {$IFDEF ProtectedMode}
  443. {$IFDEF Windows}
  444.     PUSH    CS
  445.     CALL    AllocCSToDSAlias
  446. {$ELSE}
  447.     MOV    AX,CS
  448.     ADD    AX,SelectorInc
  449. {$ENDIF}
  450.     MOV    DS,AX
  451.     CLI
  452.     PUSH    WORD PTR DS:@@Int
  453.     PUSH    DS
  454.     MOV    AL,IntNo
  455.     MOV    BYTE PTR DS:@@Int+1,AL
  456. {$ELSE}
  457.     PUSH    WORD PTR CS:@@Int
  458.     MOV    AL,IntNo
  459.     MOV    BYTE PTR CS:@@Int+1,AL
  460. {$ENDIF}
  461.     PUSH    BP            { Preserve our BP }
  462.     LDS    SI,Regs
  463.     CLD
  464.     LODSW
  465.     PUSH    AX            { Regs.AX }
  466.     LODSW
  467.     XCHG    AX,BX
  468.     LODSW
  469.     XCHG    AX,CX
  470.     LODSW
  471.     XCHG    AX,DX
  472.     LODSW
  473.     XCHG    AX,BP
  474.     LODSW
  475.     PUSH    AX            { Regs.SI }
  476.     LODSW
  477.     XCHG    AX,DI
  478.     LODSW
  479.     PUSH    AX            { Regs.DS }
  480.     LODSW
  481. {$IFDEF DPMI}
  482.         VERR    AX
  483.     JNZ    @@1
  484.     MOV    ES,AX
  485. @@1:    POP    AX            { Regs.DS }
  486.     VERR    AX
  487.     JNZ    @@2
  488.     MOV    DS,AX
  489. @@2:
  490. {$ELSE}
  491.     MOV    ES,AX
  492.     POP    DS            { Regs.DS }
  493. {$ENDIF}
  494.     POP    SI            { Regs.SI }
  495.     POP    AX            { Regs.AX }
  496. @@Int:    INT    0
  497.     STI
  498.     PUSHF                { New Regs.Flags, .ES, .DI, .BP }
  499.     PUSH    ES
  500.     PUSH    DI
  501.     PUSH    BP
  502.     MOV    BP,SP
  503.     MOV    BP,[BP+8]        { Recover our BP }
  504.     LES    DI,Regs
  505.     CLD
  506.     STOSW
  507.     XCHG    AX,BX
  508.     STOSW
  509.     XCHG    AX,CX
  510.     STOSW
  511.     XCHG    AX,DX
  512.     STOSW
  513.     POP    AX            { New Regs.BP }
  514.     STOSW
  515.     XCHG    AX,SI
  516.     STOSW
  517.     POP    AX            { New Regs.DI }
  518.     STOSW
  519.     MOV    AX,DS
  520.     STOSW
  521.     POP    AX            { New Regs.ES }
  522.     STOSW
  523.     POP    AX            { New Regs.Flags }
  524.     STOSW
  525.     POP    AX            { Throw away our pushed BP }
  526. {$IFDEF ProtectedMode}
  527.     POP    DS
  528.     POP    WORD PTR DS:@@Int
  529. {$ELSE}
  530.     POP    WORD PTR CS:@@Int
  531. {$ENDIF}
  532. {$IFDEF Windows}
  533.     MOV    AX,DS
  534.     POP    DS
  535.     PUSH    AX
  536.     CALL    FreeSelector
  537. {$ELSE}
  538.     POP    DS
  539. {$ENDIF}
  540. end;
  541.  
  542. procedure MsDos(var Regs: TRegisters);
  543. begin
  544.   Intr($21, Regs);
  545. end;
  546.  
  547. procedure GetDate(var Year, Month, Day, DayOfWeek: Word); assembler;
  548. asm
  549.     MOV    AH,2AH
  550.     INT    21H
  551.     XOR    AH,AH
  552.     LES    DI,DayOfWeek
  553.     STOSW
  554.     MOV    AL,DL
  555.     LES    DI,Day
  556.     STOSW
  557.     MOV    AL,DH
  558.     LES    DI,Month
  559.     STOSW
  560.     XCHG    AX,CX
  561.     LES    DI,Year
  562.     STOSW
  563. end;
  564.  
  565. procedure SetDate(Year, Month, Day: Word); assembler;
  566. asm
  567.     MOV    CX,Year
  568.     MOV    DH,BYTE PTR Month
  569.     MOV    DL,BYTE PTR Day
  570.     MOV    AH,2BH
  571.     INT    21H
  572. end;
  573.  
  574. procedure GetTime(var Hour, Minute, Second, Sec100: Word); assembler;
  575. asm
  576.     MOV    AH,2CH
  577.     INT    21H
  578.     XOR    AH,AH
  579.     MOV    AL,DL
  580.     LES    DI,Sec100
  581.     STOSW
  582.     MOV    AL,DH
  583.     LES    DI,Second
  584.     STOSW
  585.     MOV    AL,CL
  586.     LES    DI,Minute
  587.     STOSW
  588.     MOV    AL,CH
  589.     LES    DI,Hour
  590.     STOSW
  591. end;
  592.  
  593. procedure SetTime(Hour, Minute, Second, Sec100: Word); assembler;
  594. asm
  595.     MOV    CH,BYTE PTR Hour
  596.     MOV    CL,BYTE PTR Minute
  597.     MOV    DH,BYTE PTR Second
  598.     MOV    DL,BYTE PTR Sec100
  599.     MOV    AH,2DH
  600.     INT    21H
  601. end;
  602.  
  603. procedure GetCBreak(var Break: Boolean); assembler;
  604. asm
  605.     MOV    AX,3300H
  606.     INT    21H
  607.     LES    DI,Break
  608.     MOV    ES:[DI],DL
  609. end;
  610.  
  611. procedure SetCBreak(Break: Boolean); assembler;
  612. asm
  613.     MOV    DL,Break
  614.     MOV    AX,3301H
  615.     INT    21H
  616. end;
  617.  
  618. procedure GetVerify(var Verify: Boolean); assembler;
  619. asm
  620.     MOV    AH,54H
  621.     INT    21H
  622.     LES    DI,Verify
  623.     STOSB
  624. end;
  625.  
  626. procedure SetVerify(Verify: Boolean); assembler;
  627. asm
  628.     MOV    AL,Verify
  629.     MOV    AH,2EH
  630.     INT    21H
  631. end;
  632.  
  633. function DiskFree(Drive: Byte): Longint; assembler;
  634. asm
  635.     MOV    DL,Drive
  636.     MOV    AH,36H
  637.     INT    21H
  638.     MOV    DX,AX
  639.     CMP    AX,0FFFFH
  640.     JE    @@1
  641.     MUL    CX
  642.     MUL    BX
  643. @@1:
  644. end;
  645.  
  646. function DiskSize(Drive: Byte): Longint; assembler;
  647. asm
  648.     MOV    DL,Drive
  649.     MOV    AH,36H
  650.     INT    21H
  651.     MOV    BX,DX
  652.     MOV    DX,AX
  653.     CMP    AX,0FFFFH
  654.     JE    @@1
  655.     MUL    CX
  656.     MUL    BX
  657. @@1:
  658. end;
  659.  
  660. procedure GetFAttr(var F; var Attr: Word); assembler;
  661. asm
  662.     PUSH    DS
  663.     LDS    DX,F
  664.     ADD    DX,OFFSET TFileRec.Name
  665.     MOV    AX,4300H
  666.     INT    21H
  667.     POP    DS
  668.     JNC    @@1
  669.     XOR    CX,CX
  670.     JMP    @@2
  671. @@1:    XOR    AX,AX
  672. @@2:    MOV    DosError,AX
  673.     LES    DI,Attr
  674.     XCHG    AX,CX
  675.     STOSW
  676. end;
  677.  
  678. procedure SetFAttr(var F; Attr: Word); assembler;
  679. asm
  680.     PUSH    DS
  681.     LDS    DX,F
  682.     ADD    DX,OFFSET TFileRec.Name
  683.     MOV    CX,Attr
  684.     MOV    AX,4301H
  685.     INT    21H
  686.     POP    DS
  687.     JC    @@1
  688.     XOR    AX,AX
  689. @@1:    MOV    DosError,AX
  690. end;
  691.  
  692. procedure GetFTime(var F; var Time: Longint); assembler;
  693. asm
  694.     LES    DI,F
  695.     MOV    BX,ES:[DI].TFileRec.Handle
  696.     MOV    AX,5700H
  697.     INT    21H
  698.     JNC    @@1
  699.     XOR    CX,CX
  700.     XOR    DX,DX
  701.     JMP    @@2
  702. @@1:    XOR    AX,AX
  703. @@2:    MOV    DosError,AX
  704.     LES    DI,Time
  705.     CLD
  706.     XCHG    AX,CX
  707.     STOSW
  708.     XCHG    AX,DX
  709.     STOSW
  710. end;
  711.  
  712. procedure SetFTime(var F; Time: Longint); assembler;
  713. asm
  714.     LES    DI,F
  715.     MOV    BX,ES:[DI].TFileRec.Handle
  716.     MOV    CX,WORD PTR Time[0]
  717.     MOV    DX,WORD PTR Time[2]
  718.     MOV    AX,5701H
  719.     INT    21H
  720.     JC    @@1
  721.     XOR    AX,AX
  722. @@1:    MOV    DosError,AX
  723. end;
  724.  
  725. procedure FindFirst(Path: PChar; Attr: Word; var F: TSearchRec); assembler;
  726. asm
  727.     PUSH    DS
  728.     LDS    DX,F
  729.     MOV    AH,1AH
  730.     INT    21H
  731.     POP    DS
  732.     LES    DI,Path
  733.     MOV    CX,Attr
  734.     MOV    AH,4EH
  735.     CALL    AnsiDosFunc
  736.     JC    @@1
  737. {$IFDEF Windows}
  738.     LES    DI,F
  739.     ADD    DI,OFFSET TSearchRec.Name
  740.     PUSH    ES
  741.     PUSH    DI
  742.     PUSH    ES
  743.     PUSH    DI
  744.     CALL    OemToAnsi
  745. {$ENDIF}
  746.     XOR    AX,AX
  747. @@1:    MOV    DosError,AX
  748. end;
  749.  
  750. procedure FindNext(var F: TSearchRec); assembler;
  751. asm
  752.     PUSH    DS
  753.     LDS    DX,F
  754.     MOV    AH,1AH
  755.     INT    21H
  756.     POP    DS
  757.     MOV    AH,4FH
  758.     INT    21H
  759.     JC    @@1
  760. {$IFDEF Windows}
  761.     LES    DI,F
  762.     ADD    DI,OFFSET TSearchRec.Name
  763.     PUSH    ES
  764.     PUSH    DI
  765.     PUSH    ES
  766.     PUSH    DI
  767.     CALL    OemToAnsi
  768. {$ENDIF}
  769.     XOR    AX,AX
  770. @@1:    MOV    DosError,AX
  771. end;
  772.  
  773. procedure UnpackTime(P: Longint; var T: TDateTime); assembler;
  774. asm
  775.     LES    DI,T
  776.     CLD
  777.     MOV    AX,P.Word[2]
  778.     MOV    CL,9
  779.     SHR    AX,CL
  780.     ADD    AX,1980
  781.     STOSW
  782.     MOV    AX,P.Word[2]
  783.     MOV    CL,5
  784.     SHR    AX,CL
  785.     AND    AX,15
  786.     STOSW
  787.     MOV    AX,P.Word[2]
  788.     AND    AX,31
  789.     STOSW
  790.     MOV    AX,P.Word[0]
  791.     MOV    CL,11
  792.     SHR    AX,CL
  793.     STOSW
  794.     MOV    AX,P.Word[0]
  795.     MOV    CL,5
  796.     SHR    AX,CL
  797.     AND    AX,63
  798.     STOSW
  799.     MOV    AX,P.Word[0]
  800.     AND    AX,31
  801.     SHL    AX,1
  802.     STOSW
  803. end;
  804.  
  805. procedure PackTime(var T: TDateTime; var P: Longint); assembler;
  806. asm
  807.     PUSH    DS
  808.     LDS    SI,T
  809.     CLD
  810.     LODSW
  811.     SUB    AX,1980
  812.     MOV    CL,9
  813.     SHL    AX,CL
  814.     XCHG    AX,DX
  815.     LODSW
  816.     MOV    CL,5
  817.     SHL    AX,CL
  818.     ADD    DX,AX
  819.     LODSW
  820.     ADD    DX,AX
  821.     LODSW
  822.     MOV    CL,11
  823.     SHL    AX,CL
  824.     XCHG    AX,BX
  825.     LODSW
  826.     MOV    CL,5
  827.     SHL    AX,CL
  828.     ADD    BX,AX
  829.     LODSW
  830.     SHR    AX,1
  831.     ADD    AX,BX
  832.     POP    DS
  833.     LES    DI,P
  834.     STOSW
  835.     XCHG    AX,DX
  836.     STOSW
  837. end;
  838.  
  839. procedure GetIntVec(IntNo: Byte; var Vector: Pointer); assembler;
  840. asm
  841.     MOV    AL,IntNo
  842.     MOV    AH,35H
  843.     INT    21H
  844.     MOV    AX,ES
  845.     LES    DI,Vector
  846.     CLD
  847.     XCHG    AX,BX
  848.     STOSW
  849.     XCHG    AX,BX
  850.     STOSW
  851. end;
  852.  
  853. procedure SetIntVec(IntNo: Byte; Vector: Pointer); assembler;
  854. asm
  855.     PUSH    DS
  856.     LDS    DX,Vector
  857.     MOV    AL,IntNo
  858.     MOV    AH,25H
  859.     INT    21H
  860.     POP    DS
  861. end;
  862.  
  863. function FileSearch(Dest, Name, List: PChar): PChar; assembler;
  864. asm
  865.     PUSH    DS
  866.     CLD
  867.     LDS    SI,List
  868.     LES    DI,Dest
  869.     MOV    CX,fsPathName
  870. @@1:    PUSH    DS
  871.     PUSH    SI
  872.     JCXZ    @@3
  873.     LDS    SI,Name
  874. @@2:    LODSB
  875.     OR    AL,AL
  876.     JE    @@3
  877.     STOSB
  878.     LOOP    @@2
  879. @@3:    XOR    AL,AL
  880.     STOSB
  881.     LES    DI,Dest
  882.     MOV    AX,4300H
  883.     CALL    AnsiDosFunc
  884.     POP    SI
  885.     POP    DS
  886.     JC    @@4
  887.     TEST    CX,18H
  888.     JE    @@9
  889. @@4:    LES    DI,Dest
  890.     MOV    CX,fsPathName
  891.     XOR    AH,AH
  892.     LODSB
  893.     OR    AL,AL
  894.     JE    @@8
  895. @@5:    CMP    AL,';'
  896.     JE    @@7
  897.     JCXZ    @@6
  898.     MOV    AH,AL
  899.     STOSB
  900.     DEC    CX
  901. @@6:    LODSB
  902.     OR    AL,AL
  903.     JNE    @@5
  904.     DEC    SI
  905. @@7:    JCXZ    @@1
  906.     CMP    AH,':'
  907.     JE    @@1
  908.     MOV    AL,'\'
  909.     CMP    AL,AH
  910.         JE    @@1
  911.     STOSB
  912.     DEC    CX
  913.     JMP    @@1
  914. @@8:    STOSB
  915. @@9:    MOV    AX,Dest.Word[0]
  916.     MOV    DX,Dest.Word[2]
  917.     POP    DS
  918. end;
  919.  
  920. function FileExpand(Dest, Name: PChar): PChar; assembler;
  921. var
  922.   TempName: array[0..159] of Char;
  923. asm
  924.     PUSH    DS
  925.     CLD
  926.     LDS    SI,Name
  927.     LEA    DI,TempName
  928.     PUSH    SS
  929.     POP    ES
  930.     LODSW
  931.     OR    AL,AL
  932.     JE    @@1
  933.     CMP    AH,':'
  934.     JNE    @@1
  935.     CMP    AL,'a'
  936.     JB    @@2
  937.     CMP    AL,'z'
  938.     JA    @@2
  939.     SUB    AL,20H
  940.     JMP    @@2
  941. @@1:    DEC    SI
  942.     DEC    SI
  943.     MOV    AH,19H
  944.     INT    21H
  945.     ADD    AL,'A'
  946.     MOV    AH,':'
  947. @@2:    STOSW
  948.     CMP    [SI].Byte,'\'
  949.     JE    @@3
  950.     SUB    AL,'A'-1
  951.     MOV    DL,AL
  952.     MOV    AL,'\'
  953.     STOSB
  954.     PUSH    DS
  955.     PUSH    SI
  956.     MOV    AH,47H
  957.     MOV    SI,DI
  958.     PUSH    ES
  959.     POP    DS
  960.     INT    21H
  961.     POP    SI
  962.     POP    DS
  963.     JC    @@3
  964.     XOR    AL,AL
  965.     CMP    AL,ES:[DI]
  966.     JE    @@3
  967. {$IFDEF Windows}
  968.     PUSH    ES
  969.     PUSH    ES
  970.     PUSH    DI
  971.     PUSH    ES
  972.     PUSH    DI
  973.     CALL    OemToAnsi
  974.     POP    ES
  975. {$ENDIF}
  976.     MOV    CX,0FFFFH
  977.     XOR    AL,AL
  978.     CLD
  979.     REPNE    SCASB
  980.     DEC    DI
  981.     MOV    AL,'\'
  982.     STOSB
  983. @@3:    MOV    CX,8
  984. @@4:    LODSB
  985.     OR    AL,AL
  986.     JE    @@7
  987.     CMP    AL,'\'
  988.     JE    @@7
  989.     CMP    AL,'.'
  990.     JE    @@6
  991.     JCXZ    @@4
  992.     DEC    CX
  993. {$IFNDEF Windows}
  994.     CMP    AL,'a'
  995.     JB    @@5
  996.     CMP    AL,'z'
  997.     JA    @@5
  998.     SUB    AL,20H
  999. {$ENDIF}
  1000. @@5:    STOSB
  1001.     JMP    @@4
  1002. @@6:    MOV    CL,3
  1003.     JMP    @@5
  1004. @@7:    CMP    ES:[DI-2].Word,'.\'
  1005.     JNE    @@8
  1006.     DEC    DI
  1007.     DEC    DI
  1008.     JMP    @@10
  1009. @@8:    CMP    ES:[DI-2].Word,'..'
  1010.     JNE    @@10
  1011.     CMP    ES:[DI-3].Byte,'\'
  1012.     JNE    @@10
  1013.     SUB    DI,3
  1014.     CMP    ES:[DI-1].Byte,':'
  1015.     JE    @@10
  1016. @@9:    DEC    DI
  1017.     CMP    ES:[DI].Byte,'\'
  1018.     JNE    @@9
  1019. @@10:    MOV    CL,8
  1020.     OR    AL,AL
  1021.     JNE    @@5
  1022.     CMP    ES:[DI-1].Byte,':'
  1023.     JNE    @@11
  1024.     MOV    AL,'\'
  1025.     STOSB
  1026. @@11:    LEA    SI,TempName
  1027.     PUSH    SS
  1028.     POP    DS
  1029.     MOV    CX,DI
  1030.     SUB    CX,SI
  1031.     CMP    CX,79
  1032.     JBE    @@12
  1033.     MOV    CX,79
  1034. @@12:    LES    DI,Dest
  1035.     PUSH    ES
  1036.     PUSH    DI
  1037. {$IFDEF Windows}
  1038.     PUSH    ES
  1039.     PUSH    DI
  1040. {$ENDIF}
  1041.     REP    MOVSB
  1042.     XOR    AL,AL
  1043.     STOSB
  1044. {$IFDEF Windows}
  1045.     CALL    AnsiUpper
  1046. {$ENDIF}
  1047.     POP    AX
  1048.     POP    DX
  1049.     POP    DS
  1050. end;
  1051.  
  1052. {$W+}
  1053.  
  1054. function FileSplit(Path, Dir, Name, Ext: PChar): Word;
  1055. var
  1056.   DirLen, NameLen, Flags: Word;
  1057.   NamePtr, ExtPtr: PChar;
  1058. begin
  1059.   NamePtr := StrRScan(Path, '\');
  1060.   if NamePtr = nil then NamePtr := StrRScan(Path, ':');
  1061.   if NamePtr = nil then NamePtr := Path else Inc(NamePtr);
  1062.   ExtPtr := StrScan(NamePtr, '.');
  1063.   if ExtPtr = nil then ExtPtr := StrEnd(NamePtr);
  1064.   DirLen := NamePtr - Path;
  1065.   if DirLen > fsDirectory then DirLen := fsDirectory;
  1066.   NameLen := ExtPtr - NamePtr;
  1067.   if NameLen > fsFilename then NameLen := fsFilename;
  1068.   Flags := 0;
  1069.   if (StrScan(NamePtr, '?') <> nil) or (StrScan(NamePtr, '*') <> nil) then
  1070.     Flags := fcWildcards;
  1071.   if DirLen <> 0 then Flags := Flags or fcDirectory;
  1072.   if NameLen <> 0 then Flags := Flags or fcFilename;
  1073.   if ExtPtr[0] <> #0 then Flags := Flags or fcExtension;
  1074.   if Dir <> nil then StrLCopy(Dir, Path, DirLen);
  1075.   if Name <> nil then StrLCopy(Name, NamePtr, NameLen);
  1076.   if Ext <> nil then StrLCopy(Ext, ExtPtr, fsExtension);
  1077.   FileSplit := Flags;
  1078. end;
  1079.  
  1080. {$W-}
  1081.  
  1082. function GetCurDir(Dir: PChar; Drive: Byte): PChar; assembler;
  1083. asm
  1084.     MOV    AL,Drive
  1085.     OR    AL,AL
  1086.     JNE    @@1
  1087.     MOV    AH,19H
  1088.     INT    21H
  1089.     INC    AX
  1090. @@1:    MOV    DL,AL
  1091.     LES    DI,Dir
  1092.     PUSH    ES
  1093.     PUSH    DI
  1094.     CLD
  1095.     ADD    AL,'A'-1
  1096.     MOV    AH,':'
  1097.     STOSW
  1098.     MOV    AX,'\'
  1099.     STOSW
  1100.     PUSH    DS
  1101.     LEA    SI,[DI-1]
  1102.     PUSH    ES
  1103.     POP    DS
  1104.     MOV    AH,47H
  1105.     INT    21H
  1106.     JC    @@2
  1107. {$IFDEF Windows}
  1108.     PUSH    DS
  1109.     PUSH    SI
  1110.     PUSH    DS
  1111.     PUSH    SI
  1112.     CALL    OemToAnsi
  1113. {$ENDIF}
  1114.     XOR    AX,AX
  1115. @@2:    POP    DS
  1116.     MOV    DosError,AX
  1117.     POP    AX
  1118.     POP    DX
  1119. end;
  1120.  
  1121. procedure SetCurDir(Dir: PChar); assembler;
  1122. asm
  1123.     LES    DI,Dir
  1124.     MOV    AX,ES:[DI]
  1125.     OR    AL,AL
  1126.     JE    @@2
  1127.     CMP    AH,':'
  1128.     JNE    @@1
  1129.     AND    AL,0DFH
  1130.     SUB    AL,'A'
  1131.     MOV    DL,AL
  1132.     MOV    AH,0EH
  1133.     INT    21H
  1134.     MOV    AH,19H
  1135.     INT    21H
  1136.     CMP    AL,DL
  1137.     MOV    AX,15
  1138.     JNE    @@3
  1139.     CMP    AH,ES:[DI+2]
  1140.     JE    @@2
  1141. @@1:    MOV    AH,3BH
  1142.     CALL    AnsiDosFunc
  1143.     JC    @@3
  1144. @@2:    XOR    AX,AX
  1145. @@3:    MOV    DosError,AX
  1146. end;
  1147.  
  1148. procedure CreateDir(Dir: PChar); assembler;
  1149. asm
  1150.     LES    DI,Dir
  1151.     MOV    AH,39H
  1152.     CALL    AnsiDosFunc
  1153.     JC    @@1
  1154.     XOR    AX,AX
  1155. @@1:    MOV    DosError,AX
  1156. end;
  1157.  
  1158. procedure RemoveDir(Dir: PChar); assembler;
  1159. asm
  1160.     LES    DI,Dir
  1161.     MOV    AH,3AH
  1162.     CALL    AnsiDosFunc
  1163.     JC    @@1
  1164.     XOR    AX,AX
  1165. @@1:    MOV    DosError,AX
  1166. end;
  1167.  
  1168. {$IFDEF Windows}
  1169.  
  1170. procedure ArgStrCount; assembler;
  1171. asm
  1172.     LDS    SI,CmdLine
  1173.     CLD
  1174. @@1:    LODSB
  1175.     OR    AL,AL
  1176.     JE    @@2
  1177.     CMP    AL,' '
  1178.     JBE    @@1
  1179. @@2:    DEC    SI
  1180.     MOV    BX,SI
  1181. @@3:    LODSB
  1182.     CMP    AL,' '
  1183.     JA    @@3
  1184.     DEC    SI
  1185.     MOV    AX,SI
  1186.     SUB    AX,BX
  1187.     JE    @@4
  1188.     LOOP    @@1
  1189. @@4:
  1190. end;
  1191.  
  1192. function GetArgCount: Integer; assembler;
  1193. asm
  1194.     PUSH    DS
  1195.     XOR    CX,CX
  1196.     CALL    ArgStrCount
  1197.     XCHG    AX,CX
  1198.     NEG    AX
  1199.     POP    DS
  1200. end;
  1201.  
  1202. function GetArgStr(Dest: PChar; Index: Integer;
  1203.   MaxLen: Word): PChar; assembler;
  1204. asm
  1205.     MOV    CX,Index
  1206.     JCXZ    @@2
  1207.     PUSH    DS
  1208.     CALL    ArgStrCount
  1209.     MOV    SI,BX
  1210.     LES    DI,Dest
  1211.     MOV    CX,MaxLen
  1212.     CMP    CX,AX
  1213.     JB    @@1
  1214.     XCHG    AX,CX
  1215. @@1:    REP    MOVSB
  1216.     XCHG    AX,CX
  1217.     STOSB
  1218.     POP    DS
  1219.     JMP    @@3
  1220. @@2:    PUSH    HInstance
  1221.     PUSH    Dest.Word[2]
  1222.     PUSH    Dest.Word[0]
  1223.     MOV    AX,MaxLen
  1224.     INC    AX
  1225.     PUSH    AX
  1226.     CALL    GetModuleFileName
  1227. @@3:    MOV    AX,Dest.Word[0]
  1228.     MOV    DX,Dest.Word[2]
  1229. end;
  1230.  
  1231. {$ELSE}
  1232.  
  1233. procedure ArgStrCount; assembler;
  1234. asm
  1235.     MOV    DS,PrefixSeg
  1236.     MOV    SI,80H
  1237.     CLD
  1238.     LODSB
  1239.     MOV    DL,AL
  1240.     XOR    DH,DH
  1241.     ADD    DX,SI
  1242. @@1:    CMP    SI,DX
  1243.     JE    @@2
  1244.     LODSB
  1245.     CMP    AL,' '
  1246.     JBE    @@1
  1247.     DEC    SI
  1248. @@2:    MOV    BX,SI
  1249. @@3:    CMP    SI,DX
  1250.     JE    @@4
  1251.     LODSB
  1252.     CMP    AL,' '
  1253.     JA    @@3
  1254.     DEC    SI
  1255. @@4:    MOV    AX,SI
  1256.     SUB    AX,BX
  1257.     JE    @@5
  1258.     LOOP    @@1
  1259. @@5:
  1260. end;
  1261.  
  1262. function GetArgCount: Integer; assembler;
  1263. asm
  1264.     PUSH    DS
  1265.     XOR    CX,CX
  1266.     CALL    ArgStrCount
  1267.     XCHG    AX,CX
  1268.     NEG    AX
  1269.     POP    DS
  1270. end;
  1271.  
  1272. function GetArgStr(Dest: PChar; Index: Integer;
  1273.   MaxLen: Word): PChar; assembler;
  1274. asm
  1275.     PUSH    DS
  1276.     MOV    CX,Index
  1277.     JCXZ    @@1
  1278.     CALL    ArgStrCount
  1279.     MOV    SI,BX
  1280.     JMP    @@4
  1281. @@1:    MOV    AH,30H
  1282.     INT    21H
  1283.     CMP    AL,3
  1284.     MOV    AX,0
  1285.     JB    @@4
  1286.     MOV    DS,PrefixSeg
  1287.     MOV    ES,DS:WORD PTR 2CH
  1288.     XOR    DI,DI
  1289.     CLD
  1290. @@2:    CMP    AL,ES:[DI]
  1291.     JE    @@3
  1292.     MOV    CX,-1
  1293.     REPNE    SCASB
  1294.     JMP    @@2
  1295. @@3:    ADD    DI,3
  1296.     MOV    SI,DI
  1297.     PUSH    ES
  1298.     POP    DS
  1299.     MOV    CX,256
  1300.     REPNE    SCASB
  1301.     XCHG    AX,CX
  1302.     NOT    AL
  1303. @@4:    LES    DI,Dest
  1304.     MOV    CX,MaxLen
  1305.     CMP    CX,AX
  1306.     JB    @@5
  1307.     XCHG    AX,CX
  1308. @@5:    REP    MOVSB
  1309.     XCHG    AX,CX
  1310.     STOSB
  1311.     MOV    AX,Dest.Word[0]
  1312.     MOV    DX,Dest.Word[2]
  1313.     POP    DS
  1314. end;
  1315.  
  1316. {$ENDIF}
  1317.  
  1318. {$W+}
  1319.  
  1320. function GetEnvVar(VarName: PChar): PChar;
  1321. var
  1322.   L: Word;
  1323.   P: PChar;
  1324. begin
  1325.   L := StrLen(VarName);
  1326. {$IFDEF Windows}
  1327.   P := GetDosEnvironment;
  1328. {$ELSE}
  1329.   P := Ptr(Word(Ptr(PrefixSeg, $2C)^), 0);
  1330. {$ENDIF}
  1331.   while P^ <> #0 do
  1332.   begin
  1333.     if (StrLIComp(P, VarName, L) = 0) and (P[L] = '=') then
  1334.     begin
  1335.       GetEnvVar := P + L + 1;
  1336.       Exit;
  1337.     end;
  1338.     Inc(P, StrLen(P) + 1);
  1339.   end;
  1340.   GetEnvVar := nil;
  1341. end;
  1342.  
  1343. {$W-}
  1344.  
  1345. end.
  1346.