Computil.dpr 7.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 10019: Computil.dpr
  11. {
  12. { Rev 1.4 24/08/2004 12:41:44 ANeillans
  13. { Modified to ensure the registry object is opened in Read Only mode.
  14. }
  15. {
  16. { Rev 1.3 7/14/04 1:40:26 PM RLebeau
  17. { removed some repeating code
  18. }
  19. {
  20. { Rev 1.2 14/07/2004 21:15:38 ANeillans
  21. { Modification to allow both HKLM and HKCU to be used for fetching binary path.
  22. }
  23. {
  24. { Rev 1.1 03/05/2004 15:36:22 ANeillans
  25. { Bug fix: Rootdir blank causes AV. Changes HKEY_LOCAL_MACHINE to
  26. { HKEY_CURRENT_USER.
  27. }
  28. {
  29. { Rev 1.0 2002.11.12 10:25:38 PM czhower
  30. }
  31. program CompUtil;
  32. {$APPTYPE CONSOLE}
  33. uses
  34. Windows, SysUtils, Registry, Classes;
  35. type
  36. TWhichOption = (
  37. woHppModify,woSetupD2,woSetupD3,woSetupD4,woSetupD5,woSetupD6,woSetupD7,
  38. woSetupD8,woSetupD9,woSetupD10,woSetupD11,woSetupD12,woSetupD14,woSetupD15,
  39. woSetupC1,woSetupC3,woSetupC4,woSetupC5,woSetupC6,woSetupC7,woSetupC8,
  40. woSetupC9,woSetupC10,woSetupC11,woSetupC12,woSetupC14,woSetupC15,woInvalid);
  41. var
  42. Options: array[TWhichOption] of String = ('HppModify','SetupD2','SetupD3',
  43. 'SetupD4','SetupD5','SetupD6','SetupD7','SetupD8','SetupD9','SetupD10',
  44. 'SetupD11','SetupD12','SetupD14','SetupD15','SetupC1','SetupC3','SetupC4',
  45. 'SetupC5','SetupC6','SetupC7','SetupC8','SetupC9','SetupC10','SetupC11',
  46. 'SetupC12','SetupC14','SetupC15','Invalid');
  47. WhichOption: TWhichOption;
  48. CmdParam: string;
  49. procedure HPPModify;
  50. var
  51. InFile: file;
  52. OutFile: text;
  53. Line: AnsiString;
  54. Buffer: pointer;
  55. BufPtr: PAnsiChar;
  56. BufSize: longint;
  57. EOL: boolean;
  58. begin
  59. // Fix C++Builder HPP conversion bug:
  60. // - Input line in RVDefine.pas is
  61. // TRaveUnits = {$IFDEF WIN32}type{$ENDIF} TRaveFloat;
  62. //
  63. // - Invalid output line in RVDefine.hpp is
  64. // typedef TRaveUnits TRaveUnits;
  65. //
  66. // - Valid output line in RVDefine.hpp should be
  67. // typedef double TRaveUnits;
  68. { Read in RVDefine.hpp as binary }
  69. AssignFile(InFile,ParamStr(2) + 'RVDefine.hpp');
  70. Reset(InFile,1);
  71. BufSize := FileSize(InFile);
  72. GetMem(Buffer,BufSize);
  73. BlockRead(InFile,Buffer^,BufSize);
  74. CloseFile(InFile);
  75. BufPtr := Buffer;
  76. { Write out modified RVDefine.hpp as text }
  77. AssignFile(OutFile,ParamStr(2) + 'RVDefine.hpp');
  78. Rewrite(OutFile);
  79. While BufSize > 0 do begin
  80. Line := '';
  81. EOL := false;
  82. Repeat { Get a line of text }
  83. If BufPtr^ = #13 then begin
  84. Inc(BufPtr);
  85. Dec(BufSize);
  86. Inc(BufPtr);
  87. Dec(BufSize);
  88. EOL := true;
  89. end else begin
  90. Line := Line + BufPtr^;
  91. Inc(BufPtr);
  92. Dec(BufSize);
  93. end; { else }
  94. until EOL or (BufSize = 0);
  95. If Line = 'typedef TRaveUnits TRaveUnits;' then begin
  96. Line := 'typedef double TRaveUnits;';
  97. end; { if }
  98. Writeln(OutFile,Line);
  99. end; { while }
  100. CloseFile(OutFile);
  101. end; { HPPModify }
  102. procedure SetPath(EnvName: string; RegRoot: string);
  103. var
  104. CompilerFound: boolean;
  105. SysDirFound: boolean;
  106. KeyOpened: boolean;
  107. EnvUpdated: boolean;
  108. EnvList: TStringList;
  109. SysDir: string;
  110. ShortPath: string;
  111. LongPath: string;
  112. begin
  113. CompilerFound := GetEnvironmentVariable(PChar(EnvName), nil, 0) <> 0;
  114. SysDirFound := GetEnvironmentVariable('NDWINSYS', nil, 0) <> 0;
  115. If (not CompilerFound) or (not SysDirFound) then begin
  116. EnvUpdated := False;
  117. EnvList := TStringList.Create;
  118. try
  119. If FileExists('SetEnv.bat') then begin { Read in existing file }
  120. EnvList.LoadFromFile('SetEnv.bat');
  121. end; { if }
  122. If not CompilerFound then begin { Get compiler path and add to string list }
  123. With TRegistry.Create do try
  124. RootKey := HKEY_LOCAL_MACHINE;
  125. KeyOpened := OpenKeyReadOnly(RegRoot);
  126. if not KeyOpened then begin
  127. Writeln('Resetting registry rootkey to HKCU, and retrying');
  128. RootKey := HKEY_CURRENT_USER;
  129. KeyOpened := OpenKeyReadOnly(RegRoot);
  130. End;
  131. if KeyOpened and ValueExists('RootDir') then begin
  132. LongPath := ReadString('RootDir');
  133. SetLength(ShortPath, MAX_PATH); // when casting to a PChar, be sure the string is not empty
  134. SetLength(ShortPath, GetShortPathName(PChar(LongPath), PChar(ShortPath), MAX_PATH) );
  135. If (ShortPath[1] = #0) or (Length(ShortPath) = Length(LongPath)) then begin
  136. ShortPath := LongPath;
  137. end;
  138. EnvList.Add('SET ' + EnvName + '=' + ShortPath);
  139. EnvUpdated := True;
  140. end else begin
  141. Writeln('Compiler not installed!');
  142. Halt(1);
  143. End; { else }
  144. finally
  145. Free;
  146. end; { with }
  147. end; { if }
  148. If not SysDirFound then begin { Get System Directory and add to string list }
  149. SetLength(SysDir, MAX_PATH);
  150. SetLength(SysDir, GetSystemDirectory(PChar(SysDir), MAX_PATH));
  151. EnvList.Add('SET NDWINSYS=' + SysDir);
  152. EnvUpdated := True;
  153. end; { if }
  154. If EnvUpdated then begin
  155. EnvList.SaveToFile('SetEnv.bat');
  156. End; { if }
  157. finally
  158. EnvList.Free;
  159. end; { tryf }
  160. end; { if }
  161. end; { SetPath }
  162. begin
  163. { Figure out which feature to run }
  164. CmdParam := ParamStr(1);
  165. WhichOption := Low(WhichOption);
  166. While WhichOption < High(WhichOption) do begin
  167. If UpperCase(CmdParam) = UpperCase(Options[WhichOption]) then begin
  168. Break;
  169. end; { if }
  170. Inc(WhichOption);
  171. end; { while }
  172. Case WhichOption of
  173. woHppModify: HPPModify;
  174. woSetupD2: SetPath('NDD2','Software\Borland\Delphi\2.0');
  175. woSetupD3: SetPath('NDD3','Software\Borland\Delphi\3.0');
  176. woSetupD4: SetPath('NDD4','Software\Borland\Delphi\4.0');
  177. woSetupD5: SetPath('NDD5','Software\Borland\Delphi\5.0');
  178. woSetupD6: SetPath('NDD6','Software\Borland\Delphi\6.0');
  179. woSetupD7: SetPath('NDD7','Software\Borland\Delphi\7.0');
  180. woSetupD8: SetPath('NDD8','Software\Borland\Delphi\8.0');
  181. woSetupD9: SetPath('NDD9','Software\Borland\BDS\3.0');
  182. woSetupD10: SetPath('NDD10','Software\Borland\BDS\4.0');
  183. woSetupD11: SetPath('NDD11','Software\Borland\BDS\5.0');
  184. woSetupD12: SetPath('NDD12','Software\CodeGear\BDS\6.0');
  185. woSetupD14: SetPath('NDD14','Software\CodeGear\BDS\7.0');
  186. woSetupD15: SetPath('NDD15','Software\Embarcadero\BDS\8.0');
  187. woSetupC1: SetPath('NDC1','Software\Borland\C++Builder\1.0');
  188. woSetupC3: SetPath('NDC3','Software\Borland\C++Builder\3.0');
  189. woSetupC4: SetPath('NDC4','Software\Borland\C++Builder\4.0');
  190. woSetupC5: SetPath('NDC5','Software\Borland\C++Builder\5.0');
  191. woSetupC6: SetPath('NDC6','Software\Borland\C++Builder\6.0');
  192. woSetupC10: SetPath('NDC10','Software\Borland\BDS\4.0');
  193. woSetupC11: SetPath('NDC11','Software\Borland\BDS\5.0');
  194. woSetupC12: SetPath('NDC12','Software\CodeGear\BDS\6.0');
  195. woSetupC14: SetPath('NDC14','Software\CodeGear\BDS\7.0');
  196. woSetupC15: SetPath('NDC15','Software\Embarcadero\BDS\8.0');
  197. woInvalid: Writeln('Invalid Parameter');
  198. end; { case }
  199. end.