'===========================================================================
' Subject: DUMP OUTBOUND.HIS TO TEXT FILE    Date: 02-07-96 (16:11)       
' Author:  Justin Pasher                     Code: QB, PDS                
' Origin:  FidoNet QUIK_BAS Echo           Packet: MISC.ABC
'===========================================================================
'-> I'm kinda new to this echo, so hopefully someone will have an
'-> answer.  Does anyone have the format for FrontDoor 2.20's
'-> outbound.his history file?  If so please post it for me.

' Try this code out. It works fine for my FD 2.02. I believe the formats
'stayed the same. Enjoy! You must load QB.LIB on the command line.

DECLARE FUNCTION Cvt2Str$ (Value!)
DECLARE FUNCTION DayOfYear! (Month AS INTEGER, Day AS INTEGER, Year AS INTEGER)
DECLARE FUNCTION CurrDay! ()
DECLARE FUNCTION FindFirst! (FileSpec$)
DECLARE FUNCTION FindNext! ()
DECLARE FUNCTION LeapYear! (Year AS INTEGER)
DECLARE FUNCTION Pad$ (tString AS STRING, Spaces AS INTEGER)
DECLARE SUB Check ()
DECLARE SUB GetFileNames ()
DECLARE SUB Header ()
' History Converter v1.1
' Converted from Pascal by Justin Pasher
'
' Converts the FrontDoor history files to a textfile.
'
'   The first record in the .HIS files is not a valid history entry. It
'   contains the date/time when the .HIS file was last packed or when
'   it was created if it has never been packed. So if you're reading
'   the .HIS files for any reason, skip the first record and you'll be
'   at the first valid record.

'$INCLUDE: 'QB.BI'
DIM SHARED Regs AS RegType
DIM SHARED RegsX AS RegTypeX
CONST Revision = "1.0"  ' version number
CONST False = 0
CONST True = NOT False
COMMON SHARED FDenv$, Quantity, NumFiles, Head, NoCallers
ON ERROR GOTO 1000

' ****** Pascal structure
'    Year,                     { 1990-xxxx }
'    Month,                    { 1-12 }
'    Day,                      { 1-31 }
'    Hour,                     { 0-23 }
'    Minute,                   { 0-59 }
'    Second,                   { 0-59 }
'    Zone,                     { Zone Number }
'    Net,                      { Net Number  }
'    Node,                     { Node Number }
'    Point     : WORD;
'    SystemName: STRING[30];
'    Location  : STRING[38];
'    TimeOnLine: WORD;         { Seconds spent on-line }
'    RcvdBytes,
'    SentBytes : LONGINT;
'    Cost      : WORD;

TYPE MailHistType
    Year AS INTEGER           ' 1990-xxxx
    Month AS INTEGER          ' 1-12
    Day AS INTEGER            ' 1-31
    Hour AS INTEGER           ' 0-23
    Minute AS INTEGER         ' 0-59
    Second AS INTEGER         ' 0-59
    Zone AS INTEGER           ' Zone Number
    Net AS INTEGER            ' Net Number
    Node AS INTEGER           ' Node Number
    PointNum AS INTEGER       ' Point (if applicable)
    SNameLen AS STRING * 1
    SystemName AS STRING * 30 ' System Name
    LocLen AS STRING * 1
    Location AS STRING * 38   ' Location
    TimeOnline AS INTEGER     ' Seconds spent on-line
    RcvdBytes AS LONG
    SentBytes AS LONG
    Cost AS INTEGER
END TYPE
DIM SHARED MailHist AS MailHistType

TYPE SearchType
    DosJunk      AS STRING * 21
    Attr         AS STRING * 1
    Time         AS INTEGER
    Date         AS INTEGER
    Size         AS LONG
    FileName     AS STRING * 13
END TYPE
DIM SHARED Search AS SearchType

DIM SHARED His(1 TO 25) AS STRING * 12

  CLS
  RegsX.AX = &H1A00
  RegsX.DS = VARSEG(Search)    'Set DTA Buffer for FindFirst & FindNext
  RegsX.DX = VARPTR(Search)
  CALL InterruptX(&H21, RegsX, RegsX)
  PRINT
  PRINT "  FrontDoor History convertor (revision "; Revision; ")."
  PRINT "  A stupid program from and copyrighted by :"
  PRINT "           G‚ Janssen, 2:284/134@Fido and Helmut Kicken, 2:284/701@Fido"
  PRINT : PRINT "  Converted to QB by Justin Pasher": PRINT

  '******** Get FD directory
  Path$ = ENVIRON$("FD")
  IF Path$ <> "" THEN
    Path$ = UCASE$(Path$)
    IF RIGHT$(Path$, 1) = "\" THEN FDenv$ = Path$ ELSE FDenv$ = Path$ + "\"
  ELSE
    PRINT "  No FD environment setting found."
    PRINT "  Example:  C:\FD>SET FD=C:\FD"
    SYSTEM
  END IF
  NoCallers = True
  GetFileNames
  OPEN FDenv$ + "HISTORY.TXT" FOR OUTPUT AS #2
  FOR NumFiles = 1 TO Quantity
    OPEN FDenv$ + His(NumFiles) FOR RANDOM AS #1 LEN = LEN(MailHist)
    Check
    IF Head = True THEN PRINT #2, ""
    CLOSE #1
    Head = False
  NEXT
  IF NoCallers = True THEN PRINT "  There was no activity today."
  CLOSE #2
  PRINT "  "; FDenv$; "HISTORY.TXT is now complete!"
  SYSTEM

1000 IF ERR = 6 THEN RESUME NEXT

SUB Check
  DIM SendTot AS LONG    ' total send bytes
  DIM RcvdTot AS LONG    ' total received bytes
  DIM TimeTot AS LONG    ' total connect time
  Empty = True           ' if no calls (true) then write no callers
  GET #1, , MailHist     ' dummy read
  IF LOF(1) = 102 THEN EXIT SUB
  DO
    Text$ = ""
    GET #1, , MailHist
    IF NOT Head THEN
 Header
 Head = True
 Foot = True
 NoCallers = False
    END IF
    Empty = False
    IF MailHist.Hour < 10 THEN Text$ = "0"
    Text$ = Text$ + LTRIM$(STR$(MailHist.Hour)) + ":"
    IF MailHist.Minute < 10 THEN Text$ = Text$ + "0"
    SysName$ = LEFT$(MailHist.SystemName, ASC(MailHist.SNameLen))
    Text$ = Text$ + LTRIM$(STR$(MailHist.Minute)) + " " + SysName$
    FOR A = LEN(RTRIM$(SysName$)) TO 29
 Text$ = Text$ + " "
    NEXT
    IF MailHist.SentBytes = 0 THEN
 Text$ = Text$ + "N/A       "
    ELSE
 Text$ = Text$ + Pad$(LTRIM$(STR$(MailHist.SentBytes)), 10)
    END IF
    SendTot = SendTot + MailHist.SentBytes
    IF MailHist.RcvdBytes = 0 THEN
 Text$ = Text$ + "N/A        "
    ELSE
 Text$ = Text$ + Pad$(LTRIM$(STR$(MailHist.RcvdBytes)), 11)
    END IF
    RcvdTot = RcvdTot + MailHist.RcvdBytes
    Minutes = MailHist.TimeOnline \ 60
    Seconds = MailHist.TimeOnline MOD 60
    TimeTot = TimeTot + MailHist.TimeOnline
    IF Minutes < 10 THEN Text$ = Text$ + "0"
    Text$ = Text$ + Cvt2Str$(Minutes) + ":"
    IF Seconds < 10 THEN Text$ = Text$ + "0"
    Text$ = Text$ + Cvt2Str$(Seconds) + "   (" + LTRIM$(STR$(MailHist.Zone)) + ":" + LTRIM$(STR$(MailHist.Net)) + "/" + LTRIM$(STR$(MailHist.Node))
    IF MailHist.PointNum <> 0 THEN
 Text$ = Text$ + "." + LTRIM$(STR$(MailHist.PointNum))
    END IF
    Text$ = Text$ + ")"
    PRINT #2, Text$
  LOOP UNTIL EOF(1)
  IF Empty = False THEN
    PRINT #2, "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ"
    PRINT #2, "Totals bytes sent: "; Pad$(LTRIM$(STR$(SendTot)), 36); "Total bytes received: "; Pad$(LTRIM$(STR$(RcvdTot)), 9)
    Hours = TimeTot \ 3600
    Minutes = TimeTot MOD 3600 \ 60
    Seconds = TimeTot MOD 3600 MOD 60
    Text$ = "Total Time: "
    Text$ = Text$ + Cvt2Str$(Hours) + ":"
    IF Hours < 10 THEN Text$ = " 0" + Text$
    IF Minutes < 10 THEN Text$ = Text$ + "0"
    Text$ = Text$ + Cvt2Str$(Minutes) + ":" + Cvt2Str$(Seconds)
    PRINT #2, Text$
    PRINT #2, ""
    PRINT #2, ""
  END IF
END SUB

FUNCTION CurrDay!
  DIM Month AS INTEGER
  DIM Day AS INTEGER
  DIM Year AS INTEGER
  Month = VAL(LEFT$(DATE$, 2))
  Day = VAL(MID$(DATE$, 4, 2))
  Year = VAL(RIGHT$(DATE$, 4))
  A = DayOfYear(Month, Day, Year) - 1
  IF A = 0 THEN
    IF LeapYear(Year - 1) THEN CurrDay! = 366 ELSE CurrDay! = 365
  ELSE
    CurrDay! = A
  END IF
END FUNCTION

FUNCTION Cvt2Str$ (Value)
  Cvt2Str$ = LTRIM$(STR$(Value))
END FUNCTION

FUNCTION DayOfYear (Month AS INTEGER, Day AS INTEGER, Year AS INTEGER)
  IF LeapYear(Year) THEN N = 1 ELSE N = 2
  N = 275 * Month \ 9 - N * ((Month + 9) \ 12) + INT(Day) - 30
  DayOfYear = N
END FUNCTION

FUNCTION FindFirst (FileSpec$)
  Spec$ = FileSpec$ + CHR$(0)
  DIM DateTime(6)
  RegsX.AX = &H4E00
  RegsX.CX = Attr
  RegsX.DS = VARSEG(Spec$)
  RegsX.DX = SADD(Spec$)
  CALL InterruptX(&H21, RegsX, RegsX)
  Ecode = RegsX.AX
  IF Ecode GOTO NoMore
  F$ = Search.FileName
  Null = INSTR(F$, CHR$(0))
  IF Null THEN Search.FileName = LEFT$(F$, Null - 1)
NoMore:
  IF Ecode = 2 OR Ecode = 18 THEN FindFirst = False ELSE FindFirst = True
END FUNCTION

FUNCTION FindNext
  DIM DateTime(6)
  RegsX.AX = &H4F00
  CALL InterruptX(&H21, RegsX, RegsX)
  Ecode = RegsX.AX
  IF Ecode GOTO NoMore2
  F$ = Search.FileName
  Null = INSTR(F$, CHR$(0))
  IF Null THEN FileName$ = LEFT$(FileName$, Null - 1)
NoMore2:
  IF Ecode = 2 OR Ecode = 18 THEN FindNext = False ELSE FindNext = True
END FUNCTION

SUB GetFileNames
  RC = FindFirst(FDenv$ + "*.HIS")
  IF RC = False THEN PRINT "No *.HIS file(s) not found": EXIT SUB
  Quantity = 1
  DO
    FileName$ = UCASE$(RTRIM$(Search.FileName))
    His(Quantity) = FileName$
    IF ASC(RIGHT$(His(Quantity), 1)) = 0 THEN His(Quantity) = LEFT$(His(Quantity), LEN(His(Quantity)) - 1)
    Quantity = Quantity + 1
    RC = FindNext
  LOOP UNTIL RC = False OR Quantity = 25
  Quantity = Quantity - 1
END SUB

SUB Header
  Month = VAL(LEFT$(DATE$, 2))
  Day = VAL(MID$(DATE$, 4, 2))
  Year = VAL(RIGHT$(DATE$, 4))
  IF LEFT$(His(NumFiles), 1) = "I" THEN
    PRINT #2, "Inbound Mail/Fax/BBS callers history "
  ELSE
    PRINT #2, "Outbound Mail/Fax/BBS callers history "
  END IF
  Text$ = "(" + RTRIM$(His(NumFiles)) + ") from "
  IF Month < 10 THEN Text$ = Text$ + "0"
  Text$ = Text$ + Cvt2Str$(Month) + "-"
  IF Day < 10 THEN Text$ = Text$ + "0"
  Text$ = Text$ + Cvt2Str$(Day) + "-" + Cvt2Str$(Year) + "."
  PRINT #2, Text$
  PRINT #2, ""
  PRINT #2, "Time  System Sent                   Sent      Rcvd      Duration Node Number"
  PRINT #2, STRING$(79, "Ä")
  PRINT "  Reading "; FDenv$; His(NumFiles)
END SUB

FUNCTION LeapYear (Year AS INTEGER)
  IF ((Year MOD 100) <> 0) AND ((Year MOD 4) = 0) THEN LeapYear = True ELSE LeapYear = False
END FUNCTION

FUNCTION Pad$ (tString AS STRING, Spaces AS INTEGER)
  IF LEN(tString) > Spaces THEN Pad = LEFT$(tString, Spaces): EXIT FUNCTION
  Pad = tString + STRING$(Spaces - LEN(tString), " ")
END FUNCTION