📄 dcounter.dpr
字号:
program DCounter;
{$R *.RES}
{$APPTYPE CONSOLE}
uses SysUtils, Windows, PostCont, DosEnv01, Graphics, JPEG, Classes;
var
DOSEnv: TDOSEnvironment;
PostContent: TPostContent;
BitmapImage: TBitmap;
JPEGImage: TJPEGImage;
NumWidth: Byte;
NumStr: String[10];
Rect: TRect;
MemStream: TMemoryStream;
HandleStr: THandleStream;
CounterFile: TextFile;
FileName: String;
CountValue: LongInt;
Buffer: String[10];
RelativePath: String;
begin
{ Get the DOS Environment and the content from QUERY_STRING }
DOSEnv := TDOSEnvironment.Create;
PostContent := TPostContent.CreateFromString(DOSEnv.ValueForKey('QUERY_STRING'));
{ Create the bitmap for the counter }
BitmapImage := TBitmap.Create;
{ Load the Font attributes that were passed in the QUERY_STRING }
with PostContent, BitmapImage.Canvas.Font do begin
try
Name := ValueForKey('FontName', 1);
except
Name := 'Arial';
end;
try
Height := StrToInt(ValueForKey('FontHeight', 1));
except
Height := 16; { Pixels }
end;
try
Color := StrToInt('$' + ValueForKey('FontColor', 1));
except
Color := clBlack;
end;
end;
{ Set the background color }
with PostContent, BitmapImage.Canvas.Brush do begin
try
Color := StrToInt('$' + ValueForKey('BgColor', 1));
except
Color := clWhite;
end;
end;
with PostContent do begin
try
NumWidth := StrToInt(ValueForKey('NumWidth', 1));
except
NumWidth := 5;
end;
try
FileName := ValueForKey('FileName', 1);
except
FileName := '';
end;
end;
{ Read the current value from the data file }
CountValue := 1;
if FileName <> EmptyStr then begin
{ If the filename does not start with 'D:\' (D is any drive),
then assume that the filename is relative to the path where this
.EXE is running }
if Copy(FileName, 2, 2) <> ':\' then begin
RelativePath := DosEnv.ValueForKey('PATH_INFO') +
DosEnv.ValueForKey('SCRIPT_NAME');
RelativePath := ExtractFilePath(RelativePath);
FileName := RelativePath + FileName;
end;
try
AssignFile(CounterFile, FileName);
try
Reset(CounterFile); { 10 hit count digits max }
ReadLn(CounterFile, Buffer);
CountValue := StrToInt(Buffer) + 1;
Rewrite(CounterFile);
Buffer := IntToStr(CountValue);
WriteLn(CounterFile, Buffer);
finally
CloseFile(CounterFile);
end;
except
end;
end;
{ Create the count as a string }
NumStr := IntToStr(CountValue);
if NumWidth > 0 then
while Length(NumStr) < NumWidth do
NumStr := '0' + NumStr;
{----------------------------------------------------------------}
{----------------- Build the image -----------------------------}
{----------------------------------------------------------------}
with BitmapImage, BitmapImage.Canvas do begin
Height := TextHeight(NumStr)+4;
Width := TextWidth(NumStr)+4;
with Rect do begin
Top := 0;
Left := 0;
Bottom := Height;
Right := Width;
end;
FillRect(Rect);
TextOut(2, 2, NumStr);
end;
{---------------------------------------------------------------}
{---------- Write the image to stdout --------------------------}
{---------------------------------------------------------------}
{ Assign the bitmap to the JPEG }
JPEGImage := TJPEGImage.Create;
JPEGImage.Assign(BitmapImage);
JPEGImage.CompressionQuality := 100; { Best quality }
{ Create a stream connected to stdout }
HandleStr := THandleStream.Create(GetStdHandle(STD_OUTPUT_HANDLE));
{ Create a memory stream to get the contents of the JPEG file. This is
only to determine the size of the JPEG. If I knew how to get the
size of the JPEG right from the JPEGImage, then the saving to the
memory stream step can be avoided }
MemStream := TMemoryStream.Create;
JPEGImage.SaveToStream(MemStream);
{ Write out the content type to stdout }
WriteLn('Content-type: image/jpeg');
WriteLn('Content-length: ' + IntToStr(MemStream.Size));
WriteLn('');
{ Write the contents of the memory stream (i.e. the JPEG image) to stdout }
MemStream.SaveToStream(HandleStr);
{ Free everything }
HandleStr.Free;
MemStream.Free;
BitmapImage.Free;
JPEGImage.Free;
DOSEnv.Free;
PostContent.Free;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -