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

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

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

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

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

      Type Type26
        s0 As String*70
        s70 As String*70
      End Type

      Declare Function Func870 As Boolean
      Declare Function Func2097 As String
      Declare Sub Sub2136(s65534 As String, b65532 As Byte)
      Declare Sub Sub2563
      Declare Sub Sub2734
      Declare Sub Sub2990

      Dim t27_4463(1 To 260) As Type27
      Dim t28_5503 As Type28
      Dim o5745 As Boolean
      Dim mh5746 As MessageHeader
      Dim s6066 As String*70
      Dim s6136 As String*70
      Dim t26_6206(1 To 15) As Type26
      Dim b8306 As Byte
      Dim s8307 As String
      Dim s8311 As String
      Dim i8316 As Integer
      Dim b8320 As Byte
      Dim b8321 As Byte
      Dim i8322 As Integer
      Dim s8324 As String
      Dim s8328 As String
      Dim s8332 As String

      Dim l65531_ As Long
      Dim b65535_ As Byte

      s8307 = ProgPath + "comment.ini"
      o5745 = Func870
      b8320 = 0
      s8324 = Str(MakeWild.NodeId)
      s8328 = ProgPath + "wcwork\node" + s8324 + "\"
      s8332 = s8328 + "comment.txt"
      If Not Exists(s8307) Then
        Sub2563
      End If
  151 If Exists(s8332) Then
        Del s8332
      End If
  171 Open s8307 For Input As 1
      Open s8332 For Output As 2
  209 Do While Not EOF(1)
        b8306 = b8320
        If Not EOF(1) Then
          b8320 = b8320 + 1
        End If
  259   s8311 = Func2097
        Sub2136(s8311, b8320)
        If b8320 > 20 Then
          Sub2563
        End If
  302 Loop
  308 b8320 = 0
      If RIPDetected Then
        DisplayFile("COMMENTS.RIP")
      Else
  338   If ANSIDetected Then
          DisplayFile("COMMENTS.SCR")
        Else
  362     DisplayFile("COMMENTS.BBS")
        End If
      End If
  371 Print
      i8316 = InputYesNo("@0E@Would you like to leave a comment [@0F@y@0E@/@0F@N@0E@] ", 0)
      Print
      If i8316 Then
        If o5745 <> 0 Then
  414     Do While Not i8322
            Cls
  454       For b8320 = 1 To b8306 Step 1
              Print "@0E@[@0F@"; b8320; "@0E@] "; t26_6206(b8320).s70
            Next
  591       Print
            Print "@0E@What would you like to leave a comment about < @0F@0@0E@ to abort > ? ";
            Input b8321
            If b8321 = 0 Then
              Cls
              Sub2990
              End
            End If
  633       If Str(b8321) <> "" And b8321 > 0 And b8321 < b8306 + 1 Then
              i8322 = -1
            End If
  690     Loop
  696     s6136 = t26_6206(b8321).s0
          s6066 = t26_6206(b8321).s70
        End If
  782   Sub2734
        If EditMessage(mh5746, s8332, 150) Then
          Close 2
          AddMessage(mh5746, s8332, "", 1213417543)
        End If
  832   Del s8332
      End If
  839 Sub2990
      End

'! Called 1 time
      Function Func870 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
        Func870 = 0
        If Not Exists(s65531) Then
          Func870 = 0
        Else
  984     If Not Exists(s65508) Then
            Func870 = 0
          Else
 1011       Open s65531 For Random As 1 Len = 4 '! This value should probably be replaced with a "SizeOf" expression
 1052       For i65515 = 1 To 260 Step 1
              Get 1, i65515, t27_4463(i65515) '! 4 bytes
            Next
 1170       i65527 = i65529
            i65515 = 0
            i65513 = 1
 1193       Do While t27_4463(i65527).s1 <> s65521 And i65515 < 255
              If t27_4463(i65527).s1 = s65512 Then
                If i65513 = 1 Then
                  t28_5503.s0 = s65517
                End If
 1335           If i65513 = 7 Then
                  t28_5503.s172 = s65517
                End If
 1364           s65517 = ""
                i65513 = i65513 + 1
              End If
 1387         s65517 = s65517 + t27_4463(i65527).s1
              i65525 = t27_4463(i65527).i2
              i65527 = i65525
              i65515 = i65515 + 1
            Loop
 1511       t28_5503.s232 = s65517
            Close 1
            If s65517 = "" Then
              Func870 = 0
            Else
 1559         Open s65508 For Input As 2
 1599         For i65527 = 1 To 3 Step 1
                Input #2, s65496(i65527)
              Next
 1708
 1729         For i65515 = 1 To 3 Step 1
                If InStr(UCase(t28_5503.s0), UCase(s65496(i65515))) > 0 Then
                  b65494 = b65494 + 1
                End If
 1850           If InStr(UCase(t28_5503.s172), UCase(s65496(i65515))) > 0 Then
                  b65494 = b65494 + 1
                End If
 1925           If InStr(UCase(s65496(i65515)), UCase(t28_5503.s232)) > 0 Then
                  b65494 = b65494 + 1
                End If
 2000         Next
 2023         If b65494 = 3 Then
                o65495 = -1
              End If
 2046         Close 2
              Func870 = o65495
            End If
          End If
        End If
 2061
      End Function

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

        Input #1, s65528
        Func2097 = s65528
      End Function

'! Called 1 time
      Sub Sub2136(s65534 As String, b65532 As Byte)
        Dim b65515 As Byte
        Dim s65516 As String
        Dim s65520 As String
        Dim i65524 As Integer
        Dim i65526 As Integer
        Dim s65528 As String

        b65515 = 0
        i65526 = -1
        i65524 = 0
 2165   Do While b65515 <= Len(s65534)
          b65515 = b65515 + 1
          s65528 = Mid(s65534, b65515, 1)
          If s65528 = "=" Then
            If i65524 = -1 Then
              i65526 = 0
              i65524 = 0
            End If
 2266       If i65526 = -1 Then
              i65526 = 0
              i65524 = -1
            End If
          End If
 2296     Do While b65515 <= Len(s65534) And s65528 = "="
            b65515 = b65515 + 1
            s65528 = Mid(s65534, b65515, 1)
          Loop
 2371     If b65515 <= Len(s65534) Then
            If i65526 = -1 Then
              s65520 = s65520 + s65528
            End If
 2423       If i65524 = -1 Then
              s65516 = s65516 + s65528
            End If
          End If
 2453   Loop
 2459   t26_6206(b65532).s70 = s65520
        t26_6206(b65532).s0 = UCase(s65516)
      End Sub

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

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

'! Called 1 time
      Sub Sub2734
        Dim s65390 As String*70
        Dim dt65460 As DateTime
        Dim s65466 As String*70

        CurrentDateTime dt65460
        s65466 = User.Name
        mh5746.Flags = mh5746.Flags Or 1
        mh5746.Flags = mh5746.Flags Or 2
        mh5746.Flags = mh5746.Flags Or 8
        If o5745 = 0 Then
          mh5746.To = UCase(MakeWild.SysopName)
        Else
 2880     mh5746.To = s6136
        End If
 2896   mh5746.From = s65466
        mh5746.MsgTime = dt65460 '! 6 bytes
        s65390 = s6066
        Print
        DisplayPrompt 891
        s6066 = InputMask("", "XXXXXXXXXXXXXXXXXXXXXXXXX", s65390, 0)
        mh5746.Subject = s6066
      End Sub

'! Called 2 times
      Sub Sub2990
        If o5745 = 0 Then
          t28_5503.s0 = "@8C@<UNREGISTERED>"
          t28_5503.s172 = "@8C@<UNREGISTERED>"
        End If
 3039   Cls
        Print "@0B@Comment To:@0E@ A Selective comment utility 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@ "; t28_5503.s0
        Print Tab(26); "  @0E@BBS:@0A@ "; t28_5503.s172
        Print
        WaitEnter
      End Sub