Начну статью с того, как можно сделать свой простенький сервер HTTP. За основной компонент работающий с сетевыми протоколами я буду брать контрол «Тяга». Данный контрол выполняет те же самые функции что и стандартный компонент WinSock, но он присоединяется к проекту и компилируется вместе с ним. Так же плюсом использования данного контрола является то что можно изменять его содержимое на ваше усмотрение. Контрол вы можете скачать по следующему адресу – http://www.localhost.co.nr по вопросам работы контрола можете обращаться к автору данного произведения по icq# 780477. После успешной закачки контрола вам необходимо создать новый проект на VB и присоединить контрол к работе. Это делается так – В верхнем меню выберите опцию «Project» (Проект) - > “Add File” (добавить файл) и дальше выберите файл контрола. Так же эту операцию можно произвести с помощью быстрых клавиш “Ctrl + D”. Выкиньте на форму одну копию контрола и можно начинать. Для начала необходимо установить локальный порт на котором будет работать наша программа:

Private Sub Form_Load()
  T1.Listen 80 ‘Ставим 80-ый порт на прослушивание
End Sub

Программа будет принимать данные на этот порт. Т.к. 80-ый порт это стандартный порт HTTP протокола то мы будем использовать его =). Теперь нам необходимо получить какие ни будь данные и например вывести ошибку с текстом полученных данных.. Это делается вот так:

Private Sub T1_DataArrival(Data As String)
  MsgBox Data ’ Вывести ошибку с содержим полученных данных
End Sub

Как видно в функции “T1_DataArrival” переменная “Data” содержит в себе все данные, которые она приняла. Необходимо опробовать код. Запустите Internet Explorer и введите в поле «Адрес» - http://127.0.0.1. На экране появится ошибка которая будет содержать в себе пакет который посылает Браузер “IE” при запросе адреса (сайта например mail.ru) только в данном случае он запрашивает с вашего компьютера что то посылая этот пакет. Если очень интересно то в интересно то можно найти информацию о Стандарте HTTP пакетов и т.п. вещах. И так нам нужно поймать этот пакет чтобы досконально изучить. Выкиньте на форму текстовое поле и запишите код:

Private Sub T1_DataArrival(Data As String)
  Text1.text = Data ’ Вывести ошибку с содержим полученных данных
End Sub

В конце итоге мы получили:

GET / HTTP/1.1
Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg,
application/vnd.ms-excel, application/vnd.ms-powerpoint,
application/msword, */*
Accept-Language: ru
If-Modified-Since: Tue, 18 Jan 2005 20:13:56 GMT
If-None-Match: "0-1a0-41ed6e04"
User-Agent: Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)
Host: 127.0.0.1
Connection: Keep-Alive

Разъясню пакет по порядку:

«GET» - Означает что запрос информации происходит Get способом.
«/» - Означает что запрашивается файл который стоит по умолчанию т.е. в конфигурациях серверов обычно установлен файл который высылается сервером клиенту в случае пустого места или по другому когда клиент не указывает конкретного файла.
«HTTP/1.1» - Версия протокола
«Accept:» - далее идет список принимаемых картинок. Т.е. если пользователь указал что он не принимает картинки значит в этой строке ничего не будет или будет отсутствовать строка.
«Accept-Language» - язык
Две последующих строки являются не очень и важными для сервера поэтому я их пропускаю.

«User-Agent» - здесь указывается название, версию браузера например «IE»

«Host» - Хост к которому обращается клиент. У каждого сервера есть IP адрес за которым закреплены именно хостов. Каждый сервер может содержать очень много хостов (отдельных сайтов). Т.е. получается сервер должен распознавать к какому хосту обращается клиент. Эта строка очень важна если ты будешь продолжать писать Сервер на VB после этого урока. Т.к. мы пишем простой сервер и этих вещей мы рассматривать не будем.
И так как же нам быть? Что писать? В данном случае т.к. это простой сервер нам понадобится только одна строка из выше перечисленного пакета. А именно файл к какому обращается пользователь. Нам необходимо найти в пакете посланным Браузером имя файла которое он хочет отобразить у себя. Отталкиваться будем от первого пробела. Т.к. если отталкиваться от слова «GET» можно допустить грубейшую ошибку. Возможно пользователь запросит информацию методом «POST» и тогда он ничего не увидит кроме ругательств браузера. И так начнем:

Private Sub T1_DataArrival(Data As String)
  Dim qw ' Объявляем переменную
  qw = 1 'Тут понятно =)
  g1 = InStr(qw, Data, " ") 'Находим первый пробел в пакете присланном клиентом
  g2 = Right(Data, Len(Data) - g1) ' Берем весь текст от пробела и до конца
                                   ' путем с права на лево. Значит нам необходимо вычесть кол-во всех
                                   ' символов в пакете минус число символов до пробела Поучим кол-во
                                   ' символов которые необходимо взять с права на лево
                                   'Дальше все пакеты обьеденяет слово HTTP
  g3 = InStr(qw, g2, "HTTP") 'Находим слов HTTP в полученном тексте
  g4 = Left(g2, g3 - 1) 'Берем с лева определенное кол-во символов до HTTP минус один символ т.к. мы захватываем символ H слова HTTP
  file = Trim(g4) ' Обрезаем пробелы с обоих концов
  sendfile (file) ' Высылаем файл с помощью нашей функции
End Sub

Функцию sendfile мы еще не написали так что не обольщайтесь. Как видно в коде все просто =). Приступим к написанию той самой функции высылки файла. Но для начала создайте директорию «html» в рабочей папке проекта и в ней файл “index.html” с приятным содержанием.

Sub sendfile(file)
On Error GoTo err 'При возникновении ошибки не реагировать агрессивно и перейти на конец функции
  Dim textfile As String ' Объявляем переменную содержимое которой будем отсылать

  If Left(file, 1) = "/" Then ' Если первый символ названия файла равен слэшу то
    file = Right(file, Len(file) - 1) ' Убираем слэш в имени файла
  End If

  If file = "" Then ' Если имя файла равно пустому месту тогда
    file = "index.html" ' Имя файла делаем index.html по умолчанию главный файл сайта
  End If

  tra (file)

  If temp = "1" Then ' Если после проверки функцией tra возвращается "1" значит высылаем файл если же нет высылает сама функция tra()
  Open App.Path & "\html\" & file For Input As 1 'Открываем файл на чтение
  Do While Not EOF(1)
    Line Input #1, a$
    textfile = textfile & a$ 'Забиваем все содержимое файла в переменную
  Loop
Close #1

T1.SendData textfile ' Отсылаем текст из файла
T1.CloseConnection ' Закрываем соединение
T1.Listen 80 ' Слушаем порт 80
End If ' Конец условия функции tra()

err: ' Обработчик ошибок
End Sub

На самом, самом верху программы до кода функций необходимо написать:

Dim temp
Вглядывайся в комментария они не дадут тебе засохнуть =). Моя задача изложить как можно яснее написание данного кода но это очень сложно сделать так что будь добор попробуй еще и сам понять что я тут делаю. Теперь нам необходима функция tra(). Эта функция будет у нас служить как проверка директорию ли запрашивает пользователь или файл. Задача функции открыть файл с конфигурацией расширений и с помощью умного написанного кода определить есть ли у файла хоть один из всех занесенных в конфигурации сервера расширение, и послать «1» в переменную “temp”. Если же нет тогда вернуть цифру «0» в переменную “temp” и послать клиенту содержимое данной директории, если такова имеется. Создайте файл «ras.ts» и впишите туда:

.html
.htm
.css
Создаем функцию проверки расширений:

Sub tra(file)
  Open App.Path & "\ras.ts" For Input As 2 'Открываем файл на чтение
    Do While Not EOF(2)
      Line Input #2, a$
      If ok <> "ok" Then ' Если уже подошло одно расширение

      If Trim(a$) <> "" Then
        If Right(file, Len(a$)) = a$ Then 'Проверяем расширения
          temp = 1
          ok = "ok"
        End If
      End If
  End If
Loop
Close #2

If ok <> "ok" Then ' Если не подошло не одно расширение
  temp = 0 ' Даем отбой высылке файла
  senddir (file) ' Высылаем содержимое директории
End If
End Sub

Далее идет функция высылки содержимого директории:

Sub senddir(file)
On Error GoTo err

  Dim la As String
  If Right(file, 1) = "\" Then
    file = Left(file, Len(file) - 1)
  End If
  Mypath = App.Path & "\html\" & file & "\"
  MyName = Dir(mypath, vbDirectory): fff = 0
  fff = 0
  Do While MyName <> ""
  If Right$(mypath, 1) = "\" Then
    pth = mypath
  Else
    pth = mypath + "\"
  End If
If MyName <> "." And MyName <> ".." Then
  If (GetAttr(pth) And vbDirectory) = vbDirectory Then
    fff = fff + 1
    la = la & vbCrLf & fff & ") " & MyName
  End If
End If

MyName = Dir
Loop
  T1.SendData la
  T1.CloseConnection
  T1.Listen 80
err:
End Sub

Ну, вот собственно и все =). Сервер работает, но с большими ошибками. Для того чтобы заделать ошибки много ума не нужно, так что у тебя все впереди. Дерзай…

А. Иванов
E-Mail: termit@list.ru