You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

Uninstaller.dpr 6.5KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219
  1. program Uninstaller;
  2. {$IFDEF FPC}
  3. {$MODE Delphi}
  4. {$ENDIF}
  5. // Use this instead of {$APPTYPE XXX}
  6. // APP_XXX is the same as {$APPTYPE XXX}
  7. // Defaults to console
  8. // This is a work-around for a bug in FPC Cross Compiling to windows in delphi
  9. // mode (IsConsole is always true)
  10. {$DEFINE APP_GUI}
  11. // This block actually does the work for the above work-around
  12. {$IFDEF APP_GUI}
  13. {$APPTYPE GUI}
  14. {$ELSE}
  15. {$IFDEF APP_FS}
  16. {$APPTYPE FS}
  17. {$ELSE}
  18. {$IFDEF APP_TOOL}
  19. {$DEFINE APP_CONSOLE}
  20. {$APPTYPE TOOL}
  21. {$ELSE}
  22. {$DEFINE APP_CONSOLE}
  23. {$APPTYPE CONSOLE}
  24. {$ENDIF}
  25. {$ENDIF}
  26. {$ENDIF}
  27. uses Windows, SysUtils, registry, Vista;
  28. {$R uninstall.res}
  29. procedure dowriteln(line: String);
  30. begin
  31. if IsConsole then writeln(line);
  32. end;
  33. procedure dowrite(line: String);
  34. begin
  35. if IsConsole then write(line);
  36. end;
  37. function askQuestion(Question: String): boolean;
  38. begin
  39. Result := TaskDialog(0, 'DMDirc Uninstaller', 'Question', Question, TD_ICON_QUESTION, TD_BUTTON_YES + TD_BUTTON_NO) = mrYes;
  40. end;
  41. procedure showError(context: String; ErrorMessage: String; addFooter: boolean = true);
  42. begin
  43. if addFooter then begin
  44. ErrorMessage := ErrorMessage+#13#10;
  45. ErrorMessage := ErrorMessage+#13#10+' If you feel this is incorrect, or you require some further assistance, ';
  46. ErrorMessage := ErrorMessage+#13#10+'please feel free to contact us.';
  47. end;
  48. TaskDialog(0, 'DMDirc Setup', context, ErrorMessage, TD_ICON_ERROR, TD_BUTTON_OK, true);
  49. end;
  50. procedure showmessage(message: String; context:String = 'Information');
  51. begin
  52. TaskDialog(0, 'DMDirc Uninstaller', context, message, TD_ICON_INFORMATION, TD_BUTTON_OK);
  53. end;
  54. function GetTempDirectory(): String;
  55. var
  56. buf: array[0..MAX_PATH] of Char;
  57. wintemp, temp: String;
  58. begin
  59. GetTempPath(SizeOf(buf)-1, buf);
  60. wintemp := StrPas(buf);
  61. Randomize;
  62. temp := '\DMDirc-uninstaller-'+inttostr(1000 + Random(1000));
  63. while (DirectoryExists(wintemp+temp+'\')) do begin
  64. temp := temp+'-'+inttostr(1+Random(1000));
  65. end;
  66. MkDir(wintemp+temp+'\');
  67. result := wintemp+temp+'\';
  68. end;
  69. // Run an application and don't wait for it to finish.
  70. function Launch(sProgramToRun: String; hide: boolean = false): TProcessInformation;
  71. var
  72. StartupInfo: TStartupInfo;
  73. begin
  74. FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  75. with StartupInfo do begin
  76. cb := SizeOf(TStartupInfo);
  77. dwFlags := STARTF_USESHOWWINDOW;
  78. if hide then wShowWindow := SW_HIDE
  79. else wShowWindow := SW_SHOWNORMAL;
  80. end;
  81. CreateProcess(nil, PChar(sProgramToRun), nil, nil, False, NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, Result);
  82. end;
  83. // Run an application and wait for it to finish.
  84. function ExecAndWait(sProgramToRun: String; hide: boolean = false): Longword;
  85. var
  86. ProcessInfo: TProcessInformation;
  87. begin
  88. ProcessInfo := Launch(sProgramToRun, hide);
  89. getExitCodeProcess(ProcessInfo.hProcess, Result);
  90. while Result=STILL_ACTIVE do begin
  91. sleep(1000);
  92. GetExitCodeProcess(ProcessInfo.hProcess, Result);
  93. end;
  94. end;
  95. function KillDir(Dir: string): Integer;
  96. var
  97. searchResult: TSearchRec;
  98. begin
  99. Result := 0;
  100. if FindFirst(Dir+'\*', faDirectory + faHidden + faReadOnly + faSysfile + faAnyFile, searchResult) = 0 then
  101. begin
  102. repeat
  103. if (searchResult.attr and faDirectory) <> faDirectory then begin
  104. Try
  105. DeleteFile(Dir+'\'+searchResult.name);
  106. Except
  107. MessageBox(0, PChar('Unable to delete "'+Dir+'\'+searchResult.name+'" - is DMDirc still running?.'), 'DMDirc Uninstaller', MB_OK);
  108. end;
  109. end
  110. else begin
  111. if (searchResult.name <> '.') and (searchResult.name <> '..') then begin
  112. KillDir(Dir+'\'+searchResult.name);
  113. end;
  114. end;
  115. until FindNext(searchResult) <> 0;
  116. FindClose(searchResult);
  117. end;
  118. Try
  119. RmDir(Dir);
  120. Except
  121. end;
  122. end;
  123. var
  124. TempDir: String;
  125. InstallDir: String = '';
  126. i: Integer;
  127. Reg: TRegistry;
  128. handlerInfo: String;
  129. profileDir: String;
  130. deleteProtocol: boolean;
  131. begin
  132. if (ParamCount > 0) then begin
  133. for i := 1 to ParamCount do begin
  134. InstallDir := InstallDir+' '+paramstr(i);
  135. end;
  136. InstallDir := trim(InstallDir);
  137. KillDir(InstallDir);
  138. profileDir := GetEnvironmentVariable('USERPROFILE');
  139. if IsWindowsVista then begin
  140. // Vista
  141. KillDir(GetEnvironmentVariable('APPDATA')+'\Microsoft\Windows\Start Menu\Programs\DMDirc');
  142. DeleteFile(GetEnvironmentVariable('USERPROFILE')+'\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\DMDirc.lnk');
  143. DeleteFile(GetEnvironmentVariable('USERPROFILE')+'\Desktop\DMDirc.lnk');
  144. profileDir := profileDir+'\AppData\Roaming\DMDirc';
  145. end
  146. else begin
  147. // Not Vista
  148. KillDir(GetEnvironmentVariable('USERPROFILE')+'\Microsoft\Windows\Start Menu\Programs\DMDirc');
  149. DeleteFile(GetEnvironmentVariable('USERPROFILE')+'\Application Data\Microsoft\Internet Explorer\Quick Launch\DMDirc.lnk');
  150. DeleteFile(GetEnvironmentVariable('USERPROFILE')+'\Desktop\DMDirc.lnk');
  151. profileDir := profileDir+'\Application Data\DMDirc';
  152. end;
  153. // Remove irc:// handler if it is us.
  154. deleteProtocol := false;
  155. Reg := TRegistry.Create;
  156. Reg.RootKey := HKEY_CLASSES_ROOT;
  157. if Reg.OpenKey('irc\Shell\open\command', false) then begin
  158. handlerInfo := Reg.ReadString('');
  159. if (handlerInfo = '"'+InstallDir+'DMDirc.exe" -c %1') then begin
  160. deleteProtocol := true;
  161. end
  162. end;
  163. Reg.CloseKey;
  164. Reg.Free;
  165. if deleteProtocol then begin
  166. Reg := TRegistry.Create;
  167. Reg.RootKey := HKEY_CLASSES_ROOT;
  168. Reg.DeleteKey('irc\Shell\open\command');
  169. Reg.DeleteKey('irc\Shell\open');
  170. Reg.DeleteKey('irc\Shell');
  171. Reg.DeleteKey('irc\DefaultIcon');
  172. Reg.DeleteKey('irc');
  173. Reg.CloseKey;
  174. Reg.Free;
  175. end;
  176. Reg := TRegistry.Create;
  177. Reg.RootKey := HKEY_LOCAL_MACHINE;
  178. Reg.DeleteKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\DMDirc');
  179. Reg.CloseKey;
  180. Reg.Free;
  181. if (FileExists(profileDir+'\dmdirc.config')) then begin
  182. if MessageBox(0, PChar('A dmdirc profile has been detected ('+profileDir+') '+#13#10+'Do you want to delete it aswell?'), 'DMDirc Uninstaller', MB_YESNO) = IDYES then begin
  183. KillDir(profileDir);
  184. end;
  185. end;
  186. showmessage('DMDirc has been uninstalled from "'+InstallDir+'".', 'Uninstall Successful');
  187. end
  188. else if askQuestion('This will uninstall DMDirc. '+#13#10+#13#10+'Do you want to continue?') then begin
  189. if (ExecAndWait('java -jar "' + ExtractFileDir(paramstr(0)) + '\DMDirc.jar" -k', true) <> 0) then begin
  190. TempDir := GetTempDirectory;
  191. CopyFile(pchar(paramstr(0)), pchar(TempDir+'/uninstall.exe'), false);
  192. Launch('"'+TempDir+'/uninstall.exe" '+ExtractFileDir(paramstr(0))+'\');
  193. end else begin
  194. showError('Uninstall Aborted - DMDirc is still running.', 'Please close DMDirc before continuing')
  195. end;
  196. end;
  197. end.