我要一个CGI的一个完整的例子和如何使用GetEnvironmentVariable函数!(200分)

program Html;
{$APPTYPE CONSOLE}//必须加上
uses
SysUtils;
begin
{Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;}
writeln('CONTENT-TYPE: TEXT/HTML');
Writeln;
Writeln('<HTML><HEAD>');
Writeln('<TITLE>TIME AT THIS SITE</TITLE>');
Writeln('</HEAD><BODY>');
Writeln('<H1>TIME AT THIS SITE</H1>');
Writeln('<HR>');
Writeln('<H3>');
Writeln(FormatDateTime('"The Meet is on" dddd, mmmm d, yyyy, ' +'"at" hh:mm AM/PM', now));
Writeln('</H3>');
Writeln('</HR>');
Writeln('<I>PAGE GENERATED BY CGIDATE.EXE</I>');
Writeln('</BODY></HTML>');
end.

如何使用GetEnvironmentVariable:
var ScritpName: array[0..255] of char;
begin

GetEnvironmentVariable('SCRIPT_NAME',ScriptName,sizeof(ScriptName));
end;

第一个参数是CGI的环境变量列出几种常用的变量:
SERVER_NAME
SERVER_PORTOOL
SERVER_SOFTWARE
GATEWAY_INTERFACE
DOCEMENT_ROOT
PATH_TRANSLATED
HTTP_ACCEPT
HTTP_REFERER
SCRIPT_NAME
PATH_INFO
QUERY_STRING
CONTENT_LENGTH
REMOTE_HOST
REMOTE_USER
REMOTE_IDENT
HTTP_FROM
HTTP_USER_AGENT
HTTP_COOKIE
CONENT_LENGTH
CONENT_TYPE
你可以通过字面了解他们的用途,也可以逐个试验一下
他们的具体用途,有问题<A HREF="MAILTO XFTANG@SHTDU.EDU.CN">XFTNAG@SHTDU.EDU.CN</A>
GOOK LUCK!
 
对不起:源代码你可以看你的EMIAL通知!
 
12.6 怎样使用DELPHI编制CGI程序
DELPHI 3.0 虽然提供了编写CGI程序的向导程序,但并没有多大用处,应为CGI太象DOS程序,无法进行"可视"编程,一切均靠手动.
首先,DELPHI会建立工程文件 DPR 文件,在我们这个例子中,我们用CGI程序来判断FORM内的各元件传入的内容:
下面是CGI.DPR文件内容:
program Mil;
uses
sysUtils,
Pcgi in 'Pcgi.pas';
var
cgi:TCgi;
idx:integer;
ParameterName,ParameterValue:string;
begin
cgi:=TCgi.Create;
writeln('Content-type: text/html');
writeln;
writeln('<title>CGI Test Program</title>');
writeln('<body BACKGROUND="BACK.GIF">');
writeln('<h1>CGI Reply</h1>');
writeln('User Input String:'+cgi.ParamRawData+'<br>');
writeln('Parameter Count:'+IntToStr(cgi.Params.Count)+'<br>');
writeln('<HR>');
for idx:= 1 to cgi.Params.Countdo
begin
ParameterName:=cgi.Params.Names[idx-1];
writeln(IntToStr(idx)+' Parameter Name = '+ParameterName+'<br>');
ParameterValue:=cgi.Params.values[ParameterName];
writeln(IntToStr(idx)+' Parameter Value = '+ParameterValue+'<br>');
writeln('<HR>');

end;

writeln('</body>');
cgi.Free;
end.

使用面向对象的编程使程序更加简洁,可以看出这个程序的第一步:
cgi:=TCgi.Create;
这个事件将产生各种初始化处理工作,生成各种我们需要的数据,即各种处理好的环境变量,紧接着,程序使用writeln 语句写入CGI输出的HTML文件头,最后输出详细内容:FORM中全部元件的内容。
当然上程序是不能单独编译的，必须带上程序的核心部分：PCGI.PAS 文件，下面是这个文件的程序清单：
unit Pcgi;
interface
uses
Windows,SysUtils,Classes;

const
DefaultBufferSize=4096;
type
TCgi = Class(TObject)
private
{Private Part Declare}
FInputRawData:String;
function ParamCount:Integer;
function GetToken(aString, SepChar: String;
TokenNum: Byte):String;
function NumToken(aString, SepChar: String):integer;
function GetParamItemValue(inpStr:string;Cnt:integer):string;
function GetParamItemName(inpStr:string;Cnt:integer):string;
public
{Public Part Declare}
ContentLength:integer;
ContentType:string;
GatewayInterface:string;
HttpAccept:string;
HttpUserAgent:string;
Params:TStrings;
QueryString:string;
RemoteAddr:string;
RemoteHost:string;
RemoteUser:string;
RequestMethod:string;
ScriptName:string;
ServerName:string;
ServerProtocol:string;
ServerSoftware:string;
constructor Create;
destructor destroy ;
override ;
function ParamRawData:string;
end;

implementation
constructor TCgi.Create;
var
buf:pChar;
ContentLengthStr:string;
ret,idx:integer;
begin
inherited Create;
Params:=TStringList.Create;
// Get Server Variable
try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('REQUEST_METHOD',Buf,DefaultBufferSize);
RequestMethod:=StrPas(Buf);
finally
Freemem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('CONTENT_LENGTH',Buf,DefaultBufferSize);
try
ContentLength:=StrToInt(StrPas(Buf));
except
ContentLength:=0;
end;
finally
freeMem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('SERVER_SOFTWARE',Buf,DefaultBufferSize);
ServerSoftware:=StrPas(Buf);
finally
Freemem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('SERVER_NAME',Buf,DefaultBufferSize);
ServerName:=StrPas(Buf);
finally
Freemem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('GATEWAY_INTERFACE',Buf,DefaultBufferSize);
GatewayInterface:=StrPas(Buf);
finally
Freemem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('SERVER_PROTOCOL',Buf,DefaultBufferSize);
ServerProtocol:=StrPas(Buf);
finally
Freemem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('HTTP_ACCEPT',Buf,DefaultBufferSize);
HttpAccept:=StrPas(Buf);
finally
Freemem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('SCRIPT_NAME',Buf,DefaultBufferSize);
ScriptName:=StrPas(Buf);
finally
Freemem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('REMOTE_ADDR',Buf,DefaultBufferSize);
RemoteAddr:=StrPas(Buf);
finally
Freemem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('REMOTE_HOST',Buf,DefaultBufferSize);
RemoteHost:=StrPas(Buf);
finally
Freemem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('REMOTE_USER',Buf,DefaultBufferSize);
RemoteUser:=StrPas(Buf);
finally
Freemem(Buf);
end;

try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('CONTENT_TYPE',Buf,DefaultBufferSize);
ContentType:=StrPas(Buf);
finally
Freemem(Buf);
end;

if Uppercase(RequestMethod)='POST' then
read(FInputRawData)
else
begin
// Get Request Method
try
GetMem(Buf,DefaultBufferSize);
ret:=GetEnvironmentVariable('QUERY_STRING',Buf,DefaultBufferSize);
FInputRawData:=StrPas(Buf);
finally
Freemem(Buf);
end;
end;

for idx:= 1 to ParamCountdo
Params.Add(GetParamItemName(FInputRawData,idx)+'='+GetParamItemValue(FInputRawData,idx));
end;

destructor TCgi.destroy;
begin
Params.Free;
inherited Destroy;
end;

function TCgi.ParamRawData:string;
begin
Result:=FInputRawData;
end;

function TCgi.GetToken(aString, SepChar: String;
TokenNum: Byte):String;
var
Token : String;
StrLen : Byte;
TNum : Byte;
TEnd : Byte;
begin
StrLen := Length(aString);
TNum := 1;
TEnd := StrLen;
while ((TNum <= TokenNum) and (TEnd <> 0))do
begin
TEnd := Pos(SepChar,aString);
if TEnd <> 0 then
begin
Token := Copy(aString,1,TEnd-1);
Delete(aString,1,TEnd);
Inc(TNum);
end
else
begin
Token := aString;
end;
end;
if TNum >= TokenNum then
begin
GetToken := Token;
end
else
begin
GetToken := '';
end;
end;

function TCgi.NumToken(aString, SepChar: String):integer;
{
parameters: aString : the complete string
SepChar : a single character used as separator
between the substrings
result : the number of substrings
}
var
RChar : Char;
StrLen : integer;
TNum : integer;
TEnd : integer;
begin
if SepChar = '#' then
begin
RChar := '*'
end
else
begin
RChar := '#'
end;
StrLen := Length(aString);
TNum := 0;
TEnd := StrLen;
while TEnd <> 0do
begin
Inc(TNum);
TEnd := Pos(SepChar,aString);
if TEnd <> 0 then
begin
aString[TEnd] := RChar;
end;
end;
NumToken := TNum;
end;

function TCgi.GetParamItemName(inpStr:string;Cnt:integer):string;
var
tmpStr:string;
begin
tmpStr:= GetToken(inpStr,'&amp;',Cnt);
result:=GetToken(tmpStr,'=',1);
end;

function TCgi.GetParamItemValue(inpStr:string;Cnt:integer):string;
var
idx:integer;
tmpStr,OutStr:string;
begin
tmpStr:= GetToken(inpStr,'&amp;',Cnt);
tmpStr:= GetToken(tmpStr,'=',2);
idx:=1;
while (idx<=length(tmpStr))do
begin
if tmpStr[idx]='%' then
begin
OutStr:=OutStr+ chr(StrToint('$'+Copy(tmpStr,idx+1,2)));
inc(idx,3);
end
else
begin
if tmpStr[idx]='+' then
OutStr:=OutStr+chr(32)
else
OutStr:=OutStr+tmpStr[idx];
inc(idx);
end
end;
result:=OutStr;
end;

function Tcgi.ParamCount:Integer;
begin
Result:=NumToken(FInputRawData,'&amp;');
end;

end.

12.5 使用实例
我们就以前面提到的这个简单的例子来说明吧!
例: 建立一个站点，其中需要用户输入用户名称和密码已确认是否是会员，如果是会员，就显示"欢迎进入"的页面，否则显示"谢谢使用，请先注册"。为了说明问题,这里的会员数据库部分暂时省略,假使只有个用户LYP,密码是abcd.
第一步:编写CGI程序,将 CGI.DPR 改成以下内容:
program Mil;
uses
sysUtils,
Pcgi in 'Pcgi.pas';
var
cgi:TCgi;
idx:integer;
ParameterName,ParameterValue:string;
begin
cgi:=TCgi.Create;
writeln('Content-type: text/html');
writeln;
writeln('<title>CGI Test Program</title>');
writeln('<HR>');
if ((cgi.Params.values[cgi.Params.Names[0]]='lyp') and
(cgi.Params.values[cgi.Params.Names[1]]='abcd')) then
writeln('欢迎进入!')
else

writeln('谢谢使用，请先注册!');
writeln('<HR>');

writeln('User Input String:'+cgi.ParamRawData+'<br>');
writeln('Parameter Count:'+IntToStr(cgi.Params.Count)+'<br>');

for idx:= 1 to cgi.Params.Countdo
begin
ParameterName:=cgi.Params.Names[idx-1];
writeln(IntToStr(idx)+' Parameter Name = '+ParameterName+'<br>');
ParameterValue:=cgi.Params.values[ParameterName];
writeln(IntToStr(idx)+' Parameter Value = '+ParameterValue+'<br>');
writeln('<HR>');

end;

writeln('</body>');
cgi.Free;
end.
 
唐晓锋的例子我已经用过了,且回答了我全部的问题.
多谢李亚平更详细的例子!
 
多人接受答案了。
 
您必须登录或注册才可回复。

Similar threads

S
[教程]TToolBar.TToolButton 不同按钮下拉菜单使用同一个TPopupMenu
回复
0
查看
123
swish
S
S
[教程]Delphi 函数的内部函数在匿名回调函数中无法使用的一种解决办法
回复
0
查看
340
swish
S
S
[教程]使用 ZValueWatch 在主线程中监测值变化
回复
0
查看
229
swish
S
S
[教程]ZAsync 异步编程之四：请记住匿名函数是一个接口
回复
0
查看
577
swish
S
S
【教程】QJSON 创建根结点为数组的 JSON 内容
回复
0
查看
301
swish
S
顶部