fmain.~pas

工具名称：星星点灯赢富360 功能：1、提供大盘赢富资金盘面的查询 2、提供个股赢富盘面的查询（待开发） [代理设置说明]如果代理服务器为空

unit fmain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzTabs, ComCtrls, ExtCtrls, pngimage, RzPanel, StdCtrls,StrUtils,MaskUtils,
  Buttons,inifiles, IdTCPConnection, IdTCPClient, IdHTTP, IdBaseComponent,
  IdComponent, IdIPWatch, RzLabel, IdAntiFreezeBase, IdAntiFreeze;
const
  cfile='yf360.ini';

type
  TForm1 = class(TForm)
    RzPageControl1: TRzPageControl;
    TabSheet1: TRzTabSheet;
    TabSheet2: TRzTabSheet;
    TabSheet3: TRzTabSheet;
    TabSheet4: TRzTabSheet;
    Panel1: TPanel;
    Image1: TImage;
    Edit1: TEdit;
    ListBox1: TListBox;
    Label2: TLabel;
    Panel2: TPanel;
    lhost: TLabeledEdit;
    luser: TLabeledEdit;
    lpass: TLabeledEdit;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    Panel3: TPanel;
    zpass: TLabeledEdit;
    Label3: TLabel;
    zqq: TLabeledEdit;
    zuser: TLabeledEdit;
    zemail: TLabeledEdit;
    Button1: TButton;
    IdIPWatch1: TIdIPWatch;
    IdHTTP1: TIdHTTP;
    BitBtn5: TBitBtn;
    dpt: TTimer;
    BitBtn6: TBitBtn;
    IdAntiFreeze1: TIdAntiFreeze;
    Panel4: TPanel;
    Label4: TLabel;
    RzURLLabel1: TRzURLLabel;
    Button2: TButton;
    Timer1: TTimer;
    Panel5: TPanel;
    Label1: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    pb1: TProgressBar;
    dhost: TLabeledEdit;
    duser: TLabeledEdit;
    dpass: TLabeledEdit;
    Label7: TLabel;
    dport: TLabeledEdit;
    procedure FormCreate(Sender: TObject);
    procedure RzPageControl1Change(Sender: TObject);
    procedure Edit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormResize(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure dptTimer(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    dtime:integer;
    procedure dispImg(fname:string;hint:string);

    function downFile(fname:string;dir:string):boolean;
  public
    curPos:integer;
    ts:tstringlist;
    dcount:integer;
    procedure process;
    { Public declarations }
  end;

var
  Form1: TForm1;
  ppath:string;
implementation


{$R *.dfm}
function DeletePath(mDirName: string; Ext: String = '*'): Boolean;
var
  vSearchRec: TSearchRec;
  vPathName, tmpExt: string;
  K: Integer;
begin
  Result := true;

  tmpExt := Ext;
  if Pos('.', tmpExt) = 0 then
    tmpExt := '.' + tmpExt;

  vPathName := mDirName + '\*.*';
  K := FindFirst(vPathName, faAnyFile, vSearchRec);
  while K = 0 do
  begin
    if (vSearchRec.Attr and faDirectory > 0) and
      (Pos(vSearchRec.Name, '..') = 0) then
    begin
      FileSetAttr(mDirName + '\' + vSearchRec.Name, faDirectory);
      Result := DeletePath(mDirName + '\' + vSearchRec.Name, Ext);
    end
    else if Pos(vSearchRec.Name, '..') = 0 then
    begin
      FileSetAttr(mDirName + '\' + vSearchRec.Name, 0);
      if ((CompareText(tmpExt, ExtractFileExt(vSearchRec.Name)) = 0) or (CompareText(tmpExt, '.*') = 0)) then
        Result := DeleteFile(PChar(mDirName + '\' + vSearchRec.Name));
    end;
    if not Result then
      Break;
    K := FindNext(vSearchRec);
  end;
  FindClose(vSearchRec);
end; 
function enpass(s:string):string;
var
  i:integer;
  ch:char;
begin
  for i:=1 to length(s) do
    begin
       ch:=s[i];
       if odd(ord(ch)) then
         s[i]:= chr(ord(ch)+1)
       else
         s[i]:= chr(ord(ch)-1);
    end;
    result:=s;
end;
function TForm1.downFile(fname:string;dir:string):boolean;
var
  MyStream:TMemoryStream;
  url:string;
begin
  MyStream:=TMemoryStream.Create;
  try
    url:='http://'+lhost.Text+ts.Strings[6]+'/'+fname;
  except
    url:='http://'+lhost.Text+'/newman/dp/'+fname;
  end  ;
  try
    idhttp1.Get(url,Mystream);
  except
    result:=false;
    exit;
  end;
  try
      MyStream.SaveToFile(ppath+dir+'\'+fname);
  except
    result:=false;
    exit;
  end;
  result:=true;
end;

//定时器处理
procedure TForm1.process;
var
  i,kk:integer;
  cc:integer;//每次最多下载文件个数
begin
   kk:=listbox1.Count;
   if ts.Count=0 then //服务器返回的数据 ,=0没连接服务器
     exit;
   if not downfile('list.txt','dp') then
      exit;
   if listbox1.Count=0 then
       begin
{          bitbtn6.Enabled:=false;
          bitbtn1.Enabled:=true;
          ts.Clear;
          label1.Caption:='服务器未登录，请登录。';}
          DeletePath(ppath+'dp','*.png');
       end;
       
   listbox1.Items.LoadFromFile(ppath+'dp\list.txt');
   //if kk=listbox1.Count then
   //  exit;
   pb1.Max:= 10*listbox1.Count;
   pb1.Position:=0;
   cc:=1;
   for i:=listbox1.Count-1 downto 0 do
     begin
        if fileexists(ppath+'dp\'+listbox1.Items.Strings[i]+'.png') then
           continue;
        if downfile(listbox1.Items.Strings[i]+'.png','dp') then
           //dispimg(ppath+'dp\'+listbox1.Items.Strings[i]+'.png','');
        inc(cc);
        if cc>dcount then
          break;
        pb1.Position:=pb1.Position+10;
        application.ProcessMessages;
     end;
  pb1.Position:=0;
  if tabsheet1.Showing then
  begin
    cc:=0;
    for i:=0 to listbox1.Count-1 do
      if fileexists(ppath+'dp\'+listbox1.Items.Strings[i]+'.png') then
        inc(cc);
    label7.Caption:='共有'+inttostr(cc)+'张图片';
    curpos:=listbox1.Count-1;
    dispimg(ppath+'dp\'+listbox1.Items.Strings[curpos]+'.png','');
    edit1.SetFocus;
  end;
//   
end;

procedure TForm1.dispImg(fname:string;hint:string);
var
  s:string;
begin
  //
  if fileexists(ppath+'dp\'+listbox1.Items.Strings[curpos]+'.png') then
  try
  image1.Picture.LoadFromFile(ppath+'dp\'+listbox1.Items.Strings[curpos]+'.png');
  s:=trim(ChangeFileExt(ExtractFileName(fname),''));
  s:=FormatMaskText('0000-00-00 00:00:00;0;*',s);
  label1.Caption:='当前图时间:'+s+'  '+hint;//formatdatetime('yyyy-mm-dd hh:mm:ss',t);
  except
  end;
  application.ProcessMessages;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  form1.Resize;
  ts:=tstringlist.Create;
  ppath:=extractfilepath(paramstr(0));
  tabsheet4.Show;
  bitbtn3.Click;
  DoubleBuffered :=true;

  edit1.Height:=5;
  listbox1.Clear;
  if fileexists(ppath+'dp\list.txt') then
    listbox1.Items.LoadFromFile(ppath+'dp\list.txt');
  curPos:=0;

end;

procedure TForm1.RzPageControl1Change(Sender: TObject);
begin
  if ts.Count=0 then
    exit;
  if tabsheet1.Showing then
  begin
    if listbox1.Items.Count=0 then
      exit;
    curpos:=listbox1.Items.Count-1;
    dispimg(ppath+'dp\'+listbox1.Items.Strings[curpos]+'.png','');
    edit1.SetFocus;
  end;
end;

procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  i:integer;
begin
  if key=VK_left then
      if curpos>0 then
        dec(curpos);
  if key=VK_right then
      if curpos<listbox1.Items.Count-1 then
       inc(curpos);
   if key=VK_HOME then
     for i:=0 to listbox1.Count-1 do
       if fileexists(ppath+'dp\'+listbox1.Items.Strings[i]+'.png') then
         begin
           curpos:=i;
           break;
         end;

   if key=VK_END then
     curpos:=listbox1.Items.Count-1;
  if listbox1.Items.Count<>0 then
    dispimg(ppath+'dp\'+listbox1.Items.Strings[curpos]+'.png','');
  key:=0;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  panel2.Left:=(rzpagecontrol1.Width-panel2.Width) div 2;
  panel2.Top:=(rzpagecontrol1.Height-panel2.Height) div 2;
  if rzpagecontrol1.Width< panel2.Width+50 then
    form1.Width:=panel2.Width+50;
  if rzpagecontrol1.Height< panel2.Height+100 then
    form1.Height:=panel2.Height+100;
  panel3.Left:=(rzpagecontrol1.Width-panel3.Width) div 2;
  panel3.Top:=(rzpagecontrol1.Height-panel3.Height) div 2;
  panel4.Left:=(rzpagecontrol1.Width-panel4.Width) div 2;
  panel4.Top:=(rzpagecontrol1.Height-panel4.Height) div 2;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
  ini:tinifile;
begin
  ini:=tinifile.Create(ppath+cfile);
  ini.WriteString('cfg','host',lhost.text);
  ini.WriteString('cfg','user',luser.Text);
  ini.WriteString('cfg','passwd',enpass(lpass.Text));
  ini.WriteString('cfg','duser',duser.Text);
  ini.WriteString('cfg','dpass',dpass.Text);
  ini.WriteString('cfg','dhost',dhost.Text);
  ini.WriteString('cfg','dport',dport.Text);
  ini.Free;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
  ini:tinifile;
begin
  ini:=tinifile.Create(ppath+cfile);
  lhost.Text:=  ini.readString('cfg','host','');
  luser.Text:=ini.readString('cfg','user','');
  lpass.Text:=enpass(ini.readString('cfg','passwd',''));
  dcount:=ini.ReadInteger('cfg','count',4);
  duser.Text:=ini.readString('cfg','duser','');
  dpass.Text:=ini.readString('cfg','dpass','');
  dhost.Text:=ini.readString('cfg','dhost','');
  dport.Text:=ini.readString('cfg','dport','');
  ini.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
  request:tstringlist;
  response:tstringstream;
  url:string;
begin
  request:=tstringlist.Create ;
  response:=tstringstream.Create('');
  request.Add('cname='+idipwatch1.LocalName);
  request.Add('user='+ zuser.Text);
  request.Add('pass='+zpass.Text);
  request.Add('qq='+zqq.Text);
  request.Add('email='+zemail.Text);
  request.Add('yfchk=yfnewman');
  url:='http://'+lhost.Text+'/newman/yf360'+'/yfreg.asp';
  try
    idhttp1.Post(url,request,response);
    request.Clear;
    request.Delimiter:=',';
    request.DelimitedText:=response.DataString;
  except
    request.DelimitedText:='4,连接网站失败!';
  end;
  if strtoint(request.Strings[0])=0 then
    showmessage(request.Strings[1])
  else
    showmessage(request.Strings[1]);
end;

procedure TForm1.BitBtn5Click(Sender: TObject);
begin
  panel3.Visible:=false;
end;

procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  panel3.Visible:=true;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);

var
  request :tstringlist;
  response:tstringstream;
  url:string;
begin
  if (time()>strtotime('09:08:00')) and (time()<strtotime('09:29:00')) then
    begin
     messagebox(handle,'9:8:00--9:29:00服务器将进行初始化，无法登录！','提示',mb_yesno+MB_ICONinformation);
     exit;
    end;
  if messagebox(handle,'登录服务器，如果成功将增加服务器计数一次！'+
      #10#13#10#13+'继续吗？'+
      #10#13#10#13+'继续等待连接的提示','提示',mb_yesno+MB_ICONinformation)=idno then
        exit;
  if trim(dhost.Text)<>'' then
    begin
      idhttp1.ProxyParams.ProxyServer:=dhost.Text;
      idhttp1.ProxyParams.ProxyPort:=strtoint(dport.Text);
      if trim(duser.Text)<>'' then
        begin
          idhttp1.ProxyParams.BasicAuthentication:=true;
          idhttp1.ProxyParams.ProxyUsername:=duser.Text;
          idhttp1.ProxyParams.ProxyPassword:=dpass.Text;
        end
      else
        begin
          idhttp1.ProxyParams.BasicAuthentication:=false;
          idhttp1.ProxyParams.ProxyUsername:='';
          idhttp1.ProxyParams.ProxyPassword:='';
        end
    end
  else
    begin
      idhttp1.ProxyParams.ProxyServer:='';
      idhttp1.ProxyParams.ProxyPort:=0;
      idhttp1.ProxyParams.BasicAuthentication:=false;
      idhttp1.ProxyParams.ProxyUsername:='';
      idhttp1.ProxyParams.ProxyPassword:='';
    end;

  request:=tstringlist.Create ;
  response:=tstringstream.Create('');
  request.Add('cname='+idipwatch1.LocalName);
  request.Add('user='+ luser.Text);
  request.Add('pass='+lpass.Text);
  request.Add('qq='+zqq.Text);
  request.Add('email='+zemail.Text);
  request.Add('ver=2008.6.18');  
  request.Add('yfchk=yfnewman');

  url:='http://'+lhost.Text+'/newman/yf360'+'/yfchk.asp';
  try
    idhttp1.Post(url,request,response);
    ts.Clear;
    ts.Delimiter:=',';
    ts.DelimitedText:=response.DataString;    
    request.Clear;
    request.Delimiter:=',';
    request.DelimitedText:=response.DataString;
  except
    ts.Delimiter:=',';
    ts.DelimitedText:='4,连接网站失败!';
    request.Delimiter:=',';
    request.DelimitedText:='4,连接网站失败!';
  end;
  //showmessage(ts.Strings[0]);
  if strtoint(ts.Strings[0])=0 then
    messagebox(handle,pchar('连接服务器'+inttostr(ts.Count)+'成功,已登录'+ts.Strings[4]+'次'),'提示',mb_OK+MB_ICONinformation);
  if strtoint(ts.Strings[0])<>0 then
    messagebox(handle,pchar(request.Strings[1]),'提示',mb_OK+MB_ICONinformation);
  if strtoint(ts.Strings[0])=255 then
    halt;
  label1.Caption:='连接服务器成功,已登录';
  label5.Caption:='检查频率：'+floattostr(strtoint(ts.Strings[2])/2000)+'秒 服务器更新'+floattostr(strtoint(ts.Strings[2])/1000)+'秒';

  //ts.Text:=request.Text;
  try
    dpt.Interval:=strtoint(ts.Strings[2]) div 2;
  except
    dpt.Interval:=300000;
  end;
  dtime:=dpt.Interval div 1000;
  dpt.Enabled:=true;
  bitbtn6.Enabled:=true;
  bitbtn1.Enabled:=false;
  process;
end;

procedure TForm1.dptTimer(Sender: TObject);
begin
  process;
  dtime:=dpt.Interval div 1000;
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
  if messagebox(handle,'断开服务器连接，再登录将增加服务器计数一次！'+
      #10#13#10#13+'继续吗？','提示',mb_yesno+MB_ICONinformation)=idno then
        exit;
  bitbtn6.Enabled:=false;
  bitbtn1.Enabled:=true;
  ts.Clear;
  label1.Caption:='服务器未登录，请登录';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
zuser.Text:=enpass('刷新间隔（秒） ');
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   if ts.Count<=0 then exit;
   label6.Caption:=timetostr(time());
   dtime:=dtime -2;
   if dtime<0 then
     dtime:=0;
   try
   label5.Caption:='客户端还有'+floattostr(dtime)+'秒更新 服务器'+floattostr(strtoint(ts.Strings[2])/1000)+'秒更新一次';
   except
   end;
   if (time()>strtotime('9:10:0')) and (time()<strtotime('9:19:0')) then
     begin
      DeletePath(ppath+'dp','*.png');
      bitbtn6.Enabled:=false;
      bitbtn1.Enabled:=true;
      ts.Clear;
     end;
   //if not dpt.Enabled then
   //  dpt.Enabled:=true;
end;

end.