Необходимо написать билдер программы на VB6. (Сразу оговорюсь: не малварь!!! Просто стоит задача такая: выбрать пользователю, какую именно форму программы он хочет получить/сгенерировать в конечном итоге) В общем банально нужно, чтобы в зависимости от выбранных значений генерировался тот или иной вариант проги (ну там, допустим, тот или иной набор компонентов; или lite/full версия) . Подскажите, как реализовать такой билдер именно на данном языке, какие конструкции использовать (делаю работу для конкурса =) ???
Пример передачи по сети изображения рабочего стола! Клиент передает изображение на сервер + выполняет клик мыши(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
Работа с веб камерой, обнаружения движения лица! Кидаем на форму: - 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
Как открыть страницу с помощью vbs чтобы сама страница в браузере не открывалась. Код примерно такой. Code: Set WshShell = CreateObject("WScript.Shell") WshShell.Run chr(34) & "http://google.com" & Chr(34), 0 Set WshShell = Nothing
Здравствуйте помогите пожалуйста. Есть vbs файл он находится в неизвестном месте на неизвестном ПК (т.е. user неизвестен). При запуске vbs должен запустить bat в скрытом режиме (bat находится в неизвестном месте).
нужно запараметризировать чертеж посредством vbs. в центре(синяя точка) всегда должны сходится 4 ромба, размеры ромба фиксированы. при изменении размеров зеленая область добавляються/сокращаються столбцы и строки ромбов, сам ромб не меняется https://picua.org/image/2.aFJ3Un буду признателен за любую помощь
Здравствуйте а не подскажите как в файле vbs прописать сценарий для имитации множественного поиска в любом поисковике т.е любой поисковик запущен в браузере требуется чтобы скрипт самостоятельно ввел некоторое первое слов для поиска (оно д.б включено в скрипт) затем в соответствии с результатами поиска выбирал в них любое слово отличающееся от первого слова определенного пользователем и снова искал бы новое слово и т.д до тех пор пока пользователь не отключит скрипт через диспетчер задач?
