[ Visual Basic / VBScript (без WEB-кодинга) ] — начинающим: задаем вопросы

Обсуждение в разделе «С/С++, C#, Delphi, .NET, Asm», начал(-а) SuperTroll, 29.03.2011.

  1. UNIXTREID

    UNIXTREID Member

    Регистрация:
    2.11.2015
    Сообщения:
    140
    Одобрения:
    22
    Репутация:
    1
    Необходимо написать билдер программы на VB6. (Сразу оговорюсь: не малварь!!! Просто стоит задача такая: выбрать пользователю, какую именно форму программы он хочет получить/сгенерировать в конечном итоге) В общем банально нужно, чтобы в зависимости от выбранных значений генерировался тот или иной вариант проги (ну там, допустим, тот или иной набор компонентов; или lite/full версия) . Подскажите, как реализовать такой билдер именно на данном языке, какие конструкции использовать (делаю работу для конкурса =) ???
     
  2. maza-in

    maza-in New Member

    Регистрация:
    6.02.2016
    Сообщения:
    10
    Одобрения:
    2
    Репутация:
    0
    Пример передачи по сети изображения рабочего стола!
    Клиент передает изображение на сервер + выполняет клик мыши(click, double click)

    Cервер:
    Кидаем на форму PictureBox, Timer и Button.

    Программный код:
    Code:
    Imports System.Net.Sockets
    Imports System.Threading
    Imports System.Net
    Imports System.Runtime.Serialization.Formatters.Binary
    
    Public Class rab_stol
    
        Dim tcplis As TcpListener
        Dim tcpclient As TcpClient
        Dim ther As Thread
        Dim ns As NetworkStream
        Dim resol As Integer
        Dim resoluciony As Integer
        Dim pos_X As Integer
        Dim pos_Y As Integer
        Dim env As Byte()
    
        Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
            If Button1.Text = "Старт" Then
                Try
                    Timer1.Interval = 10
                    Timer1.Start()
                Catch ex As Exception
                    MsgBox("Проблема c IP")
                    tcpclient.Close()
                End Try
                Try
                    CheckForIllegalCrossThreadCalls = False
                    tcplis = New TcpListener(IPAddress.Any, "2015") 'АЙПИ    ПОРТ    ip IPAddress.Any
                    tcplis.Start()
    
                    ther = New Thread(AddressOf recbin)
                    ther.Start()
                    Button1.Text = "Подключен, закрыть?"
                Catch ex As Exception
                    MsgBox("Проблема c соединением")
                End Try
            Else
                Try
                    NS.Dispose()
                Catch ex As Exception
                End Try
                Try
                    tcplis.Stop()
                    ther.Abort()
                Catch ex As Exception
                    Me.Close()
                End Try
                Me.Close()
            End If
        End Sub
    
        Public Sub recbin()
            Dim BF As New BinaryFormatter
            Try
                While True
                    tcpclient = tcplis.AcceptTcpClient()
                    ns = tcpclient.GetStream
                    While tcpclient.Connected = True
                        PictureBox1.Image = BF.Deserialize(ns)
                        resol = PictureBox1.Image.Width
                        resoluciony = PictureBox1.Image.Height
                    End While
                End While
            Catch ex As Exception
                ' MsgBox("Отключен")
            End Try
        End Sub
    
        Private Sub PictureBox1_Click(sender As Object, e As EventArgs) Handles PictureBoxREMOTO.Click
            Try
                pos_X = (Cursor.Position.X - Me.Location.X - 10) * resol / PictureBox1.Width
                pos_Y = (Cursor.Position.Y - Me.Location.Y - 30) * resoluciony / PictureBox1.Height
                Dim msg As String = "IZQUIERDO:" & pos_X & ":" & pos_Y
                env = System.Text.Encoding.UTF7.GetBytes(msg)
            Catch ex As Exception
                MsgBox("Проблема с кликом")
            End Try
        End Sub
    
        Private Sub PictureBox1_DoubleClick(sender As Object, e As EventArgs) Handles PictureBox1.DoubleClick
            Try
                pos_X = (Cursor.Position.X - Me.Location.X - 10) * resol / PictureBox1.Width
                pos_Y = (Cursor.Position.Y - Me.Location.Y - 30) * resoluciony / PictureBox1.Height
                Dim msg As String = "DOBLE:" & pos_X & ":" & pos_Y
                env = System.Text.Encoding.UTF7.GetBytes(msg)
            Catch ex As Exception
                MsgBox("Проблема с двойным кликом")
            End Try
        End Sub
    
        Private Sub Timer1_Tick_1(sender As Object, e As EventArgs) Handles Timer1.Tick
            Dim BF As New BinaryFormatter
            Try
                NS = tcpclient.GetStream
                BF.Serialize(ns, env)
                env = Nothing
            Catch ex As Exception
            End Try
        End Sub
    
    End Class


    -----------------------------------------------------------------------------------------------------------
    Клиент:
    Кидаем на форму Button и два Timer(a)

    Программный код:
    Code:
    Imports System.Net.Sockets
    Imports System.Runtime.Serialization.Formatters.Binary
    Imports System.IO
    Imports System.Runtime.InteropServices
    
    Public Class rabochiy_stol
    
        Dim TcpC As New TcpClient
        Dim ns As NetworkStream
    
        Private Sub rabochiy_stol_Load(sender As Object, e As EventArgs) Handles MyBase.Load
            Timer4.Enabled = True
        End Sub
    
        Function start()
            If ButtonCONEXION.Text = "CONECTAR" Then
                Try
                    TcpC.Connect(Form1.TextBoxIP.Text, "2015")
                    Timer1.Interval = 30
                    Timer1.Start()
                    Timer2.Interval = 10
                    Timer2.Start()
                    ButtonCONEXION.Text = "CERRAR"
                    Me.WindowState = FormWindowState.Minimized
                Catch ex As Exception
                    MsgBox(ex.Message)
                    Me.Close()
                End Try
            Else
                Try
                    NS.Dispose()
                    TcpC.Close()
                Catch ex As Exception
                    Me.Close()
                End Try
                Me.Close()
            End If
        End Function
    
        Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
            Dim BF As New BinaryFormatter
            Dim IMAGEN As Bitmap
            Try
                Dim BM As Bitmap
                BM = New Bitmap(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
                Dim DIBUJO As Graphics
                DIBUJO = Graphics.FromImage(BM)
                DIBUJO.CopyFromScreen(0, 0, 0, 0, Screen.PrimaryScreen.Bounds.Size)
                DIBUJO.DrawImage(BM, 0, 0, BM.Width, BM.Height)
                IMAGEN = New Bitmap(BM)
                Dim DIBUJO2 As Graphics
                DIBUJO2 = Graphics.FromImage(IMAGEN)
                Dim MICURSOR As Cursor = Cursors.Hand
                Dim RECTANGULO As New Rectangle(Cursor.Position.X, Cursor.Position.Y, MICURSOR.Size.Width, MICURSOR.Size.Height)
                MICURSOR.Draw(DIBUJO2, RECTANGULO)
                Dim MS As New MemoryStream
                IMAGEN.Save(MS, Imaging.ImageFormat.Jpeg)
                IMAGEN = Image.FromStream(MS)
                ns = TcpC.GetStream
                BF.Serialize(NS, IMAGEN)
            Catch ex As Exception
                Timer1.Stop()
                Timer2.Stop()
                Me.Close()
                MsgBox("Сервер отключен")
            End Try
        End Sub
    
        Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick
            Try
                ns = TcpC.GetStream
                Dim BF As New BinaryFormatter
                If NS.DataAvailable Then
                    Dim MENSAJE As String = System.Text.Encoding.UTF7.GetString(BF.Deserialize(NS))
                    ORDENES(MENSAJE)
                End If
            Catch ex As Exception
                Timer1.Stop()
                Timer2.Stop()
                Me.Close()
                MsgBox("Сервер отключен")
            End Try
        End Sub
    
        Public Sub ORDENES(ByVal ORDEN As String)
            Try
                Dim PARTES As String() = ORDEN.Split(":")
                POSICIONX = PARTES(1)
                POSICIONY = PARTES(2)
                Cursor.Position = New Point(POSICIONX, POSICIONY)
                Select Case PARTES(0)
                    Case "IZQUIERDO"
                        CLICKIZDO()
                    Case "DOBLE"
                        CLICKIZDO()
                        CLICKIZDO()
                End Select
            Catch ex As Exception
                Timer1.Stop()
                Timer2.Stop()
                MsgBox(ex.Message)
            End Try
        End Sub
    
        Dim POSICIONX As Integer
        Dim POSICIONY As Integer
    
        <DllImport("user32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)>
        Public Shared Sub mouse_event(dwFlags As Integer, dx As Integer, dy As Integer, cButtons As Integer, dwExtraInfo As Integer)
        End Sub
    
        Private Const MOUSEEVENTF_LEFTDOWN As Integer = &H2
        Private Const MOUSEEVENTF_LEFTUP As Integer = &H4
        Private Const MOUSEEVENTF_RIGHTDOWN As Integer = &H8
        Private Const MOUSEEVENTF_RIGHTUP As Integer = &H10
    
        Public Sub CLICKIZDO()
            mouse_event(MOUSEEVENTF_LEFTDOWN, POSICIONX, POSICIONY, 0, 0)
            mouse_event(MOUSEEVENTF_LEFTUP, POSICIONX, POSICIONY, 0, 0)
        End Sub
    
        Public Sub CLICKDCHO()
            mouse_event(MOUSEEVENTF_RIGHTDOWN, POSICIONX, POSICIONY, 0, 0)
            mouse_event(MOUSEEVENTF_RIGHTUP, POSICIONX, POSICIONY, 0, 0)
        End Sub
    
        <DllImport("user32.dll")>
        Private Shared Function FindWindow(className As String, windowText As String) As IntPtr
        End Function
        <DllImport("user32.dll")>
        Private Shared Function ShowWindow(hwnd As IntPtr, command As Integer) As Boolean
        End Function
        Private Const SW_HIDE As Integer = 0
        Private Const SW_SHOW As Integer = 1
    
        Public Function OCULTABARRA() As Boolean
            Dim retval = False
            Dim hwndTaskBar = FindWindow("Shell_TrayWnd", "")
            If hwndTaskBar <> IntPtr.Zero Then
                retval = ShowWindow(hwndTaskBar, SW_HIDE)
            End If
            Return retval
        End Function
    
        Public Function OCULTAINICIO() As Boolean
            Dim retval = False
            OCULTABARRA()
            Dim hwndStartButton = FindWindow("Button", "старт")
            If hwndStartButton <> IntPtr.Zero Then
                retval = ShowWindow(hwndStartButton, SW_HIDE)
            End If
            Return retval
        End Function
    
        Public Function MUESTRABARRA() As Boolean
            Dim retval2 = False
            Dim hwndTaskBar = FindWindow("Shell_TrayWnd", "")
            If hwndTaskBar <> IntPtr.Zero Then
                retval2 = ShowWindow(hwndTaskBar, SW_SHOW)
            End If
            Return retval2
        End Function
    
        Public Function MUESTRAINICIO() As Boolean
            Dim retval1 = False
            MUESTRABARRA()
            Dim hwndstartbutton = FindWindow("Button", "старт")
            If hwndstartbutton <> IntPtr.Zero Then
                retval1 = ShowWindow(hwndstartbutton, SW_SHOW)
            End If
            Return retval1
        End Function
    
        Private Sub ButtonCONEXION_Click(sender As Object, e As EventArgs) Handles ButtonCONEXION.Click
            start()
        End Sub
    
    End Class
     
    Это одобряет marynli.
  3. maza-in

    maza-in New Member

    Регистрация:
    6.02.2016
    Сообщения:
    10
    Одобрения:
    2
    Репутация:
    0
    Работа с веб камерой, обнаружения движения лица!
    Кидаем на форму:
    - ComboBox1
    - PictureBox1
    - timer
    - label(name="label1")
    - label(name="gx")
    - label(name="gy")


    Программный код:

    Code:
    Imports AForge
    Imports AForge.Imaging
    Imports AForge.Imaging.Filters
    Imports AForge.Math.Geometry
    Imports AForge.Video
    Imports AForge.Video.DirectShow
    Imports HaarCascadeClassifer
    Imports HaarCascadeClassifer.HaarDetector
    Imports System.Drawing.Imaging
    
    Public Class Form1
        'Камера
        Dim дост_камер As FilterInfoCollection 'камеры доступно
        Dim WithEvents камера As VideoCaptureDevice 'Камера
        Dim Изоб_камера As Bitmap 'Изображение камеры
        'ДЕТЕКТОР ДЛЯ ЛИЦА
        Dim detector As HaarDetector
        'КООРДИНИРОВАТЬ СРАВНЕНИЕ
        Dim RX As Integer = 0
        Dim RY As Integer = 0
    
        Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
            'ДЕТЕКТОР АЛГОРИТМЫ
            Dim ХМЛдок As New Xml.XmlDocument
            ХМЛдок.LoadXml(HaarCascadeClassifer.My.Resources.haarcascade_frontalface_alt)
            detector = New HaarDetector(ХМЛдок)
            'доступные   камеры
            дост_камер = New FilterInfoCollection(FilterCategory.VideoInputDevice)
            If дост_камер.Count > 0 Then
                For i As Integer = 0 To дост_камер.Count - 1
                    ComboBox1.Items.Add(дост_камер(i).Name.ToString())
                Next
                ComboBox1.Visible = True
                PictureBox1.SizeMode = PictureBoxSizeMode.Zoom
            Else
                MsgBox("КАМЕРЫ ОТСУТСТВУЕТ")
            End If
        End Sub
    
        Private Sub ComboBox1_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
            'Камера начинает работать
            Try
                камера = New VideoCaptureDevice(дост_камер(ComboBox1.SelectedIndex).MonikerString)
                AddHandler камера.NewFrame, New NewFrameEventHandler(AddressOf video_NuevoFrame1)
                камера.Start()
                Timer1.Interval = 1000 '   Скрининг НАЧИНАЕТСЯ
                Timer1.Start()
            Catch ex As Exception
            End Try
        End Sub
    
        Private Sub video_NuevoFrame1(sender As Object, eventArgs As NewFrameEventArgs)
            Try
                Изоб_камера = DirectCast(eventArgs.Frame.Clone(), Bitmap)
            Catch ex As Exception
            End Try
        End Sub
    
        Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
            Try
                ' Скрининг
                Dim BMP As New Bitmap(Изоб_камера)
                Dim ц_т As New Pen(Brushes.Lime, 8) 'ЦВЕТ И ТОЛЩИНА
                Dim параметры As New DetectionParams(Integer.MaxValue, 0, detector.Size2Scale(100), detector.Size2Scale(BMP.Height),
                                                              1.05, 0.3, 0.2, ц_т) 'ПАРАМЕТРЫ веб камера
                Dim результат As DResults = detector.Detect(BMP, параметры)
                PictureBox1.Image = BMP ' ОБНАРУЖЕНИЕ ОБРАЗЦА
                ' КООРДИНИРОВАТЬ
                Dim цвет As Color
                Dim НАЙДЕНО As Boolean = False
                For Y = 0 To BMP.Height - 1 Step 5 'ИЩЕМ  ободку
                    For X = 0 To BMP.Width - 1 Step 5
                        цвет = BMP.GetPixel(X, Y)
                        If цвет = Color.FromArgb(255, 0, 255, 0) Then
                            Label1.Text = X & " : " & Y
                            If RY - Y > 10 Then
                                gy.Text = "Вверх"
                            ElseIf Y - RY > 10 Then
                                gy.Text = "Вниз"
                            End If
                            If X - RX > 20 Then
                                gx.Text = "Вправо"
                            ElseIf RX - X > 20 Then
                                gx.Text = "Влево"
                            End If
                            RX = X 'ОБНОВЛЕНИЕ с новым значением
                            RY = Y 'ОБНОВЛЕНИЕ с новым значением
                            НАЙДЕНО = True
                            Exit For
                        End If
                    Next
                    If НАЙДЕНО = True Then
                        Exit For
                    End If
                Next
            Catch ex As Exception
            End Try
        End Sub
    
        Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
            'Отсоединение камеры
            Try
                камера.SignalToStop()
            Catch ex As Exception
            End Try
        End Sub
    End Class
     
  4. hpol

    hpol Member

    Регистрация:
    11.12.2013
    Сообщения:
    64
    Одобрения:
    13
    Репутация:
    15
    Как открыть страницу с помощью vbs чтобы сама страница в браузере не открывалась.
    Код примерно такой.
    Code:
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.Run chr(34) & "http://google.com" & Chr(34), 0
    Set WshShell = Nothing
     
  5. Ne gomick

    Ne gomick New Member

    Регистрация:
    12.01.2018
    Сообщения:
    1
    Одобрения:
    0
    Репутация:
    0
    Здравствуйте помогите пожалуйста. Есть vbs файл он находится в неизвестном месте на неизвестном ПК (т.е. user неизвестен). При запуске vbs должен запустить bat в скрытом режиме (bat находится в неизвестном месте).
     
  6. #colorblind

    #colorblind Active Member

    Регистрация:
    31.01.2014
    Сообщения:
    505
    Одобрения:
    152
    Репутация:
    34
    With CreateObject("WScript.Shell")
    .Run "cmd /c <ПУТЬ_К_БАТНИКУ>", 0, True
    End With
     
Загрузка...
Similar Threads - Visual Basic VBScript
  1. ark_MaZaHaKa
    Ответы:
    1
    Просмотры:
    747
  2. Loan97
    Ответы:
    3
    Просмотры:
    1 673
  3. nikprim
    Ответы:
    0
    Просмотры:
    1 091
  4. djazatik
    Ответы:
    2
    Просмотры:
    1 616