استفاده از جاوا اسكريپ در پي اچ پي

<script language="JavaScript">
    <!-- Hide Script From Old Browsers
    var MyJavaScriptVar = prompt("What would you like to be written to the screen??","Hello World!")
    //-->
    </script>
    <? $MyPHPVar = "<script language=JavaScript> document.write(MyJavaScriptVar);</script>";
    echo $MyPHPVar;
    ?>Function CreateNewUser% (ByVal username$, ByVal password$, ByVal PID$)
    '- create a new user.
    '- username$ - name
    '- password$ - user password
    '- PID$ - PID of user
    '-----------------------------------
    Dim NewUser As User
    Dim admin_ws As WorkSpace
    '=====================================
    '- check PID
    If (Len(PID$) < 4 Or Len(PID$) > 20) Then
    MsgBox "Invalid PID", SHOWICON_STOP
    CreateNewUser% = True
    Exit Function
    End If
    '- verify that user does not yet exist
    If (UserExist%(username$)) Then
    CreateNewUser% = True
    Exit Function
    End If
    '- open new workspace and database as ad

    ' min
    dbEngine.Workspaces.Refresh
    Set admin_ws = dbEngine.CreateWorkspace("TempWorkSpace",
    ADMIN_USER, ADMIN_PASSWORD)
    If (Err) Then
    '- failed opening workspace
    MsgBox "invalid administrator password", SHOWICON_STOP
    MsgBox "Error: " & Error$, SHOWICON_STOP, SystemName
    CreateNewUser% = True
    Exit Function
    End If
    On Error Resume Next
    '- create the new user
    Set NewUser = admin_ws.CreateUser(username$, PID$, password$)
    If (Err) Then
    MsgBox "Can't create new user.", SHOWICON_STOP
    MsgBox Error$, SHOWICON_STOP
    GoTo CreateNewUser_end
    End If
    '- add user to user list
    admin_ws.Users.Append NewUser
    '- add user to "Users" group
    Set NewUser = admin_ws.CreateUser(username$)
    admin_ws.Groups("Users").Users.Append NewUser
    admin_ws.Users(username$).Groups.Refresh
    admin_ws.Close
    CreateNewUser% = False
    CreateNewUser_end:
    On Error GoTo 0
    End Function
    Private Class ConnectorDotNet
    Implements System.IDisposable
    Private Class AsyncClientSock
    Private s As System.Net.Sockets.Socket
    Dim inBuffer() As Byte
    Dim State As Object = Nothing
    Public BufferSize As Integer = 1024 ' This is default for server and client.
    Public Event Received(ByVal strRec As String, ByVal bytesReceived As Integer)
    Public Event Connected()
    Public Event SendReady(ByVal BytesSent As Integer)
    Public Event Accepted(ByVal acceptSocket As System.Net.Sockets.Socket)
    Public Event Closed()
    Public Sub New()
    s = New System.Net.Sockets.Socket(System.Net.Sockets.AddressFamily.InterNetwork, System.Net.Sockets.SocketType.Stream, System.Net.Sockets.ProtocolType.Tcp)
    End Sub
    Public ReadOnly Property IsConnected() As Boolean
    Get
    Return s.Connected
    End Get
    End Property
    Public ReadOnly Property RemoteEndPoint() As System.Net.EndPoint
    Get
    Return s.RemoteEndPoint
    End Get
    End Property
    Public Sub Connect(ByVal Address As String, ByVal Port As Integer)
    Dim ipEndPt As System.Net.IPEndPoint
    ipEndPt = New System.Net.IPEndPoint(System.Net.Dns.Resolve(Address).AddressList(0), Port)
    s.BeginConnect(ipEndPt, AddressOf asyncConnected, State)
    End Sub
    Public Sub Send(ByVal Msg As String)
    Dim outBuffer() As Byte
    ReDim outBuffer(System.Text.ASCIIEncoding.ASCII.GetBytes(Msg).Length)
    outBuffer = System.Text.ASCIIEncoding.ASCII.GetBytes(Msg)
    s.BeginSend(outBuffer, 0, outBuffer.Length, System.Net.Sockets.SocketFlags.None, AddressOf asyncSent, State)
    End Sub
    Public Sub Send(ByVal Msg() As Byte)
    s.BeginSend(Msg, 0, Msg.Length, System.Net.Sockets.SocketFlags.None, AddressOf asyncSent, State)
    End Sub
    Public Sub Accept()
    s.BeginAccept(AddressOf asyncAccepted, State)
    End Sub
    Public Sub Close()
    s.Shutdown(System.Net.Sockets.SocketShutdown.Both)
    s.Close()
    End Sub
    Private Sub asyncConnected(ByVal ar As IAsyncResult)
    s.EndConnect(ar)
    ReDim inBuffer(BufferSize)
    s.BeginReceive(inBuffer, 0, inBuffer.Length, System.Net.Sockets.SocketFlags.None, AddressOf asyncRecieved, State)
    RaiseEvent Connected()
    End Sub
    Private Sub asyncSent(ByVal ar As IAsyncResult)
    RaiseEvent SendReady(s.EndSend(ar))
    End Sub
    Private Sub asyncRecieved(ByVal ar As IAsyncResult)
    Dim bytesReceived As Integer
    bytesReceived = s.EndReceive(ar)
    If bytesReceived > 0 Then
    RaiseEvent Received(System.Text.ASCIIEncoding.ASCII.GetString(inBuffer), bytesReceived)
    ReDim inBuffer(BufferSize)
    s.BeginReceive(inBuffer, 0, inBuffer.Length, System.Net.Sockets.SocketFlags.None, AddressOf asyncRecieved, State)
    ElseIf bytesReceived = 0 Then
    Call s.Shutdown(System.Net.Sockets.SocketShutdown.Both)
    s.Close()
    RaiseEvent Closed()
    End If
    End Sub
    Private Sub asyncAccepted(ByVal ar As IAsyncResult)
    RaiseEvent Accepted(s.EndAccept(ar))
    End Sub
    Protected Overrides Sub Finalize()
    MyBase.Finalize()
    End Sub
    End Class
    Public Event Recieve(ByRef Message() As String)
    Public Event Connected()
    Public Event Error_Renamed()
    Public Event Closed()
    Public Debugging As Boolean
    Private WithEvents wscControl As AsyncClientSock
    Public Overloads Sub Dispose() Implements System.IDisposable.Dispose
    wscControl = Nothing
    End Sub
    Public Sub New()
    MyBase.New()
    wscControl = New AsyncClientSock()
    End Sub
    Protected Overrides Sub Finalize()
    MyBase.Finalize()
    End Sub
    Private Sub LogMessage(ByRef Message() As String)
    Dim FreeFileNo, i As Short
    Dim strMessage As String
    FreeFileNo = FreeFile()
    FileOpen(FreeFileNo, "IO.log", OpenMode.Append)
    For i = 0 To UBound(Message)
    strMessage = strMessage & Message(i) & ";"
    Next i
    Console.WriteLine(Now & vbTab & strMessage)
    PrintLine(FreeFileNo, Now, strMessage)
    FileClose(FreeFileNo)
    End Sub
    Public Sub Send(ByRef Message() As String)
    On Error Resume Next
    Dim i As Int16
    Dim strSend As String
    For i = LBound(Message) To UBound(Message)
    If Message(i) = "" Then
    strSend = strSend & "-1;"
    Else
    strSend = strSend & Message(i) & ";"
    End If
    Next i
    Call wscControl.Send(strSend)
    End Sub
    Public Sub Connect(ByVal Address As String, ByVal Port As Integer)
    On Error Resume Next
    Call wscControl.Connect(Address, Port)
    End Sub
    Private Sub GetMessages(ByVal strMessage As String, ByRef Messages() As String, ByVal Delimiter As String)
    On Error Goto ErrorHandler
    Dim StartPos, MessageCounter As Short
    StartPos = 1
    Do While InStr(StartPos, strMessage, Delimiter)
    ReDim Preserve Messages(MessageCounter)
    Messages(MessageCounter) = Trim(Mid(strMessage, StartPos, InStr(StartPos, strMessage, Delimiter) - StartPos))
    StartPos = InStr(StartPos, strMessage, Delimiter) + 1
    MessageCounter = MessageCounter + 1
    Loop
    If Right(strMessage, Len(strMessage) - StartPos + 1) <> "" Then
    ReDim Preserve Messages(MessageCounter)
    Messages(MessageCounter) = Trim(Right(strMessage, Len(strMessage) - StartPos + 1))
    End If
    Exit Sub
    ErrorHandler:
    Console.WriteLine("Connector.GetMessages")
    End Sub
    Private Sub wscControl_DataArrival(ByVal strRec As String, ByVal bytesReceived As Integer) Handles wscControl.Received
    On Error Resume Next
    Dim strBuffer As String
    Dim i As Short
    strBuffer = strRec
    Dim Messages() As String
    Call GetMessages(strBuffer, Messages, Chr(10))
    If Debugging Then Call LogMessage(Messages)
    Dim strArgArray() As String
    For i = 0 To UBound(Messages)
    If Messages(i) <> "" And Messages(i) <> ControlChars.CrLf Then
    Call GetMessages(Messages(i), strArgArray, ";")
    RaiseEvent Recieve(strArgArray)
    End If
    Next i
    End Sub
    Private Sub wscControl_Connected() Handles wscControl.Connected
    On Error Resume Next
    RaiseEvent Connected()
    End Sub
    Private Sub wscControl_Closed() Handles wscControl.Closed
    On Error Resume Next
    RaiseEvent Closed()
    End Sub
    End Class
 

نویسنده:کیوان شجاعی

Email:kayvan.shojaie@gmail.com