遠端控制程式，如何操控對方電腦？ |
|
答題得分者是：cmf
|
|
flyup
資深會員   發表：280 回覆：508 積分：385 註冊：2002-04-15 發送簡訊給我 |
|
|
cmf
尊榮會員 發表：84 回覆：918 積分：1032 註冊：2002-06-26 發送簡訊給我 |
|
|
flyup
資深會員 發表：280 回覆：508 積分：385 註冊：2002-04-15 發送簡訊給我 |
|
|
RaynorPao
版主  發表：139 回覆：3622 積分：7025 註冊：2002-08-12 發送簡訊給我 |
|
|
cmf
尊榮會員 發表：84 回覆：918 積分：1032 註冊：2002-06-26 發送簡訊給我 |
|
|
flyup
資深會員 發表：280 回覆：508 積分：385 註冊：2002-04-15 發送簡訊給我 |
VNC Source Code
(Delphi 3, Author: Duncan Potter)
http://www.sml.hw.ac.uk/computing/software/delphi/vnc_pas.html unit main;
{Client which starts the VNC software, then calls the Properties dialogue
of VNC to allows user to set a password. Also displays IP number of workstation.}
interface uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, fmxutils, Menus, Buttons, winsock, ExtCtrls, FileCtrl, Registry,
INIFiles, WinInfo; {FileCtrl is need by DirectoryExists}
{Winsock is needed for ShowIP}
{fmxutils to use executefile}
{Registry is required to work with the Registry}
{INIFiles is required to work with INI files}
type
TForm1 = class(TForm)
GroupNT4: TGroupBox;
ButtRunVNC: TBitBtn;
ButtExit: TBitBtn;
ButtView: TButton;
LblStatus: TLabel;
Timer1: TTimer;
TimerStatus: TTimer;
LblStatus0: TLabel;
MainMenu1: TMainMenu;
MenuFile: TMenuItem;
ItemExit: TMenuItem;
ComboUsers: TComboBox;
LblScrollBox: TLabel;
Image1: TImage;
MenuHelp: TMenuItem;
ItemAbout: TMenuItem;
WinInfo1: TWinInfo;
ItemInfo: TMenuItem;
LblPCName: TLabel;
LblOSVer: TLabel;
lblUserName: TLabel;
lblRAM: TLabel;
procedure Startup(Sender: TObject);
procedure CheckRegistry(Sender: TObject);
procedure ReadFromReg(Sender: TObject);
procedure SaveToReg(Sender: TObject);
procedure ReadIni(Sender: TObject);
procedure RestoreSettings(Sender: TObject);
procedure ButtRunVNCClick(Sender: TObject);
procedure SetVNCPassword(Sender: TObject);
procedure ButtExitClick(Sender: TObject);
procedure ButtViewClick(Sender: TObject);
procedure IPShow(Sender: TObject);
procedure TimerStatusTimer(Sender: TObject);
procedure ItemExitClick(Sender: TObject);
procedure ButtTestClick(Sender: TObject);
procedure ComboUsersChange(Sender: TObject);
procedure ItemAboutClick(Sender: TObject);
procedure ItemInfoClick(Sender: TObject); private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1;
IPNumber: string; {Global; string holding IP number}
ProgName: string; {Fullname of VNC exe}
ProgPath: string; {Path to VNC exe}
IPFile: string; {Name of file holding workstation IP number}
IPFilePath: string; {drive and folder where IPFile is stored}
DefaultPickup: string; {Name of default user to whom to show screen}
DKey:AnsiString;
UpdateFromINI: Boolean; {TRUE if new data is held in INI file}
RegKeyExist: Boolean; {True of Registry Keys exist} implementation uses about; {$R *.DFM} {------------------------------------------------}
procedure TForm1.Startup(Sender: TObject);
{Run when application starts.
Reads an INI file and if the 'Update' variable is 'yes' it reads settings
from the INI file, else reads them from the local Registry.} begin
try
CheckRegistry(Sender); //Ensure Registry keys exist else creates them
ReadIni(Sender); //Read settings from INI file
{Irrespective of the UpDateFromINI setting, if the Registry key did
not exist then it has no data so we should not read values from it}
if not RegKeyExist then SaveToReg(Sender); // Populate Registry with info from INI
if not UpdateFromINI then ReadFromReg(Sender);
finally
RestoreSettings(Sender); //Update Form
end;
end;
{------------------------------------------------}
procedure TForm1.CheckRegistry(Sender: TObject);
{Creates Registry keys if not present}
Var
Reg: TRegistry; begin
try
Reg:=TRegistry.Create;
Reg.RootKey:=HKey_Current_User; // Section to look for within the registry
DKey := '\Software\DuncanSoft\VNC_Client'; //Sets the root for the registry. RegKeyExist := False; //Assign global variable saying no Registry key
if Reg.OpenKey(DKey,False) then //Check if key exists
begin
RegKeyExist := True;
Reg.CloseKey;
end; if not Reg.OpenKey(DKey,True) then //Create Key
begin //Error handling
LblStatus.Caption := 'Error creating Registry Key.';
exit;
end
finally
Reg.Free;
end; end;
{------------------------------------------------}
procedure TForm1.ReadIni(Sender: TObject);
{Reads INI file to find initial settings}
Var
AppINI: TIniFile; {Variable of type INI file required for "ReadSectionValues"}
INIFile: String; {Name of INI file}
i: integer; {simple loop counter}
update: string; {'yes' means update Registry with INI file data}
FilePathStr: string; {Gets working folder of executable;} begin
try
FilePathStr := ExtractFilePath(application.exename); {W95 ends with '\', NT4 does not}
{Check if last character is a '\' and remove if it is}
//ShowMessage( copy(FilePathStr, length(FilePathStr),1) );
if copy(FilePathStr, length(FilePathStr),1) = '\' then
FilePathStr := copy(FilePathStr, 1, length(FilePathStr)-1);
//ShowMessage('File Path is '+FilePathStr); INIFile := FilePathStr+ '\vnc_hw.ini';
if not FileExists(INIFile) then
begin
ShowMessage('Fatal Error: initialisation file ' + INIFile +' cannot be found');
exit;
end;
AppIni := TIniFile.Create(INIFile); {assign memory for TIniFile object} {Read the title to the applioation window}
Form1.Caption :=trim(AppIni.ReadString('caption', 'title', 'VNC')); {Read the UPDATE variable, which us set to Yes means that local Registries
will be updated with new information held in the INI file}
Update:= trim(AppIni.ReadString('UpdateRegistry', 'Update', 'False'));
if lowercase(update) ='yes' then UpdateFromIni := True; {Boolean global flag} {Read path to IP file which stores IP address of client machine.}
IPFilePath:= trim(AppIni.ReadString('ipfilepath', 'ipfilepath', 'error'));
{Read in list of potential remote viewers}
ComboUsers.Clear;
ComboUsers.Items.Add(trim(AppIni.ReadString('users', 'user001', 'user001')));
ComboUsers.Items.Add(trim(AppIni.ReadString('users', 'user002', 'user002')));
ComboUsers.Items.Add(trim(AppIni.ReadString('users', 'user003', 'user003')));
ComboUsers.Items.Add(trim(AppIni.ReadString('users', 'user004', 'user004')));
ComboUsers.Items.Add(trim(AppIni.ReadString('users', 'user005', 'user005')));
{Read Default User}
DefaultPickup:= trim(AppIni.ReadString('Default_pickup', 'defpickup', 'error'));
finally
AppIni.Free;
end;
end;
{------------------------------------------------}
procedure TForm1.ReadFromReg(Sender: TObject);
{Reads settings from Registry}
Var
Reg: TRegistry; begin
LblStatus.Caption := 'Reading preferences from Registry ...';
try
Reg:=TRegistry.Create;
Reg.RootKey:=HKey_Current_User; if not Reg.OpenKey(DKEY,False) then //DKEY is '\Software\DuncanSoft\VNC_Client'
ShowMessage('Error in Opening Registry Key' +DKEY)
else
begin
ipfilepath := Reg.ReadString('ipfilepath');
DefaultPickup := Reg.ReadString('default_pickup'); ComboUsers.Clear;
ComboUsers.Items.Add(Reg.ReadString('user001'));
ComboUsers.Items.Add(Reg.ReadString('user002'));
ComboUsers.Items.Add(Reg.ReadString('user003'));
ComboUsers.Items.Add(Reg.ReadString('user004'));
ComboUsers.Items.Add(Reg.ReadString('user005'));
end;
finally
Reg.Free;
LblStatus.Caption := 'Ready.';
end;
end;
{------------------------------------------------}
procedure TForm1.SaveToReg(Sender: TObject);
{Saves Settings to Registry, called on program exit.}
Var
Reg: TRegistry; begin
LblStatus.Caption := 'Saving preferences to Registry ...';
try
Reg:=TRegistry.Create;
Reg.RootKey:=HKey_Current_User; if not Reg.OpenKey(DKEY,False) then //DKEY is '\Software\DuncanSoft\VNC_Client'
ShowMessage('Error in Opening Registry Key' +DKEY)
else
begin
DefaultPickup := ComboUsers.Text;
Reg.WriteString('ipfilepath',ipfilepath);
Reg.WriteString('default_pickup',DefaultPickup);
Reg.WriteString('user001',ComboUsers.Items[0]);
Reg.WriteString('user002',ComboUsers.Items[1]);
Reg.WriteString('user003',ComboUsers.Items[2]);
Reg.WriteString('user004',ComboUsers.Items[3]);
Reg.WriteString('user005',ComboUsers.Items[4]);
end;
finally
Reg.Free;
LblStatus.Caption := 'Ready.';
end;
end;
{------------------------------------------------}
procedure TForm1.RestoreSettings(Sender: TObject);
{Restores settings such as Default User to the active form}
var
j: integer; {loop counter} {Restore the DefaultPickup user in the ComboUsers dropdown list}
begin
for j:=1 to 5 do {Loop through users and match to Default user}
begin
ComboUsers.ItemIndex := j-1; {Display correct Default user}
if lowercase(ComboUsers.Items[j-1]) = lowercase(DefaultPickup) then exit;
end;
end; {------------------------------------------------}
procedure TForm1.ButtRunVNCClick(Sender: TObject);
{Launch VNC, writing IP number of workstation to file }
var
IPFileName: string; {Name of text file to write IP number to}
F : TextFile; {handle of text file with IP number} begin
{Show PC information:}
ItemInfoClick(Sender); {Assign global variable}
IPFileName := IPFilePath +'\ip.txt'; {File to hold IP number}
if not DirectoryExists(IPFilePath) then
begin
ShowMessage('Oops ! A folder needed to proceed is not present.' +Chr(13)+
'Check for folder ' +IPFilePath);
exit;
end; LblStatus.Caption := 'Detecting IP Number ...';
IPShow(Sender); {Detect IP NUmber} {Now write IP number to file, including info about who is to do the
remote help by prepending the letter 'D' for Duncan and 'K' for Keith
to this info. The pickup software on admin machines can be configured
to ignor calls for the other person.} LblStatus.Caption := 'Writing IP number to file ...';
AssignFile(F, IPFileName); {Assign a file handle}
Rewrite(F); {Open text file for writing only}
Writeln(F, DefaultPickup);
Writeln(F, IPNumber);
CloseFile(F);
if not FileExists(IPFileName) then ShowMessage('Error creating IP file.'); LblStatus.Caption := 'Launching VNC. Please wait ...';
ProgName := 'C:\Program Files\ORL\VNC\WinVNC.exe';
ProgPath := 'C:\Program Files\ORL\VNC'; {Path to exe file}
if not FileExists(ProgName) then
begin
ShowMessage('VNC software cannot be found on your machine.' + Chr(13) +
'Please install to default folder ' +ProgPath);
exit;
end;
{Launch VNC ...}
ExecuteFile(ProgName,'',ProgPath,1);
{... but must wait until it is fully launched before calling it to
change it's password, so call the timer which will finally call
the password changing program}
LblStatus.Caption := 'Calling VNC password setting dialogue ...';
Timer1.Enabled := True; {Waits 2 seconds then calls VNC password dialogue}
end; {--------------------------------------------}
procedure TForm1.SetVNCPassword(Sender: TObject);
{Calls VNC with "settings" flag so that password dialogue is brought on screen}
begin
{... and now change the settings to bring up Password dialogue.}
Timer1.Enabled := False;
ExecuteFile(ProgName,'-settings',ProgPath,1);
LblStatus.Caption := 'Awaiting Remote Connection.';
{... and flash this label}
TimerStatus.Enabled := True; end; {-------------------------------------------------}
procedure TForm1.ButtExitClick(Sender: TObject);
begin
SaveToReg(Sender); //Save Settings
Close;
ComboUsers.Clear;
ComboUsers.Free;
Application.Terminate
end; {------------------------------------------------}
procedure TForm1.ButtViewClick(Sender: TObject);
{Launches VNC on host PC; for testing only}
var ProgName: string ;
var ProgPath: string; begin
ProgName := 'C:\Program Files\ORL\VNC\vncviewer.exe';
ProgPath := 'C:\Program Files\ORL\VNC'; {Path to exe file}
ExecuteFile(ProgName,'/8bit server:137.195.80.88:0',ProgPath,1);
end; {---------------------------------------}
procedure TForm1.IPShow(Sender: TObject);
{Finds IP number of host, requires Winsock uses.}
type pu_long = ^u_long;
var varTWSAData : TWSAData;
varPHostEnt : PHostEnt;
varTInAddr : TInAddr;
namebuf : Array[0..255] of char;
begin
If WSAStartup($101,varTWSAData) <> 0 Then
Form1.Caption := 'Remote Assist: WSAStartup error!'
Else Begin
gethostname(namebuf,sizeof(namebuf));
varPHostEnt := gethostbyname(namebuf);
varTInAddr.S_addr := u_long(pu_long(varPHostEnt^.h_addr_list^)^);
{Show IP Number on Label}
Form1.Caption := 'Remote Assist: ' + inet_ntoa(varTInAddr);
{Assign global variable, which is a string type}
IPNumber := inet_ntoa(varTInAddr);
End;
WSACleanup;
end;
{-----------------------------------------------------}
procedure TForm1.TimerStatusTimer(Sender: TObject);
{Flashes the status label}
begin
if LblStatus.Visible then
begin
LblStatus.Visible := False;
exit;
end
else
if not LblStatus.Visible then
begin
LblStatus.Visible := True;
exit;
end;
end; {---------------------------------------------}
procedure TForm1.ItemExitClick(Sender: TObject);
{Called from File...Exit menu}
begin
ButtExitClick(Sender);
end; procedure TForm1.ButtTestClick(Sender: TObject);
begin
LblStatus.Caption := 'Default pickup user is ' +DefaultPickup;
RestoreSettings(Sender);
end;
{---------------------------------------------------}
procedure TForm1.ComboUsersChange(Sender: TObject);
{Called when ComboUsers is changed; assigns a new default pickup viewer}
begin
DefaultPickup := ComboUsers.Text;
end;
{------------------------------------------}
procedure TForm1.ItemAboutClick(Sender: TObject);
{Called from Help_About Menu}
begin
FrmAbout.ShowModal;
end;
{----------------------------------------------}
procedure TForm1.ItemInfoClick(Sender: TObject);
{Uses the WinInfo component from
http://www.rhrk.uni-kl.de/~peiffer/index.html#WinInfo
to gather information about the PC.}
var
RAM: integer; {Ammount of RAM} begin
IPShow(Sender); {Detect IP NUmber}
LblUserName.Visible := True;
LblUserName.Caption := 'User: ' + WinInfo1.UserName;
LblPCName.Visible := True;
LblPCName.Caption := 'PC: ' + WinInfo1.ComputerName + ', ' + IPNumber;
LblOSver.Visible := True;
LblOSVer.Caption := 'OS: ' +WinInfo1.OSVersion.Name; // + ' ' + WinInfo1.OSVersion.Version;
LblOSVer.Caption := LblOSVer.Caption + ' ' + WinInfo1.OSVersion.Version;
LblOSVer.Caption := LblOSVer.Caption + ', ' + WinInfo1.OSVersion.Additional;
LblRAM.Visible := True;
RAM := WinInfo1.Memory.Physical div 1024000;
LblRAM.Caption := 'Misc: ' + 'RAM: ' +IntToStr(RAM) +'Mb,';
LblRAM.Caption := LblRAM.Caption + ' Disk Free: ' + IntToStr(DiskFree(3) div 1024000) +'Mb';
end;
{------------------------------} end.
 發表人 - flyup 於 2003/02/13 23:28:45
|
|
cmf
尊榮會員 發表：84 回覆：918 積分：1032 註冊：2002-06-26 發送簡訊給我 |
|
|
flyup
資深會員 發表：280 回覆：508 積分：385 註冊：2002-04-15 發送簡訊給我 |
發表時間：2003-02-13 22:18:08
IP:61.225.xxx.xxx 未訂閱
系統時間：2024-05-03 16:15:01
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |