VB6之HTTP服務器的實現(二)

本文轉載自查看原文 2014-07-09 14:26 3054 VB6

接上篇，這次做了小小的改動和提升。增加了對POST的支持和對其他方法（GET和POST之外的）選擇405回復。另外，增加了對CGI的支持，目前可以使用C語言來寫（是不是好蠢的趕腳）。相對於上篇，整體做了小小的優化。這次代碼就只貼mod_cgi.bas的部分，其他文件我打包了，感興趣的同學可以下來看看。

注：由於我不是很了解WebServer，寫這個東西也是盲人摸象。像什么狀態控制、任務調度、容錯之類的基本上能省則省，另外也是因為不會寫，哈哈。如果有不足之處，還請不吝賜教，右路西褲（霓虹語：請多多指教）！

  1 'mod_cgi.bas
  2 'code by lichmama from cnblogs.com
  3 'CGI支持狀態
  4 Public CGI_ENABLED As Boolean
  5 'CGI程序目錄
  6 Public Const CGI_ROOT As String = "c:\cgi-bin\"
  7 
  8 Private Declare Function CreatePipe Lib "kernel32" ( _
  9         phReadPipe As Long, _
 10         phWritePipe As Long, _
 11         lpPipeAttributes As SECURITY_ATTRIBUTES, _
 12         ByVal nSize As Long) As Long
 13 
 14 Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" ( _
 15         lpStartupInfo As STARTUPINFO)
 16 
 17 Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" ( _
 18         ByVal lpApplicationName As String, _
 19         ByVal lpCommandLine As String, _
 20         lpProcessAttributes As Any, _
 21         lpThreadAttributes As Any, _
 22         ByVal bInheritHandles As Boolean, _
 23         ByVal dwCreationFlags As Long, _
 24         lpEnvironment As Any, _
 25         ByVal lpCurrentDriectory As String, _
 26         lpStartupInfo As STARTUPINFO, _
 27         lpProcessInformation As PROCESS_INFORMATION) As Long
 28 
 29 Private Declare Function ReadFile Lib "kernel32" ( _
 30         ByVal hFile As Long, _
 31         lpBuffer As Any, _
 32         ByVal nNumberOfBytesToRead As Long, _
 33         lpNumberOfBytesRead As Long, _
 34         lpOverlapped As Any) As Long
 35 
 36 Private Declare Function CloseHandle Lib "kernel32" ( _
 37         ByVal hObject As Long) As Long
 38 
 39 Private Type SECURITY_ATTRIBUTES
 40     nLength As Long
 41     lpSecurityDescriptor As Long
 42     bInheritHandle As Long
 43 End Type
 44 
 45 Private Type PROCESS_INFORMATION
 46     hProcess As Long
 47     hThread As Long
 48     dwProcessId As Long
 49     dwThreadId As Long
 50 End Type
 51 
 52 Private Type STARTUPINFO
 53     cb As Long
 54     lpReserved As Long
 55     lpDesktop As Long
 56     lpTitle As Long
 57     dwX As Long
 58     dwY As Long
 59     dwXSize As Long
 60     dwYSize As Long
 61     dwXCountChars As Long
 62     dwYCountChars As Long
 63     dwFillAttribute As Long
 64     dwFlags As Long
 65     wShowWindow As Integer
 66     cbReserved2 As Integer
 67     lpReserved2 As Byte
 68     hStdInput As Long
 69     hStdOutput As Long
 70     hStdError As Long
 71 End Type
 72 
 73 Private Type OVERLAPPED
 74     ternal As Long
 75     ternalHigh As Long
 76     offset As Long
 77     OffsetHigh As Long
 78     hEvent As Long
 79 End Type
 80 
 81 Private Const STARTF_USESHOWWINDOW = &H1
 82 Private Const STARTF_USESTDHANDLES = &H100
 83 Private Const SW_HIDE = 0
 84 Private Declare Sub RtlZeroMemory Lib "kernel32" (dest As Any, ByVal _
 85     numBytes As Long)
 86 
 87 
 88 Public Function ShellCGI(ByVal head As Object, rep_state As Long) As String
 89     Dim sa As SECURITY_ATTRIBUTES
 90     Dim si As STARTUPINFO
 91     Dim pi As PROCESS_INFORMATION
 92     Dim hrp As Long
 93     Dim hwp As Long
 94     Dim ret As Long
 95     Dim envstr As String
 96     
 97     'fill this with CGI standard envrionment strings,
 98     '   which delimited by chr(0)
 99     envstr = MakeEnvString(head)
100     Call RtlZeroMemory(ByVal VarPtr(sa), Len(sa))
101     Call RtlZeroMemory(ByVal VarPtr(si), Len(si))
102     Call RtlZeroMemory(ByVal VarPtr(pi), Len(pi))
103     
104     sa.nLength = Len(sa)
105     sa.lpSecurityDescriptor = 0&
106     sa.bInheritHandle = 1&
107     
108     'create pipe
109     ret = CreatePipe(hrp, hwp, sa, 0&)
110     If ret = 0 Then
111         Debug.Print "[HTTP-VBS]: CGI Exception, pipe failed"
112         Exit Function
113     End If
114     
115     si.cb = Len(si)
116     si.hStdOutput = hwp
117     si.hStdError = hwp
118     si.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
119     si.wShowWindow = SW_HIDE
120     
121     'create the cgi-process, cgi-path: head("Path_Translated")
122     ret = CreateProcess(head("Path_Translated"), vbNullString, _
123         ByVal 0&, ByVal 0&, True, 0&, ByVal envstr, vbNullString, si, pi)
124     If ret = 0 Then
125         Debug.Print "[HTTP-VBS]: CGI Exception, create process failed"
126         Exit Function
127     End If
128     
129     'read response from cgi
130     Dim nobr As Long 'num of bytes read
131     Dim lpbuff As String
132     Dim szbuff(65536 * 100) As Byte
133     Dim sum As Long
134     sum = 0
135     Call RtlZeroMemory(ByVal VarPtr(szbuff(0)), 65536 * 100)
136     Do
137         nobr = 0&
138         lpbuff = String(1024, " ")
139         If ReadFile(hrp, ByVal lpbuff, 1024&, nobr, ByVal 0&) Then
140             Call RtlMoveMemory(ByVal VarPtr(szbuff(sum)), ByVal StrPtr(lpbuff), LenB(lpbuff))
141             sum = sum + LenB(lpbuff)
142         Else
143             Exit Do
144         End If
145         Call CloseHandle(hwp)
146     Loop
147     Call CloseHandle(hrp)
148     
149     rep_state = 200
150     ShellCGI = Left(szbuff, sum)
151 End Function
152 
153 Private Function MakeEnvString(ByVal head As Object) As String
154     MakeEnvString = "REQUEST_METHOD=" & head("Request")("Method") & Chr(0) & _
155         "CONTENT_TYPE=" & head("Content-Type") & Chr(0) & _
156         "CONTENT_LENGTH=" & head("Content-Length") & Chr(0) & _
157         "QUERY_STRING=" & head("Query_String") & Chr(0) & _
158         "SCRIPT_NAME=" & head("Script_Name") & Chr(0) & _
159         "PATH_INFO=" & head("Path_Info") & Chr(0) & _
160         "PATH_TRANSLATED=" & head("Path_Translated") & Chr(0) & _
161         "REMOTE_HOST=" & head("Remote_Host") & Chr(0) & _
162         "REMOTE_ADDR=" & head("Remote_Addr") & Chr(0) & _
163         "REMOTE_PORT=" & head("Remote_Port") & Chr(0) & _
164         "REMOTE_USER=" & head("Remote_User") & Chr(0) & _
165         "REMOTE_IDENT=" & head("Remote_Ident") & Chr(0) & _
166         "AUTH_TYPE=" & head("Auth_Type") & Chr(0) & _
167         "SERVER_NAME=http-vb/0.1" & Chr(0) & _
168         "SERVER_PORT=80" & Chr(0) & _
169         "SERVER_PROTOCOL=HTTP/1.1" & Chr(0) & _
170         "DOCUMENT_ROOT=" & head("Document_Root") & Chr(0) & _
171         "SERVER_SOFTWARE=http-vb/0.1 vb/6.0" & Chr(0) & _
172         "HTTP_ACCEPT=" & head("Accept") & Chr(0) & _
173         "HTTP_USER_AGENT=" & head("User-Agent") & Chr(0) & _
174         "HTTP_REFERER=" & head("Referer") & Chr(0) & _
175         "HTTP_COOKIE=" & head("Cookie") & Chr(0) & _
176         "GATEWAY_INTERFACE=CGI/1.1" & Chr(0)
177 End Function

CGI的代碼：

 1 #include <stdio.h>
 2 #include <stdlib.h>
 3 #include <windows.h>
 4 #define ENV_MAX_LENGTH 0x7fff
 5 
 6 char *GetEnv(const char *lpName, char *lpbuff){
 7     memset(lpbuff, 0, ENV_MAX_LENGTH);
 8     GetEnvironmentVariable(lpName, lpbuff, ENV_MAX_LENGTH);
 9     return lpbuff;
10 }
11 
12 int main(int argc, char *argv[]){
13     char lpbuff[ENV_MAX_LENGTH]={0};
14     printf("Content-Type: text/html; charset=utf-8\n");
15     printf("\n");
16     printf("<html>\n");
17     printf("<head>\n");
18     printf("<meta content='text/html; charset=utf-8' http-equiv='content-type' />\n");
19     printf("<title>cgi page@lichmama</title>\n");
20     printf("</head>\n");
21     printf("<body>\n");
22     printf("<ul style='font-family:courier new'>\n");
23     printf("<li>REQUEST_METHOD: %s</li>\n", GetEnv("REQUEST_METHOD", lpbuff));
24     printf("<li>CONTENT_TYPE: %s</li>\n",   GetEnv("CONTENT_TYPE", lpbuff));
25     printf("<li>CONTENT_LENGTH: %s</li>\n", GetEnv("CONTENT_LENGTH", lpbuff));
26     printf("<li>QUERY_STRING: %s</li>\n",   GetEnv("QUERY_STRING", lpbuff));
27     printf("<li>SCRIPT_NAME: %s</li>\n",    GetEnv("SCRIPT_NAME", lpbuff));
28     printf("<li>PATH_INFO: %s</li>\n",      GetEnv("PATH_INFO", lpbuff));
29     printf("<li>PATH_TRANSLATED: %s</li>\n",GetEnv("PATH_TRANSLATED", lpbuff));
30     printf("<li>REMOTE_HOST: %s</li>\n",    GetEnv("REMOTE_HOST", lpbuff));
31     printf("<li>REMOTE_ADDR: %s</li>\n",    GetEnv("REMOTE_ADDR", lpbuff));
32     printf("<li>REMOTE_PORT: %s</li>\n",    GetEnv("REMOTE_PORT", lpbuff));
33     printf("<li>REMOTE_USER: %s</li>\n",    GetEnv("REMOTE_USER", lpbuff));
34     printf("<li>REMOTE_IDENT: %s</li>\n",   GetEnv("REMOTE_IDENT", lpbuff));
35     printf("<li>AUTH_TYPE: %s</li>\n",      GetEnv("AUTH_TYPE", lpbuff));
36     printf("<li>GATEWAY_INTERFACE: %s</li>\n", GetEnv("GATEWAY_INTERFACE", lpbuff));
37     printf("<li>SERVER_NAME: %s</li>\n",    GetEnv("SERVER_NAME", lpbuff));
38     printf("<li>SERVER_PORT: %s</li>\n",    GetEnv("SERVER_PORT", lpbuff));
39     printf("<li>SERVER_PROTOCOL: %s</li>\n",GetEnv("SERVER_PROTOCOL", lpbuff));
40     printf("<li>DOCUMENT_ROOT: %s</li>\n",  GetEnv("DOCUMENT_ROOT", lpbuff));
41     printf("<li>SERVER_SOFTWARE: %s</li>\n",GetEnv("SERVER_SOFTWARE", lpbuff));
42     printf("<li>HTTP_ACCEPT: %s</li>\n",    GetEnv("HTTP_ACCEPT", lpbuff));
43     printf("<li>HTTP_USER_AGENT: %s</li>\n",GetEnv("HTTP_USER_AGENT", lpbuff));
44     printf("<li>HTTP_REFERER: %s</li>\n",   GetEnv("HTTP_REFERER", lpbuff));
45     printf("<li>HTTP_COOKIE: %s</li>\n",    GetEnv("HTTP_COOKIE", lpbuff));
46     printf("</ul>\n");
47     printf("</body>\n");
48     printf("</html>\n");
49     return 0;
50 }

貼張圖，看看效果（看到.exe會不會覺得邪惡）：

咦，怎么添加附件？先來個百度雲盤吧。

免責聲明！

本站轉載的文章為個人學習借鑒使用，本站對版權不負任何法律責任。如果侵犯了您的隱私權益，請聯系本站郵箱yoyou2525@163.com刪除。

猜您在找 VB6之HTTP服務器的實現 VB6 制作 HTTP代理服務器 VB6 通過winsock控件數組實現客戶端和服務器多對一通信 [轉]VB實現自動取得服務器IP並連接服務器(利用UDP廣播) Java實現Http服務器(二) 從零實現一個http服務器使用python實現http服務器 tornado的http服務器實現 Java實現http服務器（一） Java實現Http服務器(三)