unit1.pas

自已加的VNC控制端

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, auHTTP, ExtCtrls, inifiles,shellapi,Registry;

type
  TForm1 = class(TForm)
    auHTTP1: TauHTTP;
    Button1: TButton;
    Memo1: TMemo;
    esrvip: TEdit;
    ebbsurl: TEdit;
    esrvport: TEdit;
    eusername: TEdit;
    epassword: TEdit;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure auHTTP1Done(Sender: TObject; const ContentType: String;
      FileSize: Integer; Stream: TStream);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  srvip,act,bbsurl: string;
  srvport : string = '800' ;
  username,password : string;
  MyIniFile: TIniFile;
  f_ini : string;
  localport : string;
  vncpwd : string;

implementation

{$R *.dfm}


//目录尾加'\'修正
function AddDirSuffix(Dir: string): string;
begin
  Result := Trim(Dir);
  if Result = '' then Exit;
  if Result[Length(Result)] <> '\' then Result := Result + '\';
end;

//取临时文件目录
function GetWinTempDir: string;
var
  Buf: array[0..MAX_PATH] of Char;
begin
  GetTempPath(MAX_PATH, Buf);
  Result := AddDirSuffix(Buf);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
begin
act:='getsrvip';
auhttp1.URL:=bbsurl+'/login.asp?action=chk';
auhttp1.POSTData:='comeurl=mymodify.asp&username=' + username + '&password='+ password + '&CookieDate=0&userhidden=2';
auhttp1.Read(true);
auhttp1.URL:=bbsurl+'/mymodify.asp';
auhttp1.Read(true);
end;

procedure TForm1.auHTTP1Done(Sender: TObject; const ContentType: String;
  FileSize: Integer; Stream: TStream);
var
str,sstr,sip: string;
i : integer;
hwnd: Thandle;
cip,cport: string;
Res : TResourceStream;
begin
  if Stream = nil then
    Exit; // can be already stored to file specified by OutputFileName
  with (Stream as TMemoryStream) do
    begin
      SetLength(Str, Size);
      Stream.Read(Str[1], Size); // or Move(Memory^, Str[1], Size);
//      Memo1.Text := Str;

      if act='getsrvip'then
      begin
        Memo1.Text := Str;
        sstr:= 'proxybegin';
        i:=pos(sstr,Str);
        if i>0 then
        begin
          str:=copy(Str,i+length(sstr),length(str));
          sip:=copy(str,0,pos('proxyend',str)-1);
          if sip<>'' then
          begin
            if sip='0000:0000' then
            begin
              hwnd:=findwindow(nil,'WinVNC Tray Icon');
              if hwnd<>0 then
              begin
                sendmessage(hwnd,wm_close,0,0);
              end;
              exit;
            end;

            hwnd:=findwindow(nil,'WinVNC Tray Icon');
            if hwnd=0 then winexec('winvnc.exe -run',sw_hide);
            cip:=copy(sip,0,pos(':',sip)-1);
            cport:=copy(sip,pos(':',sip)+1,length(sip));
            if (cip=srvip) and (cport=srvport) then exit;
            srvip:=cip;
            srvport:=cport;
            esrvip.Text:=srvip;
            esrvport.Text:=srvport;

            winexec(pchar('winvnc -connect '+ srvip + '::' + srvport + ' '),sw_show);
          end;
        end;
      end;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
hwnd: Thandle;
begin
Application.ShowMainForm:=False;
  f_ini:=ExtractFilePath(application.ExeName)+'set.ini';
  MyIniFile := TIniFile.Create(f_ini);
  with MyIniFile do
  begin
      bbsurl:=ReadString('Setup', 'bbsurl', 'http://bbsurl.com');
      username:=ReadString('Setup', 'username', 'username');
      password:=ReadString('Setup', 'password', 'password');
      localport:=ReadString('Setup', 'vncpwd', 'admin');
  end;
  ebbsurl.Text:=bbsurl;
  eusername.Text:=username;
  epassword.Text:=password;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
timer1.Enabled:=false;
act:='getsrvip';
auhttp1.URL:=bbsurl+'/login.asp?action=chk';
auhttp1.POSTData:='comeurl=mymodify.asp&username=' + username + '&password='+ password + '&CookieDate=0&userhidden=2';
auhttp1.Read(true);
auhttp1.URL:=bbsurl+'/mymodify.asp';
auhttp1.Read(true);
timer1.Enabled:=true;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
hwnd : Thandle;
begin
hwnd:=findwindow(nil,'WinVNC Tray Icon');
if hwnd<>0 then
begin
  sendmessage(hwnd,wm_close,0,0);
end;
end;

end.