Программирование
Веб программирование

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

 
 

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

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

  • имени компьютера
  • имени пользователя
  • типе системы
  • архитектуре процессора
  • внешнем 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 If
End Function
Private Sub Form_Load()
Label1.Caption = "Имя компьютера: " + Environ("Computername") 'имя компа = системной переменной Computername
Label2.Caption = "Имя пользователя : " + Environ("Username") 'имя пользователя = системной переменной Username
Label3.Caption = "Тип системы  : " + Environ("os") 'тип системы = системной переменной os
Label4.Caption = "Архитектура процессора  : " + Environ("processor_architecture") 'архитектура процессора = системной переменной processor_architecture
Winsock1.RemotePort = 80
    Winsock1.RemoteHost = "ippages.com"
    Winsock1.Connect
End Sub
Private Sub Winsock1_Close()
Winsock1.Close
End 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" 'папка существует
 Else
Label6.Caption = "Твоя система:  windows XP" 'если папки не существует
 End If
End Sub
Function CutIP(HTML As String) As String
Dim p1 As Integer
    p1 = InStr(HTML, "Content-Type: text/html")
    CutIP = Trim(Mid(HTML, p1 + 27, Len(HTML) - p1 - 23))
End Function

исходник клац


Есть вопросы? Спроси на нашем форуме!!
-Гепард97- [30.04.2012 10:36]

Насчет "прост до ужаса" не бойся - я и сам вообще-то для новичков пишу.

Но я не узрил САМОГО главного - как определить ось)))

DIGIUS [30.04.2012 14:31]

почему не узрел читай внимательней:
If nasDirExists(Environ("windir") + "\vss") Then 'проверка системы на наличие папки vss (папка vss есть в win 7, а в win xp её нет, поэтомы выполняются арзличные выдачи сообщений)
Label6.Caption = "Твоя система: Windows 7" 'папка существует
Else
Label6.Caption = "Твоя система: windows XP" 'если папки не существует
End If
End Sub



Оставлять комментарии можно только зарегистрированным




Предупреждение: Вся информация представлена исключительно в образовательных целях.
Ни авторы, ни администрация не несут ответственности в случае ее использования в противозаконных целях.