Program Todays_Transfers;
Uses dos, crt, ini, par;
Const program_hdr = 'Dire Today Transfers v1.0 freeware Copyright (c) 1997 Flux/preel';
Type TransType = (upload, download);
downloadtxtrec = Record
tt : TransType;
user : String;
date : String;
time : String;
fname : String;
prot : Char;
err : Byte;
cps : LongInt;
End;
Var protkey : Array[1..20] of Char;
protstr : Array[1..20] of String;
totprot : Byte;
pcbdat, bull, top, bot : String;
nrlen, usert, typet, filet, prott : Byte;
locps, loprot, ulstr, dlstr, datestr : String;
Function b2s(b : Boolean) : String;
Begin
If b Then b2s := 'on' Else b2s := 'off';
End;
Procedure HelpScreen;
Begin
TextColor(7);
WriteLn('Usage: today {+-}switch'); WriteLn;
WriteLn(' +switch turn on option');
WriteLn(' -switch turn off option'); WriteLn;
WriteLn(' quiet no screen output (default ', b2s(Value[1]), ')');
WriteLn(' lister use list-ppe? (will not add top&bot) (default ', b2s(Value[2]), ')');
WriteLn(' force make list even if not changed (default ', b2s(Value[3]), ')');
WriteLn(' log log what the program is doing (default ', b2s(Value[4]), ')'); WriteLn;
WriteLn('Examples:'); WriteLn;
WriteLn(' today +quiet doesn''t write anything to the screen');
WriteLn(' today +quiet +lister no display and won''t add top&bot');
Halt;
End;
Function ReadLine(fn : String; i : Integer) : String;
Var f : Text;
idx:Integer;
s : String;
Begin
Assign(f, fn);
{$i-}
Reset(f);
{$i+}
If ioresult = 0 Then Begin
For idx := 1 to i do ReadLn(f, s);
ReadLine := s;
Close(f);
End;
End;
Procedure ReadProts;
Var f : Text;
s : String;
Begin
totprot := 0;
Assign(f, ReadLine(pcbdat, 45));
Reset(f);
While not Eof(f) do Begin
Inc(totprot);
ReadLn(f, s);
protkey[totprot] := s[1];
s := Copy(s, 5, Length(s)); s := Copy(s, Pos(',', s) + 1, Length(s));
protstr[totprot] := Copy(s, 1, Pos(',', s) - 1);
End;
Inc(totprot);
protkey[totprot] := '-';
protstr[totprot] := loprot;
Close(f);
End;
Function GetProt(k : Char) : String;
Var b : Byte;
Begin
For b := 1 to totprot do
If protkey[b] = k Then Begin
GetProt := protstr[b];
Exit;
End;
End;
Function s2b(s : String) : Byte;
Var code : Integer; b : Byte;
Begin
Val(s, b, code);
s2b := b;
End;
Function s2long(s : String) : LongInt;
Var code : Integer; b : LongInt;
Begin
Val(s, b, code);
s2long := b;
End;
Function w2s(w : Word) : String;
Var s : String;
Begin
Str(w, s);
w2s := s;
End;
Function i2s(i : Integer) : String;
Var s : String;
Begin
Str(i, s);
i2s := s;
End;
Function long2s(i : LongInt) : String;
Var s : String;
Begin
Str(i, s);
long2s := s;
End;
Function Lower(s : String): String;
Var i : Integer;
Begin
For i := 1 to Length(s) do
If (s[i] >= 'A') and (s[i] <= 'Z') Then
Inc(s[i], 32);
Lower := S;
End;
Function Mixed(s : String) : String;
Var i : Integer;
Begin
s := Lower(s);
s[1] := UpCase(s[1]);
For i := 2 to Length(s) do If s[i - 1] = ' ' Then s[i] := UpCase(s[i]);
Mixed := s;
End;
Function Upper(s : String) : String;
Var i : Integer;
Begin
For i := 1 to Length(s) do s[i] := UpCase(s[i]);
Upper := s;
End;
Function Fixtt(t : TransType) : String;
Begin
Case t of
download : Fixtt := dlstr;
upload : Fixtt := ulstr;
End;
End;
Function Exist(filename : String) : Boolean;
Var f : File;
Begin
Assign(f, filename);
{$i-}
Reset(f);
{$i+}
If IOResult = 0 Then Begin Exist := True; Close(f); End
Else Exist := False;
End;
Function Space(num : Integer) : String;
Var s : String;
Begin
s[0] := Chr(num);
FillChar(s[1], num, ' ');
Space := s;
End;
Function FixInt(i : Integer) : String;
Begin
FixInt := Space(nrlen - Length(i2s(i))) + i2s(i);
End;
Function FixWord(w : Word) : String;
Begin
If Length(w2s(w)) = 1 Then FixWord := '0' + w2s(w)
Else FixWord := w2s(w);
End;
Function CurDate : String;
Var y, m, d, dow : Word;
Begin
GetDate(y, m, d, dow);
CurDate := FixWord(m) + '-' + FixWord(d) + '-' + w2s(y);
End;
Function CurTime : String;
Var h, m, s, hund : Word;
Begin
GetTime(h, m, s, hund);
CurTime := FixWord(h) + ':' + FixWord(m) + ':' + FixWord(s);
End;
Function Replace(s1, s2, s3 : String) : String;
Var p : Integer;
Begin
Repeat
p := Pos(s2, s1);
If p > 0 Then Begin
Delete(s1, p, Length(s2));
Insert(s3, s1, p);
End;
Until p = 0;
Replace := s1;
End;
Function Date2Format(s1, s2 : String) : String;
Var s : String;
Begin
s := s1;
s := Replace(s, 'mm', Copy(s2, 4, 2));
s := Replace(s, 'dd', Copy(s2, 1, 2));
If Pos('yyyy', s) > 0 Then s := Replace(s, 'yyyy', Copy(s2, 7, 4))
Else s := Replace(s, 'yy', Copy(s2, 9, 2));
Date2Format := s;
End;
Function RTrim(s : String) : String;
Var i : Integer;
Begin
For i := Length(s) downto 1 do Begin
If s[i] = ' ' Then Delete(s, i, 1)
Else Break;
End;
RTrim := s;
End;
Procedure ReadDlTxt(Var dl : downloadtxtrec; s : String);
Begin
With dl do Begin
Case s[2] of
'D' : tt := download;
'U' : tt := upload;
End;
s := Copy(s, 5, Length(s));
user := Copy(s, 1, Pos(',', s) - 1);
s := Copy(s, Pos(',', s) + 1, Length(s));
date := Copy(s, 1, Pos(',', s) - 1);
s := Copy(s, Pos(',', s) + 1, Length(s));
time := Copy(s, 1, Pos(',', s) - 1);
s := Copy(s, Pos(',', s) + 1, Length(s));
fname := Copy(s, 1, Pos(',', s) - 1);
s := Copy(s, Pos(',', s) + 1, Length(s));
prot := s[1];
s := Copy(s, Pos(',', s) + 1, Length(s));
err := s2b(Copy(s, 1, Pos(',', s) - 1));
s := Copy(s, Pos(',', s) + 1, Length(s));
cps := s2long(Copy(s, 1, Length(s)));
End;
End;
Function FixFile(s : String) : String;
Var d : DirStr; n : NameStr; e : ExtStr;
Begin
FSplit(s, d, n, e);
Case filet of
11, 21, 31, 41 : FixFile := n + e;
12, 22, 32, 42 : FixFile := n + Space(8 - Length(n)) + e;
End;
End;
Procedure FCopy(fn1, fn2 : String);
Var fromf, tof : File;
numread, numwritten : Word;
buf : Array[1..2048] of Char;
Begin
Assign(fromf, fn1);
Reset(fromf, 1);
Assign(tof, fn2);
Rewrite(tof, 1);
Repeat
BlockRead(fromf, buf, SizeOf(buf), numread);
BlockWrite(tof, buf, numread, numwritten);
Until (numread = 0) or (numwritten <> numread);
Close(fromf);
Close(tof);
End;
Procedure FDelete(fn : String);
Var f : File;
Begin
If Exist(fn) Then Begin
Assign(f, fn);
Erase(f);
End;
End;
Procedure TAppend(fn1, fn2 : String);
Var f1, f2 : Text;
s : String;
Begin
Assign(f1, fn1); Append(f1);
Assign(f2, fn2); Reset(f2);
While not Eof(f2) do Begin
ReadLn(f2, s);
WriteLn(f1, s);
End;
Close(f1); Close(f2);
End;
Procedure ZeroMake(fn : String);
Var f : File;
Begin
Assign(f, fn);
Rewrite(f);
Close(f);
End;
Function FixMiddle(dt : downloadtxtrec; org : String; i : Integer) : String;
Var s : String;
Begin
s := org;
s := Replace(s, '%NR%', FixInt(i));
Case usert of
1: s := Replace(s, '%USER%', Upper(dt.user));
2: s := Replace(s, '%USER%', Lower(dt.user));
3: s := Replace(s, '%USER%', Mixed(dt.user));
4: s := Replace(s, '%USER%', dt.user);
End;
Case typet of
1: s := Replace(s, '%TYPE%', Upper(Fixtt(dt.tt)));
2: s := Replace(s, '%TYPE%', Lower(Fixtt(dt.tt)));
3: s := Replace(s, '%TYPE%', Mixed(Fixtt(dt.tt)));
4: s := Replace(s, '%TYPE%', Fixtt(dt.tt));
End;
Case filet of
11, 12: s := Replace(s, '%FILE%', Upper(FixFile(dt.fname)));
21, 22: s := Replace(s, '%FILE%', Lower(FixFile(dt.fname)));
31, 32: s := Replace(s, '%FILE%', Mixed(FixFile(dt.fname)));
41, 42: s := Replace(s, '%FILE%', FixFile(dt.fname));
End;
s := Replace(s, '%DATE%', Date2Format(datestr, dt.date));
s := Replace(s, '%TIME%', dt.time);
Case prott of
1: s := Replace(s, '%PROT%', Upper(GetProt(dt.prot)));
2: s := Replace(s, '%PROT%', Lower(GetProt(dt.prot)));
3: s := Replace(s, '%PROT%', Mixed(GetProt(dt.prot)));
4: s := Replace(s, '%PROT%', GetProt(dt.prot));
End;
s := Replace(s, '%ERRORS%', i2s(dt.err));
If dt.cps > 0 Then s := Replace(s, '%CPS%', i2s(dt.cps))
Else s := Replace(s, '%CPS%', locps);
FixMiddle := s;
End;
Procedure Work(i : Integer);
Begin
Case i of
1:Write('|');
2:Write('/');
3:Write('-');
4:Write('\');
5:Write('|');
6:Write('/');
7:Write('-');
8:Write('\');
End;
End;
Procedure Backup(b : Byte);
Begin
GotoXY(WhereX - b, WhereY);
End;
Procedure Log(s : String; b : Boolean);
Var f : Text;
Begin
Assign(f, 'today.log');
If not Exist('today.log') Then Rewrite(f)
Else Append(f);
If not b Then WriteLn(f, Space(14) + CurTime + ' - ' + s)
Else WriteLn(f, s);
Close(f);
End;
Function FTime(fn : String) : String;
Var ft : LongInt;
f : File;
dt : DateTime;
Begin
If not Exist(fn) Then Exit;
Assign(f, fn);
Reset(f);
GetFTime(f, ft);
Close(f);
UnPackTime(ft, dt);
With dt do
FTime := FixWord(hour) + ':' + FixWord(min) + ':' + FixWord(sec);
End;
Function FDate(fn : String) : String;
Var ft : LongInt;
f : File;
dt : DateTime;
Begin
If not Exist(fn) Then Exit;
Assign(f, fn);
Reset(f);
GetFTime(f, ft);
Close(f);
UnPackTime(ft, dt);
With dt do
FDate := FixWord(day) + '-' + FixWord(month) + '-' + w2s(year);
End;
Procedure SaveTime;
Var f : Text;
Begin
Assign(f, 'today.dat');
Rewrite(f);
Write(f, FTime(ReadLine(pcbdat, 46)) + Space(1) + FDate(ReadLine(pcbdat, 46)));
Close(f);
End;
Function CompareTime : Boolean;
Var t, d : String;
Begin
CompareTime := False;
If not Exist('today.dat') Then exit;
t := Copy(ReadLine('today.dat', 1), 1, 8);
d := Copy(ReadLine('today.dat', 1), 10, 10);
If (t = FTime(ReadLine(pcbdat, 46))) and (d = FDate(ReadLine(pcbdat, 46))) Then CompareTime := True;
End;
Var txt, out, cfg : Text;
ln, middle : String;
dltxt : downloadtxtrec;
nr, wrk, dl, ul : Byte;
tot : LongInt;
b1, b2, b3, b4, b5 : Byte;
Begin
If not Exist('today.ini') Then Begin
Write(program_hdr);
WriteLn;
WriteLn('Error: "today.ini" does not exist');
Halt;
End;
If not Exist('today.cfg') Then Begin
Write(program_hdr);
WriteLn;
WriteLn('Error: "today.cfg" does not exist');
Halt;
End;
b1 := ReadIniByte('today.ini', 'switches', 'defquiet');
b2 := ReadIniByte('today.ini', 'switches', 'defmode');
b3 := ReadIniByte('today.ini', 'switches', 'uselister');
b4 := ReadIniByte('today.ini', 'switches', 'force');
b5 := ReadIniByte('today.ini', 'switches', 'dolog');
pcbdat := ReadIniStr('today.ini', 'filesettings', 'pcbdat');
bull := ReadIniStr('today.ini', 'filesettings', 'bulletin');
top := ReadIniStr('today.ini', 'filesettings', 'topfile');
bot := ReadIniStr('today.ini', 'filesettings', 'botfile');
If b1 = 0 Then Value[1] := False Else Value[1] := True;
If b3 = 0 Then Value[2] := False Else Value[2] := True;
If b4 = 0 Then Value[3] := False Else Value[3] := True;
If b5 = 0 Then Value[4] := False Else Value[4] := True;
ln := '';
For b4 := 1 to ParamCount do ln := ParamStr(b4) + Space(1) + ln;
GetSwitches(ln, False);
If not Value[1] Then Begin
Write(program_hdr);
WriteLn;
End;
If (ParamStr(1) = '/?') or (ParamStr(1) = '-?') or
(Lower(ParamStr(1)) = '/h') or (Lower(ParamStr(1)) = '-h') Then HelpScreen;
If Value[4] Then Log(CurDate + ' - Dire Today Transfers', True);
If not Exist(ReadLine(pcbdat, 46)) Then Begin
If Value[4] Then Begin
Log('"' + ReadLine(pcbdat, 46) + '" didn''t exist', False);
Log('', True);
End;
If not Value[1] Then WriteLn('Error: ', ReadLine(pcbdat, 46), ' doesn''t exist');
Halt;
End;
If (not Value[3]) and (CompareTime) Then Begin
If Value[4] Then Begin
Log('"' + ReadLine(pcbdat, 46) + '" was not changed since last', False);
Log('', True);
End;
If not Value[1] Then WriteLn('Error: ', ReadLine(pcbdat, 46), ' was not changed');
Halt;
End;
If ParamCount = 0 Then ln := 'none';
If Value[4] Then Log('Parameters: ' + ln, False);
If not Value[1] Then Begin
WriteLn('Parameters: ', ln); WriteLn;
WriteLn('* Memory available: ', MemAvail, 'kb');
Write('* Initializing .. ');
End;
If Value[4] Then Log('Memory available: ' + long2s(MemAvail), False);
ln := '';
nrlen := 3;
usert := 3;
typet := 4;
filet := 1;
prott := 4;
locps := 'Local';
loprot := 'PFED';
ulstr := 'Uploaded';
dlstr := 'Downloaded';
datestr := 'dd.mm.yy';
nrlen := ReadIniByte('today.ini', 'stringsettings', 'nrlen');
usert := ReadIniByte('today.ini', 'stringsettings', 'user');
typet := ReadIniByte('today.ini', 'stringsettings', 'type');
filet := ReadIniByte('today.ini', 'stringsettings', 'file');
prott := ReadIniByte('today.ini', 'stringsettings', 'prot');
locps := ReadIniStr('today.ini', 'stringsettings', 'localcpsstr');
loprot := ReadIniStr('today.ini', 'stringsettings', 'localprotstr');
ulstr := ReadIniStr('today.ini', 'stringsettings', 'uploadstr');
dlstr := ReadIniStr('today.ini', 'stringsettings', 'downloadstr');
datestr := ReadIniStr('today.ini', 'stringsettings', 'dateformat');
If not Value[1] Then Begin
WriteLn('(ok)');
Case b2 of
1: Write('* Working (');
2: Write('* Working .. ');
End;
End;
middle := ReadLine('today.cfg', 1);
Assign(txt, ReadLine(pcbdat, 46)); Reset(txt);
Assign(out, 'TEMP'); Rewrite(out);
ReadProts;
nr := 0; tot := 0; wrk := 0; dl := 0; ul := 0;
Repeat
If not Value[1] Then Begin
Case b2 of
1: Begin
GotoXY(12, WhereY);
Write(nr:4, '/', tot:4, ')');
End;
2: Begin
Inc(wrk); If wrk = 9 Then wrk := 1;
Work(wrk);
Backup(1);
End;
3: Begin
GotoXY(1, WhereY);
Write('* ', tot, ' lines read. ');
End;
End;
End;
ReadLn(txt, ln);
ReadDlTxt(dltxt, ln);
If dltxt.date = CurDate Then Begin
If dltxt.tt = download Then Inc(dl)
Else Inc(ul);
Inc(nr);
WriteLn(out, FixMiddle(dltxt, middle, nr));
End;
Inc(tot);
Until Eof(txt);
If nr = 0 Then Begin
WriteLn(out, ReadLine('today.cfg', 2));
End;
Close(txt); Close(out);
If not Value[1] Then Begin
Case b2 of
1: Begin
GotoXY(12, WhereY);
WriteLn(nr:4, '/', tot:4, '), done.');
End;
2: WriteLn('(done)');
3: WriteLn('Transfers today: ', ul, ' uploads, ', dl, ' downloads');
End;
Write('* Making bulletin .. ');
End;
ZeroMake(bull);
If (not Value[2]) and Exist(top) Then TAppend(bull, top);
TAppend(bull, 'TEMP');
If (not Value[2]) and (Exist(bot)) Then TAppend(bull, bot);
FDelete('TEMP');
SaveTime;
If not Value[1] Then WriteLn('(done)');
If Value[4] Then Begin
Log('Transfers today: ' + i2s(ul) + ' uploads, ' + i2s(dl) + ' downloads', False);
Log('', True);
End;
End.
