program xe3preloader; {$APPTYPE CONSOLE} {$RTTI EXPLICIT METHODS([]) FIELDS([]) PROPERTIES([])} {$WEAKLINKRTTI ON} uses System.SysUtils, System.IOUtils, Winapi.Windows; const WINTRUST_ACTION_GENERIC_VERIFY_V2: TGUID = '{00AAC56B-CD44-11d0-8CC2-00C04FC295EE}' ; // _WINTRUST_DATA.dwUIChoice WTD_UI_ALL = 1 ; WTD_UI_NONE = 2 ; WTD_UI_NOBAD = 3 ; WTD_UI_NOGOOD = 4 ; // _WINTRUST_DATA.fdwRevocationChecks WTD_REVOKE_NONE = $00000000 ; WTD_REVOKE_WHOLECHAIN = $00000001 ; // _WINTRUST_DATA.dwUnionChoice WTD_CHOICE_FILE = 1 ; WTD_CHOICE_CATALOG = 2 ; WTD_CHOICE_BLOB = 3 ; WTD_CHOICE_SIGNER = 4 ; WTD_CHOICE_CERT = 5 ; // _WINTRUST_DATA.dwStateAction WTD_STATEACTION_IGNORE = $00000000 ; WTD_STATEACTION_VERIFY = $00000001 ; WTD_STATEACTION_CLOSE = $00000002 ; WTD_STATEACTION_AUTO_CACHE = $00000003 ; WTD_STATEACTION_AUTO_CACHE_FLUSH = $00000004 ; WTD_UICONTEXT_EXECUTE = 0 ; WTD_UICONTEXT_INSTALL = 1 ; type WINTRUST_FILE_INFO_ = record cbStruct: DWORD; pcwszFilePath: LPCWSTR; hFile: THandle; pgKnownSubject: PGUID; end {WINTRUST_FILE_INFO_}; TWinTrustFileInfo = WINTRUST_FILE_INFO_ ; PWinTrustFileInfo = ^WINTRUST_FILE_INFO_ ; _WINTRUST_DATA = record cbStruct: DWORD; // = sizeof(WINTRUST_DATA) pPolicyCallbackData: PVOID; // optional: used to pass data between the app and policy pSIPClientData: PVOID; // optional: used to pass data between the app and SIP. dwUIChoice: DWORD; // required: UI choice, one of WTD_UI_xx fdwRevocationChecks: DWORD; // required: certificate revocation check options, one of WTD_REVOKE_xx dwUnionChoice: DWORD; // required: which structure is being passed in, one of WTD_CHOICE_xx Info: record {union part of the original struct } case integer of 0: (pFile: PWinTrustFileInfo); // individual file // 1: (pCatalog: PWinTrustCatalogInfo); // member of a Catalog File // 2: (pBlob: PWinTrustBlobInfo); // memory blob // 3: (pSgnr: PWinTrustSgnrInfo); // signer structure only // 4: (pCert: PWinTrustCertInfo); end ; dwStateAction: DWORD; // optional (Catalog File Processing), WTD_STATEACTION_xx hWVTStateData: THANDLE; // optional (Catalog File Processing) pwszURLReference: LPCWSTR ; // optional: (future) used to determine zone. dwProvFlags: DWORD; // optional: WTD_PROV_FLAGS, etc dwUIContext: DWORD; // optional: used to determine action text in UI. WTD_UICONTEXT_xx end {_WINTRUST_DATA}; TWinTrustData = _WINTRUST_DATA ; PWinTrustData = ^_WINTRUST_DATA ; function DeleteDelimiter( const iStr: String; const iDelimiter: String = '\'): String; var Len: Cardinal; begin Result := iStr; Len := Length(Result); if (Result[Len] = iDelimiter) then Result := Copy(Result, 1, Len - 1); end; procedure RegValueGetPathValue( const iAddress: String; var ioPath, ioValue: String); begin ioPath := DeleteDelimiter(ExtractFilePath(iAddress)); ioValue := ExtractFileName(iAddress); if (ioPath <> '') and (ioPath[1] = '\') then Delete(ioPath, 1, 1); end; function GetRegValueFull( const iReservedKey: DWORD; const iAddress, iPath, iValue: String; const iRegType: DWORD; var ioBuffSize: DWORD; const iBuff: Pointer): Boolean; var hReg: HKEY; RegType: DWORD; begin hReg := 0; RegType := iRegType; RegOpenKeyEx( iReservedKey, PChar(iPath), 0, KEY_QUERY_VALUE, hReg); try Result := ( RegQueryValueEx( hReg, PChar(iValue), nil, @RegType, iBuff, @ioBuffSize ) = ERROR_SUCCESS ); finally RegCloseKey(hReg); end; end; function GetRegStringValue( const iReservedKey: DWORD; const iAddress, iPath, iValue: String): String; var VarSize: DWORD; begin SetLength(Result, $ff); VarSize := Length(Result); if ( GetRegValueFull( iReservedKey, iAddress, iPath, iValue, REG_SZ, VarSize, PChar(Result) ) ) then Result := StrPas(PChar(Result)) else Result := ''; end; function GetRegValue2( const iReservedKey: DWORD; const iAddress: String): String; var Path, Value: String; begin RegValueGetPathValue(iAddress, Path, Value); Result := GetRegStringValue(iReservedKey, iAddress, Path, Value); end; function GetLastErrorMsg: String; begin Result := SysErrorMessage(GetLastError); end; var Path: String; DLLWnd: THandle; trustData: TWinTrustData; fileInfo: TWinTrustFileInfo; begin Writeln(''); Writeln('///// XE3 DLL Preloader /////'); Writeln(''); Path := GetRegValue2(HKEY_CURRENT_USER, '\Software\Embarcadero\BDS\10.0\RootDir'); Writeln('target: ' + Path); Writeln(''); if (DirectoryExists(Path)) then begin Write('Processing'); for Path in TDirectory.GetFiles( Path, '*.dll', TSearchOption.soAllDirectories) do begin try Write('.'); fileInfo.cbStruct := sizeof(TWinTrustFileInfo); fileInfo.hFile := 0; fileInfo.pcwszFilePath := PChar(Path); fileInfo.pgKnownSubject := Nil; trustData.cbStruct := sizeof(TWinTrustData); trustData.pPolicyCallbackData := Nil; trustData.pSIPClientData := Nil; trustData.dwUIChoice := WTD_UI_NONE; trustData.Info.pFile := @fileInfo; trustData.fdwRevocationChecks := WTD_REVOKE_WHOLECHAIN; trustData.dwUnionChoice := WTD_CHOICE_FILE; trustData.dwStateAction := WTD_STATEACTION_IGNORE; trustData.hWVTStateData := 0; trustData.pwszURLReference := Nil; trustData.dwProvFlags := 0; trustData.dwUIContext := WTD_UICONTEXT_EXECUTE; WinVerifyTrust(INVALID_HANDLE_VALUE, WINTRUST_ACTION_GENERIC_VERIFY_V2, @trustData); DLLWnd := LoadLibraryEx(PWideChar(Path), 0, LOAD_LIBRARY_AS_DATAFILE); if (DLLWnd > 0) then FreeLibrary(DLLWnd); except on E: EAccessViolation do begin Writeln(''); Writeln(Path + ': ' + E.Message); end; end; if (GetLastError <> ERROR_SUCCESS) then begin Writeln(''); Writeln(Path + ': ' + GetLastErrorMsg); end; end; end else Writeln('target path not found.'); Writeln('end.'); end.