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

Wildcat! WCX | 1994-12-05 | 3KB | 287 lines

'! Decompiled with wccNosy version 4.20f (freeware)
'! Input File: in.wcx  3208 bytes  02/01/123  06:46:18am
'! Code Segment Size  :2611 bytes
'! Data Segment Size  :5764 bytes
'! String Segment Size:597 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 Func310 As Boolean
      Declare Function Func1537 As String
      Declare Sub Sub1594(s65534 As String)
      Declare Function Func2002 As Integer
      Declare Function Func2064 As Integer
      Declare Sub Sub2152
      Declare Sub Sub2288
      Declare Sub Sub2459

      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
      Dim s5754 As String
      Dim b5758 As Byte
      Dim s5759 As String
      Dim o5763 As Boolean

      s5754 = ProgPath + "toall.ini"
      o5745 = Func310
      o5763 = 0
      If Not Exists(s5754) Then
        Sub2288
      End If
   92 Open s5754 For Input As 1
      Input #1, b5758
      If b5758 <> 1 And b5758 <> 2 And b5758 <> 3 And b5758 <> 4 And b5758 <> 5 Then
        Sub2288
      End If
  184 Do While Not EOF(1) And o5763 = 0
        s5759 = Func1537
        Sub1594(s5759)
        If Func2002 = -1 Then
          If Func2064 = 0 Then
            Sub2152
            o5763 = -1
          End If
        End If
  272 Loop
  278 Close 1
      Sub2459
      End

'! Called 1 time
      Function Func310 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
        Func310 = 0
        If Not Exists(s65531) Then
          Func310 = 0
        Else
  424     If Not Exists(s65508) Then
            Func310 = 0
          Else
  451       Open s65531 For Random As 1 Len = 4 '! This value should probably be replaced with a "SizeOf" expression
  492       For i65515 = 1 To 260 Step 1
              Get 1, i65515, t26_4463(i65515) '! 4 bytes
            Next
  610       i65527 = i65529
            i65515 = 0
            i65513 = 1
  633       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
  775           If i65513 = 7 Then
                  t27_5503.s172 = s65517
                End If
  804           s65517 = ""
                i65513 = i65513 + 1
              End If
  827         s65517 = s65517 + t26_4463(i65527).s1
              i65525 = t26_4463(i65527).i2
              i65527 = i65525
              i65515 = i65515 + 1
            Loop
  951       t27_5503.s232 = s65517
            Close 1
            If s65517 = "" Then
              Func310 = 0
            Else
  999         Open s65508 For Input As 2
 1039         For i65527 = 1 To 3 Step 1
                Input #2, s65496(i65527)
              Next
 1148
 1169         For i65515 = 1 To 3 Step 1
                If InStr(UCase(t27_5503.s0), UCase(s65496(i65515))) > 0 Then
                  b65494 = b65494 + 1
                End If
 1290           If InStr(UCase(t27_5503.s172), UCase(s65496(i65515))) > 0 Then
                  b65494 = b65494 + 1
                End If
 1365           If InStr(UCase(s65496(i65515)), UCase(t27_5503.s232)) > 0 Then
                  b65494 = b65494 + 1
                End If
 1440         Next
 1463         If b65494 = 3 Then
                o65495 = -1
              End If
 1486         Close 2
              Func310 = o65495
            End If
          End If
        End If
 1501
      End Function

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

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

'! Called 1 time
      Sub Sub1594(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
 1623   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
 1724       If i65528 = -1 Then
              i65528 = 0
              i65526 = -1
            End If
          End If
 1754     Do While b65517 <= Len(s65534) And s65530 = " " Or s65530 = "="
            b65517 = b65517 + 1
            s65530 = Mid(s65534, b65517, 1)
          Loop
 1842     If b65517 <= Len(s65534) Then
            If i65528 = -1 Then
              s65522 = s65522 + s65530
            End If
 1894       If i65526 = -1 Then
              s65518 = s65518 + s65530
            End If
          End If
 1924   Loop
 1930   s5746 = UCase(s65522)
        If o5745 = 0 Then
          s65518 = "group1.lst"
        End If
 1964   s5750 = ProgPath + "disp\" + UCase(s65518)
      End Sub

'! Called 1 time
      Function Func2002 As Integer
        Func2002 = 0
        If User.SecLevel = s5746 Then
          Func2002 = -1
          Print "Compared = true"
        End If
 2056
      End Function

'! Called 1 time
      Function Func2064 As Integer
        Func2064 = 0
        If User.Comment(b5758) = "ADDED" Then
          Func2064 = -1
        End If
 2140
      End Function

'! Called 1 time
      Sub Sub2152
        If Not Exists(s5750) Then
          Open s5750 For Output As 3
        Else
 2201     Open s5750 For Append As 3
        End If
 2220   Print #3, User.Name
        Close 3
        User.Comment(b5758) = "ADDED"
      End Sub

'! Called 2 times
      Sub Sub2288
        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
 2361     Open s65396 For Output As 4
        End If
 2382   Beep
        Cls
        Print "@0C@Error @0E@has occured in TOALLSET.WCX."
        Print
        Print "@0E@Please inform the Sysop of this error."
        WaitEnter
        Print #4, "Error has occured with TOALLSET.INI on "; FormatDate(d65394, "MM/DD/YYYY")
        Print #4, "Please check that TOALLSET.INI exists and is formatted correctly!"
        Print #4,
        Close 4
        WaitEnter
        End
      End Sub

'! Called 1 time
      Sub Sub2459
        If o5745 = 0 Then
          t27_5503.s0 = "@8C@<UNREGISTERED>"
          t27_5503.s172 = "@8C@<UNREGISTERED>"
        End If
 2508   Cls
        Print "@0B@To All Setup:@0E@ Update utility for 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