ISPP.Funcs.pas 61 KB

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