⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dcounter.dpr

📁 Controled counter delphi
💻 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 + -