home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mksmvp10.zip / MKGLOBT.PAS < prev    next >
Pascal/Delphi Source File  |  1997-09-27  |  8KB  |  369 lines
  1. Unit MKGlobT;
  2.  
  3. {$I MKB.Def}
  4.  
  5. Interface
  6.  
  7. {
  8.      MKGlobT - Copyright 1993 by Mark May - MK Software
  9.      You are free to use this code in your programs, however
  10.      it may not be included in Source/TPU function libraries
  11.      without my permission.
  12.  
  13.      Mythical Kingom Tech BBS (513)237-7737 HST/v32
  14.      FidoNet: 1:110/290
  15.      Rime: ->MYTHKING
  16.      You may also reach me at maym@dmapub.dma.org
  17. }
  18.  
  19.  
  20. Uses
  21.   {$IFDEF WINDOWS}
  22.   WinDos;
  23.   {$ELSE}
  24.   Dos, Use32;
  25.   {$ENDIF}
  26.  
  27. Type AddrType = Record                 {Used for Fido style addresses}
  28.   Zone: SmallWord;
  29.   Net: SmallWord;
  30.   Node: SmallWord;
  31.   Point: SmallWord;
  32.   End;
  33.  
  34. Type SecType = Record
  35.   Level: SmallWord;                         {Security level}
  36.   Flags: LongInt;                      {32 bitmapped flags}
  37.   End;
  38.  
  39. Type MKDateType = Record
  40.   Year: SmallWord;
  41.   Month: SmallWord;
  42.   Day: SmallWord;
  43.   End;
  44.  
  45. Type MKDateTime = Record
  46.   Year: SmallWord;
  47.   Month: SmallWord;
  48.   Day: SmallWord;
  49.   Hour: SmallWord;
  50.   Min: SmallWord;
  51.   Sec: SmallWord;
  52.   End;
  53.  
  54. Const
  55.   BbsVersion = 'Mythical Kingdom Bbs - Version 0.01 Alpha';
  56.   Copyright  = 'Copyright 1992, 1993 by Mark May';
  57.   Contact    = 'Contact 1:110/290  (513)237-7737 HST/V32';
  58.  
  59.  
  60. Const
  61.   uoNotAvail = 0;
  62.   uoBrowse =  1;
  63.   uoXfer   =  2;
  64.   uoMsg    =  3;
  65.   uoDoor   =  4;
  66.   uoChat   =  5;
  67.   uoQuest  =  6;
  68.   uoReady  =  7;
  69.   uoMail   =  8;
  70.   uoWait   =  9;
  71.   uoLogIn  = 10;
  72.  
  73. Function  AddrStr(Addr: AddrType): String;
  74. Function  PointlessAddrStr(Var Addr: AddrType): String;
  75. Function  ParseAddr(AStr: String; CurrAddr: AddrType; Var DestAddr: AddrType): Boolean;
  76. Function  IsValidAddr(Addr: AddrType): Boolean;
  77. Function  Access(USec: SecType; RSec: SecType): Boolean;
  78. Function  EstimateXferTime(FS: LongInt; BaudRate: Word; Effic: Word): LongInt;
  79.   {Result in seconds}
  80. Function  NameCrcCode(Str: String): LongInt; {Get CRC code for name}
  81. Function  Flag2Str(Number: Byte): String;
  82. Function  Str2Flag(St: String): Byte;
  83. Function  ValidMKDate(DT: MKDateTime): Boolean;
  84. {$IFDEF WINDOWS}
  85. Procedure DT2MKDT(Var DT: TDateTime; Var DT2: MKDateTime);
  86. Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: TDateTime);
  87. {$ELSE}
  88. Procedure DT2MKDT(Var DT: DateTime; Var DT2: MKDateTime);
  89. Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: DateTime);
  90. {$ENDIF}
  91. Procedure Str2MKD(St: String; Var MKD: MKDateType);
  92. Function MKD2Str(MKD: MKDateType): String;
  93. Function GetCompiled: String;
  94. Function AddrEqual(Addr1: AddrType; Addr2: AddrType):Boolean;
  95.  
  96. Var
  97.   StartUpPath: String[128];
  98.  
  99. Const
  100.   UseEms: Boolean = True;
  101.   LocalMode: Boolean = False;
  102.   LogToPrinter: Boolean = False;
  103.   ReLoad: Boolean = False;
  104.   NodeNumber: Byte = 1;
  105.   OverRidePort: Byte = 0;
  106.   OverRideBaud: Word = 0;
  107.   UserBaud: Word = 0;
  108.   ExitErrorLevel: Byte = 0;
  109.   TimeToEvent: LongInt = 0;
  110.   ShellToMailer: Boolean = False;
  111.  
  112. Implementation
  113.  
  114. Uses MKString, Crc32, MKMisc;
  115.  
  116.  
  117. {$I Compiled.Inc}
  118.  
  119. Function Flag2Str(Number: Byte): String;
  120.   Var
  121.     Temp1: Byte;
  122.     Temp2: Byte;
  123.     i: Word;
  124.     TempStr: String[8];
  125.  
  126.   Begin
  127.   Temp1 := 0;
  128.   Temp2 := $01;
  129.   For i := 1 to 8 Do
  130.     Begin
  131.     If (Number and Temp2) <> 0 Then
  132.       TempStr[i] := 'X'
  133.     Else
  134.       TempStr[i] := '-';
  135.     Temp2 := Temp2 shl 1;
  136.     End;
  137.   TempStr[0] := #8;
  138.   Flag2Str := TempStr;
  139.   End;
  140.  
  141.  
  142. Function Str2Flag(St: String): Byte;
  143.   Var
  144.     i: Word;
  145.     Temp1: Byte;
  146.     Temp2: Byte;
  147.  
  148.   Begin
  149.   St := StripBoth(St,' ');
  150.   St := PadLeft(St,'-',8);
  151.   Temp1 := 0;
  152.   Temp2 := $01;
  153.   For i := 1 to 8 Do
  154.     Begin
  155.     If UpCase(St[i]) = 'X' Then
  156.       Inc(Temp1,Temp2);
  157.     Temp2 := Temp2 shl 1;
  158.     End;
  159.   Str2Flag := Temp1;
  160.   End;
  161.  
  162.  
  163.  
  164.  
  165. Function AddrStr(Addr: AddrType): String;
  166.   Begin
  167.   If Addr.Point = 0 Then
  168.     AddrStr := Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' +
  169.       Long2Str(Addr.Node)
  170.   Else
  171.     AddrStr := Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' +
  172.       Long2Str(Addr.Node) + '.' + Long2Str(Addr.Point);
  173.   End;
  174.  
  175.  
  176. Function PointlessAddrStr(Var Addr: AddrType): String;
  177.   Begin
  178.   PointlessAddrStr := Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' +
  179.       Long2Str(Addr.Node);
  180.   End;
  181.  
  182.  
  183. Function Access(USec: SecType; RSec: SecType): Boolean;
  184.   Begin
  185.   If (USec.Level >=  RSec.Level) Then
  186.     Access :=  ((RSec.Flags and Not(USec.Flags)) = 0)
  187.   Else
  188.     Access := False;
  189.   End;
  190.  
  191.  
  192. Function EstimateXferTime(FS: LongInt; BaudRate: Word; Effic: Word): LongInt;
  193.   Begin
  194.   If BaudRate > 0 Then
  195.     EstimateXferTime := ((FS * 100) Div Effic) Div (BaudRate Div 10)
  196.   Else
  197.     EstimateXferTime := ((FS * 100) Div Effic) Div (960);
  198.   End;
  199.  
  200.  
  201. Function NameCrcCode(Str: String): LongInt;
  202.   Var
  203.     NCode: LongInt;
  204.     i: WOrd;
  205.  
  206.   Begin
  207.   NCode := UpdC32(Length(Str),$ffffffff);
  208.   i := 1;
  209.   While i < Length(Str) Do
  210.     Begin
  211.     NCode := Updc32(Ord(UpCase(Str[i])), NCode);
  212.     Inc(i);
  213.     End;
  214.   NameCrcCode := NCode;
  215.   End;
  216.  
  217.  
  218. Function ParseAddr(AStr: String; CurrAddr: AddrType; Var DestAddr: AddrType): Boolean;
  219.   Var
  220.     SPos: Word;
  221.     EPos: Word;
  222.     TempStr: String;
  223.     Code: Word;
  224.     BadAddr: Boolean;
  225.  
  226.   Begin
  227.   BadAddr := False;
  228.   AStr := StripBoth(Upper(AStr), ' ');
  229.   EPos := Length(AStr);
  230.   {thanks for the fix domain problem to Ryan Murray @ 1:153/942}
  231.   Code := Pos('@', AStr);
  232.   If Code > 0 then
  233.     Delete(Astr, Code, Length(Astr) + 1 - Code);
  234.   SPos := Pos(':',AStr) + 1;
  235.   If SPos > 1 Then
  236.     Begin
  237.     TempStr := StripBoth(Copy(AStr,1,Spos - 2), ' ');
  238.     Val(TempStr,DestAddr.Zone,Code);
  239.     If Code <> 0 Then
  240.       BadAddr := True;
  241.     AStr := Copy(AStr,Spos,Length(AStr));
  242.     End
  243.   Else
  244.     DestAddr.Zone := CurrAddr.Zone;
  245.   SPos := Pos('/',AStr) + 1;
  246.   If SPos > 1 Then
  247.     Begin
  248.     TempStr := StripBoth(Copy(AStr,1,Spos - 2), ' ');
  249.     Val(TempStr,DestAddr.Net,Code);
  250.     If Code <> 0 Then
  251.       BadAddr := True;
  252.     AStr := Copy(AStr,Spos,Length(AStr));
  253.     End
  254.   Else
  255.     DestAddr.Net := CurrAddr.Net;
  256.   EPos := Pos('.', AStr) + 1;
  257.   If EPos > 1 Then
  258.     Begin
  259.     TempStr := StripBoth(Copy(AStr,EPos,Length(AStr)), ' ');
  260.     Val(TempStr,DestAddr.Point,Code);
  261.     If Code <> 0 Then
  262.       DestAddr.Point := 0;
  263.     AStr := Copy(AStr,1,EPos -2);
  264.     End
  265.   Else
  266.     DestAddr.Point := 0;
  267.   TempStr := StripBoth(AStr,' ');
  268.   If Length(TempStr) > 0 Then
  269.     Begin
  270.     Val(TempStr,DestAddr.Node,Code);
  271.     If Code <> 0 Then
  272.       BadAddr := True;
  273.     End
  274.   Else
  275.     DestAddr.Node := CurrAddr.Node;
  276.   ParseAddr := Not BadAddr;
  277.   End;
  278.  
  279.  
  280. {$IFDEF WINDOWS}
  281. Procedure DT2MKDT(Var DT: TDateTime; Var DT2: MKDateTime);
  282. {$ELSE}
  283. Procedure DT2MKDT(Var DT: DateTime; Var DT2: MKDateTime);
  284. {$ENDIF}
  285.  
  286.   Begin
  287.   DT2.Year := DT.Year;
  288.   DT2.Month := DT.Month;
  289.   DT2.Day := DT.Day;
  290.   DT2.Hour := DT.Hour;
  291.   DT2.Min := DT.Min;
  292.   DT2.Sec := DT.Sec;
  293.   End;
  294.  
  295.  
  296. {$IFDEF WINDOWS}
  297. Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: TDateTime);
  298. {$ELSE}
  299. Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: DateTime);
  300. {$ENDIF}
  301.  
  302.   Begin
  303.   DT2.Year := DT.Year;
  304.   DT2.Month := DT.Month;
  305.   DT2.Day := DT.Day;
  306.   DT2.Hour := DT.Hour;
  307.   DT2.Min := DT.Min;
  308.   DT2.Sec := DT.Sec;
  309.   End;
  310.  
  311.  
  312. Function  ValidMKDate(DT: MKDateTime): Boolean;
  313.   Var
  314.     {$IFDEF WINDOWS}
  315.     DT2: TDateTime;
  316.     {$ELSE}
  317.     DT2: DateTime;
  318.     {$ENDIF}
  319.  
  320.   Begin
  321.   MKDT2DT(DT, DT2);
  322.   ValidMKDate := ValidDate(DT2);
  323.   End;
  324.  
  325.  
  326. Procedure Str2MKD(St: String; Var MKD: MKDateType);
  327.   Begin
  328.   FillChar(MKD, SizeOf(MKD), #0);
  329.   MKD.Year := Str2Long(Copy(St, 7, 2));
  330.   MKD.Month := Str2Long(Copy(St, 1, 2));
  331.   MKD.Day := Str2Long(Copy(St, 4, 2));
  332.   If MKD.Year < 80 Then
  333.     Inc(MKD.Year, 2000)
  334.   Else
  335.     Inc(MKD.Year, 1900);
  336.   End;
  337.  
  338.  
  339. Function MKD2Str(MKD: MKDateType): String;
  340.   Begin
  341.   MKD2Str := PadLeft(Long2Str(MKD.Month),'0',2) + '-' +
  342.              PadLeft(Long2Str(MKD.Day), '0',2) + '-' +
  343.              PadLeft(Long2Str(MKD.Year Mod 100), '0', 2);
  344.   End;
  345.  
  346.  
  347. Function GetCompiled: String;
  348.   Begin
  349.   GetCompiled := Compiled;
  350.   End;
  351.  
  352.  
  353. Function AddrEqual(Addr1: AddrType; Addr2: AddrType):Boolean;
  354.   Begin
  355.   AddrEqual := ((Addr1.Zone = Addr2.Zone) and (Addr1.Net = Addr2.Net)
  356.     and (Addr1.Node = Addr2.Node) and (Addr1.Point = Addr2.Point));
  357.   End;
  358.  
  359.  
  360.  
  361. Function  IsValidAddr(Addr: AddrType): Boolean;
  362.   Begin
  363.   IsValidAddr := ((Addr.Zone = 0) And (Addr.Net = 0));
  364.     { We have to skip administrative '/0' addresses}
  365.   End;
  366.  
  367.  
  368. End.
  369.