script.cls

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

                        'If p$(h) <> "" Then Debug.Print p$(h)
                        If w$(h + 1) <> "" Then
                           SetString w$(h + 1), p$(h)
                        End If
                     Next h
                  End If
               End If
               
               If cmd$ = "fread" Then
                  If file(Val(w$(1))) <> 0 Then
                     Input #file(Val(w$(1))), g$
                     If IsString(w$(2)) = 1 Then SetString w$(2), g$
                     If IsInteger(w$(2)) = 1 Then SetInteger w$(2), Val(g$)
                  End If
                  GoTo WIPEOUT
               End If
               
               If cmd$ = "file" Then
                  Select Case w$(1)
                     
                     Case "openappend"
                        'Debug.Print "OPENING FOR APPEND"
                        w$(2) = ParseParam(w$(2))
                        xx = Val(w$(3))
                        If file(xx) = 0 Then
                            file(xx) = FreeFile
                            If InStr(w$(2), "..") Or InStr(w$(2), Longbow.SecurityFile) Then
                                WXB sck, "Script Security Prevented This Script From Being Run"
                                sx(sck).Reqok = True
                                GoTo WIPEOUT
                            End If
                            Open GetDirectory(filename$) & w$(2) For Append As file(xx)
                        End If
                     
                     Case "openin"
                        w$(2) = ParseParam(w$(2))
                        xx = Val(w$(3))
                        If file(xx) = 0 Then
                           file(xx) = FreeFile
                           If InStr(w$(2), "..") Or InStr(w$(2), Longbow.SecurityFile) Then
                              WXB sck, "Script Security Prevented This Script From Being Run"
                              sx(sck).Reqok = True
                              GoTo WIPEOUT
                           End If
                           If Exists(GetDirectory(filename$) & w$(2)) = 1 Then
                              Open GetDirectory(filename$) & w$(2) For Input As file(xx)
                           Else
                              file(xx) = 0: filea(xx) = 0
                           End If
                        End If
                     
                     Case "openout"
                        w$(2) = ParseParam(w$(2))
                        xx = Val(w$(3))
                        If file(xx) = 0 Then
                           file(xx) = FreeFile
                           If InStr(w$(2), "..") Or InStr(w$(2), Longbow.SecurityFile) Then
                              WXB sck, "Script Security Prevented This Script From Being Run"
                              sx(sck).Reqok = True
                              GoTo WIPEOUT
                           End If
                           Open GetDirectory(filename$) & w$(2) For Output As file(xx)
                        End If
                     
                     Case "close"
                        If file(Val(w$(2))) <> 0 Then
                           Close file(Val(w$(2)))
                           file(Val(w$(2))) = 0
                           filea(Val(w$(2))) = 0
                        End If
                     
                     Case "kill"
                        If Exists(GetDirectory(filename$) & w$(2)) = 1 Then
                           Kill GetDirectory(filename$) & w$(2)
                        End If
                     
                     Case "copy"
                        If Exists(GetDirectory(filename$) & w$(2)) = 1 Then
                           SecureCopy GetDirectory(filename$) & w$(2), GetDirectory(filename$) & w$(3)
                        End If
                  End Select
                  GoTo WIPEOUT
               End If
               
               If cmd$ = "image" Then
                    If InStr(w$(2), "..") Then
                        WXB sck, "Script Security Error"
                        sx(sck).Reqok = True
                        GoTo WIPEOUT
                    End If

                    Select Case w$(1)
                        
                        Case "font"
                            rtt$ = ParseParam(w$(2))
                            fsu.pic(sck).Font = rtt$
                        Case "fontbold"
                            fsu.pic(sck).FontBold = True
                        Case "fontnobold"
                            fsu.pic(sck).FontBold = False
                        Case "fontitalic"
                            fsu.pic(sck).FontItalic = True
                        Case "fontnoitalic"
                            fsu.pic(sck).FontItalic = False
                        Case "fontunderline"
                            fsu.pic(sck).FontUnderline = True
                        Case "fontnounderline"
                            fsu.pic(sck).FontUnderline = False
                        Case "fontstrikethru"
                            fsu.pic(sck).FontStrikethru = True
                        Case "fontnostrikethru"
                            fsu.pic(sck).FontStrikethru = False
                        Case "fontsize"
                            rs1 = Val(ParseParam(w$(2)))
                            fsu.pic(sck).FontSize = rs1
                        Case "currentx"
                            rs1 = Val(ParseParam(w$(2)))
                            fsu.pic(sck).CurrentX = rs1
                        Case "currenty"
                            rs1 = Val(ParseParam(w$(2)))
                            fsu.pic(sck).CurrentY = rs1
                        Case "pset"
                            fsu.pic(sck).PSet (Val(ParseParam(w$(2))), Val(ParseParam(w$(3))))
                        Case "line"
                            fsu.pic(sck).Line (Val(ParseParam(w$(2))), Val(ParseParam(w$(3))))-(Val(ParseParam(w$(4))), Val(ParseParam(w$(5))))
                        Case "circle"
                            fsu.pic(sck).Circle (Val(ParseParam(w$(2))), Val(ParseParam(w$(2)))), Val(ParseParam(w$(2)))
                        Case "box"
                            fsu.pic(sck).Line (Val(ParseParam(w$(2))), Val(ParseParam(w$(3))))-(Val(ParseParam(w$(4))), Val(ParseParam(w$(5)))), , B
                        Case "rect"
                            fsu.pic(sck).Line (Val(ParseParam(w$(2))), Val(ParseParam(w$(3))))-(Val(ParseParam(w$(4))), Val(ParseParam(w$(5)))), , BF
                        Case "write"
                            fsu.Print ParseParam(w$(2))
                        Case "copyrect"
                            DESTX = Val(ParseParam(w$(2)))
                            DESTY = Val(ParseParam(w$(3)))
                            SRCX = Val(ParseParam(w$(4)))
                            SRCY = Val(ParseParam(w$(5)))
                            RECTWIDTH = Val(ParseParam(w$(6)))
                            RECTHEIGHT = Val(ParseParam(w$(7)))
                            m_imutils.BitBlt fsu.pic(sck).hdc, DESTX, DESTY, RECTWIDTH, RECTHEIGHT, fsu.pic(sck).hdc, SRCX, SRCY, SRCCOPY
                            fsu.pic(sck).Refresh
                        Case "width"
                            rt1 = Val(ParseParam(w$(2)))
                            If rt1 > 640 Then rt1 = 640
                            fsu.pic(sck).ScaleWidth = rt1
                        Case "height"
                            rt1 = Val(ParseParam(w$(2)))
                            If rt1 > 640 Then rt! = 480
                            fsu.pic(sck).ScaleHeight = rt1
                        Case "back"
                            rt1 = Val(ParseParam(w$(2)))
                            fsu.pic(sck).BackColor = rt1
                        Case "clear"
                            fsu.pic(sck).Cls
                        Case "fore"
                            rt1 = Val(ParseParam(w$(2)))
                            fsu.pic(sck).ForeColor = rt1
                        Case "penwidth"
                            rt1 = Val(ParseParam(w$(2)))
                            fsu.pic(sck).DrawWidth = rt1
                        Case "load"
                            fsu.pic(sck).Picture = LoadPicture(GetDirectory(filename) & ParseParam(w$(2)))
                        Case "quality"
                            IMGQUAL = Val(ParseParam(w$(2)))
                        Case "save"
                            SavePicture fsu.pic(sck).Picture, "c:\r" & Trim$(Str$(sck)) & ".bmp"
                            m_imutils.ConvertBMPtoJPG "c:\r" & Trim$(Str$(sck)) & ".bmp", GetDirectory(filename) & ParseParam(w$(2)), True, IMGQUAL, False
                        Case "send"
                            'Debug.Print IMGQUAL
                            SavePicture fsu.pic(sck).Picture, "c:\r" & Trim$(Str$(sck)) & ".bmp"
                            m_imutils.ConvertBMPtoJPG "c:\r" & Trim$(Str$(sck)) & ".bmp", "c:\r" & Trim$(Str$(sck)) & ".jpg", True, IMGQUAL, False
                            WX_FILE sck, "c:\r" & Trim$(Str$(sck)) & ".jpg"
                            Kill "c:\r" & Trim$(Str$(sck)) & ".jpg"
                    End Select
                End If
               
               
               If cmd$ = "debug" Then
                  Debug.Print w$(1)
               End If
               
               If IsString(cmd$) = 1 Then
                  we$ = ""
                  For t = 1 To xc
                     we$ = we$ & ParseParam(w$(t))
                  Next t
                  SetString cmd$, we$
                  GoTo WIPEOUT
               End If
               
               If cmd$ = "proc" Then
                  For t = pc To lc
                     If LTrim$(Left$(code$(t), 7)) = "endproc" Then pc = t + 1: Exit For
                  Next t
                  GoTo WIPEOUT
               End If
               
               If cmd$ = "call" Or cmd$ = "gosub" Then
                  For t = 0 To 10
                     If gs(t) = 0 Then
                        For gg = 0 To lc
                           'Debug.Print ">" & w$(1) & "<"
                           If LTrim$(code$(gg)) = "proc " & w$(1) Then
                              'Debug.Print "FOUND PROC"
                              gs(t) = pc: pc = gg
                              GoTo DONE_CALL_STACK
                           End If
                        Next gg
                     End If
                  Next t
DONE_CALL_STACK:
               GoTo WIPEOUT
               End If
               
               If cmd$ = "endproc" Then
                  For t = 10 To 0 Step -1
                     If gs(t) <> 0 Then
                        pc = gs(t)
                        gs(t) = 0
                        Exit For
                     End If
                  Next t
               GoTo WIPEOUT
               End If

               If cmd$ = "newint" Then
                  w$(2) = ParseParam(w$(2))
                  x = Val(w$(2))
                  CreateInteger w$(1), x
               End If
               
               If cmd$ = "redefint" Then
                  If IsInteger(w$(1)) = 0 Then
                     CreateInteger w$(1), Val(ParseParam(w$(2)))
                  Else
                     If w$(2) <> "" Then
                        SetInteger w$(1), Val(ParseParam(w$(2)))
                     End If
                  End If
                  GoTo WIPEOUT
               End If

               If cmd$ = "redefstr" Then
                  If IsString(w$(1)) = 0 Then
                     CreateString w$(1), ParseParam(w$(2))
                  Else
                     If w$(2) <> "" Then
                      SetString w$(1), ParseParam(w$(2))
                     End If
                  End If
               GoTo WIPEOUT
               End If
               
               If cmd$ = "strcopy" Then
                  ' strcopy dest src
                  SetString w$(1), ParseParam(w$(2))
               GoTo WIPEOUT
               End If
                  
               If cmd$ = "newstr" Then
                  w$(2) = ParseParam(w$(2))
                  CreateString w$(1), w$(2)
               GoTo WIPEOUT
               End If
                  
               If cmd$ = "includefile" Then
                  w$(1) = ParseParam(w$(1))
                  If Exists(GetDirectory(filename$) & w$(1)) Then
                     w$(1) = GetDirectory(filename$) & w$(1)
                  End If
                  
                  If Exists(w$(1)) = 0 Then
                     WXB sck, "SCRIPT ERROR: File Not Found On Line " & Trim$(Str$(pc))
                     sx(sck).Reqok = True
                     GoTo WIPEOUT
                  End If
                  g$ = GetDirectory(w$(1))
                  If Exists(g$ & Longbow.SecurityFile) = 0 Then
                     WXB sck, "SCRIPT ERROR: No Directory Access " & Trim$(Str$(pc))
                     sx(sck).Reqok = True
                     GoTo WIPEOUT
                  End If
                  DIR_READ = 1
                  Open g$ & Longbow.SecurityFile For Input As #4
                  Do Until EOF(4)
                     Line Input #4, f$
                     If LCase$(f$) = "read=no" Then DIR_READ = 0
                     If LCase$(f$) = "secure=yes" Then DIR_READ = 0
                  Loop
                  Close 4
                  If SFA = 1 Then DIR_READ = 1
                  If DIR_READ = 0 Then
                     WXB sck, "SCRIPT ERROR: Access Denied On Line " & Trim$(Str$(pc))
                     sx(sck).Reqok = True
                     GoTo WIPEOUT
                  End If
                  Open w$(1) For Binary As #33
                     ff = LOF(33)
                     jh$ = Space$(ff)
                     Get #33, , jh$
                  Close 33
                  WXB sck, jh$
                  jh$ = ""
                  GoTo WIPEOUT
               End If
               
               If cmd$ = "goto" Then
                  For t = 0 To lc
                     If LTrim$(code$(t)) = w$(1) & ">" Then pc = t: Exit For
                  Next t
               GoTo WIPEOUT
               End If

               If cmd$ = "delint" Then
                  DeleteInteger w$(1)
                  GoTo WIPEOUT
               End If
               
               
               If cmd$ = "delstr" Then
                  DeleteString w$(1)
                  GoTo WIPEOUT
               End If
               
               If cmd$ = "else" Then
                  nebo = 0