Санкт-Петербургский
Государственный электротехнический университет
Отчет
по лабораторной работе №4
«Коммуникации»
Выполнил: Солоха В.Н.
Группа:0331
Факультет КТИ
Санкт-Петербург
2003г.
Цель работы: Организовать связь между двумя компьютерами. (Выбран метод соединения по WinSock32 по порту 80)
Используемые API функции:
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function ChooseFont Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As ChooseFont) As Long
Private Declare Function PrintDlg Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PrintDlg) As Long
Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hOwner As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
Private Declare Function SHShutDownDialog Lib "shell32" Alias "#60" (ByVal YourGuess As Long) As Long
Private Declare Function SHRestartSystem Lib "shell32" Alias "#59" (ByVal hOwner As Long, ByVal sPrompt As String, ByVal uFlags As Long) As Long
Private Declare Function SHRunDialog Lib "shell32" Alias "#61" (ByVal hOwner As Long, ByVal hIcon As Long, ByVal sDir As Long, ByVal szTitle As String, ByVal szPrompt As String, ByVal uFlags As Long) As Long
Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwndOwner As Long, ByVal iDrive As Long, ByVal iCapacity As Long, ByVal iFormatType As Long) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHChangeIconDialog Lib "shell32" Alias "#62" (ByVal hOwner As Long, ByVal szFilename As String, ByVal Reserved As Long, lpIconIndex As Long) As Long
Private Declare Function SHObjectProperties Lib "shell32" Alias "#178" (ByVal hOwner As Long, ByVal uFlags As Long, ByVal sName As String, ByVal sParam As String) As Long
Private Declare Function SHAbout Lib "shell32" Alias "ShellAboutA" (ByVal hOwner As Long, ByVal sAppName As String, ByVal sPrompt As String, ByVal hIcon As Long) As Long
Private Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" (ByVal szPath As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHFree Lib "shell32" Alias "#196" ()
Private Declare Function ILFree Lib "shell32" Alias "#195" (ByVal pidlFree As Long)
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Declare Function CopyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Declare Function ExtractIconEx Lib "shell32" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetTextFace Lib "gdi32" Alias "GetTextFaceA" (ByVal hdc As Long, ByVal nCount As Long, ByVal lpFacename As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hOwner As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (p1 As Any, p2 As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Также использован стандартная библиотека MSWINSCK.OCX
Интерфейс программы:
Текст программы:
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Коммуникации -=HTTP Сервер =-"
ClientHeight = 2265
ClientLeft = 45
ClientTop = 435
ClientWidth = 8400
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 2265
ScaleWidth = 8400
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command1
Caption = "..."
Height = 255
Left = 7800
TabIndex = 17
Top = 600
Width = 495
End
Begin VB.Frame Frame1
Caption = "Страницы по различным событиям"
Height = 1215
Left = 120
TabIndex = 6
Top = 960
Width = 3375
Begin VB.TextBox Text3
Height = 285
Left = 1320
TabIndex = 10
Text = "notfound.html"
Top = 720
Width = 1935
End
Begin VB.TextBox Text2
Height = 285
Left = 1320
TabIndex = 8
Text = "index.html"
Top = 360
Width = 1935
End
Begin VB.Label Label4
Caption = "Не найдена:"
Height = 255
Left = 120
TabIndex = 9
Top = 720
Width = 1095
End
Begin VB.Label Label3
Caption = "По умолчанию:"
Height = 255
Left = 120
TabIndex = 7
Top = 360
Width = 1455
End
End
Begin VB.TextBox Text1
Height = 285
Left = 3600
TabIndex = 4
Top = 600
Width = 4095
End
Begin VB.OptionButton Option1
Caption = "Обычный HTTP сервер"
Height = 255
Left = 600
TabIndex = 3
Top = 2760
Value = -1 'True
Visible = 0 'False
Width = 2175
End
Begin Проект1.Linez3D Linez3D1
Height = 135
Left = 0
TabIndex = 2
Top = 360
Width = 8295
_ExtentX = 14631
_ExtentY = 238
End
Begin MSWinsockLib.Winsock W
Index = 0
Left = 360
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin MSWinsockLib.Winsock ListenW
Left = 0
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
LocalPort = 80
End
Begin VB.CheckBox Check1
Caption = "Включить сервер"
Height = 375
Left = 3600
Style = 1 'Graphical
TabIndex = 0
Top = 1800
Width = 4695
End
Begin VB.Label Label8
Caption = "Байт"
Height = 255
Left = 7680
TabIndex = 16
Top = 1440
Width = 615
End
Begin VB.Label TrafikOUT
BorderStyle = 1 'Fixed Single
Caption = "0"
Height = 255
Left = 5280
TabIndex = 15
Top = 1440
Width = 2295
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "Исходящий траффик:"
Height = 195
Left = 3600
TabIndex = 14
Top = 1440
Width = 1635
End
Begin VB.Label Label6
Caption = "Байт"
Height = 255
Left = 7680
TabIndex = 13
Top = 1080
Width = 615
End
Begin VB.Label TrafikIN
BorderStyle = 1 'Fixed Single
Caption = "0"
Height = 255
Left = 5280
TabIndex = 12
Top = 1080
Width = 2265
End
Begin VB.Label Label5
Caption = "Входящий траффик:"
Height = 255
Left = 3600
TabIndex = 11
Top = 1080
Width = 1575
End
Begin VB.Label Label2
Caption = "Папка, в которой находятся файлы сервера:"
Height = 255
Left = 120
TabIndex = 5
Top = 600
Width = 3615
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "Сервер Выключен!"
BeginProperty Font
Name = "Comic Sans MS"
Size = 12
Charset = 204
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 495
Left = 2760
TabIndex = 1
Top = 0
Width = 2175
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Socket(65535) As Boolean
Private DLG As New ClsDialog
Dim SysFolder As String
Private Sub Check1_Click()
If Check1.Value = 1 Then
ListenW.Listen
Check1.Caption = "Выключить сервер"
Label1.Caption = "Сервер Включен!"
Label1.ForeColor = &H8000&
Frame1.Enabled = False
Text1.Enabled = False
Else
For i = 1 To 65535
If Socket(i) = True Then
W(i).Close
Unload W(i)
Socket(i) = False
End If
Next
ListenW.Close
Check1.Caption = "Включить сервер"
Label1.Caption = "Сервер Выключен!"
Label1.ForeColor = vbRed
Frame1.Enabled = True
Text1.Enabled = True
End If
End Sub
Private Sub Command1_Click()
DLG.ShowFolder "Выберите папку, которая предназначена для хранения файлов сервера."
Text1.Text = DLG.InitDir
If Right(Text1.Text, 1) <> "\" Then Text1.Text = Text1.Text & "\"
End Sub
Private Sub Form_Load()
Text1.Text = GetSetting("HTTP", "config", "folder")
For i = 1 To 65535
Socket(i) = False
Next
End Sub
Private Sub GoldButton1_Click()
End Sub
Private Sub ListenW_ConnectionRequest(ByVal requestID As Long)
For i = 1 To 65535
If Socket(i) = False Then
Load W(i)
W(i).RemotePort = 80 + i
W(i).Accept requestID
Socket(i) = True
Exit For
End If
Next
ListenW.Close
ListenW.Listen
End Sub
Private Sub Text1_Change()
SysFolder = Text1.Text
SaveSetting "HTTP", "config", "folder", SysFolder
End Sub
Private Sub W_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim InData As String
Dim URL As String
Dim OutStr As String
W(Index).GetData InData, vbString
TrafikIN.Caption = Val(TrafikIN.Caption) + bytesTotal
URL = Mid(InData, 6, InStr(7, InData, " ") - 6)
If Left(URL, 1) = " " Then URL = Text2.Text
Open SysFolder & "logfile.log" For Append As 3
Print #3, "[" & Date$ & " " & Time$ & "]" & vbCrLf & InData & vbCrLf & "------------------------------------------" & vbCrLf
On Error GoTo errr:
Open SysFolder & URL For Input As 10
Close
1
Open SysFolder & URL For Binary As 1
OutStr = Input(LOF(1), 1)
Close
W(Index).SendData OutStr
TrafikOUT.Caption = Val(TrafikOUT.Caption) + Len(OutStr)
Exit Sub
errr:
Close
URL = Text3.Text
GoTo 1
End Sub
Private Sub Ext(Index As Integer)
Socket(Index) = False
Unload W(Index)
End Sub
Private Sub W_SendComplete(Index As Integer)
W(Index).Close
Ext Index
End Sub