J
jack011
Unregistered / Unconfirmed
GUEST, unregistred user!
窗体Msg的信息:
unit Unit_Msg;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TFmMsg = class(TForm)
BitBtn1: TBitBtn;
StaticText1: TStaticText;
procedure BitBtn1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure StaticText1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FmMsg: TFmMsg;
implementation
{$R *.dfm}
procedure TFmMsg.BitBtn1Click(Sender: TObject);
begin
close;
end;
procedure TFmMsg.FormShow(Sender: TObject);
begin
//self.Left := 700;
//self.Top := 530;
end;
在Svchost.exe中调用FORM程序:
function ShowMsgForm(): Pchar;
stdcall;
begin
try
FmMsg := TFmMsg.create(Application);
FmMsg.Show;
//finally
// FmMsg.free;
except
log('c:/clog.txt', '无法创建窗体Msg!');
exit;
end;
end;
主要程序参照以下高人的代码,但是窗体Msg无法显示出来,请问各位大虾,问题出在哪里?
用Delphi编写一个Svchost.exe调用的DLL模块
作者：west3316 提交日期：2006-9-24 11:12:00
作者: Maco
?? 这个模块的代码在网上流传的是用C写的,这里我花了一个早上用Delphi写了一个DLL,可以自己扩充各种功能.
??
unit Unit_Msg;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;
type
TFmMsg = class(TForm)
BitBtn1: TBitBtn;
StaticText1: TStaticText;
procedure BitBtn1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure StaticText1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FmMsg: TFmMsg;
implementation
{$R *.dfm}
procedure TFmMsg.BitBtn1Click(Sender: TObject);
begin
close;
end;
procedure TFmMsg.FormShow(Sender: TObject);
begin
//self.Left := 700;
//self.Top := 530;
end;
在Svchost.exe中调用FORM程序:
function ShowMsgForm(): Pchar;
stdcall;
begin
try
FmMsg := TFmMsg.create(Application);
FmMsg.Show;
//finally
// FmMsg.free;
except
log('c:/clog.txt', '无法创建窗体Msg!');
exit;
end;
end;
主要程序参照以下高人的代码,但是窗体Msg无法显示出来,请问各位大虾,问题出在哪里?
用Delphi编写一个Svchost.exe调用的DLL模块
作者：west3316 提交日期：2006-9-24 11:12:00
作者: Maco
?? 这个模块的代码在网上流传的是用C写的,这里我花了一个早上用Delphi写了一个DLL,可以自己扩充各种功能.
??
代码:
??{
?? 文件名: ServiceDll.dpr
?? 概述: 替换由svchost.exe启动的某个系统服务,具体服务由全局变量 ServiceName 决定.
??
?? 经测试,生成的DLL文件运行完全正常.
?? 测试环境: Windows 2003 Server + Delphi 7.0
??
?? 代码只实现了一个框架,没有任何实际动作,仅作为学习用.如果你使用本代码
?? 进行了任何扩充和修改,希望您能将代码寄一份给我.
??
?? 日期: 2005-04-01
?? 作者: yanxizhen yanxizhen#163.com
??}
??
??library ServiceDll;
??
??uses
?? SysUtils,
?? Classes,
?? winsvc,
?? System,
?? Windows;
??
??{ 定义全局变量 }
??var
?? // 服务控制信息句柄
?? SvcStatsHandle : SERVICE_STATUS_HANDLE;
?? // 存储服务状态
?? dwCurrState : DWORD;
?? // 服务名称
?? ServiceName : PChar = 'BITS';
??
??{ 调试函数,用于输出调试文本 }
??procedure OutPutText(CH:PChar);
??var
?? FileHandle: TextFile;
?? F : Integer;
??begin
?? try
?? if not FileExists('zztestdll.txt') then
?? F := FileCreate('zztestdll.txt');
?? finally
?? if F > 0 then
FileClose(F);
?? end;
??
?? AssignFile(FileHandle,'zztestdll.txt');
?? Append(FileHandle);
?? Writeln(FileHandle,CH);
?? Flush(FileHandle);
?? CloseFile(FileHandle);
??end;
??
??
??{ dll入口和出口处理函数 }
??procedure DLLEntryPoint(dwReason : DWord);
??begin
??
?? case dwReason of
?? DLL_PROCESS_ATTACH:
?? ;
?? DLL_PROCESS_DETACH:
?? ;
?? DLL_THREAD_ATTACH:
?? ;
?? DLL_THREAD_DETACH:
?? ;
?? end;
??end;
??
??{ 与SCM管理器通话 }
??function TellSCM(dwState : DWORD ;
dwExitCode : DWORD;
dwProgress : DWORD ): LongBool;
??var
?? srvStatus : service_status;
??begin
?? srvStatus.dwServiceType := SERVICE_WIN32_SHARE_PROCESS;
?? dwCurrState := dwState;
?? srvStatus.dwCurrentState := dwState;
?? srvStatus.dwControlsAccepted := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE or SERVICE_ACCEPT_SHUTDOWN;
?? srvStatus.dwWin32ExitCode := dwExitCode;
?? srvStatus.dwServiceSpecificExitCode := 0;
?? srvStatus.dwCheckPoint := dwProgress;
?? srvStatus.dwWaitHint := 3000;
?? Result := SetServiceStatus( SvcStatsHandle, srvStatus );
??end;
??
??{ Service 控制函数 }
??PROCEDURE servicehandler(fdwcontrol:integer);
STDCALL;
??begin
??
?? CASE fdwcontrol OF
??
?? SERVICE_CONTROL_STOP:
?? begin
?? TellSCM( SERVICE_STOP_PENDING, 0, 1 );
?? Sleep(10);
?? TellSCM( SERVICE_STOPPED, 0, 0 );
?? end;
??
?? SERVICE_CONTROL_PAUSE:
?? begin
?? TellSCM( SERVICE_PAUSE_PENDING, 0, 1 );
?? TellSCM( SERVICE_PAUSED, 0, 0 );
?? end;
??
?? SERVICE_CONTROL_CONTINUE:
?? begin
?? TellSCM( SERVICE_CONTINUE_PENDING, 0, 1 );
?? TellSCM( SERVICE_RUNNING, 0, 0 );
?? end;
??
?? SERVICE_CONTROL_INTERROGATE:
?? TellSCM( dwCurrState, 0, 0 );
??
?? SERVICE_CONTROL_SHUTDOWN:
?? TellSCM( SERVICE_STOPPED, 0, 0 );
??
?? end;
??
??end;
??
??
??{ service main }
??procedure ServiceMain(argc : Integer;
VAR argv : pchar );
StdCall;
??begin
?? { try
?? begin
?? if ParamStr(1) <> '' then
?? svcname := strNew(PChar(ParamStr(1)))
?? else
?? begin
?? svcname := strAlloc(10 * Sizeof(Char));
?? svcname := 'none';
?? end;
?? OutPutText(svcname);
?? end
?? finally
?? strdispose(svcname);
?? end;
?? }
??
?? // 注册控制函数
?? SvcStatsHandle := RegisterServiceCtrlHandler(ServiceName, @servicehandler);
?? IF (SvcStatsHandle = 0) then
?? begin
?? OutPutText('Error in RegisterServiceCtrlHandler');
?? exit;
?? END
?? else
?? begin
?? FreeConsole();
?? end;
??
?? // 启动服务
?? TellSCM( SERVICE_START_PENDING, 0, 1 );
?? TellSCM( SERVICE_RUNNING, 0, 0 );
?? OutPutText('Service is Running');
??
?? // 这里可以执行我们真正要作的代码
?? while ((dwCurrState <> SERVICE_STOP_PENDING) and (dwCurrState <> SERVICE_STOPPED))do
?? begin
if not FmMsg.Showing then
ShowMsgForm;
//显示FORM,有问题,如何解决呢????????????????谢谢!
?? sleep(1000);
?? end;
??
?? OutPutText('Service Exit');
??
??end;
??
??
??// 导出函数列表
??exports
?? ServiceMain;
??
??{ dll入口点 }
??begin
?? DllProc := @DLLEntryPoint;
??end.
nMouseDown:=MouseD;