The Pier Shareware 6/The_Pier_Shareware_Number_6_(The_Pier_Exchange)_(1995).iso/005/wildpack.zip/TOALL.WCX

Wildcat! WCX | 1994-12-05 | 4KB | 312 lines

'! Decompiled with wccNosy version 4.20f (freeware)
'! Input File: in.wcx  3515 bytes  02/01/123  06:46:18am
'! Code Segment Size  :2844 bytes
'! Data Segment Size  :6435 bytes
'! String Segment Size:671 bytes
'! Compiled with WCC version 4.01

      Type Type27
        s0 As String*50
        Filler50(1 To 122) As Byte
        s172 As String*60
        s232 As String*10
      End Type

      Type Type26
        Filler0(1 To 1) As Byte
        s1 As String*1
        i2 As Integer
      End Type

      Declare Function Func605 As Boolean
      Declare Function Func1832 As String
      Declare Function Func1891 As Boolean
      Declare Sub Sub1944(s65534 As String)
      Declare Sub Sub2354
      Declare Sub Sub2525
      Declare Sub Sub2677

      Dim t26_4463(1 To 260) As Type26
      Dim t27_5503 As Type27
      Dim o5745 As Boolean
      Dim s5746 As String
      Dim s5750 As String*70
      Dim s5820 As String*70
      Dim s5890 As String
      Dim b5894 As Byte
      Dim mh5895 As MessageHeader
      Dim s6215 As String*70
      Dim s6286 As String
      Dim s6290 As String*70
      Dim s6360 As String
      Dim o6364 As Boolean
      Dim s6365 As String*70

      s5890 = ProgPath + "toall.ini"
      s6360 = ProgPath + "toall.txt"
      o5745 = Func605
      Cls
      If Not Exists(s5890) Then
        Sub2354
      End If
  103 Open s5890 For Input As 1
      Open s6360 For Output As 2
      Input #1, b5894
      If b5894 <> 1 And b5894 <> 2 And b5894 <> 3 And b5894 <> 4 And b5894 <> 5 Then
        Sub2354
      End If
      Do
  214   s6286 = Func1832
        Sub1944(s6286)
        o6364 = Func1891
      Loop Until o6364 = -1
      Close 1
      DisplayPrompt 888
      s6290 = InputMask("", "XXXXXXXXXXXXXXXXXXXXXXXXX", "", 1213417543)
      If s6290 = "" Then
        Sub2525
        End
      End If
  326 DisplayPrompt 891
      s6215 = InputMask("", "XXXXXXXXXXXXXXXXXXXXXXXXX", "", 1213417543)
      s5820 = UCase(s6290)
      Sub2677
      If EditMessage(mh5895, s6360, 150) Then
        Close 2
        If UCase(s6290) = "ALL" Then
          Print "@8F@Please wait, distributing mail..."
          Open s5750 For Input As 3
          Input #3, s6365
  466     Do While Not EOF(3)
            s5820 = UCase(s6365)
            Sub2677
            AddMessage(mh5895, s6360, "", 1213417543)
            Input #3, s6365
          Loop
  536     Close 3
        Else
  547     AddMessage(mh5895, s6360, "", 1213417543)
        End If
      End If
  568 Del s6360
      Sub2525
      Reset
      End

'! Called 1 time
      Function Func605 As Boolean
        Dim l65476 As Long
        Dim i65480 As Integer
        Dim l65482 As Long
        Dim i65486 As Integer
        Dim l65488 As Long
        Dim i65492 As Integer
        Dim b65494 As Byte
        Dim o65495 As Boolean
        Dim s65496(1 To 3) As String
        Dim s65508 As String
        Dim s65512 As String*1
        Dim i65513 As Integer
        Dim i65515 As Integer
        Dim s65517 As String
        Dim s65521 As String
        Dim i65525 As Integer
        Dim i65527 As Integer
        Dim i65529 As Integer
        Dim s65531 As String

        s65531 = ProgPath + "tvs.key"
        i65529 = 69
        s65521 = Chr(255)
        s65512 = Chr(0)
        i65515 = 0
        b65494 = 0
        s65508 = ProgPath + "tvs.cfg"
        o65495 = 0
        Func605 = 0
        If Not Exists(s65531) Then
          Func605 = 0
        Else
  719     If Not Exists(s65508) Then
            Func605 = 0
          Else
  746       Open s65531 For Random As 1 Len = 4 '! This value should probably be replaced with a "SizeOf" expression
  787       For i65515 = 1 To 260 Step 1
              Get 1, i65515, t26_4463(i65515) '! 4 bytes
            Next
  905       i65527 = i65529
            i65515 = 0
            i65513 = 1
  928       Do While t26_4463(i65527).s1 <> s65521 And i65515 < 255
              If t26_4463(i65527).s1 = s65512 Then
                If i65513 = 1 Then
                  t27_5503.s0 = s65517
                End If
 1070           If i65513 = 7 Then
                  t27_5503.s172 = s65517
                End If
 1099           s65517 = ""
                i65513 = i65513 + 1
              End If
 1122         s65517 = s65517 + t26_4463(i65527).s1
              i65525 = t26_4463(i65527).i2
              i65527 = i65525
              i65515 = i65515 + 1
            Loop
 1246       t27_5503.s232 = s65517
            Close 1
            If s65517 = "" Then
              Func605 = 0
            Else
 1294         Open s65508 For Input As 2
 1334         For i65527 = 1 To 3 Step 1
                Input #2, s65496(i65527)
              Next
 1443
 1464         For i65515 = 1 To 3 Step 1
                If InStr(UCase(t27_5503.s0), UCase(s65496(i65515))) > 0 Then
                  b65494 = b65494 + 1
                End If
 1585           If InStr(UCase(t27_5503.s172), UCase(s65496(i65515))) > 0 Then
                  b65494 = b65494 + 1
                End If
 1660           If InStr(UCase(s65496(i65515)), UCase(t27_5503.s232)) > 0 Then
                  b65494 = b65494 + 1
                End If
 1735         Next
 1758         If b65494 = 3 Then
                o65495 = -1
              End If
 1781         Close 2
              Func605 = o65495
            End If
          End If
        End If
 1796
      End Function

'! Called 1 time
      Function Func1832 As String
        Dim s65528 As String

        s5746 = ""
        s5750 = ""
        Input #1, s65528
        Func1832 = s65528
      End Function

'! Called 1 time
      Function Func1891 As Boolean
        Func1891 = 0
        If User.SecLevel = s5746 Then
          Func1891 = -1
        End If
 1936
      End Function

'! Called 1 time
      Sub Sub1944(s65534 As String)
        Dim b65517 As Byte
        Dim s65518 As String
        Dim s65522 As String
        Dim i65526 As Integer
        Dim i65528 As Integer
        Dim s65530 As String

        b65517 = 0
        i65528 = -1
        i65526 = 0
 1973   Do While b65517 <= Len(s65534)
          b65517 = b65517 + 1
          s65530 = Mid(s65534, b65517, 1)
          If s65530 = " " Then
            If i65526 = -1 Then
              i65528 = 0
              i65526 = 0
            End If
 2074       If i65528 = -1 Then
              i65528 = 0
              i65526 = -1
            End If
          End If
 2104     Do While b65517 <= Len(s65534) And s65530 = " " Or s65530 = "="
            b65517 = b65517 + 1
            s65530 = Mid(s65534, b65517, 1)
          Loop
 2192     If b65517 <= Len(s65534) Then
            If i65528 = -1 Then
              s65522 = s65522 + s65530
            End If
 2244       If i65526 = -1 Then
              s65518 = s65518 + s65530
            End If
          End If
 2274   Loop
 2280   s5746 = UCase(s65522)
        If o5745 = 0 Then
          s65518 = "GROUP1.LST"
        End If
 2314   s5750 = ProgPath + "disp\" + UCase(s65518)
      End Sub

'! Called 2 times
      Sub Sub2354
        Dim d65394 As Date
        Dim s65396 As String*140

        s65396 = ProgPath + "toallerr.log"
        CurrentDate d65394
        If Exists(s65396) Then
          Open s65396 For Append As 4
        Else
 2427     Open s65396 For Output As 4
        End If
 2448   Beep
        Cls
        Print "@0C@Error @0E@has occured in TOALL.WCX."
        Print
        Print "@0E@Please inform the Sysop of this error."
        WaitEnter
        Print #4, "Error has occured with TOALL.INI on "; FormatDate(d65394, "MM/DD/YYYY")
        Print #4, "Please check that TOALL.INI exists and is formatted correctly!"
        Print #4,
        Close 4
        WaitEnter
        End
      End Sub

'! Called 2 times
      Sub Sub2525
        If o5745 = 0 Then
          t27_5503.s0 = "@8C@<UNREGISTERED>"
          t27_5503.s172 = "@8C@<UNREGISTERED>"
        End If
 2574   Cls
        Print "@0B@To All:@0E@ Utility to send messages to ALL version 1.0.401"
        Print
        Print "@0E@Brought to you by @09@TVS Software."
        Print "@0E@Compiled on: 3\12.1994  @08@(December 3, 1994)"
        Print
        Print "@0E@This Software is Registered to: "
        Print Tab(26); "@0E@SysOp:@0A@ "; t27_5503.s0
        Print Tab(26); "  @0E@BBS:@0A@ "; t27_5503.s172
        Print
        WaitEnter
      End Sub

'! Called 2 times
      Sub Sub2677
        Dim dt65460 As DateTime
        Dim s65466 As String*70

        CurrentDateTime dt65460
        s65466 = User.Name
        mh5895.Flags = mh5895.Flags Or 1
        mh5895.Flags = mh5895.Flags Or 2
        mh5895.Flags = mh5895.Flags Or 8
        mh5895.To = s5820
        mh5895.From = s65466
        mh5895.MsgTime = dt65460 '! 6 bytes
        mh5895.Subject = s6215
      End Sub