instfunc.pas

源代码

      while True do begin
        if FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY = 0 then begin
          { Found a file }
          Result := False;
          Break;
        end;
        if (StrComp(FindData.cFileName, '.') <> 0) and
           (StrComp(FindData.cFileName, '..') <> 0) then begin
          { Found a subdirectory }
          Result := False;
          Break;
        end;
        if not FindNextFile(H, FindData) then begin
          if GetLastError <> ERROR_NO_MORE_FILES then begin
            { Exited the loop early due to some unexpected error. The directory
              might not be empty, so return False }
            Result := False;
          end;
          Break;
        end;
      end;
    finally
      Windows.FindClose(H);
    end;
  end
  else begin
    { The directory may not exist, or it may lack list permission }
    Result := False;
  end;
end;

procedure IncrementSharedCount(const Filename: String;
  const AlreadyExisted: Boolean);
const
  SharedDLLsKey = NEWREGSTR_PATH_SETUP + '\SharedDLLs';  {don't localize}
var
  ErrorCode: Longint;
  K: HKEY;
  Disp, Size, Count, CurType, NewType: DWORD;
  CountStr: String;
  FilenameP: PChar;
begin
  ErrorCode := RegCreateKeyEx(HKEY_LOCAL_MACHINE, SharedDLLsKey, 0, nil,
    REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE, nil, K, @Disp);
  if ErrorCode <> ERROR_SUCCESS then
    raise Exception.Create(FmtSetupMessage(msgErrorRegOpenKey,
        [GetRegRootKeyName(HKEY_LOCAL_MACHINE), SharedDLLsKey]) + SNewLine2 +
      FmtSetupMessage(msgErrorFunctionFailedWithMessage,
        ['RegCreateKeyEx', IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
  FilenameP := PChar(Filename);
  Count := 0;
  NewType := REG_DWORD;
  try
    if RegQueryValueEx(K, FilenameP, nil, @CurType, nil, @Size) = ERROR_SUCCESS then
      case CurType of
        REG_SZ:
          if RegQueryStringValue(K, FilenameP, CountStr) then begin
            Count := StrToInt(CountStr);
            NewType := REG_SZ;
          end;
        REG_BINARY: begin
            if (Size >= 1) and (Size <= 4) then begin
              if RegQueryValueEx(K, FilenameP, nil, nil, @Count, @Size) <> ERROR_SUCCESS then
                { ^ relies on the high 3 bytes of Count being initialized to 0 }
                Abort;
              NewType := REG_BINARY;
            end;
          end;
        REG_DWORD: begin
            Size := SizeOf(DWORD);
            if RegQueryValueEx(K, FilenameP, nil, nil, @Count, @Size) <> ERROR_SUCCESS then
              Abort;
          end;
      end;
  except
    Count := 0;
  end;
  if Integer(Count) < 0 then Count := 0;  { just in case... }
  if (Count = 0) and AlreadyExisted then
    Inc(Count);
  Inc(Count);
  case NewType of
    REG_SZ: begin
        CountStr := IntToStr(Count);
        RegSetValueEx(K, FilenameP, 0, NewType, PChar(CountStr), Length(CountStr)+1);
      end;
    REG_BINARY, REG_DWORD:
      RegSetValueEx(K, FilenameP, 0, NewType, @Count, SizeOf(Count));
  end;
  RegCloseKey(K);
end;

function DecrementSharedCount(const Filename: String): Boolean;
{ Attempts to decrement the shared file reference count of Filename. Returns
  True if the count reached zero (meaning it's OK to delete the file). }
const
  SharedDLLsKey = NEWREGSTR_PATH_SETUP + '\SharedDLLs';  {don't localize}
var
  ErrorCode: Longint;
  K: HKEY;
  CountRead: Boolean;
  Count, CurType, Size: DWORD;
  CountStr: String;
begin
  Result := False;

  ErrorCode := RegOpenKeyEx(HKEY_LOCAL_MACHINE, SharedDLLsKey, 0,
    KEY_QUERY_VALUE or KEY_SET_VALUE, K);
  if ErrorCode = ERROR_FILE_NOT_FOUND then
    Exit;
  if ErrorCode <> ERROR_SUCCESS then
    raise Exception.Create(FmtSetupMessage(msgErrorRegOpenKey,
        [GetRegRootKeyName(HKEY_LOCAL_MACHINE), SharedDLLsKey]) + SNewLine2 +
      FmtSetupMessage(msgErrorFunctionFailedWithMessage,
        ['RegOpenKeyEx', IntToStr(ErrorCode), Win32ErrorString(ErrorCode)]));
  try
    if RegQueryValueEx(K, PChar(Filename), nil, @CurType, nil, @Size) <> ERROR_SUCCESS then
      Exit;

    CountRead := False;
    Count := 0;
    try
      case CurType of
        REG_SZ:
          if RegQueryStringValue(K, PChar(Filename), CountStr) then begin
            Count := StrToInt(CountStr);
            CountRead := True;
          end;
        REG_BINARY: begin
            if (Size >= 1) and (Size <= 4) then begin
              if RegQueryValueEx(K, PChar(Filename), nil, nil, @Count, @Size) = ERROR_SUCCESS then
                { ^ relies on the high 3 bytes of Count being initialized to 0 }
                CountRead := True;
            end;
          end;
        REG_DWORD: begin
            Size := SizeOf(DWORD);
            if RegQueryValueEx(K, PChar(Filename), nil, nil, @Count, @Size) = ERROR_SUCCESS then
              CountRead := True;
          end;
      end;
    except
      { don't propogate exceptions (e.g. from StrToInt) }
    end;
    { If we failed to read the count, or it's in some type we don't recognize,
      don't touch it }
    if not CountRead then
      Exit;

    Dec(Count);
    if Integer(Count) <= 0 then begin
      Result := True;
      RegDeleteValue(K, PChar(Filename));
    end
    else begin
      case CurType of
        REG_SZ: begin
            CountStr := IntToStr(Count);
            RegSetValueEx(K, PChar(Filename), 0, REG_SZ, PChar(CountStr), Length(CountStr)+1);
          end;
        REG_BINARY, REG_DWORD:
          RegSetValueEx(K, PChar(Filename), 0, CurType, @Count, SizeOf(Count));
      end;
    end;
  finally
    RegCloseKey(K);
  end;
end;

function GetFileDateTime(const Filename: string; var DateTime: TFileTime): Boolean;
var
  Handle: THandle;
  FindData: TWin32FindData;
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
      DateTime := FindData.ftLastWriteTime;
      Result := True;
      Exit;
    end;
  end;
  Result := False;
  DateTime.dwLowDateTime := 0;
  DateTime.dwHighDateTime := 0;
end;

function GetMD5OfFile(const Filename: String): TMD5Digest;
{ Gets MD5 sum of the file Filename. An exception will be raised upon
  failure. }
var
  F: TFile;
  NumRead: Cardinal;
  Context: TMD5Context;
  Buf: array[0..65535] of Byte;
begin
  MD5Init(Context);
  F := TFile.Create(Filename, fdOpenExisting, faRead, fsReadWrite);
  try
    while True do begin
      NumRead := F.Read(Buf, SizeOf(Buf));
      if NumRead = 0 then Break;
      MD5Update(Context, Buf, NumRead);
    end;
  finally
    F.Free;
  end;
  Result := MD5Final(Context);
end;

function GetMD5OfString(const S: String): TMD5Digest;
begin
  Result := MD5Buf(Pointer(S)^, Length(S));
end;

var
  SFCInitialized: Boolean;
  SfcIsFileProtectedFunc: function(RpcHandle: THandle; ProtFileName: PWideChar): BOOL; stdcall;

function IsProtectedSystemFile(const Filename: String): Boolean;
{ Returns True if the specified file is protected by Windows File Protection
  (and therefore can't be replaced). }
var
  M: HMODULE;
  FN: String;
  Buf: array[0..4095] of WideChar;
begin
  if not SFCInitialized then begin
    M := SafeLoadLibrary(PChar(AddBackslash(GetSystemDir) + 'sfc.dll'),
      SEM_NOOPENFILEERRORBOX);
    if M <> 0 then
      SfcIsFileProtectedFunc := GetProcAddress(M, 'SfcIsFileProtected');
    SFCInitialized := True;
  end;
  if Assigned(SfcIsFileProtectedFunc) then begin
    FN := PathExpand(Filename);  { only FQ paths are accepted }
    Buf[MultiByteToWideChar(CP_ACP, 0, PChar(FN), Length(FN), Buf,
      (SizeOf(Buf) div SizeOf(Buf[0])) - 1)] := #0;
    Result := (Buf[0] <> #0) and SfcIsFileProtectedFunc(0, Buf);
  end
  else begin
    { Windows File Protection doesn't exist on Windows 95/98/NT4 }
    Result := False;
  end;
end;

function InstExec(const Filename, Params: String; WorkingDir: String;
  const WaitUntilTerminated, WaitUntilIdle: Boolean; const ShowCmd: Integer;
  const ProcessMessagesProc: TProcedure; var ResultCode: Integer): Boolean;
var
  CmdLine: String;
  WorkingDirP: PChar;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  Result := True;
  CmdLine := '"' + Filename + '"';
  if Params <> '' then
    CmdLine := CmdLine + ' ' + Params;
  if (CompareText(PathExtractExt(Filename), '.bat') = 0) or
     (CompareText(PathExtractExt(Filename), '.cmd') = 0) then begin
    { Use our own handling for .bat and .cmd files since passing them straight
      to CreateProcess on Windows NT 4.0 has problems: it doesn't properly
      quote the command line it passes to cmd.exe. This didn't work before:
        Filename: "c:\batch.bat"; Parameters: """abc"""
      And other Windows versions might have unknown quirks too, since
      CreateProcess isn't documented to accept .bat files in the first place. }
    if UsingWinNT then
      { With cmd.exe, the whole command line must be quoted for quoted
        parameters to work. For example, this fails:
          cmd.exe /c "z:\blah.bat" "test"
        But this works:
          cmd.exe /c ""z:\blah.bat" "test""
      }
      CmdLine := '"' + AddBackslash(GetSystemDir) + 'cmd.exe" /C "' + CmdLine + '"'
    else
      CmdLine := '"' + AddBackslash(GetWinDir) + 'COMMAND.COM" /C ' + CmdLine;
  end;
  if WorkingDir = '' then
    WorkingDir := PathExtractDir(Filename);
  FillChar(StartupInfo, SizeOf(StartupInfo), 0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := ShowCmd;
  if WorkingDir <> '' then
    WorkingDirP := PChar(WorkingDir)
  else
    WorkingDirP := nil;
  if not CreateProcess(nil, PChar(CmdLine), nil, nil, False, 0, nil,
     WorkingDirP, StartupInfo, ProcessInfo) then begin
    Result := False;
    ResultCode := GetLastError;
    Exit;
  end;
  with ProcessInfo do begin
    { Don't need the thread handle, so close it now }
    CloseHandle(hThread);
    if WaitUntilIdle then
      WaitForInputIdle(hProcess, INFINITE);
    if WaitUntilTerminated then
      { Wait until the process returns, but still process any messages that
        arrive. }
      repeat
        { Process any pending messages first because MsgWaitForMultipleObjects
          (called below) only returns when *new* messages arrive }
        if Assigned(ProcessMessagesProc) then
          ProcessMessagesProc;
      until MsgWaitForMultipleObjects(1, hProcess, False, INFINITE, QS_ALLINPUT) <> WAIT_OBJECT_0+1;
    { Get the exit code. Will be set to STILL_ACTIVE if not yet available }
    GetExitCodeProcess(hProcess, DWORD(ResultCode));
    { Then close the process handle }
    CloseHandle(hProcess);
  end;
end;

function InstShellExec(const Verb, Filename, Params: String; WorkingDir: String;
  const WaitUntilTerminated, WaitUntilIdle: Boolean; const ShowCmd: Integer;
  const ProcessMessagesProc: TProcedure; var ResultCode: Integer): Boolean;
var
  Info: TShellExecuteInfo;
begin
  if WorkingDir = '' then
    WorkingDir := PathExtractDir(Filename);

  FillChar(Info, SizeOf(Info), 0);
  Info.cbSize := SizeOf(Info);
  Info.fMask := SEE_MASK_FLAG_NO_UI or SEE_MASK_FLAG_DDEWAIT or
    SEE_MASK_NOCLOSEPROCESS;
  Info.lpVerb := Pointer(Verb);
  Info.lpFile := PChar(Filename);
  Info.lpParameters := PChar(Params);
  if WorkingDir <> '' then
    Info.lpDirectory := PChar(WorkingDir);
  Info.nShow := ShowCmd;
  Result := ShellExecuteEx(@Info);
  if not Result then begin
    ResultCode := GetLastError;
    Exit;