script.cls

完整的主机服务器, (含代码).程序会监视联结到主机程序上的所有机器.可是设置开启端口,最多用户..非常完整.!

   
BAILMEOUT:
   ' ucase(lcase(forname) & ' ' & lcase(surname))
   '      a                                    cc
   
   a = InStr(para$, "(")
   b = Len(para$)
   For c = b To 1 Step -1
      If Mid$(para$, c, 1) = ")" Then x = x + 1
      If Mid$(para$, c, 1) <> ")" Then GoTo ALLOUT
      
   Next c
   
ALLOUT:
   
   x = x - 1
   
   z$ = Mid$(para$, a + 1, Len(para$) - a - x)
   
   'Debug.Print "z$=" & z$
   'ucase(lcase(ucase('name')))
   'ucase(lcase('NAME'))
   'ucase('name')
   
   If Left$(para$, 3) = "int" Then
        ParseParam = Str$(Int(Val(LCase(ParseParam(Mid(para$, 5, Len(para$) - 5))))))
        Exit Function
    End If
   
   If Left$(para$, 5) = "lcase" Then
      ParseParam = LCase(ParseParam(Mid$(para$, 7, Len(para$) - 7)))
      Exit Function
   End If
   
   If Left$(para$, 5) = "ucase" Then
      ParseParam = UCase(ParseParam(Mid$(para$, 7, Len(para$) - 7)))
      Exit Function
   End If
   
    If Left$(para$, 3) = "len" Then
        ParseParam = Trim$(Str$(Len(ParseParam(GetParam(para$, 0)))))
        Exit Function
    End If
        
    If Left$(para$, 5) = "ltrim" Then
        ParseParam = LTrim(ParseParam(Mid$(para$, 7, Len(para$) - 7)))
        Exit Function
    End If
    
    If Left$(para$, 5) = "rtrim" Then
        ParseParam = RTrim(ParseParam(Mid$(para$, 7, Len(para$) - 7)))
        Exit Function
    End If
    
    If Left$(para$, 4) = "trim" Then
        ParseParam = Trim(ParseParam(Mid$(para$, 6, Len(para$) - 6)))
    End If
   
   If Left$(para$, 3) = "rnd" Then
      d1 = Val(ParseParam(GetParam(para$, 0)))
      d2 = Val(ParseParam(GetParam(para$, 1)))
      j = (Rnd(1) * (d2 - d1)) + d1
      ParseParam = Trim$(Str$(j))
      Exit Function
   End If
   
   If Left$(para$, 4) = "left" Then
        r1$ = ParseParam(GetParam(para$, 0))
        d1 = Val(ParseParam(GetParam(para$, 1)))
        ParseParam = Left$(r1$, d1)
        Exit Function
    End If

    If Left$(para$, 5) = "right" Then
        r1$ = ParseParam(GetParam(para$, 0))
        d1 = Val(ParseParam(GetParam(para$, 1)))
        ParseParam = Right$(r1$, d1)
        Exit Function
    End If
    
    If Left$(para$, 9) = "uridecode" Then
        r1$ = ParseParam(GetParam(para$, 0))
        ParseParam = RidFormatting(r1$)
    End If
    
    If Left$(para$, 7) = "replstr" Then
        ' replstr stringname, find, replace
        r1$ = ParseParam(GetParam(para$, 0))
        r2$ = ParseParam(GetParam(para$, 1))
        r3$ = ParseParam(GetParam(para$, 2))
        temp1$ = ReplaceStr(r1$, r2$, r3$)
        ParseParam = temp1$
    End If
        
   If Left$(para$, 3) = "mid" Then
      rl$ = ParseParam(GetParam(para$, 0))
      d1 = Val(ParseParam(GetParam(para$, 1)))
      d2 = Val(ParseParam(GetParam(para$, 2)))
      ParseParam = Mid$(rl$, d1, d2)
      Exit Function
   End If
   
    If Left$(para$, 6) = "revstr" Then
        r1$ = ParseParam(GetParam(para$, 0))
        ParseParam = RevStr(r1$)
        Exit Function
    End If
        
    If Left$(para$, 3) = "chr" Then
        d1 = Val(ParseParam(GetParam(para$, 0)))
        ParseParam = Chr$(d1)
    End If
   
    If Left$(para$, 3) = "asc" Then
        ds2$ = ParseParam(GetParam(para$, 0))
        ParseParam = Trim$(Str$(Asc(ds2$)))
    End If
    
    If Left$(para$, 3) = "eof" Then
        ds2$ = ParseParam(GetParam(para$, 0))
        ff$ = Trim$(Str$(EOF(file(Val(ds2$)))))
        If ff$ = "True" Then ff$ = "-1"
        If ff$ = "False" Then ff$ = "0"
        ParseParam = ff$
    End If
    
    If Left$(para$, 5) = "instr" Then
        ds2$ = "": ds3$ = "": ds4$ = ""
        ds2$ = ParseParam(GetParam(para$, 0))
        ds3$ = ParseParam(GetParam(para$, 1))
        ds4$ = ParseParam(GetParam(para$, 2))
        cd234$ = Trim$(Str$(InStr(Val(ds2$), ds3$, ds4$)))
        ParseParam = cd234$
    End If
        
    If Left$(para$, 9) = "b64decode" Then
        ds2$ = ""
        ds2$ = ParseParam(GetParam(para$, 0))
        ParseParam = B64.Decode(ds2$)
        Exit Function
    End If
    
    If Left$(para$, 9) = "b64encode" Then
        ds2$ = ""
        ds2$ = ParseParam(GetParam(para$, 0))
        ParseParam = B64.Encode(ds2$)
        Exit Function
    End If
    
    If Left$(para$, 10) = "is2edecode" Then
        ds2$ = "": ds3$ = ""
        ds2$ = ParseParam(GetParam(para$, 0))
        ds3$ = ParseParam(GetParam(para$, 1))
        ParseParam = m_is2e.Decrypt(ds2$, ds3$)
        Exit Function
    End If
    
    If Left$(para$, 10) = "is2eencode" Then
        ds2$ = "": ds3$ = ""
        ds2$ = ParseParam(GetParam(para$, 0))
        ds3$ = ParseParam(GetParam(para$, 1))
        ParseParam = m_is2e.Encrypt(ds2$, ds3$)
        Exit Function
    End If
    
    If Left$(para$, 9) = "preformat" Then
        ds2$ = "": ds3$ = ""
        ds2$ = ParseParam(GetParam(para$, 0))
        ParseParam = UnRidFormatting(ds2$)
        Exit Function
    End If
    
    Exit Function
ParseParamErrCheck:
    WXB CURRENTSOCK, "Scripting Error - " & Err.Description
    sx(sck).Reqok = True
End Function


Public Function IsInteger(pint_name As String) As Integer
   Dim t As Integer
   For t = 0 To toti
      If pint_name$ = inn$(t) & "%" Then IsInteger = 1: Exit Function
   Next t
   IsInteger = 0
End Function

Public Sub CreateInteger(int_name As String, Optional int_data As Integer)
   Dim t As Integer
   For t = 0 To 1000
      If inn$(t) = "" Then inn$(t) = int_name$: ind(t) = int_data: toti = t + 1: Exit Sub
      If t = 500 Then DoEvents
   Next t
End Sub

Public Function GetInteger(int_name As String) As Integer
   Dim t As Integer
   For t = 0 To toti
      If inn$(t) & "%" = int_name$ Then GetInteger = ind(t): Exit Function
      If t = 500 Then DoEvents
   Next t
End Function

Public Sub DeleteInteger(int_name As String)
   Dim t As Integer
   For t = 0 To toti
      If inn$(t) & "%" = int_name$ Then inn$(t) = "": ind(t) = 0: Exit Sub
      If t = 500 Then DoEvents
   Next t
End Sub

Public Sub SetInteger(int_name As String, int_data As Integer)
   Dim t As Integer
   For t = 0 To toti
      If inn$(t) & "%" = int_name$ Then ind(t) = int_data: Exit Sub
      If t = 500 Then DoEvents
   Next t
End Sub

Public Function IsString(pstring_name As String) As Integer
   Dim t As Integer
   For t = 0 To tots
      If pstring_name$ = stn$(t) & "$" Then IsString = 1: Exit Function
   Next t
   IsString = 0
End Function



Public Sub CreateString(string_name As String, Optional string_data As String)
   Dim t As Integer
   If Right$(string_name$, 1) = "$" Then string_name$ = Left$(string_name$, Len(string_name$) - 1)
   For t = 0 To 1000
      If stn$(t) = "" Then stn$(t) = string_name: std$(t) = string_data: tots = t + 1: Exit Sub
      If t = 500 Then DoEvents
   Next t
End Sub

Public Function GetString(string_name As String) As String
   For t = 0 To tots
      If stn$(t) & "$" = string_name$ Then GetString = std$(t): Exit Function
      If t = 500 Then DoEvents
   Next t
End Function

Public Sub DeleteString(string_name As String)
   For t = 0 To tots
      If stn$(t) & "$" = string_name$ Then stn$(t) = "": std$(t) = "": Exit Sub
      If t = 500 Then DoEvents
   Next t
End Sub

Public Sub SetString(string_name As String, string_data As String)
   'Debug.Print "SetString(" & string_name$ & "," & string_data$ & ")"
   For t = 0 To tots
      If stn$(t) & "$" = string_name$ Then std$(t) = string_data$: Exit Sub
      If t = 500 Then DoEvents
   Next t
End Sub

Public Function GetConst(poss_const As String) As String
   Select Case poss_const
      Case "#time"
         r$ = Time$
      Case "#date"
         r$ = Date$
      Case "#timer"
         r$ = Trim$(Str$(Timer))
      Case "#svname"
         r$ = Longbow.ServerName
      Case "#svadmin"
         r$ = Longbow.ServerAdmin
   End Select
   GetConst = r$
End Function

Public Function GetParam(ByVal comd As String, paramnum As Integer) As String
Dim d$(200)
Dim iq As Boolean
Dim dd As Integer
Dim a As Integer
Dim b As Integer
Dim c$
Dim ij As Integer
Dim wc As Integer

dd = InStr(comd$, "(")
comd$ = Right$(comd$, Len(comd$) - dd)
comd$ = Left$(comd$, Len(comd$) - 1)
a = Len(comd$)
iq = False: ij = 0
For b = 1 To a
   c$ = Mid$(comd$, b, 1)
   If c$ = "(" And iq = False Then ij = ij + 1
   If c$ = ")" And iq = False Then ij = ij - 1
   If c$ = "'" Then iq = Not iq
   If c$ = "," And iq = False And ij = 0 Then wc = wc + 1: c$ = ""
   d$(wc) = d$(wc) & c$
Next b
GetParam = d$(paramnum)
End Function

Public Sub SecureCopy(src As String, dest As String)
   On Error GoTo SECCOPYERROR
   FileCopy src, dest
   Exit Sub
SECCOPYERROR:
End Sub

Public Sub ScriptTidy()
    Dim t As Integer
    ' Tidy up the scripting resources when the script ends

    ' Close all open files
    For t = 0 To 10
        If file(t) <> 0 Then Close file(t): filea(t) = 0
    Next t
    
    ' Clear the picture box
        fsu.pic(CURRENTSOCK).Cls
        fsu.di(CURRENTSOCK).Path = Longbow.DefaultRoot
        fsu.fi(CURRENTSOCK).Path = Longbow.DefaultRoot
    
End Sub