Студопедия

Главная страница Случайная страница

Разделы сайта

АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника






Собираем поверхностную информацию о системе






Даный код был написан от нефиг делать, он прост до ужаса =).

Он в состоянии собрать поверхностную информацию о:

· имени компьютера

· имени пользователя

· типе системы

· архитектуре процессора

· внешнем ip

· о системе(win7 или win xp)

Вот код:

Dim HTMLCode As String Public Function nasDirExists(strPathName As String) As Boolean On Error Resume Next Dim strDir As String strDir = Dir(strPathName, vbDirectory) If (Len(strDir) = 0 Or Err = 76) Then nasDirExists = False Else nasDirExists = True End IfEnd FunctionPrivate Sub Form_Load()Label1.Caption = " Имя компьютера: " + Environ(" Computername") 'имя компа = системной переменной ComputernameLabel2.Caption = " Имя пользователя: " + Environ(" Username") 'имя пользователя = системной переменной UsernameLabel3.Caption = " Тип системы: " + Environ(" os") 'тип системы = системной переменной osLabel4.Caption = " Архитектура процессора: " + Environ(" processor_architecture") 'архитектура процессора = системной переменной processor_architectureWinsock1.RemotePort = 80 Winsock1.RemoteHost = " ippages.com" Winsock1.ConnectEnd SubPrivate Sub Winsock1_Close()Winsock1.CloseEnd Sub Private Sub Winsock1_Connect() Winsock1.SendData " GET " + " /simple/" + " HTTP/1.0" + Chr(10) + Chr(10)End Sub Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long) Winsock1.GetData HTMLCode 'Получаем данные и помещаем их в переменную Label5.Caption = " Твой внешний ip: " + CutIP(HTMLCode) 'label6 = полученному с сервера внешнему ip If nasDirExists(Environ(" windir") + " \vss") Then 'проверка системы на наличие папки vss (папка vss есть в win 7, а в win xp её нет, поэтомы выполняются арзличные выдачи сообщений)Label6.Caption = " Твоя система: Windows 7" 'папка существует ElseLabel6.Caption = " Твоя система: windows XP" 'если папки не существует End IfEnd SubFunction CutIP(HTML As String) As StringDim p1 As Integer p1 = InStr(HTML, " Content-Type: text/html") CutIP = Trim(Mid(HTML, p1 + 27, Len(HTML) - p1 - 23))End Function

 

Проверяем подключен ли Интернет

Иногда надо проверить подключен ли интернет, я нашёл много способов но они либо кривые, либо для них нужны компоненты которые есть не на каждом компьютере.

Думал я и придумал, что есть простое решение задачи для этого нам нужен файл лежащий на удалённом сервере (ftp), и нам нужно знать его содержимое (желателен собственный сайт или же сайт на котором сожержимое файла не менялось и не будет менятся (у меня есть сайт соотвецтвенно я сам создам файл и не буду его менять).

Нам нужно знать к нему путь, на моём сайте это вот такой путь: https://rgserver.my1.ru/vbbook.ru, и его содержимое: " привет! ".

теперь нам понадобится компонент: Internet Transfer Control 6.0 (его можно добавить нажав: ctrl + t => и начинайте его искать в графе " Управления"), нашли?), кидайте его на форму!

Теперь код:

(из того что было в интернете короче этого кода только код на vb.net)

Private Sub Form_Load() Dim vData As VariantvData = Me. Inet1.OpenURL(" https://rgserver.my1.ru/vbbook.ru", icString) If (vData = " привет! ") Then 'если полученный с интернета текст будет равен заданному в программе тексту: привет! то: Me. Caption = " Интернет подключен! " ' если текст совпадёт то будет сообщение о том что интернет включен Else ' или Me. Caption = " Интернет не подключен! " ' если текст не совпадёт то будет сообщение о том что интернет не включен End If ' завершение процедуры проверки End Sub

 

Определяем разрядность системы

Иногда нужно узнать какая разрядность у системы (например мне нужно было узнать какой установщик качать, из за того что установщик на x86 (x32) отказывался устанавливатся на x64, понадобилось определение разрядности, а разрядность бывает: x86 (так же известна как x32) и x64. Они различаются тем что x86 (x32) может видить до 4 гигов оперативной памяти (приложения работают чуть медленнее), в отличии от x64 (которая жрёт немного больше оперативной памяти, но видит от 4+ гигов оперативы, и приложения работают на ней быстрее), поэтому разработчики которые любят " железки" не брезгают тем, что их программа может работать быстрее на x64 нежели на x32, поэтому некоторые крупные разработчики делают разные версии своих программ под x86(x32), и x64, соотвецтвенно что некоторые приложения " заточенные" под одну разрядность отказываются работать в другой и нужно определить разрядность и скоректировать установку, ломал я голову и придумал =)

Dim x64 As String 'объявляем переменные Private Sub Form_Load()x64 = Environ(" PROGRAMFILES(x86)") ' присваиваем системную переменную папки, если это x86 то системная переменная выдаст пустоту, потому что в ней нет системной папки! If (x64 = " ") Then ' а тут и определим что выдаст переменная x64 если пустоту то у пользователя x32, а если выдаст не пустоту а в случае x64 она выдаст путь: C: \Program Files (x86), который не как не похож на пустоту согласитесь =). MsgBox " У тебя x32 (x86)" ' выдает такосообщение если переменная = пустоте Else MsgBox " У тебя x64" 'или если переменная = C: \Program Files (x86) (а путь до папки это явно не пустота) End IfEnd Sub

 






© 2023 :: MyLektsii.ru :: Мои Лекции
Все материалы представленные на сайте исключительно с целью ознакомления читателями и не преследуют коммерческих целей или нарушение авторских прав.
Копирование текстов разрешено только с указанием индексируемой ссылки на источник.