１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"CGI カウンターを作る"
URLを指定しなくても、デフォルトでその頁ファイル自体の カウントを表示す
るCGIのサンプルです。
WEBMODULEを作成して、
３つのアクションアイテムをセットします。
１にはパスインフォ /SETCOUNTER
３にはパスインフォ /PAGEVIEW
をつけておきます。
２にはデフォルトをtrueにしておきましょう。
使用法は htmlファイルで、
<IMG SRC="/Scripts/count.exe">
だけで使用できます。
クエリーとして使えるのは
URL=URL名 実際のURLでなくても勝手につけた名前でも構わないけど他の人の
迷惑にならない様に(笑)
CL=色 これは「$RRGGBB」か、(#RRGGBBでないの)clRed clBlueなどのDelphi
で設定されているTColorの識別子。
BK=色 バックグラウンドカラー 指定はCL=と同じ
W=文字のサイズ １６〜７２
CLM=桁数 １〜１２ 桁数は指定しなければ６となる。
STOP=1 ０以外の数字を書く。 カウンタを進めない
DT=FormatDateTimeの書式文字列。 日付を表示・カウンタは進まない
*******
次に
<FORM METHOD=POST ACTION=/Scripts/Count.exe/SETCOUNTER>
<INPUT TYPE=TEXT NAME="CNT">
<INPUT TYPE=TEXT NAME="PW">
<INPUT TYPE=SUBMIT VALUE="SET COUNTER">
</FORM>
でカウンターをセットします。
CNTはセットする値
PW はINIファイルに記録させたパスワード
*******
最後に
<FORM METHOD=POST ACTION=/Scripts/Count.exe/PAGEVIEW>
<INPUT TYPE=SUBMIT VALUE="ページビューリスト">
</FORM>
どのファイル(URL)がどのくらいのカウントかを表示させます。
*****ソース
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, HTTPApp, IniFiles,
Graphics, JPeg;
type
TWebModule1 = class(TWebModule)
procedure WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure WebModule1WebActionItem2Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
procedure WebModule1WebActionItem3Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
WebModule1: TWebModule1;
implementation
{$R *.DFM}
procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
cnt:integer;
ini:TIniFile;
url,pw:string;
begin
cnt:=StrToIntDef(Request.ContentFields.Values['CNT'],0);
pw :=Request.ContentFields.Values['PW'];
ini:=TIniFile.Create('Count.Ini');
url:=Request.ContentFields.Values['URL'];
if url='' then url:=request.Referer ;
try
if pw=ini.ReadString('Config','Password','no-password' then
ini.WriteInteger('URLs',url,cnt);
finally
ini.Free;
end;
writeln('Content-type: text/html'#13);
writeln('<HTML><BODY><A HREF="'
+Request.Referer+'">もどる</A></BODY></HTML>');
handled:=true;
end;
procedure TWebModule1.WebModule1WebActionItem2Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
ini:TIniFile;
bmp:TBitmap;
jpg:TJPegImage;
g:TMemoryStream;
clm,w,cnt:integer;
cl,bk:TColor;
fn,dt,url,txt:string;
go:boolean;
dmy:cardinal;
begin
ini:=TIniFile.Create('Count.ini');
bmp:=TBitmap.Create;
jpg:=TJpegImage.Create;
mem:=TMemoryStream.Create;
g :=TMemoryStream.Create;
clm:=StrToIntDef(Request.QueryFields.Values['CLM'],0);
go :=StrToIntDef(Request.QueryFields.Values['STOP'],0)=0;
dt :=Request.QueryFields.Values['DT'];
fn :=Request.QueryFields.Values['FN'];
if fn='' then fn:='Comic Sans MS';
url:=Request.QueryFields.Values['URL'];
if url='' then url:=request.Referer;
if not (clm in [1..12]) then clm:=6;
w :=StrToIntDef(Request.QueryFields.Values['W'],24);
if w<16 then w:=16;
if w>72 then w:=72;
try
cl :=StringToColor(Request.QueryFields.Values['CL']);
except
cl:=clBlack;
end;
try
bk :=StringToColor(Request.QueryFields.Values['BK']);
except
bk:=clWhite;
end;
if cl=bk then cl:= bk xor $ffffff;
try
txt:='Content-Type: Image/Jpeg';
writeln;
mem.Write(PChar(txt)^,Length(txt));
cnt:=ini.ReadInteger('URLs',url,-1);
if go and (dt='') then inc(cnt);
if cnt>0 then begin
if go and (dt='') then ini.WriteInteger('URLs',url,cnt);
if dt='' then txt:=Format('%.*d',[clm,cnt])
else txt:=FormatDateTime(dt,now);
end else begin
txt:='URL not Allowed';
end;
bmp.Canvas.Font.name:=fn;
bmp.Canvas.Font.Height:=w;
bmp.Canvas.Font.Color:=cl;
bmp.Canvas.Brush.Color:=bk;
bmp.Width:=bmp.Canvas.TextWidth(txt);
bmp.Height:=bmp.Canvas.TextHeight(txt);
bmp.Canvas.FillRect(rect(0,0,bmp.width,bmp.height));
bmp.Canvas.TextOut(0,0,txt);
jpg.Assign(bmp);
jpg.SaveToStream(g);
writeln('Content-type: image/jpeg');
writeln(Format('Content-Length: %d',[g.size])); writeln;
g.Seek(0,0);
flush(Output);
WriteFile(TTextRec(Output).Handle,PChar(g.Memory)^,g.size,dmy,nil);
finally
ini.Free;
bmp.Free;
jpg.Free;
mem.Free;
g.Free;
end;
end;
procedure TWebModule1.WebModule1WebActionItem3Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
ini:TIniFIle;
st:TStringList;
i,j:integer;
begin
ini:=TIniFile.Create('Count.ini');
st:=TStringList.Create;
try
ini.ReadSectionValues('URLs',st);
writeln('Content-type: text/html'); writeln;
writeln('<HTML><HEAD><TITLE></TITLE>');
writeln('</TITLE></HEAD><BODY><PRE>');
if st.count>0 then begin
writeln(Format('%10s %s',['View','URL']));
for i:=0 to st.count-1 do begin
j:=pos('=',st[i]);
if j=0 then j:=1;
writeln(Format('%10s %s',
[copy(st[i],j+1,20),copy(st[i],1,j-1)]));
end
end else
writeln('PageListはありません。');
finally
ini.Free;
st.Free;
end;
writeln('</PRE></BODY></HTML>');
handled:=true;
end;
end.
URL=http://dmj.psnet.ne.jp/ Delphiマガジン発売
卯月、穀雨、筍ごはん FDELPHI ☆ 瑠瓏 <KHB05271@nifty.ne.jp>
FJBUILDR Sat,4/24/99 14:24
Original document by 瑠瓏 氏 ID:(KHB05271)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。