这个是一人COM应用,利用客户应用程序通过远程服务器上的服务端应用发送按键。由于这段工作时间紧,我先将源代码中部份内容贴上,并在资源中提供全部源代码下载。 注意看到程序代码里“魔兽世界”四个字,大家就应该可以想到我用它是干什么的了,不是要黑别人,而是要带一个牧师小号,呵呵。
==========服务器端================
unit skSrv;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,SyncObjs;
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,SyncObjs;
type
TfrmskSrv = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Button1: TButton;
memInfo: TMemo;
chkBlock: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
TfrmskSrv = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Panel3: TPanel;
Button1: TButton;
memInfo: TMemo;
chkBlock: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure chkBlockClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmskSrv: TfrmskSrv;
csection:TCriticalSection;
InfoCount:integer;
BlockInfo:integer;
frmskSrv: TfrmskSrv;
csection:TCriticalSection;
InfoCount:integer;
BlockInfo:integer;
implementation
{$R *.dfm}
procedure TfrmskSrv.Button1Click(Sender: TObject);
begin
Close;
end;
begin
Close;
end;
procedure TfrmskSrv.FormCreate(Sender: TObject);
begin
csection:=TCriticalSection.Create;
BlockInfo:=0;
end;
begin
csection:=TCriticalSection.Create;
BlockInfo:=0;
end;
procedure TfrmskSrv.FormDestroy(Sender: TObject);
begin
csection.Free;
end;
begin
csection.Free;
end;
procedure TfrmskSrv.chkBlockClick(Sender: TObject);
begin
if chkBlock.Checked then
InterlockedIncrement(BlockInfo)
else
InterlockedDecrement(BlockInfo);
end;
begin
if chkBlock.Checked then
InterlockedIncrement(BlockInfo)
else
InterlockedDecrement(BlockInfo);
end;
end.//======类型库===========
unit SdkSrv_TLB;
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// WARNING
// -------
// The types declared in this file were generated from data read from a
// Type Library. If this type library is explicitly or indirectly (via
// another type library referring to this type library) re-imported, or the
// 'Refresh' command of the Type Library Editor activated while editing the
// Type Library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //
// PASTLWTR : 1.2
// File generated on 2007-08-07 19:37:40 from Type Library described below.
// File generated on 2007-08-07 19:37:40 from Type Library described below.
// ************************************************************************ //
// Type Lib: D:/MyPrograms/Sendkey/src/SdkSrv.tlb (1)
// LIBID: {3B01ECB9-6782-4B27-8BB4-84B2B4E4B962}
// LCID: 0
// Helpfile:
// HelpString: SdkSrv Library
// DepndLst:
// (1) v2.0 stdole, (C:/WINDOWS/system32/STDOLE2.TLB)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
// Type Lib: D:/MyPrograms/Sendkey/src/SdkSrv.tlb (1)
// LIBID: {3B01ECB9-6782-4B27-8BB4-84B2B4E4B962}
// LCID: 0
// Helpfile:
// HelpString: SdkSrv Library
// DepndLst:
// (1) v2.0 stdole, (C:/WINDOWS/system32/STDOLE2.TLB)
// ************************************************************************ //
{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{$VARPROPSETTER ON}
interface
uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants;
// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
SdkSrvMajorVersion = 1;
SdkSrvMinorVersion = 0;
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
SdkSrvMajorVersion = 1;
SdkSrvMinorVersion = 0;
LIBID_SdkSrv: TGUID = '{3B01ECB9-6782-4B27-8BB4-84B2B4E4B962}';
IID_IMySendKey: TGUID = '{24049466-2060-4CAF-BBE7-559268B54127}';
DIID_IMySendKeyEvents: TGUID = '{A10A15B5-8B3E-4366-9252-E5418699ACF7}';
CLASS_MySendKey: TGUID = '{95E49D0E-D659-4366-9279-BB700D9161F0}';
type
DIID_IMySendKeyEvents: TGUID = '{A10A15B5-8B3E-4366-9252-E5418699ACF7}';
CLASS_MySendKey: TGUID = '{95E49D0E-D659-4366-9279-BB700D9161F0}';
type
// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IMySendKey = interface;
IMySendKeyDisp = dispinterface;
IMySendKeyEvents = dispinterface;
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IMySendKey = interface;
IMySendKeyDisp = dispinterface;
IMySendKeyEvents = dispinterface;
// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
MySendKey = IMySendKey;
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
MySendKey = IMySendKey;
// *********************************************************************//
// Interface: IMySendKey
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {24049466-2060-4CAF-BBE7-559268B54127}
// *********************************************************************//
IMySendKey = interface(IDispatch)
['{24049466-2060-4CAF-BBE7-559268B54127}']
procedure SendStr(vwait: SYSINT); safecall;
function Get_WinName: WideString; safecall;
procedure Set_WinName(const Value: WideString); safecall;
function Get_KeyStr: WideString; safecall;
procedure Set_KeyStr(const Value: WideString); safecall;
procedure SetWinAndKey(const WinName: WideString; const KeyStr: WideString); safecall;
procedure SendStr2(const KeyStr: WideString; vwait: Integer); safecall;
property WinName: WideString read Get_WinName write Set_WinName;
property KeyStr: WideString read Get_KeyStr write Set_KeyStr;
end;
// *********************************************************************//
// DispIntf: IMySendKeyDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {24049466-2060-4CAF-BBE7-559268B54127}
// *********************************************************************//
IMySendKeyDisp = dispinterface
['{24049466-2060-4CAF-BBE7-559268B54127}']
procedure SendStr(vwait: SYSINT); dispid 201;
property WinName: WideString dispid 202;
property KeyStr: WideString dispid 203;
procedure SetWinAndKey(const WinName: WideString; const KeyStr: WideString); dispid 204;
procedure SendStr2(const KeyStr: WideString; vwait: Integer); dispid 205;
end;
// DispIntf: IMySendKeyDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {24049466-2060-4CAF-BBE7-559268B54127}
// *********************************************************************//
IMySendKeyDisp = dispinterface
['{24049466-2060-4CAF-BBE7-559268B54127}']
procedure SendStr(vwait: SYSINT); dispid 201;
property WinName: WideString dispid 202;
property KeyStr: WideString dispid 203;
procedure SetWinAndKey(const WinName: WideString; const KeyStr: WideString); dispid 204;
procedure SendStr2(const KeyStr: WideString; vwait: Integer); dispid 205;
end;
// *********************************************************************//
// DispIntf: IMySendKeyEvents
// Flags: (4096) Dispatchable
// GUID: {A10A15B5-8B3E-4366-9252-E5418699ACF7}
// *********************************************************************//
IMySendKeyEvents = dispinterface
['{A10A15B5-8B3E-4366-9252-E5418699ACF7}']
end;
// DispIntf: IMySendKeyEvents
// Flags: (4096) Dispatchable
// GUID: {A10A15B5-8B3E-4366-9252-E5418699ACF7}
// *********************************************************************//
IMySendKeyEvents = dispinterface
['{A10A15B5-8B3E-4366-9252-E5418699ACF7}']
end;
// *********************************************************************//
// The Class CoMySendKey provides a Create and CreateRemote method to
// create instances of the default interface IMySendKey exposed by
// the CoClass MySendKey. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMySendKey = class
class function Create: IMySendKey;
class function CreateRemote(const MachineName: string): IMySendKey;
end;
// The Class CoMySendKey provides a Create and CreateRemote method to
// create instances of the default interface IMySendKey exposed by
// the CoClass MySendKey. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoMySendKey = class
class function Create: IMySendKey;
class function CreateRemote(const MachineName: string): IMySendKey;
end;
implementation
uses ComObj;
class function CoMySendKey.Create: IMySendKey;
begin
Result := CreateComObject(CLASS_MySendKey) as IMySendKey;
end;
begin
Result := CreateComObject(CLASS_MySendKey) as IMySendKey;
end;
class function CoMySendKey.CreateRemote(const MachineName: string): IMySendKey;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MySendKey) as IMySendKey;
end;
begin
Result := CreateRemoteComObject(MachineName, CLASS_MySendKey) as IMySendKey;
end;
end.
//==========实现类型库===========//
unit uSrvMain;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
ComObj, ActiveX, AxCtrls, Classes, SdkSrv_TLB, StdVcl,uComFactory;
ComObj, ActiveX, AxCtrls, Classes, SdkSrv_TLB, StdVcl,uComFactory;
type
TMySendKey = class(TAutoObject, IConnectionPointContainer, IMySendKey)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint;
FEvents: IMySendKeyEvents;
{ note: FEvents maintains a *single* event sink. For access to more
than one event sink, use FConnectionPoint.SinkList, and iterate
through the list of sinks. }
FWinName:string;
FKeyStr:string;
//FInfoCount:integer;
public
procedure Initialize; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
procedure SendStr(vwait: SYSINT); safecall;
function Get_WinName: WideString; safecall;
procedure Set_WinName(const Value: WideString); safecall;
function Get_KeyStr: WideString; safecall;
procedure Set_KeyStr(const Value: WideString); safecall;
procedure WriteInfo;
procedure SetWinAndKey(const WinName, KeyStr: WideString); safecall;
procedure SendStr2(const KeyStr: WideString; vWait: Integer); safecall;
end;
TMySendKey = class(TAutoObject, IConnectionPointContainer, IMySendKey)
private
{ Private declarations }
FConnectionPoints: TConnectionPoints;
FConnectionPoint: TConnectionPoint;
FEvents: IMySendKeyEvents;
{ note: FEvents maintains a *single* event sink. For access to more
than one event sink, use FConnectionPoint.SinkList, and iterate
through the list of sinks. }
FWinName:string;
FKeyStr:string;
//FInfoCount:integer;
public
procedure Initialize; override;
protected
{ Protected declarations }
property ConnectionPoints: TConnectionPoints read FConnectionPoints
implements IConnectionPointContainer;
procedure EventSinkChanged(const EventSink: IUnknown); override;
procedure SendStr(vwait: SYSINT); safecall;
function Get_WinName: WideString; safecall;
procedure Set_WinName(const Value: WideString); safecall;
function Get_KeyStr: WideString; safecall;
procedure Set_KeyStr(const Value: WideString); safecall;
procedure WriteInfo;
procedure SetWinAndKey(const WinName, KeyStr: WideString); safecall;
procedure SendStr2(const KeyStr: WideString; vWait: Integer); safecall;
end;
implementation
uses ComServ, sndkey32, skSrv, DateUtils;
procedure TMySendKey.EventSinkChanged(const EventSink: IUnknown);
begin
FEvents := EventSink as IMySendKeyEvents;
end;
begin
FEvents := EventSink as IMySendKeyEvents;
end;
procedure TMySendKey.Initialize;
begin
inherited Initialize;
FConnectionPoints := TConnectionPoints.Create(Self);
if AutoFactory.EventTypeInfo <> nil then
FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
AutoFactory.EventIID, ckSingle, EventConnect)
else FConnectionPoint := nil;
end;
begin
inherited Initialize;
FConnectionPoints := TConnectionPoints.Create(Self);
if AutoFactory.EventTypeInfo <> nil then
FConnectionPoint := FConnectionPoints.CreateConnectionPoint(
AutoFactory.EventIID, ckSingle, EventConnect)
else FConnectionPoint := nil;
end;
procedure TMySendKey.SendStr(vwait: SYSINT);
begin
if (FWinName<>'') and (FKeyStr<>'') then begin
if AppActivate(PAnsiChar(FWinName)) then begin
SendKeys(PAnsiChar(fkeystr),vwait=0);
if BlockInfo=0 then
writeinfo;
end;
end;
end;
function TMySendKey.Get_WinName: WideString;
begin
Result:=FWinName;
end;
begin
Result:=FWinName;
end;
procedure TMySendKey.Set_WinName(const Value: WideString);
begin
if Value<>'' then begin
FWinName:=Value;
end;
end;
begin
if Value<>'' then begin
FWinName:=Value;
end;
end;
function TMySendKey.Get_KeyStr: WideString;
begin
result:=FKeyStr;
end;
begin
result:=FKeyStr;
end;
procedure TMySendKey.Set_KeyStr(const Value: WideString);
begin
if Value<>'' then begin
FKeyStr:=Value;
end;
end;
begin
if Value<>'' then begin
FKeyStr:=Value;
end;
end;
procedure TMySendKey.WriteInfo;
begin
With frmskSrv.memInfo.Lines do begin
csection.Acquire;
try
if InfoCount>1000 then begin
clear;
InfoCount:=0;
end;
Add(concat(FWinName,':',FKeyStr));
inc(InfoCount);
finally
csection.Release;
end;
end;
end;
begin
With frmskSrv.memInfo.Lines do begin
csection.Acquire;
try
if InfoCount>1000 then begin
clear;
InfoCount:=0;
end;
Add(concat(FWinName,':',FKeyStr));
inc(InfoCount);
finally
csection.Release;
end;
end;
end;
procedure TMySendKey.SetWinAndKey(const WinName, KeyStr: WideString);
begin
FWinName:=WinName;
FKeyStr:=KeyStr;
if BlockInfo=0 then
WriteInfo;
end;
begin
FWinName:=WinName;
FKeyStr:=KeyStr;
if BlockInfo=0 then
WriteInfo;
end;
procedure TMySendKey.SendStr2(const KeyStr: WideString; vWait: Integer);
begin
if (FWinName<>'') then begin
if AppActivate(PAnsiChar(FWinName)) then begin
FKeyStr:=KeyStr;
SendKeys(PAnsiChar(FKeyStr),vwait=0);
if BlockInfo=0 then
writeinfo;
end;
end;
end;
begin
if (FWinName<>'') then begin
if AppActivate(PAnsiChar(FWinName)) then begin
FKeyStr:=KeyStr;
SendKeys(PAnsiChar(FKeyStr),vwait=0);
if BlockInfo=0 then
writeinfo;
end;
end;
end;
initialization
TMyComApartmentFactory.Create(ComServer, TMySendKey, Class_MySendKey,
ciMultiInstance, tmApartment);
end.
TMyComApartmentFactory.Create(ComServer, TMySendKey, Class_MySendKey,
ciMultiInstance, tmApartment);
end.
//=======改写的Apartment线程工厂类==============// { *********************************************************************** }
{ }
{ Delphi Runtime Library }
{ }
{ Copyright (c) 1997-2001 Borland Software Corporation }
{ }
{ *********************************************************************** }
{ }
{ Delphi Runtime Library }
{ }
{ Copyright (c) 1997-2001 Borland Software Corporation }
{ }
{ *********************************************************************** }
unit uComFactory;
{$H+,X+}
interface
uses ActiveX, ComObj, Classes;
type
{ Component object factory }
TMyComApartmentFactory = class(TAutoObjectFactory, IClassFactory)
protected
function CreateInstance(const UnkOuter: IUnknown; const IID: TGUID;
out Obj): HResult; stdcall;
public
constructor Create(ComServer: TComServerObject;
ComClass: TAutoClass; const ClassID: TGUID;
Instancing: TClassInstancing; ThreadingModel: TThreadingModel = tmSingle);
end;
protected
function CreateInstance(const UnkOuter: IUnknown; const IID: TGUID;
out Obj): HResult; stdcall;
public
constructor Create(ComServer: TComServerObject;
ComClass: TAutoClass; const ClassID: TGUID;
Instancing: TClassInstancing; ThreadingModel: TThreadingModel = tmSingle);
end;
implementation
uses
Windows, SysUtils;
Windows, SysUtils;
type
{ TApartmentThread }
TMyApartmentThread = class(TThread)
private
FFactory: IClassFactory2;
FUnkOuter: IUnknown;
FIID: TGuid;
FSemaphore: THandle;
FStream: Pointer;
FCreateResult: HResult;
protected
procedure Execute; override;
public
constructor Create(Factory: IClassFactory2; UnkOuter: IUnknown; IID: TGuid);
destructor Destroy; override;
property Semaphore: THandle read FSemaphore;
property CreateResult: HResult read FCreateResult;
property ObjStream: Pointer read FStream;
end;
private
FFactory: IClassFactory2;
FUnkOuter: IUnknown;
FIID: TGuid;
FSemaphore: THandle;
FStream: Pointer;
FCreateResult: HResult;
protected
procedure Execute; override;
public
constructor Create(Factory: IClassFactory2; UnkOuter: IUnknown; IID: TGuid);
destructor Destroy; override;
property Semaphore: THandle read FSemaphore;
property CreateResult: HResult read FCreateResult;
property ObjStream: Pointer read FStream;
end;
{ TMyApartmentThread }
constructor TMyApartmentThread.Create(Factory: IClassFactory2;
UnkOuter: IUnknown; IID: TGuid);
begin
FFactory := Factory;
FUnkOuter := UnkOuter;
FIID := IID;
FSemaphore := CreateSemaphore(nil, 0, 1, nil);
FreeOnTerminate := True;
inherited Create(False);
end;
UnkOuter: IUnknown; IID: TGuid);
begin
FFactory := Factory;
FUnkOuter := UnkOuter;
FIID := IID;
FSemaphore := CreateSemaphore(nil, 0, 1, nil);
FreeOnTerminate := True;
inherited Create(False);
end;
destructor TMyApartmentThread.Destroy;
begin
CloseHandle(FSemaphore);
inherited Destroy;
end;
begin
CloseHandle(FSemaphore);
inherited Destroy;
end;
procedure TMyApartmentThread.Execute;
var
msg: TMsg;
Unk: IUnknown;
begin
try
CoInitializeEx(nil,COINIT_APARTMENTTHREADED);
try
FCreateResult := FFactory.CreateInstanceLic(FUnkOuter, nil, FIID, '', Unk);
FUnkOuter := nil;
FFactory := nil;
if FCreateResult = S_OK then
CoMarshalInterThreadInterfaceInStream(FIID, Unk, IStream(FStream));
ReleaseSemaphore(FSemaphore, 1, nil);
if FCreateResult = S_OK then
while GetMessage(msg, 0, 0, 0) do
begin
DispatchMessage(msg);
Unk._AddRef;
if Unk._Release = 1 then break;
end;
finally
Unk := nil;
CoUninitialize;
end;
except
{ No exceptions should go unhandled }
end;
end;
var
msg: TMsg;
Unk: IUnknown;
begin
try
CoInitializeEx(nil,COINIT_APARTMENTTHREADED);
try
FCreateResult := FFactory.CreateInstanceLic(FUnkOuter, nil, FIID, '', Unk);
FUnkOuter := nil;
FFactory := nil;
if FCreateResult = S_OK then
CoMarshalInterThreadInterfaceInStream(FIID, Unk, IStream(FStream));
ReleaseSemaphore(FSemaphore, 1, nil);
if FCreateResult = S_OK then
while GetMessage(msg, 0, 0, 0) do
begin
DispatchMessage(msg);
Unk._AddRef;
if Unk._Release = 1 then break;
end;
finally
Unk := nil;
CoUninitialize;
end;
except
{ No exceptions should go unhandled }
end;
end;
{ TMyComApartmentFactory }
constructor TMyComApartmentFactory.Create(ComServer: TComServerObject;
ComClass:TAutoClass; const ClassID: TGUID;
Instancing: TClassInstancing; ThreadingModel: TThreadingModel);
begin
inherited Create(ComServer, ComClass,
ClassID, Instancing, ThreadingModel);
end;
ComClass:TAutoClass; const ClassID: TGUID;
Instancing: TClassInstancing; ThreadingModel: TThreadingModel);
begin
inherited Create(ComServer, ComClass,
ClassID, Instancing, ThreadingModel);
end;
function TMyComApartmentFactory.CreateInstance(const UnkOuter: IUnknown;
const IID: TGUID; out Obj): HResult; stdcall;
begin
if not IsLibrary and (ThreadingModel = tmApartment) then
begin
LockServer(True);
try
with TMyApartmentThread.Create(Self, UnkOuter, IID) do
begin
if WaitForSingleObject(Semaphore, INFINITE) = WAIT_OBJECT_0 then
begin
Result := CreateResult;
if Result <> S_OK then Exit;
Result := CoGetInterfaceAndReleaseStream(IStream(ObjStream), IID, Obj);
end else
Result := E_FAIL
end;
finally
LockServer(False);
end;
end else
Result := inherited CreateInstance(UnkOuter, IID, Obj);
end;
const IID: TGUID; out Obj): HResult; stdcall;
begin
if not IsLibrary and (ThreadingModel = tmApartment) then
begin
LockServer(True);
try
with TMyApartmentThread.Create(Self, UnkOuter, IID) do
begin
if WaitForSingleObject(Semaphore, INFINITE) = WAIT_OBJECT_0 then
begin
Result := CreateResult;
if Result <> S_OK then Exit;
Result := CoGetInterfaceAndReleaseStream(IStream(ObjStream), IID, Obj);
end else
Result := E_FAIL
end;
finally
LockServer(False);
end;
end else
Result := inherited CreateInstance(UnkOuter, IID, Obj);
end;
initialization
finalization
end.
//客户端 关键代码是uRmtobj.pas这个文件
//客户端主窗体代码
unit uSndClient;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, sdkSrv_tlb, comobj,activex, ExtCtrls,urmtobj,
ComCtrls, ToolWin,UApartThread,Buttons, LMDCustomComponent, LMDIniCtrl;
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, sdkSrv_tlb, comobj,activex, ExtCtrls,urmtobj,
ComCtrls, ToolWin,UApartThread,Buttons, LMDCustomComponent, LMDIniCtrl;
type
TfrmSendKey = class(TForm)
edWinName: TEdit;
edKeystr: TEdit;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
edComputer: TEdit;
edUser: TEdit;
edPsw: TEdit;
lmdIni: TLMDIniCtrl;
btnWriteIni: TButton;
btnLoadKey: TButton;
cbOnTop: TCheckBox;
ToolBar1: TToolBar;
tb1: TToolButton;
tb2: TToolButton;
tb3: TToolButton;
tb4: TToolButton;
tb5: TToolButton;
tb6: TToolButton;
ToolButton10: TToolButton;
tb7: TToolButton;
tb8: TToolButton;
btStop: TButton;
ToolButton1: TToolButton;
sbMini: TSpeedButton;
procedure Button2Click(Sender: TObject);
procedure btnWriteIniClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnLoadKeyClick(Sender: TObject);
procedure cbOnTopClick(Sender: TObject);
procedure tb1Click(Sender: TObject);
procedure btStopClick(Sender: TObject);
procedure sbMiniClick(Sender: TObject);
protected
edWinName: TEdit;
edKeystr: TEdit;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
edComputer: TEdit;
edUser: TEdit;
edPsw: TEdit;
lmdIni: TLMDIniCtrl;
btnWriteIni: TButton;
btnLoadKey: TButton;
cbOnTop: TCheckBox;
ToolBar1: TToolBar;
tb1: TToolButton;
tb2: TToolButton;
tb3: TToolButton;
tb4: TToolButton;
tb5: TToolButton;
tb6: TToolButton;
ToolButton10: TToolButton;
tb7: TToolButton;
tb8: TToolButton;
btStop: TButton;
ToolButton1: TToolButton;
sbMini: TSpeedButton;
procedure Button2Click(Sender: TObject);
procedure btnWriteIniClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnLoadKeyClick(Sender: TObject);
procedure cbOnTopClick(Sender: TObject);
procedure tb1Click(Sender: TObject);
procedure btStopClick(Sender: TObject);
procedure sbMiniClick(Sender: TObject);
protected
private
FWinSize:integer;
FWoWKeyString:string;
FSendWinName:string;
FRegion:THandle;
FMainInt:MySendKey;
procedure SetWoWKeyString(const Value: string);
function ReadWoWKeyString: string;
procedure SetSendWinName(const Value: string);
function ReadSendWinName: string;
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
procedure FreeCurrentRegion;
{ Private declarations }
public
FWoWKeyList:TStringList;
sComputer,sUser,sPsw:widestring;
property WoWKeyString:string read ReadWoWKeyString write SetWoWKeyString;
property SendWinName:string read ReadSendWinName write SetSendWinName;
{ Public declarations }
end;
FWinSize:integer;
FWoWKeyString:string;
FSendWinName:string;
FRegion:THandle;
FMainInt:MySendKey;
procedure SetWoWKeyString(const Value: string);
function ReadWoWKeyString: string;
procedure SetSendWinName(const Value: string);
function ReadSendWinName: string;
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
procedure FreeCurrentRegion;
{ Private declarations }
public
FWoWKeyList:TStringList;
sComputer,sUser,sPsw:widestring;
property WoWKeyString:string read ReadWoWKeyString write SetWoWKeyString;
property SendWinName:string read ReadSendWinName write SetSendWinName;
{ Public declarations }
end;
var
frmSendKey: TfrmSendKey;
rmtObject:IMySendKey;
KeyCount:integer;
thr:TTmpThread;
frmSendKey: TfrmSendKey;
rmtObject:IMySendKey;
KeyCount:integer;
thr:TTmpThread;
implementation
uses Math, StrUtils;
{$R *.dfm}
{ TTmpThread }
procedure TfrmSendKey.Button2Click(Sender: TObject);
begin
close;
end;
procedure TfrmSendKey.SetWoWKeyString(const Value: string);
begin
FWoWKeyString := Value;
end;
begin
FWoWKeyString := Value;
end;
function TfrmSendKey.ReadWoWKeyString: string;
begin
if edKeystr.Text<>'' then
FWoWKeyString:=edKeystr.Text;
result:=FWoWKeyString;
end;
begin
if edKeystr.Text<>'' then
FWoWKeyString:=edKeystr.Text;
result:=FWoWKeyString;
end;
procedure TfrmSendKey.SetSendWinName(const Value: string);
begin
FSendWinName := Value;
end;
begin
FSendWinName := Value;
end;
function TfrmSendKey.ReadSendWinName: string;
begin
if edWinName.Text<>'' then
FSendWinName:=edWinName.text;
result:=FSendWinName;
end;
begin
if edWinName.Text<>'' then
FSendWinName:=edWinName.text;
result:=FSendWinName;
end;
procedure TfrmSendKey.FormCreate(Sender: TObject);
begin
FWoWKeyList:=TStringList.Create;
FWinSize:=Height;
{ for i:=0 to ComponentCount-1 do begin
with Components[i] do
tmp:=CreateRectRgn(Left,Top,Left+Width,Top+Height);
if i=0 then begin
FRegion:=tmp;
Continue;
end;
CombineRgn(FRegion,FRegion,tmp,RGN_AND);
DeleteObject(tmp);
end;
If FRegion<>0 then
SetWindowRgn(Handle,FRegion,true); }
{for i:=0 to ControlCount-1 do
if TToolButton(Controls[i]).Style=tbsButton then begin
TToolButton(Controls[i]).Caption:=inttostr(TToolButton(Controls[i]).tag);
TToolButton(Controls[i]).Width:=23;
end; }
end;
begin
FWoWKeyList:=TStringList.Create;
FWinSize:=Height;
{ for i:=0 to ComponentCount-1 do begin
with Components[i] do
tmp:=CreateRectRgn(Left,Top,Left+Width,Top+Height);
if i=0 then begin
FRegion:=tmp;
Continue;
end;
CombineRgn(FRegion,FRegion,tmp,RGN_AND);
DeleteObject(tmp);
end;
If FRegion<>0 then
SetWindowRgn(Handle,FRegion,true); }
{for i:=0 to ControlCount-1 do
if TToolButton(Controls[i]).Style=tbsButton then begin
TToolButton(Controls[i]).Caption:=inttostr(TToolButton(Controls[i]).tag);
TToolButton(Controls[i]).Width:=23;
end; }
end;
procedure TfrmSendKey.FormDestroy(Sender: TObject);
begin
if Assigned(thr) then
with thr do begin
Terminate;
Free;
end;
FWoWKeyList.Free;
rmtObject:=nil;
FMainInt:=nil;
//FreeCurrentRegion;
end;
begin
if Assigned(thr) then
with thr do begin
Terminate;
Free;
end;
FWoWKeyList.Free;
rmtObject:=nil;
FMainInt:=nil;
//FreeCurrentRegion;
end;
procedure TfrmSendKey.btnWriteIniClick(Sender: TObject);
begin
with lmdIni do begin
WriteString('WOWKey','KeyStr',WoWKeyString);
WriteString('WOWKey','SendWin',SendWinName);
end;
end;
begin
with lmdIni do begin
WriteString('WOWKey','KeyStr',WoWKeyString);
WriteString('WOWKey','SendWin',SendWinName);
end;
end;
procedure TfrmSendKey.btnLoadKeyClick(Sender: TObject);
begin
with lmdIni do begin
WoWKeyString:=ReadString('WOWKey','KeyStr','9,r,4');
edKeystr.Text:=FWoWKeyString;
SendWinName:=ReadString('WOWKey','SendWin','魔兽世界');
edWinName.Text:=FSendWinName;
end;
end;
begin
with lmdIni do begin
WoWKeyString:=ReadString('WOWKey','KeyStr','9,r,4');
edKeystr.Text:=FWoWKeyString;
SendWinName:=ReadString('WOWKey','SendWin','魔兽世界');
edWinName.Text:=FSendWinName;
end;
end;
procedure TfrmSendKey.cbOnTopClick(Sender: TObject);
begin
with cbOnTop do begin
If Checked then frmSendKey.FormStyle:=fsStayOnTop
else
frmSendKey.FormStyle:=fsNormal;
end;
end;
begin
with cbOnTop do begin
If Checked then frmSendKey.FormStyle:=fsStayOnTop
else
frmSendKey.FormStyle:=fsNormal;
end;
end;
procedure TfrmSendKey.tb1Click(Sender: TObject);
begin
if not Assigned(FMainInt) then begin
sComputer:=trim(edComputer.Text);
sUser:=trim(edUser.text);
sPsw:=trim(edpsw.text);
FMainInt:=CreatRMTObj(sComputer,sUser,sPsw);
FMainInt.WinName:=trim(edWinName.Text);
end;
if Assigned(FMainint) then
with FMainint do begin
SendStr2(inttostr(TToolButton(Sender).tag),-1);
end;
end;
begin
if not Assigned(FMainInt) then begin
sComputer:=trim(edComputer.Text);
sUser:=trim(edUser.text);
sPsw:=trim(edpsw.text);
FMainInt:=CreatRMTObj(sComputer,sUser,sPsw);
FMainInt.WinName:=trim(edWinName.Text);
end;
if Assigned(FMainint) then
with FMainint do begin
SendStr2(inttostr(TToolButton(Sender).tag),-1);
end;
end;
procedure TfrmSendKey.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited;
if M.Result = htClient then M.Result := htCaption;
end;
begin
inherited;
if M.Result = htClient then M.Result := htCaption;
end;
procedure TfrmSendKey.FreeCurrentRegion;
begin
if FRegion<>0 then begin
SetWindowRgn(Handle,0,true);
DeleteObject(FRegion);
FRegion:=0;
end;
end;
begin
if FRegion<>0 then begin
SetWindowRgn(Handle,0,true);
DeleteObject(FRegion);
FRegion:=0;
end;
end;
procedure TfrmSendKey.btStopClick(Sender: TObject);
begin
with btstop do begin
if tag=$ff then begin
if not Assigned(thr) then
thr:=TTmpThread.Create(true);
FWoWKeyList.CommaText:=WoWKeyString;//传送字符串
tag:=$0;
Caption:='S&top';
thr.Resume;
end
else begin
thr.Suspend;
tag:=$ff;
Caption:='&Send'
end;
end;
end;
begin
with btstop do begin
if tag=$ff then begin
if not Assigned(thr) then
thr:=TTmpThread.Create(true);
FWoWKeyList.CommaText:=WoWKeyString;//传送字符串
tag:=$0;
Caption:='S&top';
thr.Resume;
end
else begin
thr.Suspend;
tag:=$ff;
Caption:='&Send'
end;
end;
end;
procedure TfrmSendKey.sbMiniClick(Sender: TObject);
begin
If sbMini.Caption = '↓' then begin
Height:=FWinSize;
sbMini.Caption := '↑'
end
else begin
Height:=ToolBar1.Height+2;
sbMini.Caption := '↓'
end;
end;
begin
If sbMini.Caption = '↓' then begin
Height:=FWinSize;
sbMini.Caption := '↑'
end
else begin
Height:=ToolBar1.Height+2;
sbMini.Caption := '↓'
end;
end;
end.
//===========uRmtObj.pas==================//
unit uSndClient;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, sdkSrv_tlb, comobj,activex, ExtCtrls,urmtobj,
ComCtrls, ToolWin,UApartThread,Buttons, LMDCustomComponent, LMDIniCtrl;
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, sdkSrv_tlb, comobj,activex, ExtCtrls,urmtobj,
ComCtrls, ToolWin,UApartThread,Buttons, LMDCustomComponent, LMDIniCtrl;
type
TfrmSendKey = class(TForm)
edWinName: TEdit;
edKeystr: TEdit;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
edComputer: TEdit;
edUser: TEdit;
edPsw: TEdit;
lmdIni: TLMDIniCtrl;
btnWriteIni: TButton;
btnLoadKey: TButton;
cbOnTop: TCheckBox;
ToolBar1: TToolBar;
tb1: TToolButton;
tb2: TToolButton;
tb3: TToolButton;
tb4: TToolButton;
tb5: TToolButton;
tb6: TToolButton;
ToolButton10: TToolButton;
tb7: TToolButton;
tb8: TToolButton;
btStop: TButton;
ToolButton1: TToolButton;
sbMini: TSpeedButton;
procedure Button2Click(Sender: TObject);
procedure btnWriteIniClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnLoadKeyClick(Sender: TObject);
procedure cbOnTopClick(Sender: TObject);
procedure tb1Click(Sender: TObject);
procedure btStopClick(Sender: TObject);
procedure sbMiniClick(Sender: TObject);
protected
edWinName: TEdit;
edKeystr: TEdit;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
edComputer: TEdit;
edUser: TEdit;
edPsw: TEdit;
lmdIni: TLMDIniCtrl;
btnWriteIni: TButton;
btnLoadKey: TButton;
cbOnTop: TCheckBox;
ToolBar1: TToolBar;
tb1: TToolButton;
tb2: TToolButton;
tb3: TToolButton;
tb4: TToolButton;
tb5: TToolButton;
tb6: TToolButton;
ToolButton10: TToolButton;
tb7: TToolButton;
tb8: TToolButton;
btStop: TButton;
ToolButton1: TToolButton;
sbMini: TSpeedButton;
procedure Button2Click(Sender: TObject);
procedure btnWriteIniClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnLoadKeyClick(Sender: TObject);
procedure cbOnTopClick(Sender: TObject);
procedure tb1Click(Sender: TObject);
procedure btStopClick(Sender: TObject);
procedure sbMiniClick(Sender: TObject);
protected
private
FWinSize:integer;
FWoWKeyString:string;
FSendWinName:string;
FRegion:THandle;
FMainInt:MySendKey;
procedure SetWoWKeyString(const Value: string);
function ReadWoWKeyString: string;
procedure SetSendWinName(const Value: string);
function ReadSendWinName: string;
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
procedure FreeCurrentRegion;
{ Private declarations }
public
FWoWKeyList:TStringList;
sComputer,sUser,sPsw:widestring;
property WoWKeyString:string read ReadWoWKeyString write SetWoWKeyString;
property SendWinName:string read ReadSendWinName write SetSendWinName;
{ Public declarations }
end;
FWinSize:integer;
FWoWKeyString:string;
FSendWinName:string;
FRegion:THandle;
FMainInt:MySendKey;
procedure SetWoWKeyString(const Value: string);
function ReadWoWKeyString: string;
procedure SetSendWinName(const Value: string);
function ReadSendWinName: string;
procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;
procedure FreeCurrentRegion;
{ Private declarations }
public
FWoWKeyList:TStringList;
sComputer,sUser,sPsw:widestring;
property WoWKeyString:string read ReadWoWKeyString write SetWoWKeyString;
property SendWinName:string read ReadSendWinName write SetSendWinName;
{ Public declarations }
end;
var
frmSendKey: TfrmSendKey;
rmtObject:IMySendKey;
KeyCount:integer;
thr:TTmpThread;
frmSendKey: TfrmSendKey;
rmtObject:IMySendKey;
KeyCount:integer;
thr:TTmpThread;
implementation
uses Math, StrUtils;
{$R *.dfm}
{ TTmpThread }
procedure TfrmSendKey.Button2Click(Sender: TObject);
begin
close;
end;
procedure TfrmSendKey.SetWoWKeyString(const Value: string);
begin
FWoWKeyString := Value;
end;
begin
FWoWKeyString := Value;
end;
function TfrmSendKey.ReadWoWKeyString: string;
begin
if edKeystr.Text<>'' then
FWoWKeyString:=edKeystr.Text;
result:=FWoWKeyString;
end;
begin
if edKeystr.Text<>'' then
FWoWKeyString:=edKeystr.Text;
result:=FWoWKeyString;
end;
procedure TfrmSendKey.SetSendWinName(const Value: string);
begin
FSendWinName := Value;
end;
begin
FSendWinName := Value;
end;
function TfrmSendKey.ReadSendWinName: string;
begin
if edWinName.Text<>'' then
FSendWinName:=edWinName.text;
result:=FSendWinName;
end;
begin
if edWinName.Text<>'' then
FSendWinName:=edWinName.text;
result:=FSendWinName;
end;
procedure TfrmSendKey.FormCreate(Sender: TObject);
begin
FWoWKeyList:=TStringList.Create;
FWinSize:=Height;
{ for i:=0 to ComponentCount-1 do begin
with Components[i] do
tmp:=CreateRectRgn(Left,Top,Left+Width,Top+Height);
if i=0 then begin
FRegion:=tmp;
Continue;
end;
CombineRgn(FRegion,FRegion,tmp,RGN_AND);
DeleteObject(tmp);
end;
If FRegion<>0 then
SetWindowRgn(Handle,FRegion,true); }
{for i:=0 to ControlCount-1 do
if TToolButton(Controls[i]).Style=tbsButton then begin
TToolButton(Controls[i]).Caption:=inttostr(TToolButton(Controls[i]).tag);
TToolButton(Controls[i]).Width:=23;
end; }
end;
begin
FWoWKeyList:=TStringList.Create;
FWinSize:=Height;
{ for i:=0 to ComponentCount-1 do begin
with Components[i] do
tmp:=CreateRectRgn(Left,Top,Left+Width,Top+Height);
if i=0 then begin
FRegion:=tmp;
Continue;
end;
CombineRgn(FRegion,FRegion,tmp,RGN_AND);
DeleteObject(tmp);
end;
If FRegion<>0 then
SetWindowRgn(Handle,FRegion,true); }
{for i:=0 to ControlCount-1 do
if TToolButton(Controls[i]).Style=tbsButton then begin
TToolButton(Controls[i]).Caption:=inttostr(TToolButton(Controls[i]).tag);
TToolButton(Controls[i]).Width:=23;
end; }
end;
procedure TfrmSendKey.FormDestroy(Sender: TObject);
begin
if Assigned(thr) then
with thr do begin
Terminate;
Free;
end;
FWoWKeyList.Free;
rmtObject:=nil;
FMainInt:=nil;
//FreeCurrentRegion;
end;
begin
if Assigned(thr) then
with thr do begin
Terminate;
Free;
end;
FWoWKeyList.Free;
rmtObject:=nil;
FMainInt:=nil;
//FreeCurrentRegion;
end;
procedure TfrmSendKey.btnWriteIniClick(Sender: TObject);
begin
with lmdIni do begin
WriteString('WOWKey','KeyStr',WoWKeyString);
WriteString('WOWKey','SendWin',SendWinName);
end;
end;
begin
with lmdIni do begin
WriteString('WOWKey','KeyStr',WoWKeyString);
WriteString('WOWKey','SendWin',SendWinName);
end;
end;
procedure TfrmSendKey.btnLoadKeyClick(Sender: TObject);
begin
with lmdIni do begin
WoWKeyString:=ReadString('WOWKey','KeyStr','9,r,4');
edKeystr.Text:=FWoWKeyString;
SendWinName:=ReadString('WOWKey','SendWin','魔兽世界');
edWinName.Text:=FSendWinName;
end;
end;
begin
with lmdIni do begin
WoWKeyString:=ReadString('WOWKey','KeyStr','9,r,4');
edKeystr.Text:=FWoWKeyString;
SendWinName:=ReadString('WOWKey','SendWin','魔兽世界');
edWinName.Text:=FSendWinName;
end;
end;
procedure TfrmSendKey.cbOnTopClick(Sender: TObject);
begin
with cbOnTop do begin
If Checked then frmSendKey.FormStyle:=fsStayOnTop
else
frmSendKey.FormStyle:=fsNormal;
end;
end;
begin
with cbOnTop do begin
If Checked then frmSendKey.FormStyle:=fsStayOnTop
else
frmSendKey.FormStyle:=fsNormal;
end;
end;
procedure TfrmSendKey.tb1Click(Sender: TObject);
begin
if not Assigned(FMainInt) then begin
sComputer:=trim(edComputer.Text);
sUser:=trim(edUser.text);
sPsw:=trim(edpsw.text);
FMainInt:=CreatRMTObj(sComputer,sUser,sPsw);
FMainInt.WinName:=trim(edWinName.Text);
end;
if Assigned(FMainint) then
with FMainint do begin
SendStr2(inttostr(TToolButton(Sender).tag),-1);
end;
end;
begin
if not Assigned(FMainInt) then begin
sComputer:=trim(edComputer.Text);
sUser:=trim(edUser.text);
sPsw:=trim(edpsw.text);
FMainInt:=CreatRMTObj(sComputer,sUser,sPsw);
FMainInt.WinName:=trim(edWinName.Text);
end;
if Assigned(FMainint) then
with FMainint do begin
SendStr2(inttostr(TToolButton(Sender).tag),-1);
end;
end;
procedure TfrmSendKey.WMNCHitTest(var M: TWMNCHitTest);
begin
inherited;
if M.Result = htClient then M.Result := htCaption;
end;
begin
inherited;
if M.Result = htClient then M.Result := htCaption;
end;
procedure TfrmSendKey.FreeCurrentRegion;
begin
if FRegion<>0 then begin
SetWindowRgn(Handle,0,true);
DeleteObject(FRegion);
FRegion:=0;
end;
end;
begin
if FRegion<>0 then begin
SetWindowRgn(Handle,0,true);
DeleteObject(FRegion);
FRegion:=0;
end;
end;
procedure TfrmSendKey.btStopClick(Sender: TObject);
begin
with btstop do begin
if tag=$ff then begin
if not Assigned(thr) then
thr:=TTmpThread.Create(true);
FWoWKeyList.CommaText:=WoWKeyString;//传送字符串
tag:=$0;
Caption:='S&top';
thr.Resume;
end
else begin
thr.Suspend;
tag:=$ff;
Caption:='&Send'
end;
end;
end;
begin
with btstop do begin
if tag=$ff then begin
if not Assigned(thr) then
thr:=TTmpThread.Create(true);
FWoWKeyList.CommaText:=WoWKeyString;//传送字符串
tag:=$0;
Caption:='S&top';
thr.Resume;
end
else begin
thr.Suspend;
tag:=$ff;
Caption:='&Send'
end;
end;
end;
procedure TfrmSendKey.sbMiniClick(Sender: TObject);
begin
If sbMini.Caption = '↓' then begin
Height:=FWinSize;
sbMini.Caption := '↑'
end
else begin
Height:=ToolBar1.Height+2;
sbMini.Caption := '↓'
end;
end;
begin
If sbMini.Caption = '↓' then begin
Height:=FWinSize;
sbMini.Caption := '↑'
end
else begin
Height:=ToolBar1.Height+2;
sbMini.Caption := '↓'
end;
end;
end.
//==关键代码uApartThread.pas==//
unit UApartThread;
interface
uses sysutils,classes,windows,activex,SdkSrv_TLB,uRmtObj,strutils;
uses sysutils,classes,windows,activex,SdkSrv_TLB,uRmtObj,strutils;
type
TTmpThread=class(TThread)
procedure Execute; override;
end;
TTmpThread=class(TThread)
procedure Execute; override;
end;
function GetWaitTime(var str: string): integer;
Function CreatRMTObj(const ComputerName,UserName,Password:widestring):MySendKey;
Function CreatRMTObj(const ComputerName,UserName,Password:widestring):MySendKey;
implementation
uses comobj, uSndClient;
uses comobj, uSndClient;
function GetWaitTime(var str: string): integer;
var
tmp:string;
begin
Result:=0;
if str[1]='@' then begin
tmp:=MidStr(str,2,4);
TryStrToInt(tmp,result);
Delete(str,1,5);
end
end;
var
tmp:string;
begin
Result:=0;
if str[1]='@' then begin
tmp:=MidStr(str,2,4);
TryStrToInt(tmp,result);
Delete(str,1,5);
end
end;
Function CreatRMTObj(const ComputerName,UserName,Password:widestring):MySendKey;
begin
Result:=IMySendKey(DoConnect(@CLASS_MySendKey,
@IID_IMySendKey,
ComputerName,UserName,Password));
end;
procedure TTmpThread.Execute;
var
tmp:string;
begin
CoInitializeEx(nil,COINIT_APARTMENTTHREADED);
try
with frmSendKey do begin
if not assigned(rmtObject) then begin
sComputer:=trim(edComputer.Text);
sUser:=trim(edUser.text);
sPsw:=trim(edpsw.text);
rmtObject:=CreatRMTObj(sComputer,sUser,sPsw);
end;
rmtObject.WinName:=SendWinName;//目标Windows标题
KeyCount:=0;
while (not terminated) do begin
if not Assigned(rmtObject) then exit;
if KeyCount>=FWoWKeyList.Count then KeyCount:=0;
tmp:=FWoWKeyList[keyCount];
with rmtobject do begin
Sleep(GetWaitTime(tmp));
SendStr2(tmp,-1);
inc(KeyCount);
end;
end;
end;
finally
CoUninitialize;
end;
end;
end.
有问题留言或email。不过回复的有点慢,见谅.