Балконы и окна
21.10.2023

Vb6 примеры программ со сплит. Готовые проекты на VB6. Примеры работы с файлами

Всем привет!
Сегодня я хотел бы поговорить о криптографии. Я сделал пример использования специальной криптографии - стеганографии. Этот метод скрывает сам факт шифрования данных. Существует множество видов стеганографии. Я бы хотел поговорить о LBS-методе, в котором данные скрываются в младших битах аудио данных. Это выглядит так, как-будто пользователи обмениваются аудио файлами, но на самом деле они обмениваются секретными данными. Тот кто не знает об этом методе не будет даже подозревать о обмене секретными данными. В некоторых случаях это может быть очень полезно.
Как это работает?
WAVE-PCM файл (без компрессии) содержит аудио данные. На самом деле звук является аналоговым событием, т.е. непрерывным. Для того чтобы перевести его в цифровую форму нужно проквантовать его с некоторыми потерями. Этот процесс характеризуется двумя параметрами: разрядностью и частотой дискретизации. Разрядность влияет на то как много уровней сигнала может содержаться в каждом семпле. Частота дискретизации влияет на то какая максимальная частота может содержатся в аудиоданных:

В нашем случае нас интересует только разрядность аудиоданных. Она может быть 32, 24, 16, ... бит на семпл. Главная идея стеганографии (в нашем случае) - переписать младшие биты аудиоданных. Чем больше бит мы будем использовать, тем сильнее будут искажения.
Наглядно:


Как видно из рисунка метод сохраняет все шифруемые данные в определенных битах аудиоданных (в данном случае 4 бита на каждый семпл). Также заметьте что для сохранения данных нужно использовать аудио файл бо́льший по размеру чем шифруемый файл. Для примера, если мы будем использовать 3 бита для кодирования, аудиофайл должен будет иметь размер как минимум в 16/3 раза больше чем кодируемый. Я говорю 16 потому что я использую 16 бит на семпл в моем примере.
В прикрепленном примере я также сохраняю оригинальное имя файла. Формат данных наглядно:


Когда происходит упаковка берется каждый байт из шифруемого файла. Затем извлекается необходимые биты из очередного байта, а также очищаются соответственные биты в аудиоданных. Далее эти биты устанавливаются посредством операции побитовое-ИЛИ. Для извлечения необходимых бит используются маски и сдвиги. Маски оставляют необходимые биты, а сдвиги размещают их в начале байта.
Распаковка происходит с точностью наоборот. Извлекаются биты из аудио файла и собирается исходный файл. Спектр аудиофайла в зависимости от битности:

Надеюсь что этот небольшой обзор будет полезным.
Спасибо за внимание.

Использование функции Split в VBA Excel, ее синтаксис и параметры. Значения, возвращаемые функцией Split. Примеры использования.

Функция Split предназначена в VBA Excel для разделения строки на подстроки по специальным меткам - разделителям. Разделителем может быть как отдельный символ, так и строка из нескольких символов. Функция Split по своему действию является обратной функции , которая создает одну строку из массива подстрок.

Синтаксис функции

Split (Expression,,,)

Обязательным параметром функции Split является Expression - если остальные параметры явно не указаны, используются их значения по-умолчанию.

Параметры функции

*Если используется двоичное сравнение (0 или CompareMethod.Binary), функция чувствительна к регистру букв. Если используется текстовое сравнение (1 или CompareMethod.Text), функция не чувствительна к регистру букв.

Возвращаемые значения

Функция Split возвращает одномерный массив с индексацией от нуля, который содержит указанное параметром Limit число подстрок. Чаще всего, функция Split используется со значением параметра Limit по-умолчанию, равному -1, когда возвращаются все найденные в исходной строке подстроки.

Пример 1

Sub Test1() Dim a() As String a = Split("vremya ne zhdet") MsgBox a(0) & vbNewLine & a(1) & vbNewLine & a(2) End Sub Результат в MsgBox: vremya ne zhdet

В первом примере используются Delimiter и Limit по-умолчанию.

Пример 2

Sub Test2() Dim a() As String a = Split("vremya-ne-zhdet","-", 2) MsgBox a(0) & vbNewLine & a(1) End Sub Результат в MsgBox: vremya ne-zhdet

Во втором примере Delimiter = "-", а Limit = 2.

Для присваивания результатов функции Split используется предварительно объявленный текстовый , который можно использовать в строке присваивания с пустыми скобками или без них. В представленных выше примерах массив указан без скобок.

Вы можете скопировать коды из приведенных примеров в модуль VBA своей рабочей книги Excel, посмотреть, как они работают. Поэкспериментируйте, подставляя свои данные, чтобы на практике ознакомиться с возможностями функции Split.

Всем привет, в этой статье я хочу показать Вам полезные коды небольших программ. Которые Вы можете использовать для написания уже своих более серьезных программ, ну или Вы искали именно эти функции, которые здесь описаны.

Все коды использовались в среде программирования Microsoft Visual Basic v6.0.

Выход с подтверждением

Первая своего рода программка, ну или функция, это выход с сообщением о подтверждение выхода. В общем, откройте среду программирования Visual Basic, создайте стандартный проект, потом поместите на форму одну кнопку, щелкните на кнопке и у Вас откроется окно редактирования кода, и туда Вам необходимо вставить следующий код:

Beep Dim message As String Dim buttonsandicons As Integer Dim title As String Dim response As String message = "Хотите выйти?" title = "Выход" buttonasicons = vbYesNo + vbQuestion response = MsgBox(message, buttonasicons, title) If response = vbYes Then End End If

Пароль на запуск программы

Dim Password, Pword PassWord = "12345" Pword = InputBox("Введите пароль") If Pword <> PassWord Then MsgBox "Пароль не верный" End End If

Где, 12345 это пароль на запуск программы. Но этот код можно использовать, где только захотите.

Вывод сообщения

Если хотите просто выводить сообщение, для чего-нибудь, то вставьте это:

Beep Dim message As String Dim buttonsandicons As Integer Dim title As String message = "Сообщение" title = "Сообщение" buttonasicons = vbOKOnly + vbexciamation MsgBox message, buttonsandicons, title

Рисование на форме

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Form1.CurrentX = X Form1.CurrentY = Y End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Line (Form1.CurrentX, Form1.CurrentY)-(X, Y), QBColor(0) End If End Sub

Цвет можете менять с помощью параметра QBColor(0), т.е. вместо 0 поставьте другую цифру.

Перезагрузка компьютера

Для того чтобы перезагрузить компьютер: поместите кнопку и вставьте следующий код:

Dim strComputer As String strComputer = "." Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate, (Shutdown)}!\\" _ & strComputer & "\root\cimv2") Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem") For Each ObjOperatingSystem In colOperatingSystems ObjOperatingSystem.Reboot " Для перезагрузки Next

Запуск программы в единственном экземпляре

Следующий пример поможет Вам сделать так, чтобы программа запускалась только один раз, т.е. в случае повторного запуска она выдаст соответствующее сообщение. В код формы вставьте:

Private Sub Form_Load() If App.PrevInstance = True Then MsgBox "Проект уже запущен!" End End If

Выключение компьютера

Для того чтобы выключить компьютер можно использовать следующий код:

Dim strComputer As String strComputer = "." Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate,(Shutdown)}!\\" _ & strComputer & "\root\cimv2") Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem") For Each ObjOperatingSystem In colOperatingSystems ObjOperatingSystem.ShutDown "Для выключения Next

Завершение любого процесса

Для того чтобы завершить процесс можете использовать следующий код:

Shell "Cmd /x/c taskkill /f /im ICQlite.exe", vbvhite

Где, вместо ICQlite.exe может быть любой процесс.

Сколько работает компьютер

Ниже показан пример того, как можно определить время работы компьютера. Данный способ основан на использование библиотеки kernel32, поэтому в самом начале кода формы подключите данную DLL.

Private Declare Function GetTickCount Lib "kernel32" () As Long "А в код кнопки: Dim a_hour, a_minute, a_second a = Format(GetTickCount() / 1000, "0") "всего секунд a_days = Int(a / 86400) a = a - a_days * 86400 a_hour = Int(a / 3600) a = a - a_hour * 3600 a_minute = Int(a / 60) a_second = a - a_minute * 60 MsgBox "Ваш компьютер работает " & Str(a_days) & " дня" & Str(a_hour) _ & " часа " & Str(a_minute) & " минут" & Str(a_second) & " секунд"

Мы рассмотрели простые функции, которые можно использовать практически везде. Теперь рассмотрим более серьезные примеры, и они Вам могут очень сильно помочь написать свои крупные проекты.

Примеры работы с папками

Удалить каталог

Private Declare Function RemoveDirectory& Lib _ "kernel32" Alias "RemoveDirectoryA" (ByVal lpPathName As String) "Удаление каталога (пустого!) PathName$ = "D:\t" code& = RemoveDirectory(PathName) If code& = 0 Then "Ошибка удаления каталога Else "Каталог удален End If

Создать каталог

Sub MakeDir(dirname As String) Dim i As Long, path As String Do i = InStr(i + 1, dirname & "\", "\") path = Left$(dirname, i - 1) If Right$(path, 1) <> ":" And Dir$(path, vbDirectory) = "" Then MkDir path End If Loop Until i >= Len(dirname) End Sub Private Sub Command1_Click() Call MakeDir("C:\Soft\1\2\3\") End Sub

Список всех папок с под папками

На форму добавляем 2 текстовых поля и кнопку, имя первого текстового поля: StartText, имя второго текстового поля OutText. Свойство Multiline = true, имя кнопки = CmdStart

Static running As Boolean Dim AllDirs As New Collection Dim next_dir As Integer Dim dir_name As String Dim sub_dir As String Dim i As Integer Dim txt As String If running Then running = False CmdStart.Enabled = False CmdStart.Caption = "Stopping" Else running = True MousePointer = vbHourglass CmdStart.Caption = "Stop" OutText.Text = "" DoEvents next_dir = 1 AllDirs.Add StartText.Text Do While next_dir <= AllDirs.Count dir_name = AllDirs(next_dir) next_dir = next_dir + 1 sub_dir = Dir$(dir_name & "\*", vbDirectory) Do While sub_dir <> "" If UCase$(sub_dir) <> "PAGEFILE.SYS" And sub_dir <> "." And sub_dir <> ".." Then sub_dir = dir_name & "\" & sub_dir On Error Resume Next If GetAttr(sub_dir) And vbDirectory Then AllDirs.Add sub_dir End If sub_dir = Dir$(, vbDirectory) Loop DoEvents If Not running Then Exit Do Loop txt = "" For i = 1 To AllDirs.Count txt = txt & AllDirs(i) & vbCrLf Next i OutText.Text = txt MousePointer = vbDefault unning = False End If

Теперь запускаем программу, в текстовом поле StartText пишем: C:\windows, и жмем на кнопку.

Размер каталога

Const MAX_PATH = 260 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Declare Function FindFirstFile Lib _ "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib _ "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib _ "kernel32" (ByVal hFindFile As Long) As Long Public Function SizeOf(ByVal DirPath As String) As Double Dim hFind As Long Dim fdata As WIN32_FIND_DATA Dim dblSize As Double Dim sName As String Dim x As Long On Error Resume Next x = GetAttr(DirPath) If Err Then SizeOf = 0: Exit Function If (x And vbDirectory) = vbDirectory Then dblSize = 0 Err.Clear sName = Dir$(EndSlash(DirPath) & "*.*", vbSystem Or vbHidden Or vbDirectory) If Err.Number = 0 Then hFind = FindFirstFile(EndSlash(DirPath) & "*.*", fdata) If hFind = 0 Then Exit Function Do If (fdata.dwFileAttributes And vbDirectory) = vbDirectory Then sName = Left$(fdata.cFileName, InStr(fdata.cFileName, vbNullChar) - 1) If sName <> "." And sName <> ".." Then dblSize = dblSize + SizeOf(EndSlash(DirPath) & sName) End If Else dblSize = dblSize + fdata.nFileSizeHigh * 65536 + fdata.nFileSizeLow End If DoEvents Loop While FindNextFile(hFind, fdata) <> 0 hFind = FindClose(hFind) End If Else On Error Resume Next dblSize = FileLen(DirPath) End If SizeOf = dblSize End Function Private Function EndSlash(ByVal PathIn As String) As String If Right$(PathIn, 1) = "\" Then EndSlash = PathIn Else EndSlash = PathIn & "\" End If End Function Private Sub Form_Load() "Замените "D:\soft" той директорией, размер которой хотите узнать MsgBox SizeOf("D:\soft") / 1000000 End Sub

Примеры работы с файлами

Копировать

Допустим, у нас есть файл с именем 1.txt в папке C:\1\ , а нам нужно скопировать его в C:\2\ для этого пишем следующий код:

Filecopy "C:\1\1.txt","C:\2\1.txt"

Примечание! Если в каталоге 2 уже находится файл с именем 1.txt, то он будет заменен на 1.txt из каталога 1.

Private Declare Function CopyFile Lib _ "kernel32.dll" Alias "CopyFileA" _ (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long Private Sub Command1_Click() " Скопируем файл C:\1.txt в D:\1.txt. Dim retval As Long " возвращаемое значение "Копируем файл retval = CopyFile("C:\1.txt", "D:\1.txt", 1) If retval = 0 Then "Если ошибка MsgBox "Не могу скопировать" Else "Если все нормально MsgBox "Файл скопирован." End If End Sub

Удаление

Например, мы хотим удалить файл 1.txt из корня диска C:\

Kill ("C:\1.txt")

Способ API

Private Declare Function DeleteFile Lib _ "kernel32.dll" Alias "DeleteFileA" (ByVal lpFileName As String) As Long Private Sub Command1_Click() "Удаляем файл C:\Samples\anyfile.txt Dim retval As Long "Возвращаемое значение retval = DeleteFile("C:\1.txt") If retval = 1 Then MsgBox "Файл успешно удален." End Sub

Перемещение

Можно, например, переместит и так:

Filecopy "C:\1.txt","C:\2\1.txt" Kill ("C:\1.txt")

Но лучше так (через API):

Private Declare Function MoveFile Lib _ "kernel32.dll" Alias "MoveFileA" _ (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long Private Sub Command1_Click() Dim retval As Long "Возвращаемое значение retval = MoveFile("C:\1.txt", "C:\2\1.txt") If retval = 1 Then MsgBox "Успешно переместился" Else MsgBox "Ошибка" End If End Sub

Переименование

Для того чтобы переименовать файл 1.txt находящийся в C:\ на 2.txt можно использовать следующий код:

Filecopy "C:\1.txt","C:\2.txt" Kill ("C:\1.txt")

Способ API

Private Declare Function MoveFile Lib _ "kernel32.dll" Alias "MoveFileA" _ (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long Private Sub Command1_Click() Dim retval As Long " возвращаемое значение retval = MoveFile("C:\1.txt", "C:\2.txt") If retval = 1 Then MsgBox "Успешно" Else MsgBox "Ошибка" End If End Sub

Определить размер файла

Размер файла можно определить двумя путями:

Если файл можно открыть функцией OPEN, то можно воспользоваться функцией LOF

Dim FileFree As Integer Dim FileSize As Long FileFree = FreeFile Open "C:\WIN\GENERAL.TXT" For Input As FileFree FileSize = LOF(FileFree) Close FileFree

Или использовать функцию FileLen

Dim lFileSize As Long FileSize = FileLen("C:\WIN\GENERAL.TXT")

Скрыть часы программно

Добавьте 2 кнопки и вставляйте код:

Option Explicit Private Declare Function FindWindow Lib _ "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib _ "user32" Alias "FindWindowExA" _ (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function ShowWindow Lib _ "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Dim hnd As Long Private Sub Command1_Click() ShowWindow hnd, 0 End Sub Private Sub Command2_Click() ShowWindow hnd, 1 End Sub Private Sub Form_Load() hnd = FindWindow("Shell_TrayWnd", vbNullString) hnd = FindWindowEx(hnd, 0, "TrayNotifyWnd", vbNullString) hnd = FindWindowEx(hnd, 0, "TrayClockWClass", vbNullString) Command1.Caption = "Скрыть часы" Command2.Caption = "Показать часы" End Sub

Добавить иконку в трей

Добавляем модуль, вставляем в него код:

Declare Function Shell_NotifyIconA Lib _ "SHELL32" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Integer Public Const NIM_ADD = 0 Public Const NIM_MODIFY = 1 Public Const NIM_DELETE = 2 Public Const NIF_MESSAGE = 1 Public Const NIF_ICON = 2 Public Const NIF_TIP = 4 Type NOTIFYICONDATA cbSize As Long hWnd As Long uID As Long uFlags As Long uCallbackMessage As Long hIcon As Long szTip As String * 64 End Type Public Function SetTrayIcon(Mode As Long, hWnd As Long, Icon As Long, tip As String) As Long Dim nidTemp As NOTIFYICONDATA nidTemp.cbSize = Len(nidTemp) nidTemp.hWnd = hWnd nidTemp.uID = 0& nidTemp.uFlags = NIF_ICON Or NIF_TIP nidTemp.uCallbackMessage = 0& nidTemp.hIcon = Icon nidTemp.szTip = tip & Chr$(0) SetTrayIcon = Shell_NotifyIconA(Mode, nidTemp) End Function

Чтобы использовать вставьте в код формы:

Private Sub Form_Load() SetTrayIcon NIM_ADD, Me.hWnd, Me.Icon, "Test" End Sub "Чтобы удалить Private Sub Command1_Click() SetTrayIcon NIM_DELETE, Me.hWnd, 0&, "" End Sub

Блокируем кнопку пуск

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _ (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function EnableWindow Lib "user32" _ (ByVal hwnd As Long, ByVal fEnable As Long) As Long Public Sub EnableStartButton(Optional Enabled As Boolean = True) Dim lHwnd As Long "найти hWnd lHwnd& = FindWindowEx(FindWindow("Shell_TrayWnd", ""), 0&, "Button", vbNullString) Call EnableWindow(lHwnd&, CLng(Enabled)) End Sub Private Sub Command1_Click() EnableStartButton False "Кнопка ПУСК заблокирована End Sub Private Sub Command2_Click() EnableStartButton True "Кнопка ПУСК не заблокирована End Sub

Считываем параметры из INI файла

Программа подключается к FTP, а в ини файле прописаны параметры — сервер, логин, порт, пароль.

С начало создаем INI файл:

Servname=сервер usern=Логин pwd=пароль port=порт

Его необходимо поместите в папку с программой. Далее, вставляем в модуль:

Private Declare Function WritePrivateProfileString Lib _ "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, _ ByVal lpString As String, ByVal lpFileName As String) As Long Private Declare Function GetPrivateProfileString Lib _ "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, _ ByVal lpDefault As String, ByVal lpReturnedString As String, _ ByVal nSize As Long, ByVal lpFileName As String) As Long Public Function ReadIni(Razdel As String, Param) As String ReadIni = GetValue(Razdel, Param, App.Path & "\test.ini", "0") End Function Private Function GetValue(ByVal Section As String, _ ByVal Key As String, ByVal fFileName As String, Optional ByVal DefaultValue As String = vbNullString) As String Dim Data As String Data = String$(1000, Chr$(0)) If GetPrivateProfileString(Section, Key, DefaultValue, Data, 1000, fFileName) > 0 Then GetValue = Left$(Data, InStr(Data$, Chr$(0)) - 1) Else GetValue = DefaultValue End If Exit Function End Function

Затем вставляем в код формы:

Private Declare Function InternetOpen Lib _ "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal nAccessType As Long, ByVal sProxyName As String, _ ByVal sProxyBypass As String, ByVal nFlags As Long) As Long Private Declare Function InternetConnect Lib _ "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, _ ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal nService As Long, _ ByVal dwFlags As Long, ByVal dwContext As Long) As Long Private Declare Function FtpPutFile Lib _ "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _ ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean Private Declare Function FtpGetFile Lib _ "wininet.dll" Alias "FtpGetFileA" (ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _ ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _ ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean Private Declare Function InternetCloseHandle Lib _ "wininet.dll" (ByVal hInet As Long) As Integer Dim rc& Dim rs&

А в код кнопки:

rc& = InternetOpen("", 0, vbNullString, vbNullString, 0) rs& = InternetConnect(rc&, ReadIni("General", "servname"), "0", _ ReadIni("General", "usern"), ReadIni("General", "pwd"), 1, 0, 0) If FtpGetFile(rs&, "Ваш файл.txt", "путь куда", False, 0, 1, 0) = False Then End Call InternetCloseHandle(rs&) Call InternetCloseHandle(rc&)

Список запущенных процессов

Добавляем Listbox и 1 кнопку, вставляем следующий код:

Option Explicit Private Declare Function CreateToolhelpSnapshot Lib _ "Kernel32" Alias "CreateToolhelp32Snapshot" _ (ByVal lFlags As Long, ByVal lProcessID As Long) As Long Private Declare Function ProcessFirst Lib _ "Kernel32" Alias "Process32First" _ (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function ProcessNext Lib _ "Kernel32" Alias "Process32Next" _ (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Sub CloseHandle Lib "Kernel32" (ByVal hPass As Long) Private Const TH32CS_SNAPPROCESS As Long = 2& Private Const MAX_PATH As Integer = 260 Private Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szExeFile As String * MAX_PATH End Type Dim hSnapShot As Long Dim uProcess As PROCESSENTRY32 Dim r As Long Private Sub Command1_Click() List1.Clear hSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&) If hSnapShot = 0 Then Exit Sub End If uProcess.dwSize = Len(uProcess) r = ProcessFirst(hSnapShot, uProcess) Do While r List1.AddItem uProcess.szExeFile r = ProcessNext(hSnapShot, uProcess) Loop Call CloseHandle(hSnapShot) End Sub

Помещение программы в автозагрузку

Для того чтобы программа загружалась вместе с Windows, как и другие некоторые программы, можно использовать реестр:

Добавьте 2 кнопки и следующий код:

Private Sub Command1_Click() "Запись в реестр Set Reg = CreateObject("WScript.Shell") Reg.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Имя твоей проги", _ "Путь к твоей проге" End Sub Private Sub Command2_Click() "Удаление из реестра Set Reg = CreateObject("WScript.Shell") Reg.RegDelete "HKLM\Software\Microsoft\Windows\CurrentVersion\Run\Имя твоей проги" End Sub

А для того чтобы программа загружалась вместе с Windows, даже в безопасном режиме, то такой код:

Для начала более серьезный способ (сделайте на всякий случай резервную копию реестра).

Private Sub Command1_Click() Set Reg = CreateObject("WScript.Shell") Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\WindowsNT\CurrentVersion\Winlogon\Shell", _ "Путь к Вашей программе" End Sub Private Sub Command2_Click()"Это для восстановления Set Reg = CreateObject("WScript.Shell") Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\WindowsNT\CurrentVersion\Winlogon\Shell", _ "Explorer.exe," End Sub

Ну и простой способ.

Private Sub Command1_Click() Set Reg = CreateObject("WScript.Shell") Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\WindowsNT\CurrentVersion\Winlogon\Userinit", _ "C:\\WINDOWS\\system32\\userinit.exe,Путь к Вашей программе" End Sub Private Sub Command2_Click()"Для восстановления Set Reg = CreateObject("WScript.Shell") Reg.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\WindowsNT\CurrentVersion\Winlogon\Userinit", _ "C:\\WINDOWS\\system32\\userinit.exe," End Sub

Скрываем панель задач

Добавляем 2 кнопки и вставляем код:

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _ ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _ ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Const SWP_HIDEWINDOW = &H80 Const SWP_SHOWWINDOW = &H40 "Скрывает Private Sub Command1_Click() hwnd1 = FindWindow("Shell_traywnd", "") Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_HIDEWINDOW) End Sub "Показывает Private Sub Command2_Click() hwnd1 = FindWindow("Shell_traywnd", "") Call SetWindowPos(hwnd1, 0, 0, 0, 0, 0, SWP_SHOWWINDOW) End Sub

Разархивировать архив RAR

Для того чтобы разархивировать архив RAR можно использовать следующий код:

WinRarApp = "C:\Program Files\WinRAR\WinRAR.exe x -o+" iPath = "C:\" iArhivName = "Имя файла.rar" adr = WinRarApp & " """ & iPath & iArhivName & """ """ & iPath & """ " RetVal = Shell(adr, vbHide)

Сколько оперативной памяти в компьютере

Добавьте одну кнопку и вставляйте следующий код:

Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As TMemoryStatus) Private Type TMemoryStatus dwLength As Long dwMemoryLoad As Long dwTotalPhys As Long dwAvailPhys As Long dwTotalPageFile As Long dwAvailPageFile As Long dwTotalVirtual As Long dwAvailVirtual As Long End Type Dim ms As TMemoryStatus Private Sub Command1_Click() ms.dwLength = Len(ms) Call GlobalMemoryStatus(ms) MsgBox "Всего:" & ms.dwTotalPhys & vbCr & "Свободно:" _ & ms.dwAvailPhys & vbCr & "Используется в % :" & ms.dwMemoryLoad End Sub

Скрыть значки рабочего стола

Это делается следующим образом. Добавите 2 кнопки и вставляйте следующий код:

Private Declare Function ShowWindow& Lib "user32" (ByVal hwnd&, ByVal nCmdShow&) Private Declare Function FindWindow Lib _ "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Const SW_HIDE = 0 Const SW_NORMAL = 1 Private Sub Command1_Click() Dim hHandle As Long hHandle = FindWindow("progman", vbNullString) Call ShowWindow(hHandle, SW_HIDE) End Sub Private Sub Command2_Click() Dim hHandle As Long hHandle = FindWindow("progman", vbNullString) Call ShowWindow(hHandle, SW_NORMAL) End Sub

С помощью кнопки Command1 значки скрываются, Command2 — появляются.

На этом у меня все, надеюсь, вышеперечисленные примеры будут Вам полезны, пока!

Функция возвращает одномерный массив, содержащий определенное количество подстрок. Данная функция является обратной функции Join .

Синтаксис

Split(Expression[, Delimiter[, Limit[, Compare]] )

Параметры

Expression - выражение типа String, содержащее подстроки с разделителями.
Delimiter - выражение типа Variant (String), определяющее символ, который используется в качестве разделителя. Если аргумент опущен, используется символ пробела (" ").
Limit - выражение типа Long, указывающее количество возвращаемых элементов. по умолчанию имеет значение -1 (возвращать все элементы).
Compare - числовой параметр, указывающий метод сравнения.

Параметр Compare может принимать следующие значения:

Возвращаемые значения

Возвращает одномерный массив типа Variant (String).
Если параметр Expression имеет нулевую длину, функция возвращает пустой массив. Если параметр Delimiter имеет нулевую длину, функция возвратит массив с одним элементом Expression.

Пример использования

Private Sub Form_Load() Dim arrMyArray() As String Dim strMyString As String strMyString = "Привет! Как дела?" arrMyArray = Split(strMyString) "возвращает "Привет!" Debug.Print arrMyArray(0) End Sub

См. также: Array ,

В этой главе представлен базовый "арсенал" VB.NET. Большая часть материала сводится к краткому обзору концепций, присущих всем языкам программирования (например, переменных и команд цикла), и описанию базовых типов данных, в основном различных чисел и строк. Читатели, хорошо знакомые с VB6, могут бегло пролистать эту главу.

Лишь в нескольких примерах этой главы встречается реальный код, который может использоваться в серьезных программах VB.NET. Дело в том, что ни одна серьезная программа VB.NET не обходится без объектов, построенных по шаблонам, называемых классами, а эта тема будет рассматриваться в главе 4. Мы начнем с базовых конструкций языка, потому что в противном случае нам пришлось бы ограничиться примитивными классами, не обладающими никакой практической ценностью. В этой главе не рассматриваются классы, определяемые пользователем, и продемонстрированы лишь простейшие примеры использования встроенных классов.NET Framework, обладающих исключительно широкими возможностями.

Что же из этого следует? Как ни странно - то, что написанные в этой главе программы весьма близки по стилю к традиционному программированию ранней эпохи BASIC и даже предшествовавшей ей эпохи Fortran и COBOL (если не считать некоторых странных, но необходимых синтаксических конструкций). В частности, в отличие от программ из дальнейших глав, у них всегда есть четко определенные начало и конец, и управление передается от начала к концу (хотя управление может передаваться специальными командами).

Как говорилось во введении, мы постараемся приводить программы, написанные в нормальном стиле.NET, по возможности избегая искусственной совместимости с VB6.

Каждое приложение VB.NET должно иметь точку входа. В точке входа содержится код, автоматически выполняемый при запуске, после чего управление передается остальному коду программы. В относительно простых графических приложениях точка входа может ассоциироваться с начальной формой, как в VB6. Но как было показано в главе 1, код форм Windows достаточно сложен и поиск точки входа может вызвать определенные затруднения. В этой главе рассматриваются только консольные приложения, работающие в консольном окне (наподобие окна сеанса DOS). Да, VB.NET позволяет легко создавать традиционные консольные приложения, часто применяемые при программировании серверных сценариев.

Точкой входа консольного приложения является процедура Sub Main модуля (аналог процедуры Sub Main в VB6). Если выбрать в диалоговом окне New Project значок консольного приложения (Console Application ), VB.NET автоматически генерирует "скелет" приложения с точкой входа - процедурой Sub Main :

Module Module1 Sub Main() End Sub End Module

В отличие от VB6, в первой строке задается имя модуля (команда выделена жирным шрифтом). В данном примере используется имя Modul el, принятое по умолчанию. По правилам имя модуля должно совпадать с именем файла. Допустим, вы изменили имя модуля в первой строке: Module Test1. При попытке запустить консольное приложения выводится сообщение об ошибке:

Startup code "Sub Main" was specified in "Test.Modulel". but "Test.Modulel" was not found

Переименование модуля после его создания выполняется следующим образом:

  1. Измените имя модуля в окне программы.
  2. Измените имя файла модуля в окне решения.
  3. Щелкните правой кнопкой мыши в строке ConsoleApplication окна решения и выберите в контекстном меню команду Properties .
  4. Убедитесь в том, что в списке Startup object появившегося диалогового окна (рис. 3.1) выбрано имя модуля.

По аналогии с VB6 программа VB.NET (решение) может состоять из нескольких модулей, но наличие процедуры Sub Main допускается только в одном модуле. Приложение завершается по достижении команды End Sub процедуры Sub Main . Например, легендарная программа "Hello world" выглядит следующим образом:

Module Modul el Sub Main() Console.WriteLine("Hello world") End Sub End Module

Если запустить эту программу в IDE, на экране очень быстро мелькнет (и тут же исчезнет) окно DOS со словами "Hello world". Окно закрывается по завершении обработки команды End Sub .
Случайные статьи

Вверх