home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / MISC / TGPORT12.ZIP / TELEPORT.PAS < prev   
Pascal/Delphi Source File  |  1997-09-21  |  12KB  |  399 lines
  1. Program TelegardCallersInPortal;
  2. {---------------------------------------------------------------------------}
  3. {                          .∙·General·Information·∙.                        }
  4. {---------------------------------------------------------------------------}
  5. {
  6.  
  7.                              North Star Technologies
  8.                        Telegard Callers in Portal of Power
  9.                           Copyright (c) 1997 Jon Parise
  10.  
  11. Version:  1.2
  12.  
  13. Description:
  14.     Imports the last few callers in Telegard to Portal's status display.
  15.  
  16. Legal Notice:
  17.     This source code has been included with this release of TelePort.  You
  18. are free to modify and recompile the source code for your own, personal use.
  19. The modified source code may not be distributed under the existing or new
  20. name.
  21.     The original copyright still belongs to me, Jon Parise.  All future
  22. official releases will only be distributed by me.  Should you make a
  23. significant modification to the source and feel it should be distributed,
  24. please send me your modified code and it will be included in a future release
  25. with full credit for the modification granted to you.
  26. }
  27.  
  28. Uses  Dos, Crt;
  29.  
  30. {$I Telegard.Inc}  { Telegard structure definitions }
  31.  
  32. {---------------------------------------------------------------------------}
  33. {                         .∙·Constant·Declarations·∙.                       }
  34. {---------------------------------------------------------------------------}
  35. Const
  36.   Product = 'Telegard Callers in Portal of Power';
  37.   Release = '1.2';
  38.  
  39.   HexId : Array[0..$F] of Char = '0123456789ABCDEF';
  40.  
  41. {---------------------------------------------------------------------------}
  42. {                           .∙·Type·Declarations·∙.                         }
  43. {---------------------------------------------------------------------------}
  44.  
  45.   { The Portal structures below were taken from PopTypes.Pas released in the
  46.     Portal of Power 0.62 Developer's Kit }
  47.  
  48. Type
  49.   tFidoAddress = Record
  50.     Zone,
  51.     Net,
  52.     Node,
  53.     Point    : Integer;
  54.    End; { tFidoAddress }
  55.  
  56.   tEventTimer = Record
  57.     StartTics  : LongInt;
  58.     ExpireTics : LongInt;
  59.    End; { tEventTimer }
  60.  
  61.   tPortalRec = Record
  62.     Event       : Byte;
  63.     Filler1     : Array[1..14] Of Byte;
  64.     LastRan     : LongInt;
  65.     LastEDate   : LongInt;
  66.     Filler2     : Byte;
  67.     LastEtStart : LongInt;
  68.     Filler3     : Integer;
  69.     Users       : Array[1..5] Of Record
  70.       Name : String[35];
  71.       T    : LongInt;   { Seconds since midnight }
  72.      End;
  73.     UserTime    : LongInt;
  74.     KbdPassword : String[20];
  75.     Filler4     : Array[1..46] Of Byte;
  76.     Calls       : Array[1..2,1..5] Of Record
  77.       Adr  : tFidoAddress;
  78.       Name : String[16];
  79.       T    : LongInt;
  80.      End; { Calls }
  81.     MacroStatus : Boolean;
  82.     Poll        : tFidoAddress;
  83.     LastCalled  : tFidoAddress;
  84.     NextTime    : tEventTimer;
  85.     Filler      : Array[1..408] Of Char;
  86.    End; { tPortalRec }
  87.  
  88. Type
  89.   tCallers = Record
  90.     Name   : String[35];    { Caller's name (35 chars max) }
  91.     Time   : LongInt;       { Time of call (Unix-style) }
  92.    End; { tCallers }
  93.  
  94. {---------------------------------------------------------------------------}
  95. {                         .∙·Variable·Declarations·∙.                       }
  96. {---------------------------------------------------------------------------}
  97.  
  98. Var
  99.   Callers        : Array[1..5] of tCallers;
  100.   PortalStatus   : tPortalRec;
  101.   TelegardDir    : PathStr;              { Path to Telegard's Data dir }
  102.   PortalDir      : PathStr;              { Path to Portal's main dir }
  103.   Task           : String[2];            { Task num (for Portal??.Dat) }
  104.   J              : Byte;
  105.   {$IfDef Os2}
  106.   Err            : LongInt;
  107.   {$Else}
  108.   Err            : Integer;
  109.   {$EndIf}
  110.  
  111. {---------------------------------------------------------------------------}
  112. {                         .∙·Function·Declarations·∙.                       }
  113. {---------------------------------------------------------------------------}
  114.  
  115. { Detects whether or not Share is installed.  From SWAG, by Lars Hellsten
  116.  
  117.                                       Sharing Method
  118. Access Method  Compatibility  Deny Write  Deny Read  Deny None
  119. --------------------------------------------------------------
  120. Read Only           0             32          48         64
  121. Write Only          1             33          49         65
  122. Read/Write          2             34          50         66
  123. --------------------------------------------------------------
  124. }
  125.  
  126. {$IfnDef Os2}
  127. Function ShareInstalled : Boolean;
  128. Var Regs : Registers;
  129.  
  130.  Begin { ShareInstalled }
  131.  
  132.   Regs.AH := $16;
  133.   Regs.AL := $00;
  134.   Intr($21, Regs);
  135.   ShareInstalled := (Regs.AL = $FF);
  136.  
  137.  End; { ShareInstalled }
  138. {$EndIf}
  139.  
  140. {---------------------------------------------------------------------------}
  141.  
  142. Function AddBackSlash (S : PathStr) : PathStr;
  143.  
  144.  Begin
  145.   If S[Length(S)] <> '\' then S := S + '\';
  146.   AddBackSlash := S;
  147.  End;
  148.  
  149. {---------------------------------------------------------------------------}
  150.  
  151. { Converts the Unix datestamp used in Telegard's Laston.Dat file to the
  152.   time formated used by Portal (number of seconds since midnight) }
  153.  
  154. Function ConvTime (Unix : LongInt) : LongInt;
  155. Var
  156.   Sec  : Word;
  157.   Min  : Word;
  158.   Hour : Word;
  159.  
  160.  Begin { ConvTime }
  161.  
  162.    Sec  := Unix mod 60; Unix := Unix div 60;
  163.    Min  := Unix mod 60; Unix := Unix div 60;
  164.    Hour := Unix mod 24;
  165.    ConvTime := Sec + (Min *60) + (Hour * 3600);
  166.  
  167.  End; { ConvTime }
  168.  
  169. {---------------------------------------------------------------------------}
  170.  
  171. Function IntToHex (Num : LongInt; Digits : Byte) : String;
  172. Var
  173.  S : String;
  174.  C : Byte;
  175.  N : Array[1..SizeOf(LongInt)] of Byte Absolute Num;
  176.  
  177.  Begin { IntToHex }
  178.  
  179.   S := '';
  180.   For C := 4 DownTo 1 do S := S + HexId[N[C] shr 4] + HexId[n[c] and $F];
  181.   IntToHex := Copy(S,8-Digits+1,Digits);
  182.  
  183.  End; { IntToHex }
  184.  
  185. {---------------------------------------------------------------------------}
  186.  
  187. Function fExist (Fn : PathStr) : Boolean;
  188. Var DirInfo : SearchRec;
  189.  
  190.  Begin { fExist }
  191.  
  192.   FindFirst (Fn, Anyfile - Directory - VolumeId, DirInfo);
  193.   FExist := DosError = 0;
  194.  
  195.  End;  { fExist }
  196.  
  197.  
  198. {---------------------------------------------------------------------------}
  199. {                         .∙·Procedure·Declarations·∙.                      }
  200. {---------------------------------------------------------------------------}
  201.  
  202. {  Do not change the below copyright information. }
  203. Procedure Copyright;
  204.  
  205.  Begin { Copyright }
  206.  
  207.   Writeln;  Writeln;
  208.   TextAttr := LightCyan;
  209.   Writeln (Product + ' v' + Release);
  210.   TextAttr := Cyan;
  211.   Writeln ('Copyright 1997 by Jon Parise.  All rights reserved.');
  212.   TextAttr := DarkGray;
  213.   Writeln ('A North Star Technologies Software Release');
  214.   Writeln;
  215.  
  216.  End;  { Copyright }
  217.  
  218. {---------------------------------------------------------------------------}
  219.  
  220. { Displays the parameter help screen with examples }
  221. Procedure Help;
  222.  
  223.  Begin { Help }
  224.  
  225.   Copyright;
  226.   Writeln;
  227.   TextAttr := White;    Write('     Usage');
  228.   TextAttr := DarkGray; Write(':  ');
  229.   TextAttr := Cyan;     Write('TelePort {Telegard Data Dir} {Portal Dir} [Portal Task]');
  230.   Writeln;  Writeln;
  231.   TextAttr := White;    Write('   Example');
  232.   TextAttr := DarkGray; Write(':  ');
  233.   TextAttr := Cyan;     Write('TelePort D:\Telegard\Data D:\Portal  ');
  234.   Write('  (Writes to Portal.Dat)'); Writeln;
  235.   Write('             ');
  236.   Write('TelePort D:\Telegard\Data D:\Portal 2');
  237.   Write('  (Writes to Portal02.Dat)'); Writeln;
  238.   Writeln;
  239.   Halt (1);
  240.  
  241.  End;  { Help }
  242.  
  243. {---------------------------------------------------------------------------}
  244.  
  245. Procedure ReadTelegardCallers (FileName : String);
  246. Var
  247.   fCallers     : File of LCallers;
  248.   OpenAttempts : Integer;
  249.   GoAhead      : Boolean;
  250.   I            : LongInt;
  251.   TempRec      : LCallers;
  252.   NumCallers   : Byte;
  253.  
  254.  Begin { ReadTelegardCallers }
  255.  
  256.   If Not fExist(Filename) then
  257.     Begin
  258.       Writeln;
  259.       Writeln('   ',Filename,' was not found!');
  260.       Halt(3);
  261.     End;
  262.   {$IfnDef Os2} If ShareInstalled then FileMode := 32; {$EndIf}
  263.   Assign(fCallers,FileName);
  264.   OpenAttempts := 1;
  265.   Repeat
  266.     {$I-} Reset(fCallers); {$I+}
  267.     GoAhead := (IOResult = 0);
  268.     If (Not GoAhead) then Inc(OpenAttempts);
  269.   Until (GoAhead) or (OpenAttempts > 1000);
  270.  
  271.   NumCallers := FileSize(fCallers);
  272.  
  273.   If NumCallers > 0 then
  274.     Begin
  275.       If NumCallers > 5 then NumCallers := 5;
  276.       Seek(fCallers, FileSize(fCallers) - NumCallers);
  277.       For I := 1 to NumCallers do
  278.         Begin
  279.           Read(fCallers,TempRec);
  280.           Callers[I].Name := TempRec.Handle;
  281.           Callers[I].Time := ConvTime(TempRec.LogonTime);
  282.           { Puts an asterisk in from of the user's name if he/she is new }
  283.           If TempRec.NewUser then Callers[I].Name := '*' + Callers[I].Name;
  284.        End;
  285.     End;
  286.  
  287.   Close(fCallers);
  288.   {$IfnDef Os2} If ShareInstalled then FileMode := 2; {$EndIf}
  289.  
  290.  End;  { ReadTelegardCallers }
  291.  
  292. {---------------------------------------------------------------------------}
  293.  
  294. Procedure ReadPortalDat (FileName : String);
  295. Var
  296.   fPortal      : File of tPortalRec;
  297.   OpenAttempts : Integer;
  298.   GoAhead      : Boolean;
  299.  
  300.  Begin { ReadPortalDat }
  301.  
  302.   If Not fExist(Filename) then
  303.     Begin
  304.       Writeln;
  305.       Writeln('   ',Filename,' was not found!');
  306.       Halt(2);
  307.     End;
  308.   {$IfnDef Os2} If ShareInstalled then FileMode := 32; {$EndIf}
  309.   Assign(fPortal,FileName);
  310.   OpenAttempts := 1;
  311.   Repeat
  312.     {$I-} Reset(fPortal); {$I+}
  313.     GoAhead := (IOResult = 0);
  314.     If (Not GoAhead) then Inc(OpenAttempts);
  315.   Until (GoAhead) or (OpenAttempts > 1000);
  316.   Read (fPortal,PortalStatus);
  317.   Close(fPortal);
  318.   {$IfnDef Os2} If ShareInstalled then FileMode := 2; {$EndIf}
  319.  
  320.  End;  { ReadPortalDat }
  321.  
  322. {---------------------------------------------------------------------------}
  323.  
  324. Procedure WritePortalDat (FileName : String);
  325. Var
  326.   fPortal      : File of tPortalRec;
  327.   OpenAttempts : Integer;
  328.   GoAhead      : Boolean;
  329.  
  330.  Begin { WritePortalDat }
  331.  
  332.   {$IfnDef Os2} If ShareInstalled then FileMode := 50; {$EndIf}
  333.   Assign(fPortal,FileName);
  334.   OpenAttempts := 1;
  335.   Repeat
  336.     {$I-} Rewrite(fPortal); {$I+}
  337.     GoAhead := (IOResult = 0);
  338.     If (Not GoAhead) then Inc(OpenAttempts);
  339.   Until (GoAhead) or (OpenAttempts > 1000);
  340.   Write (fPortal,PortalStatus);
  341.   Close(fPortal);
  342.   {$IfnDef Os2} If ShareInstalled then FileMode := 2; {$EndIf}
  343.  
  344.  End;  { WritePortalDat }
  345.  
  346. {---------------------------------------------------------------------------}
  347.  
  348. Procedure ImportIt;
  349. Var I : Byte;
  350.  
  351.  Begin { ImportIt }
  352.  
  353.   Copyright;
  354.   TextAttr := Cyan;
  355.   Writeln('Telegard Dir :  ',TelegardDir);
  356.   Writeln('  Portal Dir :  ',PortalDir);
  357.   If Task <> '' then Writeln(' Portal Task :  ',J,' (',Task,')');
  358.   For I := 1 to 5 do
  359.     Begin
  360.       Callers[I].Name := '';
  361.       Callers[I].Time := 0;
  362.     End;
  363.   ReadPortalDat(PortalDir + 'Portal' + Task + '.Dat');
  364.   ReadTelegardCallers(TelegardDir + 'Laston.Dat');
  365.   For I := 1 to 5 do
  366.     Begin
  367.       PortalStatus.Users[I].Name := Callers[I].Name;
  368.       PortalStatus.Users[I].T    := Callers[I].Time;
  369.     End;
  370.   WritePortalDat(PortalDir + 'Portal' + Task + '.Dat');
  371.  
  372.  End;  { ImportIt }
  373.  
  374. {---------------------------------------------------------------------------}
  375. {                               .∙·Main·Body·∙.                             }
  376. {---------------------------------------------------------------------------}
  377.  
  378. Begin { Main }
  379.  
  380.  If (ParamCount <= 3) and (ParamCount >= 2) then
  381.    Begin
  382.      TelegardDir := AddBackSlash(ParamStr(1));
  383.      PortalDir   := AddBackSlash(ParamStr(2));
  384.      If ParamCount = 3 then
  385.        Begin
  386.          Val(ParamStr(3),J,Err);
  387.          Task := IntToHex(J,2);
  388.          If Length(Task) = 1 then Task := '0' + Task;
  389.          If Task = '00' then Task := '';
  390.        End else Task := '';
  391.    End else Help;
  392.  
  393.  ImportIt;
  394.  Writeln;
  395.  Writeln('Telegard callers successfully imported into Portal',Task,'.Dat');
  396.  Writeln;
  397.  
  398. End.  { Main }
  399.