ISPP.Funcs.pas 60 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102
  1. {
  2. Inno Setup Preprocessor
  3. Copyright (C) 2001-2002 Alex Yackimoff
  4. Inno Setup
  5. Copyright (C) 1997-2024 Jordan Russell
  6. Portions by Martijn Laan
  7. For conditions of distribution and use, see LICENSE.TXT.
  8. }
  9. unit ISPP.Funcs;
  10. interface
  11. uses
  12. Windows, Classes, ISPP.VarUtils, ISPP.Intf, ISPP.Preprocessor, ISPP.Parser;
  13. procedure RegisterFunctions(Preproc: TPreprocessor);
  14. implementation
  15. uses
  16. SysUtils, IniFiles, Registry, Math, ISPP.Consts, ISPP.Base, ISPP.IdentMan,
  17. ISPP.Sessions, DateUtils, Shared.FileClass, MD5, SHA1, SHA256, PathFunc, Shared.CommonFunc,
  18. Shared.Int64Em;
  19. var
  20. IsWin64: Boolean;
  21. function PrependPath(const Ext: Longint; const Filename: String): String;
  22. begin
  23. var Preprocessor := TObject(Ext) as TPreprocessor;
  24. Result := PathExpand(Preprocessor.PrependDirName(Filename,
  25. Preprocessor.SourcePath));
  26. end;
  27. function CheckParams(const Params: IIsppFuncParams;
  28. Types: array of TIsppVarType; Minimum: Byte; var Error: TIsppFuncResult): Boolean;
  29. var
  30. I: Integer;
  31. begin
  32. FillChar(Error, SizeOf(TIsppFuncResult), 0);
  33. Result := False;
  34. if Params.GetCount < Minimum then
  35. begin
  36. Error.ErrParam := Minimum;
  37. Error.Error := ISPPFUNC_INSUFARGS;
  38. Exit;
  39. end
  40. else if Params.GetCount > (High(Types) + 1) then
  41. begin
  42. Error.ErrParam := High(Types) + 1;
  43. Error.Error := ISPPFUNC_MANYARGS;
  44. Exit;
  45. end
  46. else
  47. with IInternalFuncParams(Params) do
  48. for I := 0 to Params.GetCount - 1 do
  49. begin
  50. if (Types[I] = evSpecial) or (Get(I)^.Typ = evNull) then Continue;
  51. if Types[I] <> Get(I)^.Typ then
  52. begin
  53. if Types[I] = evStr then
  54. Error.Error := ISPPFUNC_STRWANTED
  55. else
  56. Error.Error := ISPPFUNC_INTWANTED;
  57. Error.ErrParam := I;
  58. Exit;
  59. end;
  60. end;
  61. Result := True;
  62. end;
  63. function Int(Ext: Longint; const Params: IIsppFuncParams;
  64. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  65. procedure MakeError(E: Exception);
  66. begin
  67. FuncResult.Error(PChar(E.Message));
  68. Result.Error := ISPPFUNC_FAIL;
  69. end;
  70. begin
  71. if CheckParams(Params, [evSpecial, evInt], 1, Result) then
  72. try
  73. with IInternalFuncParams(Params) do
  74. ResPtr^ := ToInt(Get(0)^);
  75. except
  76. on E: EConvertError do
  77. with IInternalFuncParams(Params) do
  78. begin
  79. if GetCount > 1 then
  80. ResPtr^ := Get(1)^
  81. else
  82. MakeError(E);
  83. end;
  84. on E: Exception do
  85. MakeError(E);
  86. end;
  87. end;
  88. function Str(Ext: Longint; const Params: IIsppFuncParams;
  89. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  90. begin
  91. if CheckParams(Params, [evSpecial], 1, Result) then
  92. try
  93. with IInternalFuncParams(Params) do
  94. ResPtr^ := ToStr(Get(0)^);
  95. except
  96. on E: Exception do
  97. begin
  98. FuncResult.Error(PChar(E.Message));
  99. Result.Error := ISPPFUNC_FAIL
  100. end;
  101. end;
  102. end;
  103. {FileExists(<filename>)}
  104. function FileExists(Ext: Longint; const Params: IIsppFuncParams; const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  105. begin
  106. if CheckParams(Params, [evStr], 1, Result) then
  107. try
  108. with IInternalFuncParams(Params) do
  109. MakeBool(ResPtr^, NewFileExists(PrependPath(Ext, Get(0).AsStr)));
  110. except
  111. on E: Exception do
  112. begin
  113. FuncResult.Error(PChar(E.Message));
  114. Result.Error := ISPPFUNC_FAIL
  115. end;
  116. end;
  117. end;
  118. function DirExists(Ext: Longint; const Params: IIsppFuncParams; const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  119. begin
  120. if CheckParams(Params, [evStr], 1, Result) then
  121. try
  122. with IInternalFuncParams(Params) do
  123. MakeBool(ResPtr^, Shared.CommonFunc.DirExists(PrependPath(Ext, Get(0).AsStr)));
  124. except
  125. on E: Exception do
  126. begin
  127. FuncResult.Error(PChar(E.Message));
  128. Result.Error := ISPPFUNC_FAIL
  129. end;
  130. end;
  131. end;
  132. function ForceDirectoriesFunc(Ext: Longint; const Params: IIsppFuncParams; const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  133. begin
  134. if CheckParams(Params, [evStr], 1, Result) then
  135. try
  136. with IInternalFuncParams(Params) do
  137. MakeBool(ResPtr^, ForceDirectories(PrependPath(Ext, Get(0).AsStr)));
  138. except
  139. on E: Exception do
  140. begin
  141. FuncResult.Error(PChar(E.Message));
  142. Result.Error := ISPPFUNC_FAIL
  143. end;
  144. end;
  145. end;
  146. {FileSize(<filename>)}
  147. function FileSize(Ext: Longint; const Params: IIsppFuncParams; const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  148. var
  149. SearchRec: TSearchRec;
  150. begin
  151. if CheckParams(Params, [evStr], 1, Result) then
  152. try
  153. with IInternalFuncParams(Params) do
  154. begin
  155. if FindFirst(PrependPath(Ext, Get(0).AsStr), faAnyFile, SearchRec) = 0 then begin
  156. try
  157. MakeInt(ResPtr^, SearchRec.Size);
  158. finally
  159. FindClose(SearchRec);
  160. end;
  161. end else
  162. MakeInt(ResPtr^, -1);
  163. end
  164. except
  165. on E: Exception do
  166. begin
  167. FuncResult.Error(PChar(E.Message));
  168. Result.Error := ISPPFUNC_FAIL
  169. end;
  170. end;
  171. end;
  172. {ReadIni(<file:str>,<section:str>,<name:str>,[<default:str>])}
  173. function ReadIni(Ext: Longint; const Params: IIsppFuncParams;
  174. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  175. var
  176. Default: string;
  177. begin
  178. if CheckParams(Params, [evStr, evStr, evStr, evStr], 3, Result) then
  179. try
  180. with IInternalFuncParams(Params) do
  181. with TIniFile.Create(Get(0).AsStr) do
  182. try
  183. if GetCount < 4 then Default := '' else Default := Get(3).AsStr;
  184. MakeStr(ResPtr^, ReadString(Get(1).AsStr, Get(2).AsStr, Default));
  185. finally
  186. Free
  187. end;
  188. except
  189. on E: Exception do
  190. begin
  191. FuncResult.Error(PChar(E.Message));
  192. Result.Error := ISPPFUNC_FAIL
  193. end;
  194. end;
  195. end;
  196. function WriteIni(Ext: Longint; const Params: IIsppFuncParams;
  197. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  198. begin
  199. if CheckParams(Params, [evStr, evStr, evStr, evSpecial], 4, Result) then
  200. try
  201. with IInternalFuncParams(Params) do
  202. with TIniFile.Create(Get(0).AsStr) do
  203. try
  204. case Get(3).Typ of
  205. evInt: WriteInteger(Get(1).AsStr, Get(2).AsStr, Get(3).AsInt);
  206. evStr: WriteString(Get(1).AsStr, Get(2).AsStr, Get(3).AsStr);
  207. else
  208. WriteString(Get(1).AsStr, Get(2).AsStr, '');
  209. end;
  210. ResPtr^ := NULL;
  211. finally
  212. Free;
  213. end;
  214. except
  215. on E: Exception do
  216. begin
  217. FuncResult.Error(PChar(E.Message));
  218. Result.Error := ISPPFUNC_FAIL
  219. end;
  220. end;
  221. end;
  222. {ReadReg(<root:int>,<key:str>,[<name:str>,<default:str>])}
  223. function ReadReg(Ext: Longint; const Params: IIsppFuncParams;
  224. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  225. const
  226. ISPPRootKeyFlagMask = $7F000000;
  227. ISPPRootKeyFlag64Bit = $02000000;
  228. ISPPRootKeyValidFlags = ISPPRootKeyFlag64Bit;
  229. procedure CrackISPPRootKey(const ISPPRootKey: Longint; var RegView64: Boolean;
  230. var RootKey: HKEY);
  231. begin
  232. { Allow only predefined key handles (8xxxxxxx). Can't accept handles to
  233. open keys because they might have our special flag bits set.
  234. Also reject unknown flags which may have a meaning in the future. }
  235. if (ISPPRootKey shr 31 <> 1) or
  236. ((ISPPRootKey and ISPPRootKeyFlagMask) and not ISPPRootKeyValidFlags <> 0) then
  237. raise Exception.Create('Invalid root key value');
  238. if ISPPRootKey and ISPPRootKeyFlag64Bit <> 0 then begin
  239. if not IsWin64 then
  240. raise Exception.Create('Cannot access 64-bit registry keys on this version of Windows');
  241. RegView64 := True
  242. end
  243. else
  244. RegView64 := False;
  245. RootKey := ISPPRootKey and not ISPPRootKeyFlagMask;
  246. end;
  247. var
  248. Name: string;
  249. Default: TIsppVariant;
  250. RegView64: Boolean;
  251. ARootKey: HKEY;
  252. AAccess: LongWord;
  253. begin
  254. if CheckParams(Params, [evInt, evStr, evStr, evSpecial], 2, Result) then
  255. try
  256. with IInternalFuncParams(Params) do begin
  257. CrackISPPRootKey(Get(0).AsInt, RegView64, ARootKey);
  258. AAccess := KEY_QUERY_VALUE;
  259. if RegView64 then
  260. AAccess := AAccess or KEY_WOW64_64KEY;
  261. with TRegistry.Create(AAccess) do
  262. try
  263. RootKey := ARootKey;
  264. if GetCount < 3 then Name := '' else Name := Get(2).AsStr;
  265. if GetCount < 4 then Default := NULL else Default := Get(3)^;
  266. if OpenKey(Get(1).AsStr, False) and ((Name = '') or ValueExists(Name)) then
  267. case GetDataType(Name) of
  268. rdString, rdExpandString: MakeStr(ResPtr^, ReadString(Name));
  269. rdInteger: MakeInt(ResPtr^, ReadInteger(Name));
  270. else
  271. CopyExpVar(Default, ResPtr^);
  272. end
  273. else
  274. CopyExpVar(Default, ResPtr^);
  275. finally
  276. Free
  277. end;
  278. end;
  279. except
  280. on E: Exception do
  281. begin
  282. FuncResult.Error(PChar(E.Message));
  283. Result.Error := ISPPFUNC_FAIL
  284. end;
  285. end;
  286. end;
  287. function GetEnvFunc(Ext: Longint; const Params: IIsppFuncParams;
  288. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  289. begin
  290. if CheckParams(Params, [evStr], 1, Result) then
  291. try
  292. with IInternalFuncParams(Params) do
  293. MakeStr(ResPtr^, GetEnv(Get(0).AsStr));
  294. except
  295. on E: Exception do
  296. begin
  297. FuncResult.Error(PChar(E.Message));
  298. Result.Error := ISPPFUNC_FAIL
  299. end;
  300. end;
  301. end;
  302. const
  303. SSetup = '[Setup]';
  304. function SetupSetting(Ext: Longint; const Params: IIsppFuncParams;
  305. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  306. function Find(L: TStrings; const S: string): string;
  307. var
  308. I, J: Integer;
  309. InSetupSection: Boolean;
  310. N: string;
  311. begin
  312. InSetupSection := False;
  313. Result := '';
  314. with L do
  315. for I := 0 to Count - 1 do
  316. begin
  317. if Trim(Strings[I]) = '' then Continue;
  318. if InSetupSection then
  319. begin
  320. if (Trim(Strings[I])[1] = '[') then
  321. begin
  322. if not SameText(Trim(Strings[I]), SSetup) then
  323. InSetupSection := False;
  324. Continue;
  325. end;
  326. J := Pos('=', Strings[I]);
  327. if J > 0 then N := Trim(Copy(Strings[I], 1, J - 1));
  328. if CompareText(N, S) = 0 then
  329. begin
  330. Result := Trim(Copy(Strings[I], J + 1, MaxInt));
  331. Break;
  332. end;
  333. end
  334. else
  335. if SameText(Trim(Strings[I]), SSetup) then
  336. InSetupSection := True;
  337. end;
  338. end;
  339. begin
  340. if CheckParams(Params, [evStr], 1, Result) then
  341. try
  342. with IInternalFuncParams(Params) do
  343. begin
  344. MakeStr(ResPtr^, Find(TPreprocessor(Ext).StringList, Get(0).AsStr));
  345. end;
  346. except
  347. on E: Exception do
  348. begin
  349. FuncResult.Error(PChar(E.Message));
  350. Result.Error := ISPPFUNC_FAIL
  351. end;
  352. end;
  353. end;
  354. {SetSetupSetting(<SetupSectionParameterName>,<ParameterValue>)}
  355. function SetSetupSetting(Ext: Longint; const Params: IIsppFuncParams;
  356. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  357. procedure DoSet(L: TStrings; const S, V: string);
  358. var
  359. I, J, FirstSetupSectionLine: Integer;
  360. InSetupSection: Boolean;
  361. N: string;
  362. begin
  363. FirstSetupSectionLine := -1;
  364. InSetupSection := False;
  365. with L do
  366. begin
  367. for I := 0 to Count - 1 do
  368. begin
  369. if Trim(Strings[I]) = '' then Continue;
  370. if InSetupSection then
  371. begin
  372. if (Trim(Strings[I])[1] = '[') then
  373. begin
  374. if not SameText(Trim(Strings[I]), SSetup) then
  375. InSetupSection := False;
  376. Continue;
  377. end;
  378. J := Pos('=', Strings[I]);
  379. if J > 0 then N := Trim(Copy(Strings[I], 1, J - 1));
  380. if CompareText(N, S) = 0 then
  381. begin
  382. Strings[I] := S + '=' + V;
  383. Exit;
  384. end;
  385. end
  386. else
  387. if SameText(Trim(Strings[I]), SSetup) then
  388. begin
  389. InSetupSection := True;
  390. if FirstSetupSectionLine < 0 then
  391. FirstSetupSectionLine := I;
  392. end;
  393. end;
  394. if FirstSetupSectionLine < 0 then
  395. FirstSetupSectionLine := L.Add(SSetup);
  396. L.Insert(FirstSetupSectionLine + 1, S + '=' + V);
  397. end;
  398. end;
  399. begin
  400. if CheckParams(Params, [evStr, evStr], 2, Result) then
  401. try
  402. with IInternalFuncParams(Params) do
  403. begin
  404. ResPtr^.Typ := evNull;
  405. DoSet(TPreprocessor(Ext).StringList, Get(0).AsStr, Get(1).AsStr);
  406. end;
  407. except
  408. on E: Exception do
  409. begin
  410. FuncResult.Error(PChar(E.Message));
  411. Result.Error := ISPPFUNC_FAIL
  412. end;
  413. end;
  414. end;
  415. {EntryCount(<SectionName>)}
  416. function EntryCountFunc(Ext: Longint; const Params: IIsppFuncParams;
  417. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  418. var
  419. I, J: Integer;
  420. DoCount: Boolean;
  421. N, S: string;
  422. begin
  423. if CheckParams(Params, [evStr], 1, Result) then
  424. try
  425. J := 0;
  426. DoCount := False;
  427. with IInternalFuncParams(Params), TStringList(TPreprocessor(Ext).StringList) do
  428. begin
  429. S := Get(0).AsStr;
  430. for I := 0 to Count - 1 do
  431. begin
  432. N := Trim(Strings[I]);
  433. if (N <> '') and (N[1] <> ';') and (N[1] = '[') then
  434. begin
  435. if DoCount then
  436. DoCount := False
  437. else
  438. if CompareText(Copy(N, 2, Length(N) - 2), S) = 0 then
  439. DoCount := True;
  440. Continue;
  441. end;
  442. if DoCount and (N <> '') and (N[1] <> ';') then Inc(J);
  443. end;
  444. MakeInt(ResPtr^, J);
  445. end;
  446. except
  447. on E: Exception do
  448. begin
  449. FuncResult.Error(PChar(E.Message));
  450. Result.Error := ISPPFUNC_FAIL
  451. end;
  452. end;
  453. end;
  454. {SaveToFile(<Filename>)}
  455. function SaveToFile(Ext: Longint; const Params: IIsppFuncParams;
  456. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  457. begin
  458. if CheckParams(Params, [evStr], 1, Result) then
  459. try
  460. with IInternalFuncParams(Params) do
  461. TPreprocessor(Ext).SaveToFile(PrependPath(Ext, Get(0).AsStr));
  462. except
  463. on E: Exception do
  464. begin
  465. FuncResult.Error(PChar(E.Message));
  466. Result.Error := ISPPFUNC_FAIL
  467. end;
  468. end;
  469. end;
  470. {Find(<what>[,<contains>[,<what>,<contains>[,<what>[,<contains>]]]])}
  471. function FindLine(Ext: Longint; const Params: IIsppFuncParams;
  472. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  473. const
  474. FIND_WHEREMASK = $01 or $02;
  475. FIND_SENSITIVE = $04;
  476. FIND_OR = $08;
  477. FIND_NOT = $10;
  478. FIND_TRIM = $20;
  479. type
  480. TFindWhere = (fwMatch, fwBegin, fwEnd, fwContains);
  481. var
  482. I: Integer;
  483. StartFromLine: Integer;
  484. Found, MoreFound, Second, Third: Boolean;
  485. Flags: array[0..2] of Integer;
  486. Strs: array[0..2] of string;
  487. Str: string;
  488. function Compare(const S1, S2: string; Sensitive: Boolean): Boolean;
  489. begin
  490. if Sensitive then
  491. Result := AnsiCompareStr(S1, S2) = 0
  492. else
  493. Result := AnsiCompareText(S1, S2) = 0;
  494. end;
  495. function Contains(const Substr: string; Sensitive: Boolean): Boolean;
  496. var
  497. L, I: Integer;
  498. begin
  499. Result := True;
  500. L := Length(Substr);
  501. for I := 1 to Length(Str) - L + 1 do
  502. if Compare(Substr, Copy(Str, I, L), Sensitive) then Exit;
  503. Result := False;
  504. end;
  505. function Meets(const Substr: string; Sensitive: Boolean; Where: Byte): Boolean;
  506. begin
  507. Result := False;
  508. case Where of
  509. 1: if Length(Substr) <= Length(Str) then
  510. Result := Compare(Substr, Copy(Str, 1, Length(Substr)), Sensitive);
  511. 2: if Length(Substr) <= Length(Str) then
  512. Result := Compare(Substr, Copy(Str, Length(Str) - Length(Substr) + 1, Length(Substr)), Sensitive);
  513. 3: if Length(Substr) <= Length(Str) then
  514. Result := Contains(Substr, Sensitive);
  515. else Result := Compare(Substr, Str, Sensitive);
  516. end;
  517. end;
  518. begin
  519. if CheckParams(Params, [evInt, evStr, evInt, evStr, evInt, evStr, evInt], 2, Result) then
  520. try
  521. with IInternalFuncParams(Params) do
  522. begin
  523. FillChar(Flags, SizeOf(Flags), 0);
  524. Strs[0] := Get(1).AsStr;
  525. Second := False;
  526. Third := False;
  527. if GetCount > 2 then
  528. begin
  529. Flags[0] := Get(2).AsInt;
  530. if GetCount > 3 then
  531. begin
  532. Strs[1] := Get(3).AsStr;
  533. Second := True;
  534. if GetCount > 4 then
  535. begin
  536. Flags[1] := Get(4).AsInt;
  537. if GetCount > 5 then
  538. begin
  539. Strs[2] := Get(5).AsStr;
  540. Third := True;
  541. if GetCount > 6 then Flags[2] := Get(6).AsInt;
  542. end
  543. end;
  544. end
  545. end;
  546. StartFromLine := Get(0).AsInt;
  547. if StartFromLine < 0 then StartFromLine := 0;
  548. with TStringList(TPreprocessor(Ext).StringList) do
  549. for I := StartFromLine to Count - 1 do
  550. begin
  551. Str := Strings[I];
  552. if Flags[0] and FIND_TRIM <> 0 then
  553. Str := Trim(Str);
  554. Found := Meets(Strs[0], Flags[0] and FIND_SENSITIVE <> 0,
  555. Flags[0] and FIND_WHEREMASK) xor (Flags[0] and FIND_NOT <> 0);
  556. if Second and (((Flags[1] and FIND_OR <> 0{OR}) and not Found) or
  557. ((Flags[1] and FIND_OR = 0{AND}) and Found)) then
  558. begin
  559. MoreFound := Meets(Strs[1], Flags[1] and FIND_SENSITIVE <> 0,
  560. Flags[1] and FIND_WHEREMASK) xor (Flags[1] and FIND_NOT <> 0);
  561. if Flags[1] and FIND_OR <> 0 then
  562. Found := Found or MoreFound
  563. else
  564. Found := Found and MoreFound;
  565. end;
  566. if Third and (((Flags[2] and FIND_OR <> 0{OR}) and not Found) or
  567. ((Flags[2] and FIND_OR = 0{AND}) and Found)) then
  568. begin
  569. MoreFound := Meets(Strs[2], Flags[2] and FIND_SENSITIVE <> 0,
  570. Flags[2] and FIND_WHEREMASK) xor (Flags[2] and FIND_NOT <> 0);
  571. if Flags[2] and FIND_OR <> 0 then
  572. Found := Found or MoreFound
  573. else
  574. Found := Found and MoreFound;
  575. end;
  576. if Found then
  577. begin
  578. MakeInt(ResPtr^, I);
  579. Exit;
  580. end;
  581. end;
  582. MakeInt(ResPtr^, -2);
  583. end;
  584. except
  585. on E: Exception do
  586. begin
  587. FuncResult.Error(PChar(E.Message));
  588. Result.Error := ISPPFUNC_FAIL
  589. end;
  590. end;
  591. end;
  592. function Exec(const Filename, Params: String; WorkingDir: String;
  593. const WaitUntilTerminated: Boolean; const ShowCmd: Integer;
  594. const Preprocessor: TPreprocessor; const OutputReader: TCreateProcessOutputReader;
  595. var ResultCode: Integer): Boolean;
  596. var
  597. CmdLine: String;
  598. WorkingDirP: PChar;
  599. StartupInfo: TStartupInfo;
  600. ProcessInfo: TProcessInformation;
  601. begin
  602. {This function is a combination of InstFuncs' InstExec and Compile's InternalSignCommand }
  603. if Filename = '>' then
  604. CmdLine := Params
  605. else begin
  606. if (Filename = '') or (Filename[1] <> '"') then
  607. CmdLine := '"' + Filename + '"'
  608. else
  609. CmdLine := Filename;
  610. if Params <> '' then
  611. CmdLine := CmdLine + ' ' + Params;
  612. if SameText(PathExtractExt(Filename), '.bat') or
  613. SameText(PathExtractExt(Filename), '.cmd') then begin
  614. { See InstExec for explanation }
  615. CmdLine := '"' + AddBackslash(GetSystemDir) + 'cmd.exe" /C "' + CmdLine + '"'
  616. end;
  617. if WorkingDir = '' then
  618. WorkingDir := PathExtractDir(Filename);
  619. end;
  620. FillChar (StartupInfo, SizeOf(StartupInfo), 0);
  621. StartupInfo.cb := SizeOf(StartupInfo);
  622. StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  623. StartupInfo.wShowWindow := ShowCmd;
  624. if WorkingDir <> '' then
  625. WorkingDirP := PChar(WorkingDir)
  626. else
  627. WorkingDirP := nil;
  628. var InheritHandles := False;
  629. var dwCreationFlags: DWORD := CREATE_DEFAULT_ERROR_MODE;
  630. if (OutputReader <> nil) and WaitUntilTerminated then begin
  631. OutputReader.UpdateStartupInfo(StartupInfo);
  632. InheritHandles := True;
  633. dwCreationFlags := dwCreationFlags or CREATE_NO_WINDOW;
  634. end;
  635. Result := CreateProcess(nil, PChar(CmdLine), nil, nil, InheritHandles,
  636. dwCreationFlags, nil, WorkingDirP, StartupInfo, ProcessInfo);
  637. if not Result then begin
  638. ResultCode := GetLastError;
  639. Exit;
  640. end;
  641. { Don't need the thread handle, so close it now }
  642. CloseHandle(ProcessInfo.hThread);
  643. if OutputReader <> nil then
  644. OutputReader.NotifyCreateProcessDone;
  645. try
  646. if WaitUntilTerminated then begin
  647. while True do begin
  648. case WaitForSingleObject(ProcessInfo.hProcess, 50) of
  649. WAIT_OBJECT_0: Break;
  650. WAIT_TIMEOUT:
  651. begin
  652. if OutputReader <> nil then
  653. OutputReader.Read(False);
  654. Preprocessor.CallIdleProc; { Doesn't allow an Abort }
  655. end;
  656. else
  657. Preprocessor.RaiseError('Exec: WaitForSingleObject failed');
  658. end;
  659. end;
  660. if OutputReader <> nil then
  661. OutputReader.Read(True);
  662. end;
  663. { Get the exit code. Will be set to STILL_ACTIVE if not yet available }
  664. if not GetExitCodeProcess(ProcessInfo.hProcess, DWORD(ResultCode)) then
  665. ResultCode := -1; { just in case }
  666. finally
  667. CloseHandle(ProcessInfo.hProcess);
  668. end;
  669. end;
  670. procedure ExecLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);
  671. begin
  672. var Preprocessor := TPreprocessor(Data);
  673. if Error then
  674. Preprocessor.WarningMsg(S)
  675. else
  676. Preprocessor.StatusMsg('Exec output: %s', [S]);
  677. end;
  678. {
  679. int Exec(str FileName, str Params, str WorkingDir, int Wait, int ShowCmd, int Log)
  680. }
  681. function ExecFunc(Ext: Longint; const Params: IIsppFuncParams;
  682. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  683. begin
  684. if CheckParams(Params, [evStr, evStr, evStr, evInt, evInt, evInt], 1, Result) then
  685. try
  686. with IInternalFuncParams(Params) do
  687. begin
  688. var ParamsS, WorkingDir: String;
  689. var WaitUntilTerminated := True;
  690. var ShowCmd := SW_SHOWNORMAL;
  691. if GetCount > 1 then ParamsS := Get(1).AsStr;
  692. if GetCount > 2 then WorkingDir := PrependPath(Ext, Get(2).AsStr);
  693. if (GetCount > 3) and (Get(3).Typ <> evNull) then WaitUntilTerminated := Get(3).AsInt <> 0;
  694. if (GetCount > 4) and (Get(4).Typ <> evNull) then ShowCmd := Get(4).AsInt;
  695. var Preprocessor := TPreprocessor(Ext);
  696. var ResultCode: Integer;
  697. var OutputReader := TCreateProcessOutputReader.Create(ExecLog, NativeInt(Preprocessor));
  698. try
  699. var Success := Exec(Get(0).AsStr, ParamsS, WorkingDir, WaitUntilTerminated,
  700. ShowCmd, Preprocessor, OutputReader, ResultCode);
  701. if not WaitUntilTerminated then
  702. MakeBool(ResPtr^, Success)
  703. else
  704. MakeInt(ResPtr^, ResultCode);
  705. finally
  706. OutputReader.Free;
  707. end;
  708. end;
  709. except
  710. on E: Exception do
  711. begin
  712. FuncResult.Error(PChar(E.Message));
  713. Result.Error := ISPPFUNC_FAIL
  714. end;
  715. end;
  716. end;
  717. type
  718. PExecAndGetFirstLineLogData = ^TExecAndGetFirstLineLogData;
  719. TExecAndGetFirstLineLogData = record
  720. Preprocessor: TPreprocessor;
  721. Line: String;
  722. end;
  723. procedure ExecAndGetFirstLineLog(const S: String; const Error, FirstLine: Boolean; const Data: NativeInt);
  724. begin
  725. var Data2 := PExecAndGetFirstLineLogData(Data);
  726. if not Error and (Data2.Line = '') and (S.Trim <> '') then
  727. Data2.Line := S;
  728. ExecLog(S, Error, FirstLine, NativeInt(Data2.Preprocessor));
  729. end;
  730. {
  731. str ExecAndGetFirstLine(str FileName, str Params, str WorkingDir,)
  732. }
  733. function ExecAndGetFirstLineFunc(Ext: Longint; const Params: IIsppFuncParams;
  734. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  735. begin
  736. if CheckParams(Params, [evStr, evStr, evStr], 1, Result) then
  737. try
  738. with IInternalFuncParams(Params) do
  739. begin
  740. var ParamsS, WorkingDir: String;
  741. if GetCount > 1 then ParamsS := Get(1).AsStr;
  742. if GetCount > 2 then WorkingDir := PrependPath(Ext, Get(2).AsStr);
  743. var Data: TExecAndGetFirstLineLogData;
  744. Data.Preprocessor := TPreprocessor(Ext);
  745. Data.Line := '';
  746. var ResultCode: Integer;
  747. var OutputReader := TCreateProcessOutputReader.Create(ExecAndGetFirstLineLog, NativeInt(@Data));
  748. try
  749. var Success := Exec(Get(0).AsStr, ParamsS, WorkingDir, True,
  750. SW_SHOWNORMAL, Data.Preprocessor, OutputReader, ResultCode);
  751. if Success then
  752. MakeStr(ResPtr^, Data.Line)
  753. else begin
  754. Data.Preprocessor.WarningMsg('CreateProcess failed (%d).', [ResultCode]);
  755. ResPtr^.Typ := evNull;
  756. end;
  757. finally
  758. OutputReader.Free;
  759. end;
  760. end;
  761. except
  762. on E: Exception do
  763. begin
  764. FuncResult.Error(PChar(E.Message));
  765. Result.Error := ISPPFUNC_FAIL
  766. end;
  767. end;
  768. end;
  769. function LenFunc(Ext: Longint; const Params: IIsppFuncParams;
  770. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  771. begin
  772. if CheckParams(Params, [evStr], 1, Result) then
  773. try
  774. with IInternalFuncParams(Params) do
  775. MakeInt(ResPtr^, Length(Get(0).AsStr));
  776. except
  777. on E: Exception do
  778. begin
  779. FuncResult.Error(PChar(E.Message));
  780. Result.Error := ISPPFUNC_FAIL
  781. end;
  782. end;
  783. end;
  784. function CopyFunc(Ext: Longint; const Params: IIsppFuncParams;
  785. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  786. var
  787. S: string;
  788. B, C: Int64;
  789. begin
  790. if CheckParams(Params, [evStr, evInt, evInt], 2, Result) then
  791. try
  792. with IInternalFuncParams(Params) do
  793. begin
  794. S := Get(0).AsStr;
  795. B := Get(1).AsInt;
  796. if GetCount > 2 then C := Get(2).AsInt else C := MaxInt;
  797. { Constrain 64-bit arguments to 32 bits without truncating them }
  798. if B < 1 then
  799. B := 1;
  800. if C > Maxint then
  801. C := Maxint;
  802. if (B > Maxint) or (C < 0) then begin
  803. { Result should be empty in these cases }
  804. B := 1;
  805. C := 0;
  806. end;
  807. MakeStr(ResPtr^, Copy(S, Integer(B), Integer(C)));
  808. end;
  809. except
  810. on E: Exception do
  811. begin
  812. FuncResult.Error(PChar(E.Message));
  813. Result.Error := ISPPFUNC_FAIL
  814. end;
  815. end;
  816. end;
  817. function PosFunc(Ext: Longint; const Params: IIsppFuncParams;
  818. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  819. begin
  820. if CheckParams(Params, [evStr, evStr], 2, Result) then
  821. try
  822. with IInternalFuncParams(Params) do
  823. begin
  824. MakeInt(ResPtr^, Pos(Get(0).AsStr, Get(1).AsStr));
  825. end;
  826. except
  827. on E: Exception do
  828. begin
  829. FuncResult.Error(PChar(E.Message));
  830. Result.Error := ISPPFUNC_FAIL
  831. end;
  832. end;
  833. end;
  834. function LowerCaseFunc(Ext: Longint; const Params: IIsppFuncParams;
  835. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  836. begin
  837. if CheckParams(Params, [evStr], 1, Result) then
  838. try
  839. with IInternalFuncParams(Params) do
  840. MakeStr(ResPtr^, LowerCase(Get(0).AsStr));
  841. except
  842. on E: Exception do
  843. begin
  844. FuncResult.Error(PChar(E.Message));
  845. Result.Error := ISPPFUNC_FAIL
  846. end;
  847. end;
  848. end;
  849. function UpperCaseFunc(Ext: Longint; const Params: IIsppFuncParams;
  850. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  851. begin
  852. if CheckParams(Params, [evStr], 1, Result) then
  853. try
  854. with IInternalFuncParams(Params) do
  855. MakeStr(ResPtr^, UpperCase(Get(0).AsStr));
  856. except
  857. on E: Exception do
  858. begin
  859. FuncResult.Error(PChar(E.Message));
  860. Result.Error := ISPPFUNC_FAIL
  861. end;
  862. end;
  863. end;
  864. function RPosFunc(Ext: Longint; const Params: IIsppFuncParams;
  865. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  866. function RPos(const Substr, S: string): Integer;
  867. begin
  868. for Result := Length(S) - Length(Substr) + 1 downto 1 do
  869. if Copy(S, Result, Length(Substr)) = Substr then
  870. Exit;
  871. Result := 0;
  872. end;
  873. begin
  874. if CheckParams(Params, [evStr, evStr], 2, Result) then
  875. try
  876. with IInternalFuncParams(Params) do
  877. begin
  878. MakeInt(ResPtr^, RPos(Get(0).AsStr, Get(1).AsStr));
  879. end;
  880. except
  881. on E: Exception do
  882. begin
  883. FuncResult.Error(PChar(E.Message));
  884. Result.Error := ISPPFUNC_FAIL
  885. end;
  886. end;
  887. end;
  888. function GetVersionNumbersStringFunc(Ext: Longint; const Params: IIsppFuncParams;
  889. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  890. var
  891. Filename: string;
  892. VersionHandle: Cardinal;
  893. SIZE: Cardinal;
  894. S: UINT;
  895. Buf: Pointer;
  896. FI: PVSFixedFileInfo;
  897. begin
  898. if CheckParams(Params, [evStr], 1, Result) then
  899. try
  900. with IInternalFuncParams(Params) do
  901. begin
  902. ResPtr^.Typ := evNull;
  903. Filename := PrependPath(Ext, Get(0).AsStr);
  904. Size := GetFileVersionInfoSize(PChar(Filename), VersionHandle);
  905. if Size > 0 then
  906. begin
  907. GetMem(Buf, Size);
  908. try
  909. GetFileVersionInfo(PChar(Filename), VersionHandle, Size, Buf);
  910. if VerQueryValue(Buf, '\', Pointer(FI), S) then
  911. begin
  912. MakeStr(ResPtr^,
  913. IntToStr((FI.dwFileVersionMS and $FFFF0000) shr 16) + '.' +
  914. IntToStr(FI.dwFileVersionMS and $FFFF) + '.' +
  915. IntToStr((FI.dwFileVersionLS and $FFFF0000) shr 16) + '.' +
  916. IntToStr(FI.dwFileVersionLS and $FFFF)
  917. );
  918. end;
  919. finally
  920. FreeMem(Buf)
  921. end;
  922. end
  923. end;
  924. except
  925. on E: Exception do
  926. begin
  927. FuncResult.Error(PChar(E.Message));
  928. Result.Error := ISPPFUNC_FAIL
  929. end;
  930. end;
  931. end;
  932. function ComparePackedVersionFunc(Ext: Longint; const Params: IIsppFuncParams;
  933. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  934. begin
  935. if CheckParams(Params, [evInt, evInt], 2, Result) then
  936. try
  937. with IInternalFuncParams(Params) do
  938. MakeInt(ResPtr^, Compare64(Integer64(Get(0).AsInt), Integer64(Get(1).AsInt)));
  939. except
  940. on E: Exception do
  941. begin
  942. FuncResult.Error(PChar(E.Message));
  943. Result.Error := ISPPFUNC_FAIL
  944. end;
  945. end;
  946. end;
  947. function SamePackedVersionFunc(Ext: Longint; const Params: IIsppFuncParams;
  948. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  949. begin
  950. if CheckParams(Params, [evInt, evInt], 2, Result) then
  951. try
  952. with IInternalFuncParams(Params) do
  953. if Compare64(Integer64(Get(0).AsInt), Integer64(Get(1).AsInt)) = 0 then
  954. MakeInt(ResPtr^, 1)
  955. else
  956. MakeInt(ResPtr^, 0)
  957. except
  958. on E: Exception do
  959. begin
  960. FuncResult.Error(PChar(E.Message));
  961. Result.Error := ISPPFUNC_FAIL
  962. end;
  963. end;
  964. end;
  965. {str GetStringFileInfo(str FileName, str StringName, int Lang)}
  966. function GetFileVersionInfoItem(Ext: Longint; const Params: IIsppFuncParams;
  967. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  968. var
  969. Buf: Pointer;
  970. function GetStringFileInfo(Lang: UINT; const Name: string; var Value: string): Boolean;
  971. var
  972. InfoBuf: Pointer;
  973. InfoBufSize: Longword;
  974. begin
  975. Result := VerQueryValue(Buf, PChar('\StringFileInfo\' + IntToHex(LoWord(Lang), 4) +
  976. IntToHex(HiWord(Lang), 4) +
  977. '\' + Name), InfoBuf, InfoBufSize) and (InfoBufSize > 0);
  978. if Result then SetString(Value, PChar(InfoBuf), InfoBufSize - 1)
  979. end;
  980. type
  981. TUINTArray = array[0..$100] of UINT;
  982. PUINTArray = ^TUINTArray;
  983. var
  984. Filename: string;
  985. VersionHandle: Cardinal;
  986. Size: Integer;
  987. Langs: PUINTArray;
  988. LangCount, I: Integer;
  989. Lang, LangsSize: UINT;
  990. Value: string;
  991. Success: Boolean;
  992. begin
  993. if CheckParams(Params, [evStr, evStr, evInt], 2, Result) then
  994. try
  995. with IInternalFuncParams(Params) do
  996. begin
  997. Success := False;
  998. ResPtr^.Typ := evNull;
  999. Filename := PrependPath(Ext, Get(0).AsStr);
  1000. Size := GetFileVersionInfoSize(PChar(Filename), VersionHandle);
  1001. if Size > 0 then
  1002. begin
  1003. GetMem(Buf, Size);
  1004. try
  1005. GetFileVersionInfo(PChar(Filename), VersionHandle, Size, Buf);
  1006. if GetCount > 2 then
  1007. begin
  1008. Lang := Get(2).AsInt;
  1009. Success := GetStringFileInfo(Lang, Get(1).AsStr, Value);
  1010. end
  1011. else
  1012. begin
  1013. if VerQueryValue(Buf, PChar('\VarFileInfo\Translation'), Pointer(Langs),
  1014. LangsSize) then
  1015. begin
  1016. LangCount := LangsSize div 4;
  1017. for I := 0 to LangCount - 1 do
  1018. begin
  1019. Success := GetStringFileInfo(Langs[I], Get(1).AsStr, Value);
  1020. if Success then Break;
  1021. end;
  1022. end;
  1023. end;
  1024. if Success then
  1025. MakeStr(ResPtr^, Value);
  1026. finally
  1027. FreeMem(Buf)
  1028. end;
  1029. end;
  1030. end;
  1031. except
  1032. on E: Exception do
  1033. begin
  1034. FuncResult.Error(PChar(E.Message));
  1035. Result.Error := ISPPFUNC_FAIL
  1036. end;
  1037. end;
  1038. end;
  1039. function DelFileFunc(Ext: Longint; const Params: IIsppFuncParams;
  1040. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1041. begin
  1042. if CheckParams(Params, [evStr], 1, Result) then
  1043. try
  1044. with IInternalFuncParams(Params) do
  1045. begin
  1046. QueueFileForDeletion(PrependPath(Ext, Get(0).AsStr));
  1047. ResPtr^.Typ := evNull;
  1048. end;
  1049. except
  1050. on E: Exception do
  1051. begin
  1052. FuncResult.Error(PChar(E.Message));
  1053. Result.Error := ISPPFUNC_FAIL
  1054. end;
  1055. end;
  1056. end;
  1057. function DelFileNowFunc(Ext: Longint; const Params: IIsppFuncParams;
  1058. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1059. begin
  1060. if CheckParams(Params, [evStr], 1, Result) then
  1061. try
  1062. with IInternalFuncParams(Params) do
  1063. begin
  1064. DeleteFile(PChar(PrependPath(Ext, Get(0).AsStr)));
  1065. ResPtr^.Typ := evNull;
  1066. end;
  1067. except
  1068. on E: Exception do
  1069. begin
  1070. FuncResult.Error(PChar(E.Message));
  1071. Result.Error := ISPPFUNC_FAIL
  1072. end;
  1073. end;
  1074. end;
  1075. function CopyFileFunc(Ext: Longint; const Params: IIsppFuncParams;
  1076. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1077. begin
  1078. if CheckParams(Params, [evStr, evStr], 2, Result) then
  1079. try
  1080. with IInternalFuncParams(Params) do
  1081. begin
  1082. CopyFile(PChar(PrependPath(Ext, Get(0).AsStr)), PChar(PrependPath(Ext, Get(1).AsStr)), False);
  1083. ResPtr^.Typ := evNull;
  1084. end;
  1085. except
  1086. on E: Exception do
  1087. begin
  1088. FuncResult.Error(PChar(E.Message));
  1089. Result.Error := ISPPFUNC_FAIL
  1090. end;
  1091. end;
  1092. end;
  1093. type
  1094. PSearchRec = ^TSearchRec;
  1095. procedure GarbageCloseFind(Item: Pointer);
  1096. begin
  1097. FindClose(PSearchRec(Item)^);
  1098. Dispose(Item);
  1099. end;
  1100. function FindFirstFunc(Ext: Longint; const Params: IIsppFuncParams;
  1101. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1102. var
  1103. Filename: string;
  1104. F: PSearchRec;
  1105. begin
  1106. if CheckParams(Params, [evStr, evInt], 2, Result) then
  1107. try
  1108. with IInternalFuncParams(Params) do
  1109. begin
  1110. Filename := PrependPath(Ext, Get(0).AsStr);
  1111. New(F);
  1112. ResPtr^.Typ := evInt;
  1113. if FindFirst(Filename, Get(1).AsInt, F^) = 0 then
  1114. begin
  1115. ResPtr^.AsInt := Integer(F);
  1116. TPreprocessor(Ext).CollectGarbage(F, @GarbageCloseFind);
  1117. end
  1118. else
  1119. begin
  1120. ResPtr^.AsInt := 0;
  1121. Dispose(F);
  1122. end;
  1123. end;
  1124. except
  1125. on E: Exception do
  1126. begin
  1127. FuncResult.Error(PChar(E.Message));
  1128. Result.Error := ISPPFUNC_FAIL
  1129. end;
  1130. end;
  1131. end;
  1132. function FindNextFunc(Ext: Longint; const Params: IIsppFuncParams;
  1133. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1134. begin
  1135. if CheckParams(Params, [evInt], 1, Result) then
  1136. try
  1137. with IInternalFuncParams(Params) do
  1138. begin
  1139. ResPtr.Typ := evInt;
  1140. if FindNext(PSearchRec(Get(0).AsInt)^) = 0 then
  1141. ResPtr^.AsInt := 1
  1142. else
  1143. ResPtr^.AsInt := 0;
  1144. end;
  1145. except
  1146. on E: Exception do
  1147. begin
  1148. FuncResult.Error(PChar(E.Message));
  1149. Result.Error := ISPPFUNC_FAIL
  1150. end;
  1151. end;
  1152. end;
  1153. function FindGetFileName(Ext: Longint; const Params: IIsppFuncParams;
  1154. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1155. begin
  1156. if CheckParams(Params, [evInt], 1, Result) then
  1157. try
  1158. with IInternalFuncParams(Params) do
  1159. begin
  1160. MakeStr(ResPtr^, PSearchRec(Get(0).AsInt)^.Name);
  1161. end;
  1162. except
  1163. on E: Exception do
  1164. begin
  1165. FuncResult.Error(PChar(E.Message));
  1166. Result.Error := ISPPFUNC_FAIL
  1167. end;
  1168. end;
  1169. end;
  1170. function FindCloseFunc(Ext: Longint; const Params: IIsppFuncParams;
  1171. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1172. begin
  1173. if CheckParams(Params, [evInt], 1, Result) then
  1174. try
  1175. with IInternalFuncParams(Params) do
  1176. begin
  1177. FindClose(PSearchRec(Get(0).AsInt)^);
  1178. Dispose(PSearchRec(Get(0).AsInt));
  1179. TPreprocessor(Ext).UncollectGarbage(Pointer(Get(0).AsInt));
  1180. end;
  1181. except
  1182. on E: Exception do
  1183. begin
  1184. FuncResult.Error(PChar(E.Message));
  1185. Result.Error := ISPPFUNC_FAIL
  1186. end;
  1187. end;
  1188. end;
  1189. procedure GarbageCloseFile(Item: Pointer);
  1190. var
  1191. F: ^TextFile;
  1192. begin
  1193. F := Item;
  1194. Close(F^);
  1195. Dispose(F);
  1196. end;
  1197. function FileOpenFunc(Ext: Longint; const Params: IIsppFuncParams;
  1198. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1199. var
  1200. F: ^TextFile;
  1201. begin
  1202. if CheckParams(Params, [evStr], 1, Result) then
  1203. try
  1204. New(F);
  1205. try
  1206. with IInternalFuncParams(Params) do
  1207. begin
  1208. FileMode := fmOpenRead or fmShareDenyWrite;
  1209. AssignFile(F^, PrependPath(Ext, Get(0).AsStr));
  1210. {$I-}
  1211. Reset(F^);
  1212. {$I+}
  1213. if IOResult <> 0 then
  1214. begin
  1215. Dispose(F);
  1216. MakeInt(ResPtr^, 0)
  1217. end
  1218. else
  1219. begin
  1220. MakeInt(ResPtr^, Integer(F));
  1221. TPreprocessor(Ext).CollectGarbage(F, @GarbageCloseFile);
  1222. end;
  1223. end;
  1224. except
  1225. Dispose(F);
  1226. raise
  1227. end;
  1228. except
  1229. on E: Exception do
  1230. begin
  1231. FuncResult.Error(PChar(E.Message));
  1232. Result.Error := ISPPFUNC_FAIL
  1233. end;
  1234. end;
  1235. end;
  1236. function FileReadFunc(Ext: Longint; const Params: IIsppFuncParams;
  1237. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1238. var
  1239. F: ^TextFile;
  1240. S: string;
  1241. begin
  1242. if CheckParams(Params, [evInt], 1, Result) then
  1243. try
  1244. with IInternalFuncParams(Params) do
  1245. begin
  1246. Integer(F) := Get(0).AsInt;
  1247. if Integer(F) = 0 then
  1248. raise Exception.Create('Invalid file handle');
  1249. {$I-}
  1250. Readln(F^, S);
  1251. {$I+}
  1252. if IOResult <> 0 then
  1253. ResPtr^ := NULL
  1254. else
  1255. MakeStr(ResPtr^, S);
  1256. end;
  1257. except
  1258. on E: Exception do
  1259. begin
  1260. FuncResult.Error(PChar(E.Message));
  1261. Result.Error := ISPPFUNC_FAIL
  1262. end;
  1263. end;
  1264. end;
  1265. function FileResetFunc(Ext: Longint; const Params: IIsppFuncParams;
  1266. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1267. var
  1268. F: ^TextFile;
  1269. begin
  1270. if CheckParams(Params, [evInt], 1, Result) then
  1271. try
  1272. with IInternalFuncParams(Params) do
  1273. begin
  1274. Integer(F) := Get(0).AsInt;
  1275. if Integer(F) = 0 then
  1276. raise Exception.Create('Invalid file handle');
  1277. {$I-}
  1278. Reset(F^);
  1279. {$I+}
  1280. if IOResult <> 0 then
  1281. raise Exception.Create('Failed to reset a file')
  1282. else
  1283. ResPtr^ := NULL
  1284. end;
  1285. except
  1286. on E: Exception do
  1287. begin
  1288. FuncResult.Error(PChar(E.Message));
  1289. Result.Error := ISPPFUNC_FAIL
  1290. end;
  1291. end;
  1292. end;
  1293. function FileEofFunc(Ext: Longint; const Params: IIsppFuncParams;
  1294. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1295. var
  1296. F: ^TextFile;
  1297. IsEof: Boolean;
  1298. begin
  1299. if CheckParams(Params, [evInt], 1, Result) then
  1300. try
  1301. with IInternalFuncParams(Params) do
  1302. begin
  1303. Integer(F) := Get(0).AsInt;
  1304. if Integer(F) = 0 then
  1305. raise Exception.Create('Invalid file handle');
  1306. {$I-}
  1307. IsEof := Eof(F^);
  1308. {$I+}
  1309. if IOResult <> 0 then
  1310. ResPtr^ := NULL
  1311. else
  1312. MakeBool(ResPtr^, IsEof);
  1313. end;
  1314. except
  1315. on E: Exception do
  1316. begin
  1317. FuncResult.Error(PChar(E.Message));
  1318. Result.Error := ISPPFUNC_FAIL
  1319. end;
  1320. end;
  1321. end;
  1322. function FileCloseFunc(Ext: Longint; const Params: IIsppFuncParams;
  1323. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1324. var
  1325. F: ^TextFile;
  1326. begin
  1327. if CheckParams(Params, [evInt], 1, Result) then
  1328. try
  1329. with IInternalFuncParams(Params) do
  1330. begin
  1331. Integer(F) := Get(0).AsInt;
  1332. if Integer(F) = 0 then
  1333. raise Exception.Create('Invalid file handle');
  1334. {$I-}
  1335. Close(F^);
  1336. {$I+}
  1337. ResPtr^ := NULL;
  1338. Dispose(F);
  1339. TPreprocessor(Ext).UncollectGarbage(Pointer(F));
  1340. end;
  1341. except
  1342. on E: Exception do
  1343. begin
  1344. FuncResult.Error(PChar(E.Message));
  1345. Result.Error := ISPPFUNC_FAIL
  1346. end;
  1347. end;
  1348. end;
  1349. function SaveStringToFileFunc(Ext: Longint; const Params: IIsppFuncParams;
  1350. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1351. var
  1352. Filename: String;
  1353. F: TextFile;
  1354. DoAppend: Boolean;
  1355. CodePage: Word;
  1356. begin
  1357. if CheckParams(Params, [evStr, evStr, evInt, evInt], 2, Result) then
  1358. try
  1359. with IInternalFuncParams(Params) do
  1360. begin
  1361. Filename := PrependPath(Ext, Get(0).AsStr);
  1362. if (GetCount < 3) or (Get(2).AsInt <> 0) then DoAppend := True else DoAppend := False;
  1363. if (GetCount < 4) or (Get(3).AsInt <> 0) then CodePage := CP_UTF8 else CodePage := 0;
  1364. DoAppend := DoAppend and NewFileExists(Filename);
  1365. AssignFile(F, FileName, CodePage);
  1366. {$I-}
  1367. if DoAppend then
  1368. Append(F)
  1369. else
  1370. Rewrite(F);
  1371. {$I+}
  1372. if IOResult <> 0 then
  1373. MakeInt(ResPtr^, 0)
  1374. else begin
  1375. try
  1376. MakeInt(ResPtr^, 1);
  1377. if not DoAppend and (CodePage = CP_UTF8) then
  1378. Write(F, #$FEFF); //Strings are UTF-16 so this UTF-16 BOM will actually be saved as an UTF-8 BOM
  1379. Write(F, Get(1).AsStr);
  1380. finally
  1381. CloseFile(F);
  1382. end;
  1383. end;
  1384. end;
  1385. except
  1386. on E: Exception do
  1387. begin
  1388. FuncResult.Error(PChar(E.Message));
  1389. Result.Error := ISPPFUNC_FAIL
  1390. end;
  1391. end;
  1392. end;
  1393. type
  1394. PDateTime = ^TDateTime;
  1395. procedure GarbageReleaseDateTime(Item: Pointer);
  1396. begin
  1397. Dispose(Item);
  1398. end;
  1399. function FileGetDate(Ext: Longint; const Params: IIsppFuncParams;
  1400. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1401. var
  1402. FileDate: PDateTime;
  1403. Age: TDateTime;
  1404. begin
  1405. if CheckParams(Params, [evStr], 1, Result) then
  1406. try
  1407. with IInternalFuncParams(Params) do
  1408. begin
  1409. if FileAge(PrependPath(Ext, Get(0).AsStr), Age) then
  1410. begin
  1411. New(FileDate);
  1412. FileDate^ := Age;
  1413. TPreprocessor(Ext).CollectGarbage(FileDate, GarbageReleaseDateTime);
  1414. MakeInt(ResPtr^, Int64(FileDate));
  1415. end
  1416. else
  1417. MakeInt(ResPtr^, -1);
  1418. end;
  1419. except
  1420. on E: Exception do
  1421. begin
  1422. FuncResult.Error(PChar(E.Message));
  1423. Result.Error := ISPPFUNC_FAIL
  1424. end;
  1425. end;
  1426. end;
  1427. function GetNow(Ext: Longint; const Params: IIsppFuncParams;
  1428. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1429. var
  1430. DateTime: PDateTime;
  1431. begin
  1432. if CheckParams(Params, [], 0, Result) then
  1433. try
  1434. with IInternalFuncParams(Params) do
  1435. begin
  1436. New(DateTime);
  1437. DateTime^ := Now;
  1438. TPreprocessor(Ext).CollectGarbage(DateTime, GarbageReleaseDateTime);
  1439. MakeInt(ResPtr^, Int64(DateTime));
  1440. end;
  1441. except
  1442. on E: Exception do
  1443. begin
  1444. FuncResult.Error(PChar(E.Message));
  1445. Result.Error := ISPPFUNC_FAIL
  1446. end;
  1447. end;
  1448. end;
  1449. function GetDateFromDT(Ext: Longint; const Params: IIsppFuncParams;
  1450. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1451. begin
  1452. if CheckParams(Params, [evInt], 1, Result) then
  1453. try
  1454. with IInternalFuncParams(Params) do
  1455. begin
  1456. MakeInt(ResPtr^, DateTimeToTimeStamp(PDateTime(Get(0).AsInt)^).Date);
  1457. end;
  1458. except
  1459. on E: EAccessViolation do
  1460. begin
  1461. FuncResult.Error('Invalid datetime value');
  1462. Result.Error := ISPPFUNC_FAIL;
  1463. end;
  1464. on E: Exception do
  1465. begin
  1466. FuncResult.Error(PChar(E.Message));
  1467. Result.Error := ISPPFUNC_FAIL
  1468. end;
  1469. end;
  1470. end;
  1471. function GetTimeFromDT(Ext: Longint; const Params: IIsppFuncParams;
  1472. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1473. begin
  1474. if CheckParams(Params, [evInt], 1, Result) then
  1475. try
  1476. with IInternalFuncParams(Params) do
  1477. begin
  1478. MakeInt(ResPtr^, DateTimeToTimeStamp(PDateTime(Get(0).AsInt)^).Time);
  1479. end;
  1480. except
  1481. on E: EAccessViolation do
  1482. begin
  1483. FuncResult.Error('Invalid datetime value');
  1484. Result.Error := ISPPFUNC_FAIL;
  1485. end;
  1486. on E: Exception do
  1487. begin
  1488. FuncResult.Error(PChar(E.Message));
  1489. Result.Error := ISPPFUNC_FAIL
  1490. end;
  1491. end;
  1492. end;
  1493. function GetDateTimeString(Ext: Longint; const Params: IIsppFuncParams;
  1494. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1495. var
  1496. NewDateSeparatorString, NewTimeSeparatorString: String;
  1497. OldDateSeparator, OldTimeSeparator: Char;
  1498. begin
  1499. if CheckParams(Params, [evStr, evStr, evStr], 3, Result) then
  1500. try
  1501. with IInternalFuncParams(Params) do
  1502. begin
  1503. OldDateSeparator := FormatSettings.DateSeparator;
  1504. OldTimeSeparator := FormatSettings.TimeSeparator;
  1505. try
  1506. NewDateSeparatorString := Get(1).AsStr;
  1507. NewTimeSeparatorString := Get(2).AsStr;
  1508. if NewDateSeparatorString <> '' then
  1509. FormatSettings.DateSeparator := NewDateSeparatorString[1];
  1510. if NewTimeSeparatorString <> '' then
  1511. FormatSettings.TimeSeparator := NewTimeSeparatorString[1];
  1512. MakeStr(ResPtr^, FormatDateTime(Get(0).AsStr, Now()));
  1513. finally
  1514. FormatSettings.TimeSeparator := OldTimeSeparator;
  1515. FormatSettings.DateSeparator := OldDateSeparator;
  1516. end;
  1517. end;
  1518. except
  1519. on E: Exception do
  1520. begin
  1521. FuncResult.Error(PChar(E.Message));
  1522. Result.Error := ISPPFUNC_FAIL
  1523. end;
  1524. end;
  1525. end;
  1526. function GetFileDateTimeString(Ext: Longint; const Params: IIsppFuncParams;
  1527. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1528. var
  1529. NewDateSeparatorString, NewTimeSeparatorString: String;
  1530. OldDateSeparator, OldTimeSeparator: Char;
  1531. Age: TDateTime;
  1532. begin
  1533. if CheckParams(Params, [evStr, evStr, evStr, evStr], 4, Result) then
  1534. try
  1535. with IInternalFuncParams(Params) do
  1536. begin
  1537. OldDateSeparator := FormatSettings.DateSeparator;
  1538. OldTimeSeparator := FormatSettings.TimeSeparator;
  1539. try
  1540. NewDateSeparatorString := Get(2).AsStr;
  1541. NewTimeSeparatorString := Get(3).AsStr;
  1542. if NewDateSeparatorString <> '' then
  1543. FormatSettings.DateSeparator := NewDateSeparatorString[1];
  1544. if NewTimeSeparatorString <> '' then
  1545. FormatSettings.TimeSeparator := NewTimeSeparatorString[1];
  1546. if not FileAge(PrependPath(Ext, Get(0).AsStr), Age) then begin
  1547. FuncResult.Error('Invalid file name');
  1548. Result.Error := ISPPFUNC_FAIL
  1549. end else
  1550. MakeStr(ResPtr^, FormatDateTime(Get(1).AsStr, Age));
  1551. finally
  1552. FormatSettings.TimeSeparator := OldTimeSeparator;
  1553. FormatSettings.DateSeparator := OldDateSeparator;
  1554. end;
  1555. end;
  1556. except
  1557. on E: Exception do
  1558. begin
  1559. FuncResult.Error(PChar(E.Message));
  1560. Result.Error := ISPPFUNC_FAIL
  1561. end;
  1562. end;
  1563. end;
  1564. function GetMD5OfFile(Ext: Longint; const Params: IIsppFuncParams;
  1565. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1566. var
  1567. Buf: array[0..65535] of Byte;
  1568. begin
  1569. if CheckParams(Params, [evStr], 1, Result) then
  1570. try
  1571. with IInternalFuncParams(Params) do
  1572. begin
  1573. var Context: TMD5Context;
  1574. MD5Init(Context);
  1575. var F := TFile.Create(PrependPath(Ext, Get(0).AsStr), fdOpenExisting, faRead, fsReadWrite);
  1576. try
  1577. while True do begin
  1578. var NumRead := F.Read(Buf, SizeOf(Buf));
  1579. if NumRead = 0 then
  1580. Break;
  1581. MD5Update(Context, Buf, NumRead);
  1582. end;
  1583. finally
  1584. F.Free;
  1585. end;
  1586. MakeStr(ResPtr^, MD5DigestToString(MD5Final(Context)));
  1587. end;
  1588. except
  1589. on E: Exception do
  1590. begin
  1591. FuncResult.Error(PChar(E.Message));
  1592. Result.Error := ISPPFUNC_FAIL
  1593. end;
  1594. end;
  1595. end;
  1596. function GetMD5OfString(Ext: Longint; const Params: IIsppFuncParams;
  1597. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1598. begin
  1599. if CheckParams(Params, [evStr], 1, Result) then
  1600. try
  1601. with IInternalFuncParams(Params) do
  1602. begin
  1603. var S := AnsiString(Get(0).AsStr);
  1604. MakeStr(ResPtr^, MD5DigestToString(MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1]))));
  1605. end;
  1606. except
  1607. on E: Exception do
  1608. begin
  1609. FuncResult.Error(PChar(E.Message));
  1610. Result.Error := ISPPFUNC_FAIL
  1611. end;
  1612. end;
  1613. end;
  1614. function GetMD5OfUnicodeString(Ext: Longint; const Params: IIsppFuncParams;
  1615. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1616. begin
  1617. if CheckParams(Params, [evStr], 1, Result) then
  1618. try
  1619. with IInternalFuncParams(Params) do
  1620. begin
  1621. var S := Get(0).AsStr;
  1622. MakeStr(ResPtr^, MD5DigestToString(MD5Buf(Pointer(S)^, Length(S)*SizeOf(S[1]))));
  1623. end;
  1624. except
  1625. on E: Exception do
  1626. begin
  1627. FuncResult.Error(PChar(E.Message));
  1628. Result.Error := ISPPFUNC_FAIL
  1629. end;
  1630. end;
  1631. end;
  1632. function GetSHA1OfFile(Ext: Longint; const Params: IIsppFuncParams;
  1633. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1634. var
  1635. Buf: array[0..65535] of Byte;
  1636. begin
  1637. if CheckParams(Params, [evStr], 1, Result) then
  1638. try
  1639. with IInternalFuncParams(Params) do
  1640. begin
  1641. var Context: TSHA1Context;
  1642. SHA1Init(Context);
  1643. var F := TFile.Create(PrependPath(Ext, Get(0).AsStr), fdOpenExisting, faRead, fsReadWrite);
  1644. try
  1645. while True do begin
  1646. var NumRead := F.Read(Buf, SizeOf(Buf));
  1647. if NumRead = 0 then
  1648. Break;
  1649. SHA1Update(Context, Buf, NumRead);
  1650. end;
  1651. finally
  1652. F.Free;
  1653. end;
  1654. MakeStr(ResPtr^, SHA1DigestToString(SHA1Final(Context)));
  1655. end;
  1656. except
  1657. on E: Exception do
  1658. begin
  1659. FuncResult.Error(PChar(E.Message));
  1660. Result.Error := ISPPFUNC_FAIL
  1661. end;
  1662. end;
  1663. end;
  1664. function GetSHA1OfString(Ext: Longint; const Params: IIsppFuncParams;
  1665. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1666. begin
  1667. if CheckParams(Params, [evStr], 1, Result) then
  1668. try
  1669. with IInternalFuncParams(Params) do
  1670. begin
  1671. var S := AnsiString(Get(0).AsStr);
  1672. MakeStr(ResPtr^, SHA1DigestToString(SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1]))));
  1673. end;
  1674. except
  1675. on E: Exception do
  1676. begin
  1677. FuncResult.Error(PChar(E.Message));
  1678. Result.Error := ISPPFUNC_FAIL
  1679. end;
  1680. end;
  1681. end;
  1682. function GetSHA1OfUnicodeString(Ext: Longint; const Params: IIsppFuncParams;
  1683. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1684. begin
  1685. if CheckParams(Params, [evStr], 1, Result) then
  1686. try
  1687. with IInternalFuncParams(Params) do
  1688. begin
  1689. var S := Get(0).AsStr;
  1690. MakeStr(ResPtr^, SHA1DigestToString(SHA1Buf(Pointer(S)^, Length(S)*SizeOf(S[1]))));
  1691. end;
  1692. except
  1693. on E: Exception do
  1694. begin
  1695. FuncResult.Error(PChar(E.Message));
  1696. Result.Error := ISPPFUNC_FAIL
  1697. end;
  1698. end;
  1699. end;
  1700. function GetSHA256OfFile(Ext: Longint; const Params: IIsppFuncParams;
  1701. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1702. var
  1703. Buf: array[0..65535] of Byte;
  1704. begin
  1705. if CheckParams(Params, [evStr], 1, Result) then
  1706. try
  1707. with IInternalFuncParams(Params) do
  1708. begin
  1709. var Context: TSHA256Context;
  1710. SHA256Init(Context);
  1711. var F := TFile.Create(PrependPath(Ext, Get(0).AsStr), fdOpenExisting, faRead, fsReadWrite);
  1712. try
  1713. while True do begin
  1714. var NumRead := F.Read(Buf, SizeOf(Buf));
  1715. if NumRead = 0 then
  1716. Break;
  1717. SHA256Update(Context, Buf, NumRead);
  1718. end;
  1719. finally
  1720. F.Free;
  1721. end;
  1722. MakeStr(ResPtr^, SHA256DigestToString(SHA256Final(Context)));
  1723. end;
  1724. except
  1725. on E: Exception do
  1726. begin
  1727. FuncResult.Error(PChar(E.Message));
  1728. Result.Error := ISPPFUNC_FAIL
  1729. end;
  1730. end;
  1731. end;
  1732. function GetSHA256OfString(Ext: Longint; const Params: IIsppFuncParams;
  1733. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1734. begin
  1735. if CheckParams(Params, [evStr], 1, Result) then
  1736. try
  1737. with IInternalFuncParams(Params) do
  1738. begin
  1739. var S := AnsiString(Get(0).AsStr);
  1740. MakeStr(ResPtr^, SHA256DigestToString(SHA256Buf(Pointer(S)^, Length(S)*SizeOf(S[1]))));
  1741. end;
  1742. except
  1743. on E: Exception do
  1744. begin
  1745. FuncResult.Error(PChar(E.Message));
  1746. Result.Error := ISPPFUNC_FAIL
  1747. end;
  1748. end;
  1749. end;
  1750. function GetSHA256OfUnicodeString(Ext: Longint; const Params: IIsppFuncParams;
  1751. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1752. begin
  1753. if CheckParams(Params, [evStr], 1, Result) then
  1754. try
  1755. with IInternalFuncParams(Params) do
  1756. begin
  1757. var S := Get(0).AsStr;
  1758. MakeStr(ResPtr^, SHA256DigestToString(SHA256Buf(Pointer(S)^, Length(S)*SizeOf(S[1]))));
  1759. end;
  1760. except
  1761. on E: Exception do
  1762. begin
  1763. FuncResult.Error(PChar(E.Message));
  1764. Result.Error := ISPPFUNC_FAIL
  1765. end;
  1766. end;
  1767. end;
  1768. function TrimFunc(Ext: Longint; const Params: IIsppFuncParams;
  1769. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1770. begin
  1771. if CheckParams(Params, [evStr], 1, Result) then
  1772. try
  1773. with IInternalFuncParams(Params) do
  1774. MakeStr(ResPtr^, Trim(Get(0).AsStr));
  1775. except
  1776. on E: Exception do
  1777. begin
  1778. FuncResult.Error(PChar(E.Message));
  1779. Result.Error := ISPPFUNC_FAIL
  1780. end;
  1781. end;
  1782. end;
  1783. function StringChangeFunc(Ext: Longint; const Params: IIsppFuncParams;
  1784. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1785. var
  1786. S: String;
  1787. begin
  1788. if CheckParams(Params, [evStr, evStr, evStr], 1, Result) then
  1789. try
  1790. with IInternalFuncParams(Params) do
  1791. begin
  1792. S := Get(0).AsStr;
  1793. StringChangeEx(S, Get(1).AsStr, Get(2).AsStr, True);
  1794. MakeStr(ResPtr^, S);
  1795. end;
  1796. except
  1797. on E: Exception do
  1798. begin
  1799. FuncResult.Error(PChar(E.Message));
  1800. Result.Error := ISPPFUNC_FAIL
  1801. end;
  1802. end;
  1803. end;
  1804. function IsWin64Func(Ext: Longint; const Params: IIsppFuncParams;
  1805. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1806. begin
  1807. if CheckParams(Params, [], 0, Result) then
  1808. try
  1809. with IInternalFuncParams(Params) do
  1810. begin
  1811. MakeBool(ResPtr^, IsWin64);
  1812. end;
  1813. except
  1814. on E: Exception do
  1815. begin
  1816. FuncResult.Error(PChar(E.Message));
  1817. Result.Error := ISPPFUNC_FAIL
  1818. end;
  1819. end;
  1820. end;
  1821. function MessageFunc(Ext: Longint; const Params: IIsppFuncParams;
  1822. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1823. begin
  1824. if CheckParams(Params, [evStr], 1, Result) then
  1825. try
  1826. with IInternalFuncParams(Params) do begin
  1827. { Also see Pragma in IsppPreprocessor }
  1828. TPreprocessor(Ext).StatusMsg(Get(0).AsStr);
  1829. ResPtr^ := NULL;
  1830. end;
  1831. except
  1832. on E: Exception do
  1833. begin
  1834. FuncResult.Error(PChar(E.Message));
  1835. Result.Error := ISPPFUNC_FAIL
  1836. end;
  1837. end;
  1838. end;
  1839. function WarningFunc(Ext: Longint; const Params: IIsppFuncParams;
  1840. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1841. begin
  1842. if CheckParams(Params, [evStr], 1, Result) then
  1843. try
  1844. with IInternalFuncParams(Params) do begin
  1845. { Also see Pragma in IsppPreprocessor }
  1846. TPreprocessor(Ext).WarningMsg(Get(0).AsStr);
  1847. ResPtr^ := NULL;
  1848. end;
  1849. except
  1850. on E: Exception do
  1851. begin
  1852. FuncResult.Error(PChar(E.Message));
  1853. Result.Error := ISPPFUNC_FAIL
  1854. end;
  1855. end;
  1856. end;
  1857. function ErrorFunc(Ext: Longint; const Params: IIsppFuncParams;
  1858. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1859. var
  1860. CatchException: Boolean;
  1861. ErrorMsg: String;
  1862. begin
  1863. CatchException := True;
  1864. if CheckParams(Params, [evStr], 1, Result) then
  1865. try
  1866. with IInternalFuncParams(Params) do begin
  1867. { Also see Pragma and pcErrorDir in IsppPreprocessor }
  1868. ErrorMsg := Get(0).AsStr;
  1869. if ErrorMsg = '' then ErrorMsg := 'Error';
  1870. CatchException := False;
  1871. TPreprocessor(Ext).RaiseError(ErrorMsg);
  1872. end;
  1873. except
  1874. on E: Exception do
  1875. begin
  1876. if CatchException then begin
  1877. FuncResult.Error(PChar(E.Message));
  1878. Result.Error := ISPPFUNC_FAIL
  1879. end else
  1880. raise;
  1881. end;
  1882. end;
  1883. end;
  1884. function AddQuotesFunc(Ext: Longint; const Params: IIsppFuncParams;
  1885. const FuncResult: IIsppFuncResult): TIsppFuncResult; stdcall;
  1886. begin
  1887. if CheckParams(Params, [evStr], 1, Result) then
  1888. try
  1889. with IInternalFuncParams(Params) do
  1890. begin
  1891. MakeStr(ResPtr^, AddQuotes(Get(0).AsStr));
  1892. end;
  1893. except
  1894. on E: Exception do
  1895. begin
  1896. FuncResult.Error(PChar(E.Message));
  1897. Result.Error := ISPPFUNC_FAIL
  1898. end;
  1899. end;
  1900. end;
  1901. procedure RegisterFunctions(Preproc: TPreprocessor);
  1902. begin
  1903. with Preproc do
  1904. begin
  1905. { -1 as Ext parameter means that function will be called with Ext set to
  1906. preprocessor instance instead of -1. }
  1907. RegisterFunction('Int', Int, -1);
  1908. RegisterFunction('Str', Str, -1);
  1909. RegisterFunction('FileExists', FileExists, -1);
  1910. RegisterFunction('DirExists', DirExists, -1);
  1911. RegisterFunction('ForceDirectories', ForceDirectoriesFunc, -1);
  1912. RegisterFunction('FileSize', FileSize, -1);
  1913. RegisterFunction('ReadIni', ReadIni, -1);
  1914. RegisterFunction('WriteIni', WriteIni, -1);
  1915. RegisterFunction('ReadReg', ReadReg, -1);
  1916. RegisterFunction('Exec', ExecFunc, -1);
  1917. RegisterFunction('ExecAndGetFirstLine', ExecAndGetFirstLineFunc, -1);
  1918. RegisterFunction('Copy', CopyFunc, -1);
  1919. RegisterFunction('Pos', PosFunc, -1);
  1920. RegisterFunction('RPos', RPosFunc, -1);
  1921. RegisterFunction('Len', LenFunc, -1);
  1922. RegisterFunction('GetVersionNumbersString', GetVersionNumbersStringFunc, -1);
  1923. RegisterFunction('ComparePackedVersion', ComparePackedVersionFunc, -1);
  1924. RegisterFunction('SamePackedVersion', SamePackedVersionFunc, -1);
  1925. RegisterFunction('GetStringFileInfo', GetFileVersionInfoItem, -1);
  1926. RegisterFunction('SaveToFile', ISPP.Funcs.SaveToFile, -1);
  1927. RegisterFunction('Find', FindLine, -1);
  1928. RegisterFunction('SetupSetting', SetupSetting, -1);
  1929. RegisterFunction('SetSetupSetting', SetSetupSetting, -1);
  1930. RegisterFunction('LowerCase', LowerCaseFunc, -1);
  1931. RegisterFunction('UpperCase', UpperCaseFunc, -1);
  1932. RegisterFunction('EntryCount', EntryCountFunc, -1);
  1933. RegisterFunction('GetEnv', GetEnvFunc, -1);
  1934. RegisterFunction('DeleteFile', DelFileFunc, -1);
  1935. RegisterFunction('DeleteFileNow', DelFileNowFunc, -1);
  1936. RegisterFunction('CopyFile', CopyFileFunc, -1);
  1937. RegisterFunction('ReadEnv', GetEnvFunc, -1);
  1938. RegisterFunction('FindFirst', FindFirstFunc, -1);
  1939. RegisterFunction('FindNext', FindNextFunc, -1);
  1940. RegisterFunction('FindGetFileName', FindGetFileName, -1);
  1941. RegisterFunction('FindClose', FindCloseFunc, -1);
  1942. RegisterFunction('FileOpen', FileOpenFunc, -1);
  1943. RegisterFunction('FileRead', FileReadFunc, -1);
  1944. RegisterFunction('FileReset', FileResetFunc, -1);
  1945. RegisterFunction('FileEof', FileEofFunc, -1);
  1946. RegisterFunction('FileClose', FileCloseFunc, -1);
  1947. RegisterFunction('SaveStringToFile', SaveStringToFileFunc, -1);
  1948. RegisterFunction('FileGetDateTime', FileGetDate, -1);
  1949. RegisterFunction('Now', GetNow, -1);
  1950. RegisterFunction('DateTimeToDate', GetDateFromDT, -1);
  1951. RegisterFunction('DateTimeToTime', GetTimeFromDT, -1);
  1952. RegisterFunction('GetDateTimeString', GetDateTimeString, -1);
  1953. RegisterFunction('GetFileDateTimeString', GetFileDateTimeString, -1);
  1954. RegisterFunction('GetMD5OfFile', GetMD5OfFile, -1);
  1955. RegisterFunction('GetMD5OfString', GetMD5OfString, -1);
  1956. RegisterFunction('GetMD5OfUnicodeString', GetMD5OfUnicodeString, -1);
  1957. RegisterFunction('GetSHA1OfFile', GetSHA1OfFile, -1);
  1958. RegisterFunction('GetSHA1OfString', GetSHA1OfString, -1);
  1959. RegisterFunction('GetSHA1OfUnicodeString', GetSHA1OfUnicodeString, -1);
  1960. RegisterFunction('GetSHA256OfFile', GetSHA256OfFile, -1);
  1961. RegisterFunction('GetSHA256OfString', GetSHA256OfString, -1);
  1962. RegisterFunction('GetSHA256OfUnicodeString', GetSHA256OfUnicodeString, -1);
  1963. RegisterFunction('Trim', TrimFunc, -1);
  1964. RegisterFunction('StringChange', StringChangeFunc, -1);
  1965. RegisterFunction('IsWin64', IsWin64Func, -1);
  1966. RegisterFunction('Message', MessageFunc, -1);
  1967. RegisterFunction('Warning', WarningFunc, -1);
  1968. RegisterFunction('Error', ErrorFunc, -1);
  1969. RegisterFunction('AddQuotes', AddQuotesFunc, -1)
  1970. end;
  1971. end;
  1972. procedure InitIsWin64;
  1973. var
  1974. IsWow64ProcessFunc: function(hProcess: THandle; var Wow64Process: BOOL): BOOL; stdcall;
  1975. Wow64Process: BOOL;
  1976. begin
  1977. IsWow64ProcessFunc := GetProcAddress(GetModuleHandle(kernel32), 'IsWow64Process');
  1978. IsWin64 := Assigned(IsWow64ProcessFunc) and
  1979. IsWow64ProcessFunc(GetCurrentProcess, Wow64Process) and
  1980. Wow64Process;
  1981. end;
  1982. initialization
  1983. InitIsWin64;
  1984. end.