unit1.~pas

通用投票,网站投票用程序。可以自动拨号上网

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, StdCtrls,WinSock,ScktComp,ShellApi,execwait;

type
  TFrmChat = class(TForm)
    CC1: TClientSocket;
    DD1: TLabel;
    DD2: TLabel;
    DD3: TLabel;
    DD4: TLabel;
    DD5: TLabel;
    Label1: TLabel;
    MyIPName: TLabel;
    MyIPaddress: TLabel;
    Button1: TButton;
    Button2: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    GroupBox1: TGroupBox;
    Label3: TLabel;
    Panel2: TPanel;
    Label5: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label6: TLabel;
    Label9: TLabel;
    eUser: TEdit;
    ePasswd: TEdit;
    eRasName: TEdit;
    eJange: TEdit;
    eModem: TEdit;
    PopupMenu1: TPopupMenu;
    app_about: TMenuItem;
    N2: TMenuItem;
    app_exit: TMenuItem;
    procedure app_aboutClick(Sender: TObject);
    procedure app_exitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CC1Connect(Sender: TObject; Socket: TCustomWinSocket);
    procedure CC1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure CC1Read(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
    PostMsg: TStringList;
    g_path:string;        //程序路径
    procedure exitwin(var msg:Tmessage);message WM_QUERYENDSESSION;
    procedure SetCount;
    procedure DOCONNECT;
    procedure DISCONNECT;
  public
    { Public declarations }
  end;

var
  FrmChat: TFrmChat;
  isConnent: boolean=False;
  posting: boolean=False;
  count2:integer=0;

implementation

{$R *.DFM}

function LocalIP:string;
type
  TaPInAddr=array [0..10] of PInAddr;
  PaPInAddr=^TaPInAddr;
var
  phe:PHostEnt;
  pptr:PaPInAddr;
  Buffer:array [0..63] of char;
  I:Integer;
  GInitData:TWSADATA;
begin
  WSAStartup($101, GInitData);
  Result:= '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe:=GetHostByName(buffer);
  if phe=nil then Exit;
  pptr:= PaPInAddr(Phe^.h_addr_list);
  I:= 0;
  while pptr^[I] <> nil do begin
    result:=StrPas(inet_ntoa(pptr^[I]^));
    Inc(I);
  end;
  WSACleanup;
end;

function replacing(S,source,target:string):string;
var
site,StrLen:integer;
begin
StrLen:=length(source);    //source的长度
while pos(source,s)>0 do
begin
site:=pos(source,s);       //source在S中出现的位置
delete(s,site,StrLen);     //删除source字符串
if target<>'' then
insert(target,s,site);     //插入target字符串到S中
end;
replacing:=s;            //返回新串
end;

procedure TFrmChat.exitwin(var msg: Tmessage);
begin
msg.Result:=1;
Application.ProcessMessages;
Application.Terminate;
end;

procedure TFrmChat.SetCount;
var
  ap:TStringlist;
begin
  ap:=TStringlist.Create;
  ap.LoadFromFile('server.ini');
  ap.Strings[6]:=Edit1.Text;
  ap.SaveToFile('server.ini');
  ap.Free;
end;

procedure TFrmChat.app_aboutClick(Sender: TObject);
begin
//关于软件(&A)
  ShellAbout(Handle,
             '通用投票の自动拨号版',
             '作者：黄兴义 Email:[e-mail]' + #13 +
             '      2007.11.20',
             Application.Icon.Handle);//显示关于信息
end;

procedure TFrmChat.app_exitClick(Sender: TObject);
begin
//退出程序(&X)
  Application.Terminate;
end;

procedure TFrmChat.FormCreate(Sender: TObject);
var
  ap:TStringlist;
  ahost,aPort:String;
  i:Integer;
begin
  MyIPaddress.Caption:=LocalIP;
  g_path:=ExtractFilePath(application.ExeName);
  ap:=TStringlist.Create;
  ap.LoadFromFile('server.ini');
  Label3.Caption:=  ap.Strings[1];
  aPort := ap.Strings[2];
  eRasName.Text:= ap.Strings[3];
  eUser.Text:= ap.Strings[4];
  ePasswd.Text:= ap.Strings[5];
  Edit1.Text:= ap.Strings[6];
  ap.Free;
  count2:=strtoint(Edit1.Text);
  PostMsg:=TStringList.Create;
  PostMsg.LoadFromFile(g_path+'POST.txt');
  i:=0;
  while pos('Host: ',PostMsg.Strings[i])=0 do inc(i);
  ahost:=copy(PostMsg.Strings[i],7,Length(PostMsg.Strings[i])-6);
  with CC1 do
  begin
    Active := False;
    Host := ahost;  //指定服务器方
    Port := strtoint(aPort);
  end;
end;

procedure TFrmChat.DISCONNECT;
begin    //断开ADSL
  if not isConnent then exit;
  //winexec(pchar('rasdial '+eRasName.Text+' /DISCONNECT'),0);
  //ExecAppWait('rasdial', eRasName.Text+' /DISCONNECT');
  ExecAppWait('rasphone', '-h '+eRasName.Text);
  isConnent:=False;
  DD1.Font.Color:= clRed;
  DD2.Font.Color:= clRed;
  DD3.Font.Color:= clRed;
  DD4.Font.Color:= clRed;
  DD5.Font.Color:= clRed;
end;

procedure TFrmChat.DOCONNECT;
begin      //连接ADSL
  if isConnent then exit;
  sleep(strtoint(eModem.Text));
  ExecAppWait('rasdial', eRasName.Text+' '+eUser.Text+' '+ePasswd.Text);
  //ExecAppWait('rasphone', '-h '+eRasName.Text);
  isConnent:=True;
  DD1.Font.Color:= clLime;
  DD2.Font.Color:= clLime;
  DD3.Font.Color:= clLime;
  DD4.Font.Color:= clLime;
  DD5.Font.Color:= clLime;
end;

procedure TFrmChat.Button1Click(Sender: TObject);
begin   //马上投票
  posting:=True;
  //DOCONNECT;
  sleep(strtoint(eJange.Text));
  CC1.Active := True;
end;

procedure TFrmChat.Button2Click(Sender: TObject);
begin   //停止投票
  CC1.Active := False;
  posting:=False;
  DISCONNECT;
  SetCount;
  DD1.Font.Color:= clRed;
  DD2.Font.Color:= clRed;
  DD3.Font.Color:= clRed;
  DD4.Font.Color:= clRed;
  DD5.Font.Color:= clRed;
end;

procedure TFrmChat.CC1Connect(Sender: TObject; Socket: TCustomWinSocket);
var
  sendmsg:string;
begin
  sendmsg:=PostMsg.GetText;
  Socket.SendText(sendmsg);
end;

procedure TFrmChat.CC1Error(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  ErrorCode := 0;
end;

procedure TFrmChat.CC1Read(Sender: TObject; Socket: TCustomWinSocket);
begin
  Memo1.Lines.Clear;
  Memo1.Lines.Append(Socket.ReceiveText);
  Socket.Close;
  INC(count2);
  Edit1.Text:= InttoStr(count2);
  if posting then begin
    DISCONNECT;
    Button1Click(Sender);
  end;
end;

end.