unit1.pas

通过淘宝网站彩票系统导出最近几期的中奖记录 可以导出成文本或SQL数据库

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Winsock, DB, ADODB, IniFiles;
const
  WM_HOSTRESOLVED = WM_USER + 1;
  WM_SOCK_EVENT = WM_USER + 2;
  HOST = 'taobao.starlott.com';

type
  TForm1 = class(TForm)
    BtnRequest: TButton;
    BtnCancel: TButton;
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    GroupBox2: TGroupBox;
    lstlog: TListBox;
    Button1: TButton;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    R1: TRadioButton;
    R2: TRadioButton;
    SaveDialog1: TSaveDialog;
    ADOQuery1: TADOQuery;
    ADOConnection1: TADOConnection;
    procedure FormCreate(Sender: TObject);
    procedure BtnRequestClick(Sender: TObject);
    procedure BtnCancelClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure HostResolveProc(var Msg: TMessage); message WM_HOSTRESOLVED;
    procedure SockEventProc(var Msg: TMessage); message WM_SOCK_EVENT;
    function GetHttpStrSend: string;
    procedure BallsFilter();
    function Rini(Root, key, list, path: string; lists: TStrings): string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Sock: TSocket;
  SockData: WSAData;
  GetHostHandle: THandle;
  HostData: Thostent;
  pHostData: phostent;
  SockAddr: sockaddr_in;
  RecBuf: array[0..65535] of char;
  RecStr: string;
  SendBuf: array[0..65535] of char;
  SendStr: string;
  Connected: Boolean;
  Stm: TStringStream;
  HostResolved: Boolean;
  TmpStr: TStringlist;
  ConnStr: string;

implementation

{$R *.dfm}

{ TForm1 }

function TForm1.GetHttpStrSend: string;
var
  str: string;
begin
  str := 'GET /ssq/jb/' + ComboBox1.Text + '.html HTTP/1.1' + #13#10;
  str := str + 'Accept: */*' + #13#10;
  str := str + 'Host: ' + HOST + #13#10;
  str := str + 'Connection: Close' + #13#10;
  str := str + #13#10;
  Result := str;
end;

procedure TForm1.HostResolveProc(var Msg: TMessage);
var
  host: string;
  iErr: integer;
begin
  if HostData.h_addr = nil then
    begin
      lstlog.Items.Append('Resolve Host Failed!');
      lstlog.ItemIndex := lstlog.Items.Count - 1;
      //ShowMessage('Resolve Host Failed!');
      self.BtnRequest.Enabled := true;
      self.BtnCancel.Enabled := false;
      exit;
    end;
  host := Format('%d.%d.%d.%d',
    [ord(HostData.h_addr^[0]),
    ord(HostData.h_addr^[1]),
      ord(HostData.h_addr^[2]),
      ord(HostData.h_addr^[3])]);
  LstLog.Items.append('IP Address is:' + Host);
  lstlog.ItemIndex := lstlog.Items.Count - 1;
  if WSAASyncSelect(Sock, self.handle, WM_SOCK_EVENT, (FD_READ or FD_WRITE or
    FD_CONNECT or FD_CLOSE or FD_ACCEPT)) = SOCKET_ERROR then
    begin
      ShowMessage('Set Seocket Async Failed!');
      self.BtnRequest.Enabled := true;
      self.BtnCancel.Enabled := false;
      Exit;
    end;
  //ShowMessage(HostData.h_addr^[0] + HostData.h_addr^[1] +HostData.h_addr^[2] +HostData.h_addr^[3] );
  SockAddr.sin_addr.S_addr := inet_addr(pchar(host)); //   '119.119.119.35'
  SockAddr.sin_port := htons(80);
  SockAddr.sin_family := AF_INET;
  if Connect(Sock, SockAddr, sizeof(SockAddr)) = Socket_ERRor then
    begin
      iErr := WSAGetLastError;
      if iErr <> WSAEWOULDBLOCK then
        showMessage('Connect Failed, Error :' + inttostr(iErr));
    end;
  self.BtnRequest.Enabled := False;
  self.BtnCancel.Enabled := True;
end;

procedure TForm1.SockEventProc(var Msg: TMessage);
var
  recLen: Integer;
begin
  //LstLog.Items.Insert(0,'Sock Event raised!');
  case msg.LParamLo of
    FD_CONNECT:
      begin
        Connected := true;
        LstLog.Items.append('Connect to Server!');
        lstlog.ItemIndex := lstlog.Items.Count - 1;
      end;
    FD_WRITE:
      begin
        SendStr := GetHttpStrSend;
        strCopy(pchar(@SEndBuf), pchar(SendStr));
        //stm.WriteString('asdfasdfasdfasdfds');
        //stm.Read( SendBuf,length(sendstr));
        //showMessage(sendbuf);
        //ShowMessage(SendBuf[0 - (length(sendstr)-1)]);
        if Connected then
          send(sock, SendBuf, length(sendstr), 0);
        LstLog.Items.append('Data Send.');
        lstlog.ItemIndex := lstlog.Items.Count - 1;
      end;
    FD_READ:
      begin
        //showMessage(RecBuf);
        RecLen := recv(sock, RecBuf, 65536, 0);
        //ShowMessage(recbuf);
        RecStr := copy(RecBuf, 0, RecLen);
        TmpStr.Append(RecStr);
        //self.MemoRec.Lines.Text := self.MemoRec.Lines.Text + (RecStr);
        //[0 - (RecLen-1)]
        LstLog.Items.append('Data Arrived, length:' + inttostr(reclen));
        lstlog.ItemIndex := lstlog.Items.Count - 1;

      end;
    FD_CLOSE:
      begin
        Connected := false;
        //CloseSocket(sock);
        LstLog.Items.append('Connection closed!');
        lstlog.ItemIndex := lstlog.Items.Count - 1;
        Self.BtnRequest.Enabled := true;
        self.BtnCancel.Enabled := false;
        if TmpStr.Count > 0 then
          BallsFilter;
      end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  inipath: string;
begin
  WSAStartUP(MakeWord(1, 0), SOckData);
  inipath := GetCurrentDir + '\config.ini';
  TmpStr := Tstringlist.create;
  if Rini('CONFIG', 'YNSQL', '0', inipath, nil) = '1' then
    begin
      ConnStr := 'Provider=SQLOLEDB;Data Source='
        + Rini('DATABASE', 'DBSERVER', '0', inipath, nil) + ';DATABASE='
        + Rini('DATABASE', 'DATABASENAME', '0', inipath, nil) + ';UID='
        + Rini('DATABASE', 'LONGID', '0', inipath, nil) + ';pwd='
        + Rini('DATABASE', 'PASSWORD', '0', inipath, nil);
      ADOConnection1.Connected := False;
      try
        ADOConnection1.ConnectionString := ConnStr;
        ADOConnection1.Connected := true;
        LstLog.Items.append('Connect database successfully !');
        lstlog.ItemIndex := lstlog.Items.Count - 1;
      except
        LstLog.Items.append('Connect database failure !');
        lstlog.ItemIndex := lstlog.Items.Count - 1;
        r2.Enabled := False;
      end;
    end;
end;

procedure TForm1.BtnRequestClick(Sender: TObject);
begin
  //pHostData:=@HostData;
  Sock := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if Sock = INVALID_SOCKET then
    begin
      //ShowMessage('Init Socket Failed!');
      LstLog.Items.append('Init Socket Failed!');
      lstlog.ItemIndex := lstlog.Items.Count - 1;
      //WSaCleanUp();
      Exit;
    end;
  HostResolved := false;
  HostData.h_addr := nil;
  GetHostHandle := WSAAsyncGetHostByName(Self.handle, WM_HOSTRESOLVED,
    pchar(HOST), pchar(@HostData), MAXGETHOSTSTRUCT);

  if GetHostHandle = 0 then // If failed
    begin
      //ShowMessage('Faild when ASyncGetHostName!');
      LstLog.Items.append('Faild when ASyncGetHostName!');
      lstlog.ItemIndex := lstlog.Items.Count - 1;
      Exit;
    end;

  BtnRequest.Enabled := false;
  self.BtnCancel.Enabled := true;
end;

procedure TForm1.BtnCancelClick(Sender: TObject);
begin
  if not HostResolved then
    WSACancelAsyncRequest(GetHostHandle)
  else
    winsock.closesocket(sock);
  BtnRequest.Enabled := true;
  btnCancel.enabled := false;
end;

procedure TForm1.BallsFilter;
var
  i, len, n1, n2: integer;
  s, s1, s2: string;
begin
  len := TmpStr.Count;
  ListBox1.Clear;
  try
    for i := 1 to len do
      begin
        s := TmpStr.Strings[i - 1];
        n1 := pos('bord2r', s);
        n2 := pos('fs13', s);
        if n1 > 0 then
          s1 := copy(s, n1 + 8, 5);
        if n2 > 0 then
          begin
            s2 := copy(s, n2 + 6, 22);
            s2 := StringReplace(s2, ' + ', ' ', [rfReplaceAll]);
          end;
        if (s1 <> '') and (s2 <> '') then
          begin
            ListBox1.Items.Add('20' + s1 + ' ' + s2);
            s1 := '';
            s2 := '';
          end;
      end;
  finally
    TmpStr.Clear;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  s1, s2: string;
begin
  if r1.Checked then
    begin
      SaveDialog1.Title := '双色球记录导出';
      SaveDialog1.Filter := '文本文件|*.txt';
      if SaveDialog1.Execute then
        ListBox1.Items.SaveToFile(SaveDialog1.FileName);
    end;
  if r2.Checked then
    begin
      try
        ADOQuery1.Close;
        ADOQuery1.SQL.Clear;
        for i := 0 to ListBox1.Items.Count - 1 do
          begin
            s1 := 'insert into balls (issue,r1,r2,r3,r4,r5,r6,r7) values ';
            s2 := ListBox1.Items[i];
            s2 := StringReplace(s2, ' ', ',', [rfReplaceAll]);
            s2 := '(' + s2 + ')';
            ADOQuery1.SQL.Add(s1 + s2);
          end;
        ADOQuery1.ExecSQL;
      except
      end;
    end;
  LstLog.Items.append('Data export successfully!');
  lstlog.ItemIndex := lstlog.Items.Count - 1;
end;

function TForm1.Rini(Root, key, list, path: string;
  lists: TStrings): string;
var
  myini: Tinifile;
begin
  try
    myini := Tinifile.Create(path);
    if list = '1' then
      myini.ReadSection(Root, lists)
    else
      result := myini.ReadString(Root, key, '0');
  finally
    myini.Free;
  end;
end;

end.