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

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

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

      Type Type28
        Filler0(1 To 24) As Byte
        w24 As Word
      End Type

      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 Func346 As Boolean
      Declare Sub Sub1573
      Declare Function Func1906 As String
      Declare Sub Sub2094
      Declare Sub Sub2275
      Declare Sub Sub2302(s65534 As String)
      Declare Sub Sub2597
      Declare Function Func2749(sr65534 As SearchRec, d65532 As Date) As Integer

      Dim t26_4463(1 To 260) As Type26
      Dim t27_5503 As Type27
      Dim s5745 As String*140
      Dim o5885 As Boolean
      Dim i5886 As Integer
      Dim s5888 As String
      Dim b5892 As Byte
      Dim i5893 As Integer
      Dim sr5895 As SearchRec
      Dim d5944 As Date

      s5745 = ProgPath + "forcenws.ini"
      i5886 = 0
      i5893 = 0
      o5885 = Func346
      d5944 = User.LastCall.D '! 2 bytes
      If Not Exists(s5745) Then
        Sub2094
      End If
  116 Sub1573
      Open s5745 For Input As 1
  143 Do While i5893 = 0
        s5888 = Func1906
        If i5893 = 0 Then
          If Exists(s5888) Then
            FindFirst(s5888, 0, sr5895)
            If Func2749(sr5895, d5944) = -1 Then
              b5892 = 1
            End If
          End If
  236     If Not Exists(s5888) Then
            b5892 = 0
          End If
  257     If b5892 = 1 Then
            Sub2302(s5888)
            If o5885 = 0 Then
              GoTo 326
            End If
          End If
        End If
  301   If EOF(1) Then
          i5893 = -1
        End If
  320 Loop
  326 Sub2597
      Close 1
      End

'! Called 1 time
      Function Func346 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
        Func346 = 0
        If Not Exists(s65531) Then
          Func346 = 0
        Else
  460     If Not Exists(s65508) Then
            Func346 = 0
          Else
  487       Open s65531 For Random As 1 Len = 4 '! This value should probably be replaced with a "SizeOf" expression
  528       For i65515 = 1 To 260 Step 1
              Get 1, i65515, t26_4463(i65515) '! 4 bytes
            Next
  646       i65527 = i65529
            i65515 = 0
            i65513 = 1
  669       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
  811           If i65513 = 7 Then
                  t27_5503.s172 = s65517
                End If
  840           s65517 = ""
                i65513 = i65513 + 1
              End If
  863         s65517 = s65517 + t26_4463(i65527).s1
              i65525 = t26_4463(i65527).i2
              i65527 = i65525
              i65515 = i65515 + 1
            Loop
  987       t27_5503.s232 = s65517
            Close 1
            If s65517 = "" Then
              Func346 = 0
            Else
 1035         Open s65508 For Input As 2
 1075         For i65527 = 1 To 3 Step 1
                Input #2, s65496(i65527)
              Next
 1184
 1205         For i65515 = 1 To 3 Step 1
                If InStr(UCase(t27_5503.s0), UCase(s65496(i65515))) > 0 Then
                  b65494 = b65494 + 1
                End If
 1326           If InStr(UCase(t27_5503.s172), UCase(s65496(i65515))) > 0 Then
                  b65494 = b65494 + 1
                End If
 1401           If InStr(UCase(s65496(i65515)), UCase(t27_5503.s232)) > 0 Then
                  b65494 = b65494 + 1
                End If
 1476         Next
 1499         If b65494 = 3 Then
                o65495 = -1
              End If
 1522         Close 2
              Func346 = o65495
            End If
          End If
        End If
 1537
      End Function

'! Called 1 time
      Sub Sub1573
        Dim i65390 As Integer
        Dim s65392 As String
        Dim s65396 As String*140

        i65390 = -1
        If ANSIEnabled Then
          s65396 = ProgPath + "disp\" + "forcenws.scr"
          If Not Exists(s65396) Then
            s65396 = ProgPath + "disp\" + "forcenws.bbs"
            If Not Exists(s65396) Then
              Cls
              Print "@0E@You will need to view updated files as chosen by the SysOp"
              Print "This is mandetory. Thank you."
              Print
              Print "                                    @0A@The Management"
              Print
              WaitEnter
              i65390 = 0
            End If
          End If
 1722   Else
 1728     s65396 = ProgPath + "disp\" + "forcenws.bbs"
        End If
 1751   If i65390 = -1 Then
          Open s65396 For Input As 2
          i5886 = 0
          Input #2, s65392
 1801     Do While Not EOF(2)
            Print s65392
            Input #2, s65392
            i5886 = i5886 + 1
            If i5886 >= User.LinesPerPage - 3 Then
              WaitEnter
              i5886 = 0
              Cls
            End If
 1882     Loop
 1888     WaitEnter
        End If
 1891   Print s65392
      End Sub

'! Called 1 time
      Function Func1906 As String
        Dim s65523 As String
        Dim b65527 As Byte
        Dim s65528 As String

        b65527 = 0
        Input #1, s65528
        If EOF(1) Then
          Sub2275
        End If
 1945   If Not (InStr(";", s65528) = 1 Or InStr(" ", s65528) = 1 Or s65528 = "") Then
          b65527 = 1
        End If
 2007   s65523 = s65528 + ".scr"
        s65528 = s65528 + ".bbs"
        If ANSIEnabled Then
          If Exists(s65523) Then
            s65528 = s65523
          End If
        End If
 2067   Func1906 = s65528
      End Function

'! Called 1 time
      Sub Sub2094
        Dim d65394 As Date
        Dim s65396 As String*140

        s65396 = ProgPath + "errorfn.log"
        CurrentDate d65394
        If Exists(s65396) Then
          Open s65396 For Append As 4
        Else
 2167     Open s65396 For Output As 4
        End If
 2188   Beep
        Cls
        Print "@0C@Error @0E@has occured in FORCENWS.WCX."
        Print
        Print "@0E@Please inform the Sysop of this error."
        WaitEnter
        Print #4, "Error has occured with FORCENWS.INI on "; FormatDate(d65394, "MM/DD/YYYY")
        Print #4, "Please check that FORCENWS.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 1 time
      Sub Sub2275
        Sub2597
        Close 1
        Cls
        End
      End Sub

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

        If o5885 = 0 Then
          If RIPDetected Then
            s65534 = ProgPath + "disp\newsltr.rip"
          Else
 2356       If ANSIDetected Then
              s65534 = ProgPath + "disp\newsltr.scr"
              If Not Exists(s65534) Then
                s65534 = ProgPath + "disp\newsltr.bbs"
              End If
 2414       Else
 2420         s65534 = ProgPath + "disp\newsltr.bbs"
            End If
          End If
        End If
 2436   Open s65534 For Input As 3
        i5886 = 0
        Input #3, s65530
 2470   Do While Not EOF(3)
          Print s65530
          Input #3, s65530
          i5886 = i5886 + 1
          If i5886 >= User.LinesPerPage - 3 Then
            i5886 = 0
            WaitEnter
            Cls
          End If
 2551   Loop
 2557   If s65530 <> "" Then
          Print s65530
        End If
 2582   WaitEnter
        Close 3
      End Sub

'! Called 2 times
      Sub Sub2597
        If o5885 = 0 Then
          t27_5503.s0 = "@8C@<UNREGISTERED>"
          t27_5503.s172 = "@8C@<UNREGISTERED>"
        End If
 2646   Cls
        Print "@0B@ForceNews:@0E@ Updated files reader 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 1 time
      Function Func2749(sr65534 As SearchRec, d65532 As Date) As Integer
        Dim i65518 As Integer
        Dim i65520 As Integer
        Dim i65522 As Integer
        Dim i65524 As Integer
        Dim i65526 As Integer
        Dim i65528 As Integer

        i65528 = sr65534.DOSDate And 31
        i65522 = d65532.Day
        i65526 = sr65534.DOSDate Div 32 And 15
        i65520 = d65532.Month
        i65524 = 1980 + sr65534.DOSDate Div 512
        i65518 = d65532.Year
        If i65524 > i65518 Then
          Func2749 = -1
        Else
 2899     If i65524 < i65518 Then
            Func2749 = 0
          Else
 2929       If i65526 >= i65520 Then
              If (i65528 >= i65522) = 0 Then GoTo 2979
              Func2749 = -1
            Else
 2979         Func2749 = 0
            End If
          End If
        End If
 2985
      End Function