一些函数，包括内存映像等（二）

function SetPrivilege(hToken: THandle; strPrivilege: PChar; bEnable: BOOL): BOOL;
var
  tp: TOKEN_PRIVILEGES;
  luid: TLargeInteger;
  tpPrevious: TOKEN_PRIVILEGES;
  cbPrevious: DWORD;
  cbRtn: DWORD;
begin
  result := TRUE;
 
  cbPrevious := sizeof(TOKEN_PRIVILEGES);
  if not LookupPrivilegeValue(nil, strPrivilege, luid) then
  begin
    result := FALSE;
    exit;
  end;
  tp.PrivilegeCount := 1;
  tp.Privileges[0].Luid := luid;
  tp.Privileges[0].Attributes := 0;
  AdjustTokenPrivileges(hToken, FALSE, tp,
          sizeof(TOKEN_PRIVILEGES),
   tpPrevious,
   cbPrevious);
  if (GetLastError() <> ERROR_SUCCESS) then
  begin
    result := FALSE;
    exit;
  end;
  tpPrevious.PrivilegeCount := 1;
  tpPrevious.Privileges[0].Luid := luid;
  if bEnable then
    tpPrevious.Privileges[0].Attributes := tpPrevious.Privileges[0].Attributes or SE_PRIVILEGE_ENABLED
  else
    tpPrevious.Privileges[0].Attributes := tpPrevious.Privileges[0].Attributes and (not SE_PRIVILEGE_ENABLED);
  AdjustTokenPrivileges(hToken,
                        FALSE,
                        tpPrevious,
                        cbPrevious,
                        nil,
                        cbRtn);
  if (GetLastError() <> ERROR_SUCCESS) then
    result := FALSE;
end;
function SetCurProcDbgPrivilege(bEnabled: boolean): BOOL;
var
  hToken : THandle;
begin
  result := TRUE;
  if (not OpenProcessToken(GetCurrentProcess(),
      TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
      hToken)) then
  begin
    result := FALSE;
    exit;
  end;
  if (not SetPrivilege(hToken, SE_DEBUG_NAME, bEnabled)) then
  begin
    result := FALSE;
    CloseHandle(hToken);
    exit;
  end;
  CloseHandle(hToken);
end;
function GetOSVersion: integer;
var
  sysVI: TosversionInfo;
begin
  sysVI.dwOSVersionInfoSize := SizeOf(sysVI);
  GetVersionEx(sysVI);
  with sysVI do
  begin
    Result := SYSUN;
    case dwPlatFormID of
      0: Result := SYS31;
      1:
      begin
        case dwMinorVersion of
          0: Result := SYS95;
          10: Result := SYS98;
          90: Result := SYSML;
        else
          Result := SYSUN;
        end;
      end;
      2:
      case dwMajorVersion of
        3, 4: Result := SYSNT;
        5: Result := SYS2K;
      end;
    end;
  end;
end;
procedure ExitWin2000(ewx: integer);
var
  hToken: THANDLE;
  hProc: THANDLE;
  mLUID: TLargeInteger;
  mPriv, mNewPriv: TOKEN_PRIVILEGES;
  mBufferLength: DWord;
begin
  try
    hProc := GetCurrentProcess();
    OpenProcessToken(hProc, TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken);
    LookupPrivilegeValue('', SE_SHUTDOWN_NAME, mLUID);
    mPriv.PrivilegeCount := 1;
    mPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
    mPriv.Privileges[0].Luid := mLUID;
    AdjustTokenPrivileges(hToken, False, mPriv, (4 + (12 * mPriv.PrivilegeCount)), mNewPriv, mBufferLength);
    ExitWindowsEx(EWX_FORCE + ewx, 0);
  except
  end;
end;
procedure ExitWin9x(EWX: integer);
begin
  ExitWindowsEx(EWX, 0);
end;
procedure ShutDownPC;
begin
  case GetOSVersion of
    SYS2K: ExitWin2000(EWX_POWEROFF);
    SYS98, SYS95: ExitWin9x(EWX_SHUTDOWN);
  end;
end;
function GetFileDateTime(const FileName: String; FileTimeType: TFileTimeType): TDateTime;
var
  Handle: THandle;
  FindData: TWin32FindData;
  LocalFileTime: TFileTime;
  DosDateTime: Integer;
begin
  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      case FileTimeType of
        fttCreation:
          FileTimeToLocalFileTime(FindData.ftCreationTime, LocalFileTime);
        fttLastAccess:
          FileTimeToLocalFileTime(FindData.ftLastAccessTime, LocalFileTime);
        fttLastWrite:
          FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      end;
      if FileTimeToDosDateTime(LocalFileTime, LongRec(DosDateTime).Hi, LongRec(DosDateTime).Lo) then
      begin
        Result := FileDateToDateTime(DosDateTime);
        Exit;
      end;
    end;
  end;
  Result := -1;
end;

function SetFileDateTime(const FileName: string; FileTimeType: TFileTimeType; aDateTime: TDateTime): Integer;
var
  Handle: THandle;
  LocalFileTime, FileTime: TFileTime;
  DosDateTime: Integer;
  I: TFileTimeType;
  FileTimes: array[TFileTimeType] of Pointer;
begin
  Result := 0;
  DosDateTime := DateTimeToFileDate(aDateTime);
  Handle := FileOpen(FileName, fmOpenWrite or fmShareDenyNone);
  if Handle <> INVALID_HANDLE_VALUE then
  try
    for I := fttCreation to fttLastWrite do
      FileTimes[I] := nil;
    DosDateTimeToFileTime(LongRec(DosDateTime).Hi, LongRec(DosDateTime).Lo, LocalFileTime);
    LocalFileTimeToFileTime(LocalFileTime, FileTime);
    FileTimes[FileTimeType] := @FileTime;
    if SetFileTime(Handle, FileTimes[fttCreation], FileTimes[fttLastAccess],
      FileTimes[fttLastWrite]) then Exit;
  finally
    FileClose(Handle);
  end;
  Result := GetLastError;
end;
function ListFiles(const Path: string; pFI: PList): integer;
var
  SRec: TSearchRec;
  retval: Integer;
  CreateFileTime, LWriteFileTime: TFileTime;
  CD, LD: integer;
  fi: PFileInfo;
begin
  result := -1;
  retval := FindFirst(Path + '\*.*', faAnyFile or faDirectory, sRec);
  try
    while retval = 0 do
    begin
      inc(result);
      new(fi);
      with fi^ do
      begin
        FileTimeToLocalFileTime(Srec.FindData.ftCreationTime, CreateFileTime);
        FileTimeToLocalFileTime(Srec.FindData.ftLastWriteTime, LWriteFileTime);
        FileTimeToDosDateTime(CreateFileTime, LongRec(CD).Hi, LongRec(CD).Lo);
        FileTimeToDosDateTime(LWriteFileTime, LongRec(LD).Hi, LongRec(LD).Lo);
        isDir := (SRec.Attr and faDirectory) <> 0;
        Value := Path + Srec.Name;
        size := SRec.FindData.nFileSizeLow;
        CreateDate := FileDateToDateTime(CD);
        ModifyDate := FileDateToDateTime(LD);
      end;
      pFI^.Add(TObject(fi));
      retval := FindNext(SRec);
    end;
  finally
    FindClose(SRec);
  end;
end;
// 用于为注册表监视线程传递数据
type
  TRegThreadData = record
    RootKey: HKEY;
    Key: string;
    Filter: integer;
    Handle: THandle;
    MsgValue: Cardinal;
    hEvent: Cardinal;
  end;
  PRegThreadData = ^TRegThreadData;
// 该函数必须重新引用把longbool型改为DWORD型
function RegNotifyChangeKeyValue(hKey: HKEY; bWatchSubtree: DWORD; dwNotifyFilter: DWORD; hEvent: THandle; fAsynchronus: DWORD): Longint; stdcall;
  external 'advapi32.dll' name 'RegNotifyChangeKeyValue';
// 注册表监视线程
procedure ScoutRegProc(p: pointer); stdcall;
var
  rtd: TRegThreadData;
  Reg: TRegistry;
  Key: HKEY;
begin
  rtd := PRegThreadData(p)^;
  Reg := TRegistry.Create;
  try
    PostMessage(rtd.Handle, rtd.MsgValue, 1, 0);            // 开始监视
    Reg.RootKey := rtd.RootKey;
    if Reg.OpenKeyReadOnly(rtd.key) then
    begin
      Key := Reg.CurrentKey;
      while RegNotifyChangeKeyValue(Key, 1, rtd.Filter, rtd.hEvent, 1) = ERROR_SUCCESS do
        if WaitForSingleObject(rtd.hEvent, INFINITE) = WAIT_OBJECT_0 then
        begin
          PostMessage(rtd.Handle, rtd.MsgValue, 0, 0);
          ResetEvent(rtd.hEvent);
        end;
    end;
  finally
    Reg.Free;
    PostMessage(rtd.Handle, rtd.MsgValue, 2, 0);            // 监视失败
  end;
end;
function StartScoutReg(RootKey: HKEY; key: string; Filter: integer; Handle: THandle; MsgValue: integer): DWORD;
var
  rtd: TRegThreadData;
  tID: DWORD;
begin
  rtd.RootKey := RootKey;
  rtd.Key := key;
  if Filter = 0 then
    rtd.Filter := REG_NOTIFY_CHANGE_NAME or
                  REG_NOTIFY_CHANGE_ATTRIBUTES or
                  REG_NOTIFY_CHANGE_LAST_SET or
                  REG_NOTIFY_CHANGE_SECURITY
  else
    rtd.Filter := Filter;
  rtd.Handle := Handle;
  rtd.MsgValue := MsgValue;
  rtd.hEvent := CreateEvent(nil, True, False, 'RegMonitorChange');
  result := CreateThread(nil, 0, @ScoutRegProc, @rtd, 0, tID);
end;
procedure KillProcess(ProcID: DWORD);
var
  hProc: THandle;
begin
  try
    SetCurProcDbgPrivilege(True);
    hProc := OpenProcess(PROCESS_TERMINATE, False, ProcID);
    TerminateProcess(hProc, 0);
  finally
    SetCurProcDbgPrivilege(False);
  end;
end;
function WriteShareData(ShareName: pchar; Data: pointer; DataSize: Cardinal): THandle;
var
  tmpData: pointer;
begin
  result := CreateFileMapping(DWord($FFFFFFFF), nil, PAGE_READWRITE, 0,
    DataSize, ShareName);
  tmpData := MapViewofFile(result, FILE_MAP_WRITE, 0, 0, 0);
  move(Data^, tmpData^, DataSize);
  UnMapViewofFile(tmpData);
end;
procedure ReadShareData(ShareName: pchar; Data: pointer; DataSize: Cardinal);
var
  hMap: THandle;
  tmpData: pointer;
begin
  hMap := CreateFileMapping(DWord($FFFFFFFF), nil, PAGE_READWRITE,
    0, DataSize, ShareName);
  try
    tmpData := MapViewofFile(hMap, FILE_MAP_READ, 0, 0, 0);
    move(tmpData^, Data^, DataSize);
    UnMapViewofFile(tmpData);
  finally
    CloseHandle(hMap);
  end;
end;
function ReadShareInteger(ShareName: pchar): integer;
begin
  ReadShareData(ShareName, @result, sizeof(integer));
end;
function WriteShareInteger(ShareName: pchar; h: integer): THandle;
begin
  result := WriteShareData(ShareName, @h, sizeof(integer));
end;
function RunAndWaitForExe(appName: pchar; cmdLine: pchar): integer;
var
  si: TStartupInfo;
  pri: TProcessInformation;
begin
  result := -1;
  FillChar(SI, sizeof(SI), #0);
  SI.cb := sizeof(SI);
  si.dwFlags := STARTF_USESHOWWINDOW;
  SI.wShowWindow := 1;
  if not CreateProcess(appName, cmdLine, nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, si, pri) then
    Exit;
  WaitForSingleObject(pri.hProcess, INFINITE);
  GetExitCodeProcess(Pri.hProcess, Cardinal(result));
end;
function ListThreads(pID: integer; pl: PList): integer;
var
  lppe: TThreadEntry32;
  SSHandle: THandle;
  Found: boolean;
  pi: PThreadInfo;
begin
  SSHandle := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
  try
    result := 0;
    lppe.dwSize := sizeof(lppe);
    Found := Thread32First(SSHandle, lppe);
    while Found do
    begin
      inc(result);
      try
        if pl <> nil then
        begin
          if pID = -1 then
          begin
            new(pi);
            pi^.ThreadID := lppe.th32ThreadID;
            pl^.Add(TObject(pi));
          end else
          begin
            if lppe.th32OwnerProcessID = Cardinal(pID) then
            begin
              new(pi);
              pi^.ThreadID := lppe.th32ThreadID;
              pl^.Add(TObject(pi));
            end;
          end;
        end;
      except
        break;
      end;
      Found := Thread32Next(SSHandle, lppe);
    end;
  finally
    CloseHandle(SSHandle);
  end;
end;
end.