home *** CD-ROM | disk | FTP | other *** search
- Library WrdCount;
-
- USES
- WinDos,
- WinCrt,
- AsmCoun1;
-
- VAR
- SaveExit : pointer; { exit proc variable }
- FileName : string;
- FileExtension : string [3];
- Counter : CountPtr;
-
- { LibExit =============================================== }
-
- {$S-}
- PROCEDURE LibExit ; far;
- begin
- ExitProc := SaveExit;
- end;
-
- { TimeMs ================================================ }
-
- function TimeMs : LongInt;
- { Returns time of day in milliseconds since midnight }
-
- var Regs : Tregisters;
-
- begin
- with Regs do begin
- AH := $2C;
- DS := Dseg; { Windows demands this! }
- ES := Dseg; { ditto }
- MsDos(Regs);
- TimeMs := 1000*(LongInt(DH)
- +60*(LongInt(CL)
- +60*LongInt(CH)))
- +10*LongInt(DL);
- end;
- end;
-
- { FileExists ============================================ }
-
- function FileExists (FileName: String) : Boolean; export;
- { Boolean function that returns True if the file exists;otherwise,
- it returns False. Closes the file if it exists. }
-
- var F : file;
-
- begin
- {$I-}
- Assign(F, FileName);
- Reset(F);
- Close(F);
- {$I+}
- FileExists := (IOResult = 0) and (FileName <> '');
- end; { FileExists }
-
- { CountFile ============================================= }
-
- PROCEDURE CountFile (FileName : string;
- VAR Start, Stop, FinalCount : longint); export;
-
- var loop : byte;
-
- begin
- { get the file extension }
- loop := pos ('.', FileName);
- if loop = 0 then FileExtension := ''
- else FileExtension := copy (FileName, succ (loop), 3);
-
- { Initialize the Count object. }
- if FileExtension = 'SAM' then
- Counter := New (AmiCountPtr, Init (FileName))
- else
- if FileExtension = 'SPR' then
- Counter := New (SprintCountPtr, Init (FileName))
- else
- Counter := New (CountPtr, Init (FileName));
-
- { Count, store, exit. }
- With Counter^ do begin
- Start := TimeMs;
- Count;
- Stop := TimeMs;
- FinalCount := WordCount;
- end;
- Dispose (Counter, Done);
- end;
-
- { ======================================================= }
- EXPORTS
- FileExists index 1,
- CountFile index 2;
-
- BEGIN
- SaveExit := ExitProc; { save old exit proc pointer }
- ExitProc := @LibExit; { install LibExit proc }
- END.
-