main.pas

很简单的一个投票机原代码

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, StdCtrls, Buttons;

type
  TGetWebHTML = class(TThread)
  protected
    procedure Execute;override;
    procedure ThreadOk;
    procedure ThreadLost;
    procedure ThreadOpen;
    procedure ThreadGetTime;
  public
    constructor Create();
    destructor Destroy;override;
  end;

type
  Tfr_main = class(TForm)
    BitBtn1: TBitBtn;
    Label1: TLabel;
    BitBtn2: TBitBtn;
    IdHTTP1: TIdHTTP;
    IdAntiFreeze1: TIdAntiFreeze;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Label4: TLabel;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fr_main: Tfr_main;
  gogogo:boolean = false;
  okvote:integer = 0;
  lostvote:integer = 0;
  sleepTime  : Integer;
  dothis : array of TGetWebHTML;
  doing  : integer =0;
implementation

{$R *.dfm}

constructor TGetWebHTML.Create();
begin
  FreeOnTerminate:=True;
  inherited Create(False);
end;

destructor TGetWebHTML.Destroy;
begin
  Synchronize(ThreadOpen);
  inherited Destroy;
end;

procedure TGetWebHTML.Execute;
var
  http       : TIdHTTP;
  Url        : string;
  ReplyInfo  : TStrings;
  Response   : TStringStream;
begin
  while gogogo do
  begin
    http:=TIdHTTP.Create(nil);
    ReplyInfo := TStringList.Create;
    Response :=TStringStream.Create('');
    ReplyInfo.Clear;
    ReplyInfo.Add('vote=1');
    try
      Url:='http://www1.aomeisoft.com/vote/vote.php?id=34&action=vote';
      http.Post(Url,ReplyInfo,Response);
      Synchronize(ThreadOk);
    except
      Synchronize(ThreadLost);
    end;
    FreeAndNil(http);
    FreeAndNil(ReplyInfo);
    FreeAndNil(Response);
    sleepTime:=5;
    sleep(sleepTime*1000);
  end;
end;

procedure TGetWebHTML.ThreadGetTime;
begin
  sleepTime:=StrToInt(fr_main.Edit1.Text);
end;

procedure TGetWebHTML.ThreadOpen;
begin
  doing:=doing-1;
  if doing=0 then
    fr_main.BitBtn1.Enabled:=true;
end;

procedure TGetWebHTML.ThreadOk;
begin
  okvote:=okvote+1;
  fr_main.Label2.Caption:='成功：'+inttostr(okvote);
end;

procedure TGetWebHTML.ThreadLost;
begin
  lostvote:=lostvote+1;
  fr_main.Label3.Caption:='失败：'+inttostr(lostvote);
end;

procedure Tfr_main.BitBtn2Click(Sender: TObject);
begin
  gogogo:=false;
end;

procedure Tfr_main.BitBtn1Click(Sender: TObject);
var
  i : integer;
begin
  setlength(dothis,10);
  BitBtn1.Enabled:=false;
  gogogo:=true;
  for i:=0 to length(dothis)-1 do
  begin
    dothis[i]:=TGetWebHTML.Create;
    doing:=doing+1;
  end;
end;

procedure Tfr_main.FormCreate(Sender: TObject);
var 
  fstyle: dWord;
begin
  fstyle := GetWindowLong(Edit1.Handle, GWL_STYLE);
  SetWindowLong(Edit1.Handle, GWL_STYLE, fstyle or ES_NUMBER);
end;

procedure Tfr_main.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if doing<>0 then CanClose:=False;
end;

end.