home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / MKMSG104 / MKGLOBT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-09  |  7KB  |  339 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;
  25.   {$ENDIF}
  26.  
  27. Type AddrType = Record                 {Used for Fido style addresses}
  28.   Zone: Word;
  29.   Net: Word;
  30.   Node: Word;
  31.   Point: Word;
  32.   End;
  33.  
  34. Type SecType = Record
  35.   Level: Word;                         {Security level}
  36.   Flags: LongInt;                      {32 bitmapped flags}
  37.   End;
  38.  
  39. Type MKDateType = Record
  40.   Year: Word;
  41.   Month: Word;
  42.   Day: Word;
  43.   End;
  44.  
  45. Type MKDateTime = Record
  46.   Year: Word;
  47.   Month: Word;
  48.   Day: Word;
  49.   Hour: Word;
  50.   Min: Word;
  51.   Sec: Word;
  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  ParseAddr(AStr: String; CurrAddr: AddrType; Var DestAddr: AddrType): Boolean;
  75. Function  Access(USec: SecType; RSec: SecType): Boolean;
  76. Function  EstimateXferTime(FS: LongInt; BaudRate: Word; Effic: Word): LongInt;
  77.   {Result in seconds}
  78. Function  NameCrcCode(Str: String): LongInt; {Get CRC code for name}
  79. Function  Flag2Str(Number: Byte): String;
  80. Function  Str2Flag(St: String): Byte;
  81. Function  ValidMKDate(DT: MKDateTime): Boolean;
  82. {$IFDEF WINDOWS}
  83. Procedure DT2MKDT(Var DT: TDateTime; Var DT2: MKDateTime);
  84. Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: TDateTime);
  85. {$ELSE}
  86. Procedure DT2MKDT(Var DT: DateTime; Var DT2: MKDateTime);
  87. Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: DateTime);
  88. {$ENDIF}
  89. Procedure Str2MKD(St: String; Var MKD: MKDateType);
  90. Function MKD2Str(MKD: MKDateType): String;
  91. Function GetCompiled: String;
  92.  
  93. Var
  94.   StartUpPath: String[128];
  95.  
  96. Const
  97.   UseEms: Boolean = True;
  98.   LocalMode: Boolean = False;
  99.   LogToPrinter: Boolean = False;
  100.   ReLoad: Boolean = False;
  101.   NodeNumber: Byte = 1;
  102.   OverRidePort: Byte = 0;
  103.   OverRideBaud: Word = 0;
  104.   UserBaud: Word = 0;
  105.   ExitErrorLevel: Byte = 0;
  106.   TimeToEvent: LongInt = 0;
  107.   ShellToMailer: Boolean = False;
  108.  
  109. Implementation
  110.  
  111. Uses MKString, Crc32, MKMisc;
  112.  
  113.  
  114. {$I Compiled.Inc}
  115.  
  116. Function Flag2Str(Number: Byte): String;
  117.   Var
  118.     Temp1: Byte;
  119.     Temp2: Byte;
  120.     i: Word;
  121.     TempStr: String[8];
  122.  
  123.   Begin
  124.   Temp1 := 0;
  125.   Temp2 := $01;
  126.   For i := 1 to 8 Do
  127.     Begin
  128.     If (Number and Temp2) <> 0 Then
  129.       TempStr[i] := 'X'
  130.     Else
  131.       TempStr[i] := '-';
  132.     Temp2 := Temp2 shl 1;
  133.     End;
  134.   TempStr[0] := #8;
  135.   Flag2Str := TempStr;
  136.   End;
  137.  
  138.  
  139. Function Str2Flag(St: String): Byte;
  140.   Var
  141.     i: Word;
  142.     Temp1: Byte;
  143.     Temp2: Byte;
  144.  
  145.   Begin
  146.   St := StripBoth(St,' ');
  147.   St := PadLeft(St,'-',8);
  148.   Temp1 := 0;
  149.   Temp2 := $01;
  150.   For i := 1 to 8 Do
  151.     Begin
  152.     If UpCase(St[i]) = 'X' Then
  153.       Inc(Temp1,Temp2);
  154.     Temp2 := Temp2 shl 1;
  155.     End;
  156.   Str2Flag := Temp1;
  157.   End;
  158.  
  159.  
  160.  
  161.  
  162. Function AddrStr(Addr: AddrType): String;
  163.   Begin
  164.   If Addr.Point = 0 Then
  165.     AddrStr := Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' +
  166.       Long2Str(Addr.Node)
  167.   Else
  168.     AddrStr := Long2Str(Addr.Zone) + ':' + Long2Str(Addr.Net) + '/' +
  169.       Long2Str(Addr.Node) + '.' + Long2Str(Addr.Point);
  170.   End;
  171.  
  172.  
  173. Function Access(USec: SecType; RSec: SecType): Boolean;
  174.   Begin
  175.   If (USec.Level >=  RSec.Level) Then
  176.     Access :=  ((RSec.Flags and Not(USec.Flags)) = 0)
  177.   Else
  178.     Access := False;
  179.   End;
  180.  
  181.  
  182. Function EstimateXferTime(FS: LongInt; BaudRate: Word; Effic: Word): LongInt;
  183.   Begin
  184.   If BaudRate > 0 Then
  185.     EstimateXferTime := ((FS * 100) Div Effic) Div (BaudRate Div 10)
  186.   Else
  187.     EstimateXferTime := ((FS * 100) Div Effic) Div (960);
  188.   End;
  189.  
  190.  
  191. Function NameCrcCode(Str: String): LongInt;
  192.   Var
  193.     NCode: LongInt;
  194.     i: WOrd;
  195.  
  196.   Begin
  197.   NCode := UpdC32(Length(Str),$ffffffff);
  198.   i := 1;
  199.   While i < Length(Str) Do
  200.     Begin
  201.     NCode := Updc32(Ord(UpCase(Str[i])), NCode);
  202.     Inc(i);
  203.     End;
  204.   NameCrcCode := NCode;
  205.   End;
  206.  
  207.  
  208. Function ParseAddr(AStr: String; CurrAddr: AddrType; Var DestAddr: AddrType): Boolean;
  209.   Var
  210.     SPos: Word;
  211.     EPos: Word;
  212.     TempStr: String;
  213.     Code: Word;
  214.     BadAddr: Boolean;
  215.  
  216.   Begin
  217.   BadAddr := False;
  218.   AStr := StripBoth(Upper(AStr), ' ');
  219.   EPos := Length(AStr);
  220.   SPos := Pos(':',AStr) + 1;
  221.   If SPos > 1 Then
  222.     Begin
  223.     TempStr := StripBoth(Copy(AStr,1,Spos - 2), ' ');
  224.     Val(TempStr,DestAddr.Zone,Code);
  225.     If Code <> 0 Then
  226.       BadAddr := True;
  227.     AStr := Copy(AStr,Spos,Length(AStr));
  228.     End
  229.   Else
  230.     DestAddr.Zone := CurrAddr.Zone;
  231.   SPos := Pos('/',AStr) + 1;
  232.   If SPos > 1 Then
  233.     Begin
  234.     TempStr := StripBoth(Copy(AStr,1,Spos - 2), ' ');
  235.     Val(TempStr,DestAddr.Net,Code);
  236.     If Code <> 0 Then
  237.       BadAddr := True;
  238.     AStr := Copy(AStr,Spos,Length(AStr));
  239.     End
  240.   Else
  241.     DestAddr.Net := CurrAddr.Net;
  242.   EPos := Pos('.', AStr) + 1;
  243.   If EPos > 1 Then
  244.     Begin
  245.     TempStr := StripBoth(Copy(AStr,EPos,Length(AStr)), ' ');
  246.     Val(TempStr,DestAddr.Point,Code);
  247.     If Code <> 0 Then
  248.       DestAddr.Point := 0;
  249.     AStr := Copy(AStr,1,EPos -2);
  250.     End
  251.   Else
  252.     DestAddr.Point := 0;
  253.   TempStr := StripBoth(AStr,' ');
  254.   If Length(TempStr) > 0 Then
  255.     Begin
  256.     Val(TempStr,DestAddr.Node,Code);
  257.     If Code <> 0 Then
  258.       BadAddr := True;
  259.     End
  260.   Else
  261.     DestAddr.Node := CurrAddr.Node;
  262.   ParseAddr := Not BadAddr;
  263.   End;
  264.  
  265.  
  266. {$IFDEF WINDOWS}
  267. Procedure DT2MKDT(Var DT: TDateTime; Var DT2: MKDateTime);
  268. {$ELSE}
  269. Procedure DT2MKDT(Var DT: DateTime; Var DT2: MKDateTime);
  270. {$ENDIF}
  271.  
  272.   Begin
  273.   DT2.Year := DT.Year;
  274.   DT2.Month := DT.Month;
  275.   DT2.Day := DT.Day;
  276.   DT2.Hour := DT.Hour;
  277.   DT2.Min := DT.Min;
  278.   DT2.Sec := DT.Sec;
  279.   End;
  280.  
  281.  
  282. {$IFDEF WINDOWS}
  283. Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: TDateTime);
  284. {$ELSE}
  285. Procedure MKDT2DT(Var DT: MKDateTime; Var DT2: DateTime);
  286. {$ENDIF}
  287.  
  288.   Begin
  289.   DT2.Year := DT.Year;
  290.   DT2.Month := DT.Month;
  291.   DT2.Day := DT.Day;
  292.   DT2.Hour := DT.Hour;
  293.   DT2.Min := DT.Min;
  294.   DT2.Sec := DT.Sec;
  295.   End;
  296.  
  297.  
  298. Function  ValidMKDate(DT: MKDateTime): Boolean;
  299.   Var
  300.     {$IFDEF WINDOWS}
  301.     DT2: TDateTime;
  302.     {$ELSE}
  303.     DT2: DateTime;
  304.     {$ENDIF}
  305.  
  306.   Begin
  307.   MKDT2DT(DT, DT2);
  308.   ValidMKDate := ValidDate(DT2);
  309.   End;
  310.  
  311.  
  312. Procedure Str2MKD(St: String; Var MKD: MKDateType);
  313.   Begin
  314.   FillChar(MKD, SizeOf(MKD), #0);
  315.   MKD.Year := Str2Long(Copy(St, 7, 2));
  316.   MKD.Month := Str2Long(Copy(St, 1, 2));
  317.   MKD.Day := Str2Long(Copy(St, 4, 2));
  318.   If MKD.Year < 80 Then
  319.     Inc(MKD.Year, 2000)
  320.   Else
  321.     Inc(MKD.Year, 1900);
  322.   End;
  323.  
  324.  
  325. Function MKD2Str(MKD: MKDateType): String;
  326.   Begin
  327.   MKD2Str := PadLeft(Long2Str(MKD.Month),'0',2) + '-' +
  328.              PadLeft(Long2Str(MKD.Day), '0',2) + '-' +
  329.              PadLeft(Long2Str(MKD.Year Mod 100), '0', 2);
  330.   End;
  331.  
  332.  
  333. Function GetCompiled: String;
  334.   Begin
  335.   GetCompiled := Compiled;
  336.   End;
  337.  
  338. End.
  339.