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

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

'! Decompiled with wccNosy version 4.20f (freeware)
'! Input File: in.wcx  3793 bytes  02/01/123  06:46:18am
'! Code Segment Size  :2892 bytes
'! Data Segment Size  :5897 bytes
'! String Segment Size:901 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 Func333 As Boolean
      Declare Sub Sub1560
      Declare Function Func1893 As String
      Declare Sub Sub2237
      Declare Sub Sub2418
      Declare Sub Sub2445(s65534 As String)
      Declare Sub Sub2740

      Dim t26_4463(1 To 260) As Type26
      Dim t27_5503 As Type27
      Dim s5745 As String*140
      Dim o5885 As Boolean
      Dim b5886 As Byte
      Dim b5887 As Byte
      Dim i5888 As Integer
      Dim s5890 As String
      Dim b5894 As Byte
      Dim i5895 As Integer

      s5745 = ProgPath + "forcebul.ini"
      b5886 = 1
      b5887 = 0
      i5888 = 0
      i5895 = 0
      o5885 = Func333
      If Not Exists(s5745) Then
        Sub2237
      End If
  115 Sub1560
      Open s5745 For Input As 1
  142 Do While i5895 = 0
        s5890 = Func1893
        If EOF(1) Then
          i5895 = -1
        End If
  185   If i5895 = 0 Then
          If s5890 = "times" Then
            If b5887 < User.TimesOn Then
              Sub2418
            End If
  245       s5890 = Func1893
          End If
  255     b5894 = 1
          If Not Exists(s5890) Then
            b5894 = 0
          End If
  283     If b5894 = 1 Then
            Sub2445(s5890)
          End If
        End If
  307 Loop
  313 Sub2740
      Close 1
      End

'! Called 1 time
      Function Func333 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
        Func333 = 0
        If Not Exists(s65531) Then
          Func333 = 0
        Else
  447     If Not Exists(s65508) Then
            Func333 = 0
          Else
  474       Open s65531 For Random As 1 Len = 4 '! This value should probably be replaced with a "SizeOf" expression
  515       For i65515 = 1 To 260 Step 1
              Get 1, i65515, t26_4463(i65515) '! 4 bytes
            Next
  633       i65527 = i65529
            i65515 = 0
            i65513 = 1
  656       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
  798           If i65513 = 7 Then
                  t27_5503.s172 = s65517
                End If
  827           s65517 = ""
                i65513 = i65513 + 1
              End If
  850         s65517 = s65517 + t26_4463(i65527).s1
              i65525 = t26_4463(i65527).i2
              i65527 = i65525
              i65515 = i65515 + 1
            Loop
  974       t27_5503.s232 = s65517
            Close 1
            If s65517 = "" Then
              Func333 = 0
            Else
 1022         Open s65508 For Input As 2
 1062         For i65527 = 1 To 3 Step 1
                Input #2, s65496(i65527)
              Next
 1171
 1192         For i65515 = 1 To 3 Step 1
                If InStr(UCase(t27_5503.s0), UCase(s65496(i65515))) > 0 Then
                  b65494 = b65494 + 1
                End If
 1313           If InStr(UCase(t27_5503.s172), UCase(s65496(i65515))) > 0 Then
                  b65494 = b65494 + 1
                End If
 1388           If InStr(UCase(s65496(i65515)), UCase(t27_5503.s232)) > 0 Then
                  b65494 = b65494 + 1
                End If
 1463         Next
 1486         If b65494 = 3 Then
                o65495 = -1
              End If
 1509         Close 2
              Func333 = o65495
            End If
          End If
        End If
 1524
      End Function

'! Called 1 time
      Sub Sub1560
        Dim i65388 As Integer
        Dim s65392 As String
        Dim s65396 As String*140

        i65388 = -1
        If ANSIEnabled Then
          s65396 = ProgPath + "disp\" + "forcebul.scr"
          If Not Exists(s65396) Then
            s65396 = ProgPath + "disp\" + "forcebul.bbs"
            If Not Exists(s65396) Then
              Cls
              Print "@0E@You will need to view some files as chosen by the SysOp"
              Print "This is mandetory. Thank you."
              Print
              Print "                                    @0A@The Management"
              Print
              WaitEnter
              i65388 = 0
            End If
          End If
 1709   Else
 1715     s65396 = ProgPath + "disp\" + "forcebul.bbs"
        End If
 1738   If i65388 = -1 Then
          Open s65396 For Input As 2
          i5888 = 0
          Input #2, s65392
 1788     Do While Not EOF(2)
            Print s65392
            Input #2, s65392
            i5888 = i5888 + 1
            If i5888 >= User.LinesPerPage - 3 Then
              WaitEnter
              i5888 = 0
              Cls
            End If
 1869     Loop
 1875     WaitEnter
        End If
 1878   Print s65392
      End Sub

'! Called 2 times
      Function Func1893 As String
        Dim s65521 As String
        Dim i65525 As Integer
        Dim b65527 As Byte
        Dim s65528 As String

        b65527 = 0
        i65525 = -1
        Input #1, s65528
        If EOF(1) Then
          Sub2418
        End If
 1940   If InStr(";", s65528) = 1 Or InStr(" ", s65528) = 1 Or s65528 = "" Then
          b5886 = b5886 + 1
        End If
 2007   If b5886 > 1 And b5887 = 0 Then
          Sub2237
        End If
 2038   If b5886 = 1 Then
          b5887 = Val(s65528)
          If b5887 < 0 Or b5887 > 10 Then
            End
          End If
 2091     Func1893 = "times"
          i65525 = 0
        End If
 2106   b5886 = b5886 + 1
        If i65525 = -1 Then
          s65521 = s65528 + ".scr"
          s65528 = s65528 + ".bbs"
          If ANSIEnabled Then
            If Exists(s65521) Then
              s65528 = s65521
            End If
          End If
 2196     Func1893 = s65528
          b5886 = b5886 + 1
        End If
 2218
      End Function

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

        s65396 = ProgPath + "errorfb.log"
        CurrentDate d65394
        If Exists(s65396) Then
          Open s65396 For Append As 4
        Else
 2310     Open s65396 For Output As 4
        End If
 2331   Beep
        Cls
        Print "@0C@Error @0E@has occured in FORCEBUL.WCX."
        Print
        Print "@0E@Please inform the Sysop of this error."
        WaitEnter
        Print #4, "Error has occured with FORCEBUL.INI on "; FormatDate(d65394, "MM/DD/YYYY")
        Print #4, "Please check that FORCEBUL.INI exists AND that it is formatted"
        Print #4, "properly. Consult the documentation for further information"
        Print #4,
        Close 4
        WaitEnter
        End
      End Sub

'! Called 2 times
      Sub Sub2418
        Sub2740
        Close 1
        Cls
        End
      End Sub

'! Called 1 time
      Sub Sub2445(s65534 As String)
        Dim s65530 As String

        If o5885 = 0 Then
          If RIPDetected Then
            s65534 = ProgPath + "bull\bull1.rip"
          Else
 2499       If ANSIDetected Then
              s65534 = ProgPath + "bull\bull1.scr"
              If Not Exists(s65534) Then
                s65534 = ProgPath + "bull\bull1.bbs"
              End If
 2557       Else
 2563         s65534 = ProgPath + "bull\bull1.bbs"
            End If
          End If
        End If
 2579   Open s65534 For Input As 3
        i5888 = 0
        Input #3, s65530
 2613   Do While Not EOF(3)
          Print s65530
          Input #3, s65530
          i5888 = i5888 + 1
          If i5888 >= User.LinesPerPage - 3 Then
            i5888 = 0
            WaitEnter
            Cls
          End If
 2694   Loop
 2700   If s65530 <> "" Then
          Print s65530
        End If
 2725   WaitEnter
        Close 3
      End Sub

'! Called 2 times
      Sub Sub2740
        If o5885 = 0 Then
          t27_5503.s0 = "@8C@<UNREGISTERED>"
          t27_5503.s172 = "@8C@<UNREGISTERED>"
        End If
 2789   Cls
        Print "@0B@ForceBulletin:@0E@ Bulletin reader for New Users 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