|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 14318 (0x37ee)
Types: TextFile
Names: »COUNTCH.PAS«
└─⟦e2123b2a1⟧ Bits:30010498 DVBS1.SW2103.src.1.8-1 Pascal TOOLS JTAS 1989-04-26 LEIF NIELSEN E.d.
└─⟦this⟧ »COUNTCH.PAS«
{[A=20,I=2,L=4,E=3,W=1-100] PASCFORM directive}\r
PROGRAM countch;\r
{ Count number of characters in file, and report result\r
\r
----------------------------------------------------------------------------\r
Date. Init. Vers. Explanation.\r
\r
1988-12-21 LEI 0.1 Original version by Leif Nielsen\r
1989-01-09 LEI Changed to use BYTEIO-derivative\r
1989-01-15 LEI Include count of combination < CR LF >\r
1989-01-27 LEI 1.1 New param TPU format\r
1989-04-18 LEI 1.2 TOTAL and SUB parameters introduced.\r
----------------------------------------------------------------------------}\r
\r
\r
USES\r
Dos,\r
DosUtil,\r
Help,\r
Param;\r
\r
CONST\r
Version = ('1.2');\r
MaxParam = 2;\r
MaxOption = 5;\r
\r
ParamList : ARRAY[1..MaxParam] OF ParamRec =\r
((Kind:KnownFile; Defined:FALSE; KeyWord:'I'; NumVal:0; TextVal:''),\r
(Kind:FileType; Defined:FALSE; KeyWord:'O'; NumVal:0; TextVal:''));\r
\r
OptionList : ARRAY[1..MaxOption] OF ParamRec =\r
((Kind:OnOff; Defined:FALSE ;KeyWord:'ESCLIST'; NumVal:0; TextVal:'OFF'), (*ESC*)\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'DETAILS'; NumVal:0; TextVal:'ON' ), (*detail*)\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'C1'; NumVal:0; TextVal:'OFF'), (*C1-chr*)\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'SUB'; NumVal:0; TextVal:'OFF'), (*Stop on SUB*)\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'TOTAL'; NumVal:0; TextVal:'OFF') ); (*char_total*)\r
\r
\r
VAR\r
Source: FILE;\r
\r
CONST\r
RecSize = 128;\r
BufSize = 160;\r
BufPos: word = RecSize;\r
BufNo: word = BufSize;\r
RecsRead: word = 1;\r
BytePos: longint = 0;\r
Lgt_source_file: longint = -2;\r
\r
VAR\r
InputBuffer: ARRAY [1..BufSize, 1..RecSize] OF byte;\r
\r
name: STRING[80]; { xxx Indtil videre her, selv om det ikke er kЏnt }\r
\r
\r
FUNCTION GetFileSize( name: STRING): longint;\r
VAR\r
f: FILE OF byte;\r
\r
BEGIN\r
Assign(f, name);\r
{$I-}\r
Reset(f);\r
{$I+}\r
IF IOResult <> 0 THEN\r
GetFileSize := -1\r
ELSE BEGIN\r
GetFileSize := FileSize(f);\r
Close(f);\r
END {if};\r
END (* GetFileSize *);\r
\r
PROCEDURE OpenByteFile(name: STRING);\r
BEGIN\r
assign(source, name);\r
reset(source, RecSize);\r
\r
Lgt_Source_file := GetFileSize(name);\r
BufPos := 1;\r
BufNo := 1;\r
BlockRead(Source, InputBuffer, BufSize, RecsRead);\r
BytePos := 0;\r
\r
END; (* OpenByteFile *)\r
\r
FUNCTION GetByte(VAR Byt: byte): boolean;\r
BEGIN\r
Byt := InputBuffer[ BufNo, BufPos ];\r
BytePos := BytePos + 1;\r
GetByte := Lgt_Source_file >= BytePos;\r
BufPos := BufPos + 1;\r
IF BufPos > RecSize THEN\r
BEGIN\r
BufPos := 1;\r
BufNo := BufNo + 1;\r
IF BufNo > BufSize THEN\r
BEGIN\r
BufNo := 1;\r
IF RecsRead > 0 THEN\r
BlockRead(Source, InputBuffer, BufSize, RecsRead);\r
END;\r
END;\r
END; (* GetByte *)\r
\r
FUNCTION LookAhead(VAR Byt: byte): boolean;\r
BEGIN\r
IF Lgt_Source_file >= BytePos THEN\r
BEGIN\r
LookAhead := true;\r
Byt := InputBuffer[ BufNo, BufPos ];\r
END\r
ELSE\r
BEGIN\r
lookAhead := false;\r
byt := 0;\r
END;\r
END; (* LookAhead *)\r
\r
\r
FUNCTION strwzero( i: longint; size, base: integer ): STRING;\r
VAR\r
k, l, m, low : longint;\r
temp: STRING[34];\r
CONST\r
digit: ARRAY [ 0..15 ] OF char =\r
( '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',\r
'A', 'B', 'C', 'D', 'E', 'F' );\r
BEGIN\r
temp[0] := chr(size);\r
FOR k := 1 TO size DO\r
temp[k] := '0';\r
\r
k := abs(i);\r
IF i < 0 THEN\r
BEGIN\r
low := 2;\r
temp[1] := '-';\r
END\r
ELSE\r
low := 1;\r
\r
l := size + 1;\r
WHILE ( k <> 0 ) AND ( l > low ) DO\r
BEGIN\r
l := l - 1;\r
temp[l] := digit[ k MOD base ];\r
k := k DIV base;\r
END;\r
IF k <> 0 THEN { overflow }\r
temp[low] := '*';\r
strwzero := temp;\r
END;\r
\r
PROCEDURE PrintDate(VAR f: text);\r
VAR\r
d, m, y, dow: word;\r
\r
BEGIN\r
GetDate(y, m, d, dow);\r
write(f, strwzero( y, 4, 10), '-', strwzero( m, 2, 10) );\r
write(f, '-', strwzero( d, 2, 10) );\r
\r
END {PrintDate};\r
\r
PROCEDURE PrintTime(VAR f: text);\r
VAR\r
h, m, s, ds: word;\r
\r
BEGIN\r
GetTime(h, m, s, ds);\r
write(f, strwzero( h, 2, 10), ':', strwzero( m, 2, 10) );\r
{ write(f, ':', strwzero( s, 2, 10) ); }\r
END {PrintTime};\r
\r
LABEL\r
99;\r
\r
CONST\r
NL = 10;\r
CR = 13;\r
SUB = 26;\r
ESC = 27;\r
\r
hex_digit: ARRAY [0..15] OF char =\r
( '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',\r
'A', 'B', 'C', 'D', 'E', 'F' );\r
assoc_char: ARRAY [0..255] OF byte = (\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 65, 66, 67,\r
68, 69, 70, 71, 72, 73, 74, 75, 76, 77,\r
78, 79, 80, 81, 82, 83, 84, 85, 86, 87,\r
88, 89, 90, 91, 92, 93, 0, 0, 0, 154,\r
144, 0, 142, 0, 143, 128, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 146, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 157, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 164, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0, 0, 0, 0, 0,\r
0, 0, 0, 0, 0, 0 );\r
\r
\r
VAR\r
byt: byte;\r
i, j, k, sum, ESC_sum, min_ln, max_ln, cr_lf_count: longint;\r
mean: real;\r
nch: ARRAY [0..255] OF longint;\r
ESC_nch: ARRAY[0..255] OF integer;\r
ch_name: ARRAY [0..255] OF STRING[3];\r
\r
ESC_mode, Detailed, C1_chars, char_total, stop_on_SUB: boolean;\r
outpfile: STRING[60];\r
O_buff: ARRAY[1..4096] OF byte;\r
\r
PROCEDURE write_hex(b: byte);\r
VAR\r
i, j: integer;\r
BEGIN\r
i := b DIV 16;\r
j := b MOD 16;\r
write(hex_digit[i]:1, hex_digit[j]:1);\r
END {write_hex};\r
\r
\r
PROCEDURE read_callparameters;\r
VAR\r
i, k: integer;\r
key_text: STRING;\r
dir_st: DirStr;\r
name_st: NameStr;\r
ext_st: ExtStr;\r
\r
BEGIN\r
\r
IF ParamCount = 0 THEN\r
BEGIN { The user must give at least the input file as parameter }\r
Showhelp;\r
Halt;\r
END;\r
\r
GetParams( Paramlist, MaxParam, OptionList, MaxOption);\r
\r
ESC_mode := OptionList[1].TextVal = 'ON';\r
\r
Detailed := OptionList[2].TextVal = 'ON';\r
\r
C1_chars := OptionList[3].TextVal = 'ON';\r
\r
stop_on_SUB := OptionList[4].TextVal = 'ON';\r
\r
char_total := OptionList[5].TextVal = 'ON';\r
\r
\r
name := ParamList[1].TextVal;\r
\r
IF ParamList[2].Defined THEN\r
outpfile := ParamList[2].TextVal\r
ELSE\r
outpfile := '';\r
\r
FileMode := FM_ReadOnly;\r
OpenByteFile( name);\r
\r
FileMode := FM_ReadWrite;\r
assign(output, outpfile);\r
SetTextBuf(Output, O_buff);\r
rewrite(output);\r
\r
END (* READ_CALLPARAMETERS *);\r
\r
\r
BEGIN\r
\r
read_callParameters;\r
\r
write(' COUNTCH v. ', Version, ' At: ');\r
PrintDate(output); write(' '); PrintTime(output); writeln;\r
writeln(' In file: ', FExpand(name) );\r
\r
FOR i := 0 TO 255 DO\r
BEGIN\r
nch[i] := 0;\r
ESC_nch[i] := 0;\r
ch_name[i] := chr(i) + ' ';\r
END;\r
\r
ch_name[ 0] := 'NUL';\r
ch_name[ 1] := 'SOH';\r
ch_name[ 2] := 'STX';\r
ch_name[ 3] := 'ETX';\r
ch_name[ 4] := 'EOT';\r
ch_name[ 5] := 'ENQ';\r
ch_name[ 6] := 'ACK';\r
ch_name[ 7] := 'BEL';\r
ch_name[ 8] := 'BS ';\r
ch_name[ 9] := 'HT ';\r
ch_name[ 10] := 'LF ';\r
ch_name[ 11] := 'VT ';\r
ch_name[ 12] := 'FF ';\r
ch_name[ 13] := 'CR ';\r
ch_name[ 14] := 'SO ';\r
ch_name[ 15] := 'SI ';\r
ch_name[ 16] := 'DLE';\r
ch_name[ 17] := 'DC1';\r
ch_name[ 18] := 'DC2';\r
ch_name[ 19] := 'DC3';\r
ch_name[ 20] := 'DC4';\r
ch_name[ 21] := 'NAK';\r
ch_name[ 22] := 'SYN';\r
ch_name[ 23] := 'ETB';\r
ch_name[ 24] := 'CAN';\r
ch_name[ 25] := 'EM ';\r
ch_name[ 26] := 'SUB';\r
ch_name[ 27] := 'ESC';\r
ch_name[ 28] := 'FS ';\r
ch_name[ 29] := 'GS ';\r
ch_name[ 30] := 'RS ';\r
ch_name[ 31] := 'US ';\r
ch_name[ 32] := 'SP ';\r
ch_name[127] := 'DEL';\r
\r
IF C1_chars THEN\r
BEGIN\r
ch_name[128] := 'NUL';\r
ch_name[129] := 'SOH';\r
ch_name[130] := 'STX';\r
ch_name[131] := 'ETX';\r
ch_name[132] := 'EOT';\r
ch_name[133] := 'ENQ';\r
ch_name[134] := 'ACK';\r
ch_name[135] := 'BEL';\r
ch_name[136] := 'BS ';\r
ch_name[137] := 'HT ';\r
ch_name[138] := 'LF ';\r
ch_name[139] := 'VT ';\r
ch_name[140] := 'FF ';\r
ch_name[141] := 'CR ';\r
ch_name[142] := 'SO ';\r
ch_name[143] := 'SI ';\r
ch_name[144] := 'DLE';\r
ch_name[145] := 'DC1';\r
ch_name[146] := 'DC2';\r
ch_name[147] := 'DC3';\r
ch_name[148] := 'DC4';\r
ch_name[149] := 'NAK';\r
ch_name[150] := 'SYN';\r
ch_name[151] := 'ETB';\r
ch_name[152] := 'CAN';\r
ch_name[153] := 'EM ';\r
ch_name[154] := 'SUB';\r
ch_name[155] := 'ESC';\r
ch_name[156] := 'FS ';\r
ch_name[157] := 'GS ';\r
ch_name[158] := 'RS ';\r
ch_name[159] := 'US ';\r
END { C1_chars };\r
\r
min_ln := maxint;\r
max_ln := -1;\r
i := 0;\r
cr_lf_count := 0;\r
\r
WHILE GetByte(byt) DO\r
BEGIN\r
nch[byt] := nch[byt] + 1;\r
\r
CASE byt OF\r
\r
CR:\r
BEGIN\r
IF LookAhead( byt ) THEN\r
IF byt = NL THEN\r
cr_lf_count := cr_lf_count + 1;\r
i := i + 1;\r
END;\r
\r
NL:\r
BEGIN\r
IF min_ln > i THEN min_ln := i;\r
IF max_ln < i THEN max_ln := i;\r
i := 0;\r
END;\r
\r
ESC:\r
BEGIN\r
IF LookAhead( byt) THEN\r
ESC_nch[byt] := ESC_nch[byt] + 1;\r
IF byt = ESC THEN { ensure that next ESC is not counted in combinations }\r
BEGIN\r
IF GetByte(byt) THEN ;\r
nch[ESC] := nch[ESC] + 1;\r
i := i + 1;\r
END;\r
i := i + 1;\r
END;\r
\r
\r
SUB:\r
BEGIN\r
i := i + 1;\r
IF stop_on_SUB THEN GOTO 99;\r
END;\r
\r
\r
ELSE\r
BEGIN\r
i := i + 1;\r
END;\r
END {case};\r
END;\r
\r
99: { output statistics }\r
sum := 0; ESC_sum := 0;\r
FOR i := 0 TO 255 DO\r
BEGIN\r
ESC_sum := ESC_sum + ESC_nch[i];\r
j := nch[i];\r
sum := sum + j;\r
byt := assoc_char[i];\r
IF byt <> 0 THEN\r
k := nch[byt]\r
ELSE\r
k := 0;\r
\r
IF detailed THEN\r
IF char_total AND ( j+k <> 0 ) THEN\r
BEGIN\r
write_hex(i);\r
write(i:4, ch_name[i]:4, j:8);\r
IF k > 0 THEN\r
BEGIN\r
write(' & '); write_hex(byt);\r
write( byt:4, ch_name[byt]:4, k:8, ' -> ', j+k:9);\r
END;\r
writeln;\r
END\r
ELSE IF j > 0 THEN\r
BEGIN\r
write_hex(i);\r
writeln(i:4, ch_name[i]:4, j:8);\r
END\r
ELSE ;\r
\r
END;\r
\r
writeln;\r
writeln(' Total: ', sum:12, ' chars, with ', nch[nl]:8, ' LF''s ');\r
IF nch[nl] > 0 THEN\r
BEGIN\r
mean := sum;\r
mean := mean / nch[nl];\r
writeln(' Min, mean and max line length: ',\r
min_ln:8, mean:11:2, max_ln:8);\r
writeln(' Found ', cr_lf_count:1, ' CR-LF combinations ');\r
\r
END;\r
\r
IF ESC_mode AND ( ESC_sum > 0 ) THEN\r
BEGIN\r
writeln;\r
writeln(' Total ', ESC_SUM:1, ' ESC kombinations found: ');\r
FOR i := 0 TO 255 DO\r
BEGIN\r
j := ESC_nch[i];\r
IF j <> 0 THEN\r
BEGIN\r
write_hex(ESC); write(' '); write_hex(i);\r
writeln(' 27', i:4, ' ESC ', ch_name[i]:4, j:8);\r
END;\r
END;\r
END;\r
close(Source);\r
END.\r
\r