a MM menses calendar
提供农历显示的MM生理周期百年历(支持1900-2100共计201年的日历查看)
支持新的国家法定节假日显示,支持安全期计算,周期预测,三年周期记录和节假日提示等多项实用功能

Download here

查看更多...

Tags: MMCalendarMMCalendar

v51217



LY Super Boot CD is a powerful emergency boot up CDROM. It can read NTFS disk under DOS mode, reset NT password, manage partition, fix HDD error, recover lost data and so on.

this tool is too old to use, so no download link provided.

查看更多...

Tags: LYLY SuperSuper BootBoot CDCD

这段代码很有意义的父亲纪念版，它是在我一生人中最痛苦的时期所开发的。唉，一切都成为永恒的怀念......
注意：需要JEDI Win32 API（JWA）库支持
另外，该方法不适用于PAE模式（WinXP SP2配备AMD64或EMT64处理器的系统），而且还不能支持Win2003 SP1
uses
  Windows, Dialogs, SysUtils, NTDDK,
  JwaWinNT, JwaWinType, JwaNtStatus, JwaAccCtrl, JwaAclApi, ntdll;
const
  KGDT_NULL     = 0;
  KGDT_R0_CODE  = 8;
  KGDT_R0_DATA  = 16;
  KGDT_R3_CODE  = 24;
  KGDT_R3_DATA  = 32;
  KGDT_TSS      = 40;
  KGDT_R0_PCR   = 48;
  KGDT_R3_TEB   = 56;
  KGDT_VDM_TILE = 64;
  KGDT_LDT      = 72;
  KGDT_DF_TSS   = 80;
  KGDT_NMI_TSS  = 88;
type
  TGDT = record
    Limit,
    BaseLow,
    BaseHigh : Word;
  end;
  PHYSICAL_ADDRESS = Large_Integer;
  CALLGATE_DESCRIPTOR = record
    Offset_0_15, Selector: Word;
    GateDescriptor:Word;
    Offset_16_31: Word;
  end;
implementation
function ZwOpenSection; external 'ntdll.dll';
function ZwClose; external 'ntdll.dll';
function SetDebugPrivilege(CanDebug: boolean): Boolean;
  function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
  var
    TP: Windows.TOKEN_PRIVILEGES;
    Dummy: Cardinal;
  begin
    TP.PrivilegeCount := 1;
    LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);
    if bEnable then
      TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
    else TP.Privileges[0].Attributes := 0;
    AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
    Result := GetLastError = ERROR_SUCCESS;
  end;
var
  hToken: Cardinal;
begin
  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
  Result := EnablePrivilege(hToken, SE_DEBUG_NAME, CanDebug);
  CloseHandle(hToken);
end;
function SetPhyscialMemorySectionCanBeWrited(hSection: THandle): boolean;
label CleanUp;
var
  pDacl, pNewDacl: JwaWinNT.PACL;
  pSD: JwaWinNT.PSECURITY_DESCRIPTOR;
  dwRes: DWORD;
  ea: EXPLICIT_ACCESS;
begin
  Result := false;
  pDacl := nil; pNewDacl := nil; pSD := nil;
  dwRes := GetSecurityInfo(hSection, SE_KERNEL_OBJECT, DACL_SECURITY_INFORMATION,
    nil, nil, @pDacl, nil, pSD);
  if dwRes <> ERROR_SUCCESS then
    begin
      MessageDlg(Format('GetSecurityInfo Error %d', [dwRes]), mtError, [mbOK], 0);
      goto CleanUp;
    end;
  ZeroMemory(@ea, sizeof(EXPLICIT_ACCESS));
  ea.grfAccessPermissions := SECTION_MAP_WRITE;
  ea.grfAccessMode := GRANT_ACCESS;
  ea.grfInheritance := NO_INHERITANCE;
  ea.Trustee.TrusteeForm := TRUSTEE_IS_NAME;
  ea.Trustee.TrusteeType := TRUSTEE_IS_USER;
  ea.Trustee.ptstrName := 'CURRENT_USER';
  dwRes := SetEntriesInAcl(1, @ea, pDacl, pNewDacl);
  if dwRes <> ERROR_SUCCESS then
     begin
       MessageDlg(Format('SetEntriesInAcl Error : %d', [dwRes]), mtError, [mbOK], 0);
       goto CleanUp;
     end;
  dwRes := SetSecurityInfo(hSection, SE_KERNEL_OBJECT,
    DACL_SECURITY_INFORMATION, nil, nil, pNewDacl, nil);
  if dwRes <> ERROR_SUCCESS then
     begin
       MessageDlg(Format('SetSecurityInfo Error : %d', [dwRes]), mtError, [mbOK], 0);
       goto CleanUp;
     end;
  Result := true;
  CleanUp:
  if pSD<>nil then LocalFree(Cardinal(pSD));
  if pNewDacl<>nil then LocalFree(Cardinal(pNewDacl));
end;
function OpenPhysicalMemory: THandle;
var
  hSection : THandle;
  status: NTSTATUS;
  objName: UNICODE_STRING;
  objectAttributes: OBJECT_ATTRIBUTES;
begin
  Result := 0;
  RtlInitUnicodeString(@objName, '\Device\PhysicalMemory');
  InitializeObjectAttributes(@objectAttributes, @objName,
    OBJ_CASE_INSENSITIVE or OBJ_KERNEL_HANDLE, 0, nil);
  status := ZwOpenSection(hSection, SECTION_MAP_READ or SECTION_MAP_WRITE, @objectAttributes);
  if (status = STATUS_ACCESS_DENIED) then
     begin
       status := ZwOpenSection(hSection, READ_CONTROL or WRITE_DAC, @objectAttributes);
       if status = STATUS_SUCCESS then  SetPhyscialMemorySectionCanBeWrited(hSection);
       ZwClose(hSection);
       status := ZwOpenSection(hSection, SECTION_MAP_READ or SECTION_MAP_WRITE, @objectAttributes);
     end;
  if status = STATUS_SUCCESS then Result :=hSection;
end;
procedure ClosePhysicalMemory(hPhysicalMemorySection: THandle);
begin
  ZwClose(hPhysicalMemorySection);
end;
function AddressIn4MBPage(Address: ULONG): Boolean;
begin
  Result := (Address > 0) and ($80000000<=Address) and (Address<$A0000000)
end;
function MiniMmGetPhysicalAddress(vAddress: ULONG): ULONG;
begin
  if AddressIn4MBPage(vAddress)
     then Result := vAddress - $80000000
     else Result := $FFFFFFFF;
end;
function MiniMmGetPhysicalPageAddress(VirtualAddress: ULONG): ULONG;
begin
  if AddressIn4MBPage(VirtualAddress)
     then Result := VirtualAddress and $1FFFF000
     else Result := $FFFFFFFF;
end;
function ExecRing0Proc(ProcEntryPoint: Pointer; SegmentLength: ULONG): boolean;
var
  GDT : TGDT; mapAddr: ULONG;
  hSection : THandle;
  cg: ^CALLGATE_DESCRIPTOR;
  farcall : array [0..2] of Word;
  BaseAddress: Pointer;
  setcg: boolean;
  i: Cardinal;
begin
  Result := false;
  asm SGDT GDT end;
  i := (gdt.BaseHigh shl 16) or gdt.BaseLow;
  mapAddr := MiniMmGetPhysicalPageAddress(i);
  if mapAddr=$FFFFFFFF then
     begin
       MessageDlg(Format('Can not convert GDT virtual address of [Base = %s  Limit = %s]',
         [IntToHex(i, 8), IntToHex(GDT.Limit, 4)]), mtError, [mbOK], 0);
       Exit;
     end;
  hSection := OpenPhysicalMemory;
  if hSection=0 then
     begin
       MessageDlg('Error in open physical memory.', mtError, [mbOK], 0);
       Exit;
     end;
  BaseAddress := MapViewOfFile(hSection, FILE_MAP_READ or FILE_MAP_WRITE, 0, mapAddr,    //low part
                     (gdt.Limit+1));
  if BaseAddress = nil then
     begin
       ZwClose(hSection);
       MessageDlg(Format('MapViewOfFile Error : %s%sGDT : Address = %s   Limit = %s',
         [SysErrorMessage(GetLastError), #13#10, IntToHex(mapAddr, 8), IntToHex(GDT.Limit, 4)]), mtError, [mbOK], 0);
       Exit;
     end;
  setcg := false;
  i := Cardinal(BaseAddress)+8;  // skip first empty entry
  while i < Cardinal(BaseAddress)+(gdt.Limit and $FFF8) do
    begin
      cg:=Ptr(i);
      with cg^ do
        begin
          if IntToHex(GateDescriptor, 4)[2] = '0' then  // call gate not present
             begin   // install callgate
               Offset_0_15 := LOWORD(Integer(ProcEntryPoint));
               Selector := KGDT_R0_CODE; // ring 0 code
               // [Installed flag=1] [Ring 3 code can call=11] 0 [386 call gate=1100] 00000000
               GateDescriptor := $EC00;
               Offset_16_31 := HIWORD(Integer(ProcEntryPoint));
               setcg := TRUE;
               Break;
             end;
        end;
      Inc(i, 8);
    end;
  if not setcg then
     begin
       UnMapViewOfFile(BaseAddress);
       ZwClose(hSection);
       MessageDlg('Can not install CallGate in your system GDT', mtError, [mbOK], 0);
       Exit;
     end;
  farcall[0] := 0;  farcall[1] := 0;
  farcall[2] := (short(ULONG(cg)-ULONG(BaseAddress))) or 3;  //Ring 3 callgate;
  if not VirtualLock(ProcEntryPoint, SegmentLength) then
     begin
       MessageDlg(SysErrorMessage(GetLastError), mtError, [mbOK], 0);
       Exit;
     end;
  try
    SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
    Sleep(0);
    asm  // call callgate
      //  push arg1 ... argN  // call far fword ptr [farcall]
      LEA EAX, farcall  // load to EAX
      DB 0FFH, 018H  // hardware code, means call fword ptr [eax]
    end;
    SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);
    Result := true;
  except
    on e: Exception do MessageDlg(e.Message, mtError, [mbOK], 0);
  end;
  VirtualUnlock(ProcEntryPoint, SegmentLength);
  // Clear callgate
  FillChar(cg^, 8, 0);
  UnMapViewOfFile(BaseAddress);
  ClosePhysicalMemory(hSection);
end;
使用示例,读取CMOS时钟:
unit NTRing0_Unit;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons;
type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  tHour, tMin, tSec: byte;
implementation
{$R *.dfm}
uses NTRing0;
procedure Ring0Proc; stdcall;
begin
  asm            // ring0 prolog
    PUSHAD // push eax,ecx,edx,ebx,ebp,esp,esi,edi onto the stack
    PUSHFD // decrement stack pointer by 4 and push EFLAGS onto the stack
    CLI    // disable interrupt
    // execute your ring0 code here ...
    MOV AH,0
    MOV DX,$70
    MOV AL,AH
    OUT DX,AL
    INC DX
    IN AL,DX
    MOV tSec,AL
    //
    MOV AH,2
    MOV DX,$70
    MOV AL,AH
    OUT DX,AL
    INC DX
    IN AL,DX
    MOV tMin,AL
    //
    MOV AH,4
    MOV DX,$70
    MOV AL,AH
    OUT DX,AL
    INC DX
    IN AL,DX
    MOV tHour,AL
    // ring0 epilog
    POPFD // restore registers pushed by pushfd
    POPAD // restore registers pushed by pushad
    RETF  // you may retf <sizeof arguments> if you pass arguments
  end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  //  execute ring 0
  if ExecRing0Proc(@Ring0Proc, 100) then
  ShowMessage(Format('CMOS Time is %d:%d:%d',
    [10*(tHour shr 4) + tHour and $F,
     10*(tMin shr 4) + tMin and $F,
     10*(tSec shr 4) + tSec and $F]));
end;
end.
调用NTOSKrnl.exe中的Ring0函数实现VA->PA（虚拟地址到物理地址）的转换
type
  TMemoryAddress = record
    PhysicalAddress : PHYSICAL_ADDRESS;  //*000
    VirtualAddress : DWord;  //*008
  end;
var
  MemoryAddress : TMemoryAddress;
  _MmGetPhysicalAddress : Cardinal;
  NTOSBaseAddr : Cardinal;
// NTOSkern.exe的加载地址，2003系统默认是$804DE000
procedure Ring0Func; stdcall;
begin
  asm
    pushad
    pushf
    cli
    mov esi, MemoryAddress.VirtualAddress
    push esi
    call _MmGetPhysicalAddress
    mov MemoryAddress.PhysicalAddress.LowPart, eax  // save low part of LARGE_INTEGER
    mov MemoryAddress.PhysicalAddress.HighPart, edx       // save high part of LARGE_INTEGER
    popf
    popad
    retf
  end;
end;
procedure MmGetPhysicalAddress;
var hNTDll: THandle;
begin
  _MmGetPhysicalAddress := 0;
  hNTDll := LoadLibrary('ntoskrnl.exe');
  if hNTDll <> 0 then
     begin
       _MmGetPhysicalAddress := NTOSBaseAddr + Cardinal(GetProcAddress(hNTDll, 'MmGetPhysicalAddress')) - hNTDll;
       FreeLibrary(hNTDll);
//       ShowMessage(Format('Virtual address of MmGetPhysicalAddress in Kernel Mode  : %s', [IntToHex(_MmGetPhysicalAddress, 8)]));
     end;
  if _MmGetPhysicalAddress > 0 then ExecRing0Proc(@Ring0Func, 32);
end;
......
MemoryAddress.VirtualAddress := StrToInt64Def(Edit1.Text, $806AB000);
  MmGetPhysicalAddress;
  Memo1.Lines.Add(Format('(Ring 0 Mode) Virtual address : $%s  = Physical address : $%s',
    [IntToHex(MemoryAddress.VirtualAddress, 8),
     IntToHex(MemoryAddress.PhysicalAddress.LowPart, 8)]));

powered by LYSoft LiuYang
http://lysoft.g4soft.net

查看更多...

Tags: DelphiDelphi Ring0Ring0

v50412 for Windows Me/2000/XP/2003
This is my first Win32 project based on Delphi.

作为LY 2000年发布的LYSoft处女作，虽然其内部比较简单，却是LYSoft发展的历史见证

查看更多...

Tags: Media PlayerMedia Player

不是由BORLAND提供的组件叫第三方组件：
安装方法：
就目前常见的各种形式的组件的安装方法介绍一下。  

1  只有一个DCU文件的组件。DCU文件是编译好的单元文件，这样的组件是作者不想把源码公布。一般来说，作者必须说明此组件适合Delphi的哪种版本，如果版本不对，在安装时就会出现错误。也正是因为没有源码，给使用者带来了不便，那就是一旦Delphi版本升级，此组件就不能再使用了，当然有的作者给出了几种版本的DCU文件，用户根据需要选择使用。这样的组件的安装方法是：在Component菜单中，选择install component，在对话框
"into existing package"页中，单击“Unit file name”后的“Browse”按扭，在打开的文件对话框中，将“文件类型”设定为*.dcu，找到要安装的DCU文件，按OK按钮返回"into existing package"页后再按OK按钮就可以安装了。注意，此时Delphi会提示dclusr40.dpk将被重建，是否继续，OK就可以了。这里是将组件安装到dclusr40.dpk包中，此包从文件名上可以看出是用户自定义组件包，先安装到这个包中吧，下面再讲有关注意事项。安装完毕会有已经将组件注册完的提示信息以及安装到哪个组件页中的信息等，到组件面板上看看，一般会出现一个新的组件页，其中有刚安装的组件。  

2、 只有PAS文件或既有PAS又有DCU文件的组件。这种组件因为有PAS文件，也就是说作者提供了源码，这就好办多了。安装的方法和上面是一样的，在文件类型中可以设定为DCU也可以设定为PAS，建议设定为PAS，这样可用你的Delphi重新编译一下，看是否会出现问题。Delphi升级后只能选择PAS文件安装，这样才能重新编译，使得组件能适应新Delphi版本。这样的组件是很值得使用的，根据心铃的经验，没有源码的组件最好不要使用，一是存在Delphi版本升级后无法使用的问题，再者当程序出现问题后用户无法调试组件来判断是否是组件中存在BUG。  

3、有dpk文件的组件包。带有dpk文件的组件包一般是有多个组件构成的，也就是说安装后会有多个组件供使用，如果只有一个组件作者一般不会制成DPK文件，使用上面的方式发布就可以了。对于这样的组件包，一般来说会有详细的安装说明文件，如上面提到的RXLIB，由于组件复杂且安装时有先后顺序，作者不提供安装说明用户根本无法正确安装。如果没有安装说明文件，那么用下面的方法安装：在File菜单下，选择”OPEN…”打开dpk文件(文件类型列表框中选*.dpk)，在出现的Package窗口中，工具栏上有Install按钮，按此按钮即可进行安装。如果Install按钮处于无效状态，那么先按Compile按钮编译，一般来说编译之后Install按钮就会处于有效状态，此时再按Install按钮就可以了。  

4、 带有Bpl文件的组件包。一般来说这也是由多种组件构成的组件包，它其实是一个动态连接库文件（DLL）。对于这种组件包的安装方法是：在component菜单下选择“install packages”，然后单击Add按钮，在打开的文件对话框中找到相应的bpl文件打开返回后，再单击Ok按钮就可以了。  

5、ActiveX控件的安装。要安装这类控件，需要先用regsvr32.exe注册，然后选择Component菜单中Import ActiveX Control项。在Import ActiveX Control打开的窗口中，只有已经注册的ActiveX控件才出现在列表中，选中一个然后按Install按钮就可以安装了。如果事先没有用regsvr32.exe注册也可以按ADD按钮找到OCX文件即时注册，注册后再进行安装。

几点说明：

1 在拿到组件后先看是否有说明文件，一般来说在说明文件中有如何安装的指导，有些还会有组件的属性、事件、方法的使用说明，这些在使用时是非常重要的。

2  在上面的组件（包）安装操作之前，最好将 *.bpl拷贝到你的System目录中，将 *.pas、*.dcu、*.dcr、*.dp?拷贝到Delphi的Lib目录中再进行。

3  前面我们提到安装DCU组件时，选用的是已经存在的dclusr40.dpk，当然也可以选择安装到一个新的包中，如果选择新包，需要先取一个名字比如DEMO，事实上安装完毕后用户可以找到的是Demo.bpl，而找不到DEMO.DPK。假如你已经将一个组件安装到dclusr40.dpk中了，还想再安装一个组件，如果再安装到dclusr40.dpk中，安装后你得到提示，原来安装的那个组件已经被取消注册，你将无法使用了。这样不就成了只能安装一个组件了吗？除非你再安装到一个新的包中才可以两个组件同时使用。当然每安装一个组件生成一个新的BPL文件也未偿不可，但BPL文件就增加许多。能否在dclusr40.dpk中多安装几个组件呢？当然是可以的。方法如下：用File菜单下的OPEN打开dclusr40.dpk文件，单击ADD按钮，在打开的对话框中选择ADD UNIT页面，按Unit file name后的“Browse”按钮打开组件单元文件，OK即可，用此种方法这样可添加多个组件的单元文件，添加完毕，按一下编译按钮，然后再按Install按钮即可，如果单元文件是编译好的（DCU）可以直接按安装按钮。

4   组件的删除。光会安装可不行，还要会删除呀。很简单，在component菜单下，选择install packages，在列表中找到安装所在的Bpl，按Remove按钮，ok！再把Bpl文件删掉就彻底了，如果不删除BPL文件，下次可以按安装BPL组件的方法再安装使用

（该文来自互联网转贴）

查看更多...

Tags: Delphi组件安装方法Delphi组件安装方法

希望能得到这样的结果  

磁盘  1  的分区  1  :  C  
磁盘  1  的分区  2  :  D  
磁盘  1  的分区  3  :  E  
磁盘  1  的分区  4  :  F  
磁盘  2  的分区  1  :  G  
磁盘  2  的分区  2  :  I  
磁盘  2  的分区  3  :  J  
磁盘  2  的分区  4  :  K  

---------------------------------------------------------------  
就是这样了，GetVolumeInfo('C').DiskNumber结果就是所在的物理磁盘ID  

需要JEDI的Win32支持库才能编译！  

function  GetVolumeInfo(DriverLetter:  Char):  TDiskExtent;  
var  
   hVolume:  THandle;  
   DiskExtents:  PVolumeDiskExtents;  
   dwOutBytes:  Cardinal;  
begin  
   with  Result  do  
       begin  
           DiskNumber  :=  0;  
           StartingOffset.QuadPart  :=  0;  
           ExtentLength.QuadPart  :=  0;  
       end;  
   hVolume  :=  CreateFile(PChar('\\.\'+DriverLetter+':'),  GENERIC_READ  or  GENERIC_WRITE,  
                                                 FILE_SHARE_READ  or  FILE_SHARE_WRITE,  nil,  OPEN_EXISTING,  0,  0);  
   if  hVolume  <  1  then  Exit;  
   DiskExtents  :=  AllocMem(Max_Path);  
   if  DeviceIoControl(hVolume,  
                               IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS,  
                               nil,  0,  
                               DiskExtents,  Max_Path,  
                               dwOutBytes,  nil)  then  
         begin  
             if  DiskExtents^.NumberOfDiskExtents  >  0  then  
                   Result  :=  DiskExtents^.Extents[0];  
         end;  
   FreeMem(DiskExtents);  
   CloseHandle(hVolume);  
end;  
  
http://lysoft.g4soft.net

查看更多...

Tags: 分区查找分区查找

只针对2000以上系统,9X的就别问我了,4年没搞了:)  

一般有4种方法:  

1)DLL挂靠方法  
程序改写为DLL结构,挂靠Explorer.exe上运行  
好处：没进程实体，普通进程查看无效  
缺点：可以通过代码叫Explorer.exe  Unload你的Dll，呵呵，还有Explorer出错时，会重新启用，那个时候需要重新挂靠你的DLL  
改进：用Debug权限挂靠WinLogon.exe，哈哈，安全系数就高很多，WinLogon死了，你也就死机了  

我主页的/projects/No  Ctrl+Alt+Del.rar是DLL挂靠方法的例子，修改就可用  

2）API  Hook方法  
关闭程序的实质是什么？TerminateProcess的API！  
只要你的Application.Title：＝‘’就不会出现在任务管理器的第一页  
第二页会出现的，但不怕，我Hook了TerminateProcess就可以保证安全了  
TerminateProcess可以Hook？可以，但Hook了没用，Handle是未知的  
因此实质上要Hook的是OpenProcess，只要是我的进程就拒绝打开  
好处：不怕你见的到，你就是关不了我  
缺点：CMD下的命令行方法Hook不到  
改进：能够Hook系统服务就一定可以，可惜难度大，需要编写驱动  

我主页的/projects/API  Hook.rar是API  Hook方法的例子，修改就可用  

3）NT内核修改方法  
修改NT系统内核对象PsLoadedModuleList上的ActiveProcessLink链表就可以在系统上“失踪”了，但实现这个功能需要驱动支持，没驱动的方法只能适合XP／2003，因为Nt5.1以上的ZwSystemDebugControl  API才能支持内核访问  
好处：你怎么都见不到进程的  
缺点：难度过大，用内核工具仍然可以看见的，很多RootKit木马就用这个方法的  
改进：几乎是终极大法，没什么别的好方法了。  

我主页的/projects/NTLowLevel.exe是演示程序

关键代码如下  
function  HideProcess:  boolean;  
label  Err;  
var  
   EProcess  :  DWord;  
   hPM,  FLink,  BLink:  Cardinal;  
begin  
   Result  :=  false;  
   EProcess  :=  GetCurrentEProcess;  
   if  EProcess  <  1  then  Exit;  
   if  not  ReadVirtualMemory(EProcess+$88,  @FLink,  4)  then  Exit;  
   if  not  ReadVirtualMemory(EProcess+$8C,  @BLink,  4)  then  Exit;  
   if  not  WriteVirtualMemory(FLink+4,  @BLink,  4)  then  Exit;  
   if  not  WriteVirtualMemory(BLink,  @FLink,  4)  then  Exit;  
   Result  :=  true;  
end;  

不要问为什么了，你需要NTDDK的知识才能明白的：）  

4）远程线程方法
没有实体的存在，没进程，没DLL，只有代码  
把代码直接注入进程空间VirtualAllocEx，用CreateRemoteThread运行，  
好处：没可见的实体，隐蔽性最强  
缺点：适合于简单代码，复杂的难以保证其可靠性和稳定性，病毒的最爱  
改进：不需要什么了  

这个没演示了，呵呵：）  
注入某个进程空间，要涉及到API定位等一系列病毒式操作，在对方的身体运行呀  
简单的代码可以，复杂的功能就很不适合，一般的程序根本就不适合，所以除非写病毒，否则不建议用这样的方法，因为连调试都变得很难  

by LYSoft

查看更多...

Tags: 不能关闭程序的方法不能关闭程序的方法

program Test;

uses
  Windows,
  SysUtils,
  ExtCtrls,
  Classes,
  Forms;

var
  timer1:TTimer; Method:TMethod;

procedure Timer1Timer(Self, Sender: TObject);  // 注意要比类下面的方法多一个Self参数
// 在类中声明是隐含了的, 改为外部声明就必须包含这个4 Bytes的用来传递TMethod.Data的参数
begin
  MessageBox(0, 'aa', 'bb', 0);
end;

begin
   timer1:=TTimer.Create(nil);
   timer1.Interval:=3000;
   Method.Data := nil;
   Method.Code := @Timer1Timer;
   timer1.OnTimer:= TNotifyEvent(Method);
   while True do Application.ProcessMessages;
end.

查看更多...

Tags: TMethodTMethod