home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pctchnqs
/
1991
/
number5
/
wrdcount.pas
< prev
Wrap
Pascal/Delphi Source File
|
1991-09-18
|
2KB
|
100 lines
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.