scriptfunc_r.pas

源代码

    if RegOpenKeyEx(RootKey, PChar(SubKeyName), 0, samDesired[Subkey], K) <> ERROR_SUCCESS then
      Exit;
    try
      PSDynArraySetLength(Pointer(Arr.Dta^), Arr.aType, 0);
      I := 0;
      while True do begin
        BufSize := Length(Buf);
        if Subkey then
          R := RegEnumKeyEx(K, I, @Buf[1], BufSize, nil, nil, nil, nil)
        else
          R := RegEnumValue(K, I, @Buf[1], BufSize, nil, nil, nil, nil);
        case R of
          ERROR_SUCCESS: ;
          ERROR_NO_MORE_ITEMS: Break;
          ERROR_MORE_DATA:
            begin
              { Double the size of the buffer and try again }
              SetString(Buf, nil, Length(Buf) * 2);
              Continue;
            end;
        else
          Exit;  { unknown failure... }
        end;
        PSDynArraySetLength(Pointer(Arr.Dta^), Arr.aType, I+1);
        SetString(S, PChar(@Buf[1]), BufSize);
        VNSetString(PSGetArrayField(Arr^, I), S);
        Inc(I);
      end;
    finally
      RegCloseKey(K);
    end;
    Result := True;
  end;

var
  PStart: Cardinal;
  ExistingFilename: String;
  K, RootKey: HKEY;
  S, N, V, DataS: String;
  Typ, ExistingTyp, Data, Size, Disp: DWord;
  Arr: TPSVariantIFC;
begin
  PStart := Stack.Count-1;
  Result := True;

  if Proc.Name = 'FILEEXISTS' then begin
    Stack.SetBool(PStart, NewFileExists(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'DIREXISTS' then begin
    Stack.SetBool(PStart, DirExists(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'FILEORDIREXISTS' then begin
    Stack.SetBool(PStart, FileOrDirExists(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'GETINISTRING' then begin
    Stack.SetString(PStart, GetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4)));
  end else if Proc.Name = 'GETINIINT' then begin
    Stack.SetInt(PStart, GetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetInt(PStart-4), Stack.GetInt(PStart-5), Stack.GetString(PStart-6)));
  end else if Proc.Name = 'GETINIBOOL' then begin
    Stack.SetBool(PStart, GetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4)));
  end else if Proc.Name = 'INIKEYEXISTS' then begin
    Stack.SetBool(PStart, IniKeyExists(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3)));
  end else if Proc.Name = 'ISINISECTIONEMPTY' then begin
    Stack.SetBool(PStart, IsIniSectionEmpty(Stack.GetString(PStart-1), Stack.GetString(PStart-2)));
  end else if Proc.Name = 'SETINISTRING' then begin
    Stack.SetBool(PStart, SetIniString(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetString(PStart-3), Stack.GetString(PStart-4)));
  end else if Proc.Name = 'SETINIINT' then begin
    Stack.SetBool(PStart, SetIniInt(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetInt(PStart-3), Stack.GetString(PStart-4)));
  end else if Proc.Name = 'SETINIBOOL' then begin
    Stack.SetBool(PStart, SetIniBool(Stack.GetString(PStart-1), Stack.GetString(PStart-2), Stack.GetBool(PStart-3), Stack.GetString(PStart-4)));
  end else if Proc.Name = 'DELETEINIENTRY' then begin
    DeleteIniEntry(Stack.GetString(PStart), Stack.GetString(PStart-1), Stack.GetString(PStart-2));
  end else if Proc.Name = 'DELETEINISECTION' then begin
    DeleteIniSection(Stack.GetString(PStart), Stack.GetString(PStart-1));
  end else if Proc.Name = 'GETENV' then begin
    Stack.SetString(PStart, GetEnv(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'GETCMDTAIL' then begin
    Stack.SetString(PStart, GetCmdTail());
  end else if Proc.Name = 'PARAMCOUNT' then begin
    Stack.SetInt(PStart, NewParamCount());
  end else if Proc.Name = 'PARAMSTR' then begin
    Stack.SetString(PStart, NewParamStr(Stack.GetInt(PStart-1)));
  end else if Proc.Name = 'ADDBACKSLASH' then begin
    Stack.SetString(PStart, AddBackslash(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'REMOVEBACKSLASH' then begin
    Stack.SetString(PStart, RemoveBackslash(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'REMOVEBACKSLASHUNLESSROOT' then begin
    Stack.SetString(PStart, RemoveBackslashUnlessRoot(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'ADDQUOTES' then begin
    Stack.SetString(PStart, AddQuotes(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'REMOVEQUOTES' then begin
    Stack.SetString(PStart, RemoveQuotes(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'GETSHORTNAME' then begin
    Stack.SetString(PStart, GetShortName(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'GETWINDIR' then begin
    Stack.SetString(PStart, GetWinDir());
  end else if Proc.Name = 'GETSYSTEMDIR' then begin
    Stack.SetString(PStart, GetSystemDir());
  end else if Proc.Name = 'GETTEMPDIR' then begin
    Stack.SetString(PStart, GetTempDir());
  end else if Proc.Name = 'STRINGCHANGE' then begin
    S := Stack.GetString(PStart);
    StringChange(S, Stack.GetString(PStart-1), Stack.GetString(PStart-2));
    Stack.SetString(PStart, S);
  end else if Proc.Name = 'USINGWINNT' then begin
    Stack.SetBool(PStart, UsingWinNT());
  end else if Proc.Name = 'FILECOPY' then begin
    ExistingFilename := Stack.GetString(PStart-1);
    if PathCompare(ExistingFilename, SetupLdrOriginalFilename) <> 0 then
      Stack.SetBool(PStart, CopyFile(PChar(ExistingFilename), PChar(Stack.GetString(PStart-2)), Stack.GetBool(PStart-3)))
    else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'CONVERTPERCENTSTRING' then begin
    S := Stack.GetString(PStart-1);
    Stack.SetBool(PStart, ConvertPercentStr(S));
    Stack.SetString(PStart-1, S);
  end else if Proc.Name = 'REGKEYEXISTS' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegOpenKeyEx(RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
      Stack.SetBool(PStart, True);
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'REGVALUEEXISTS' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegOpenKeyEx(RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
      N := Stack.GetString(PStart-3);
      Stack.SetBool(PStart, RegValueExists(K, PChar(N)));
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'REGDELETEKEYINCLUDINGSUBKEYS' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    Stack.SetBool(PStart, RegDeleteKeyIncludingSubkeys(RootKey, PChar(S)) = ERROR_SUCCESS);
  end else if Proc.Name = 'REGDELETEKEYIFEMPTY' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    Stack.SetBool(PStart, RegDeleteKeyIfEmpty(RootKey, PChar(S)) = ERROR_SUCCESS);
  end else if Proc.Name = 'REGDELETEVALUE' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegOpenKeyEx(RootKey, PChar(S), 0, KEY_SET_VALUE, K) = ERROR_SUCCESS then begin
      N := Stack.GetString(PStart-3);
      Stack.SetBool(PStart, RegDeleteValue(K, PChar(N)) = ERROR_SUCCESS);
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'REGGETSUBKEYNAMES' then begin
    Arr := NewTPSVariantIFC(Stack[PStart-3], True);
    Stack.SetBool(PStart, GetSubkeyOrValueNames(Stack.GetInt(PStart-1),
      Stack.GetString(PStart-2), @Arr, True));
  end else if Proc.Name = 'REGGETVALUENAMES' then begin
    Arr := NewTPSVariantIFC(Stack[PStart-3], True);
    Stack.SetBool(PStart, GetSubkeyOrValueNames(Stack.GetInt(PStart-1),
      Stack.GetString(PStart-2), @Arr, False));
  end else if Proc.Name = 'REGQUERYSTRINGVALUE' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegOpenKeyEx(RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
      N := Stack.GetString(PStart-3);
      S := Stack.GetString(PStart-4);
      Stack.SetBool(PStart, RegQueryStringValue(K, PChar(N), S));
      Stack.SetString(PStart-4, S);
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'REGQUERYMULTISTRINGVALUE' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegOpenKeyEx(RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
      N := Stack.GetString(PStart-3);
      S := Stack.GetString(PStart-4);
      Stack.SetBool(PStart, RegQueryMultiStringValue(K, PChar(N), S));
      Stack.SetString(PStart-4, S);
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'REGQUERYDWORDVALUE' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegOpenKeyEx(RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
      N := Stack.GetString(PStart-3);
      Size := SizeOf(Data);
      if (RegQueryValueEx(K, PChar(N), nil, @Typ, @Data, @Size) = ERROR_SUCCESS) and (Typ = REG_DWORD) then begin
        Stack.SetInt(PStart-4, Data);
        Stack.SetBool(PStart, True);
      end else
        Stack.SetBool(PStart, False);
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'REGQUERYBINARYVALUE' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegOpenKeyEx(RootKey, PChar(S), 0, KEY_QUERY_VALUE, K) = ERROR_SUCCESS then begin
      N := Stack.GetString(PStart-3);
      if (RegQueryValueEx(K, PChar(N), nil, @Typ, nil, @Size) = ERROR_SUCCESS) and (Typ = REG_BINARY) then begin
        SetLength(DataS, Size);
        if (RegQueryValueEx(K, PChar(N), nil, @Typ, @DataS[1], @Size) = ERROR_SUCCESS) and (Typ = REG_BINARY) then begin
          Stack.SetString(PStart-4, DataS);
          Stack.SetBool(PStart, True);
        end else
          Stack.SetBool(PStart, False);
      end else
        Stack.SetBool(PStart, False);
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'REGWRITESTRINGVALUE' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegCreateKeyEx(RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_QUERY_VALUE or KEY_SET_VALUE, nil, K, @Disp) = ERROR_SUCCESS then begin
      N := Stack.GetString(PStart-3);
      V := Stack.GetString(PStart-4);
      if (RegQueryValueEx(K, PChar(N), nil, @ExistingTyp, nil, nil) = ERROR_SUCCESS) and (ExistingTyp = REG_EXPAND_SZ) then
        Typ := REG_EXPAND_SZ
      else
        Typ := REG_SZ;
      if RegSetValueEx(K, PChar(N), 0, Typ, PChar(V), Length(V)+1) = ERROR_SUCCESS then
        Stack.SetBool(PStart, True)
      else
        Stack.SetBool(PStart, False);
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'REGWRITEMULTISTRINGVALUE' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegCreateKeyEx(RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, @Disp) = ERROR_SUCCESS then begin
      N := Stack.GetString(PStart-3);
      V := Stack.GetString(PStart-4);
      { Multi-string data requires two null terminators: one after the last
        string, and one to mark the end.
        Delphi's String type is implicitly null-terminated, so only one null
        needs to be added to the end. }
      if (V <> '') and (V[Length(V)] <> #0) then
        V := V + #0;
      if RegSetValueEx(K, PChar(N), 0, REG_MULTI_SZ, PChar(V), Length(V)+1) = ERROR_SUCCESS then
        Stack.SetBool(PStart, True)
      else
        Stack.SetBool(PStart, False);
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'REGWRITEDWORDVALUE' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegCreateKeyEx(RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, @Disp) = ERROR_SUCCESS then begin
      N := Stack.GetString(PStart-3);
      Data := Stack.GetInt(PStart-4);
      if RegSetValueEx(K, PChar(N), 0, REG_DWORD, @Data, SizeOf(Data)) = ERROR_SUCCESS then
        Stack.SetBool(PStart, True)
      else
        Stack.SetBool(PStart, False);
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'REGWRITEBINARYVALUE' then begin
    RootKey := Stack.GetInt(PStart-1);
    S := Stack.GetString(PStart-2);
    if RegCreateKeyEx(RootKey, PChar(S), 0, nil, REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, K, @Disp) = ERROR_SUCCESS then begin
      N := Stack.GetString(PStart-3);
      DataS := Stack.GetString(PStart-4);
      if RegSetValueEx(K, PChar(N), 0, REG_BINARY, @DataS[1], Length(DataS)) = ERROR_SUCCESS then
        Stack.SetBool(PStart, True)
      else
        Stack.SetBool(PStart, False);
      RegCloseKey(K);
    end else
      Stack.SetBool(PStart, False);
  end else if Proc.Name = 'ISADMINLOGGEDON' then begin
    Stack.SetBool(PStart, IsAdminLoggedOn());
  end else if Proc.Name = 'ISPOWERUSERLOGGEDON' then begin
    Stack.SetBool(PStart, IsPowerUserLoggedOn());
  end else if Proc.Name = 'GETUILANGUAGE' then begin
    Stack.SetInt(PStart, GetUILanguage);
  end else if Proc.Name = 'ADDPERIOD' then begin
    Stack.SetString(PStart, AddPeriod(Stack.GetString(PStart-1)));
  end else
    Result := False;
end;

{ Install }
function InstallProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
var
  PStart: Cardinal;
begin
  if IsUninstaller then
    NoUninstallFuncError(Proc.Name);

  PStart := Stack.Count-1;
  Result := True;

  if Proc.Name = 'EXTRACTTEMPORARYFILE' then begin
    ExtractTemporaryFile(Stack.GetString(PStart));
  end else
    Result := False;
end;

{ InstFunc }
procedure ProcessMessagesProc; far;
begin
  Application.ProcessMessages;
end;

function InstFuncProc(Caller: TPSExec; Proc: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
var
  PStart: Cardinal;
  Filename: String;
  WindowList: Pointer;
  ResultCode, ErrorCode: Integer;
  FreeBytes, TotalBytes: Integer64;
begin
  PStart := Stack.Count-1;
  Result := True;

  if Proc.Name = 'CHECKFORMUTEXES' then begin
    Stack.SetBool(PStart, CheckForMutexes(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'DECREMENTSHAREDCOUNT' then begin
    Stack.SetBool(PStart, DecrementSharedCount(Stack.GetString(PStart-1)));
  end else if Proc.Name = 'DELAYDELETEFILE' then begin
    DelayDeleteFile(Stack.GetString(PStart), Stack.GetInt(PStart-1));
  end else if Proc.Name = 'DELTREE' then begin
    Stack.SetBool(PStart, DelTree(Stack.GetString(PStart-1), Stack.GetBool(PStart-2), Stack.GetBool(PStart-3), Stack.GetBool(PStart-4), nil, nil, nil));
  end else if Proc.Name = 'GENERATEUNIQUENAME' then begin