XP_OTAUtils.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:15k
源码类别:

Email服务器

开发平台:

Delphi

  1. unit XP_OTAUtils;
  2. {
  3.  $Source: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/DelphiExperts/Common/XP_OTAUtils.pas,v $
  4.  $Revision: 1.2 $
  5.  $Date: 2004/05/03 15:07:15 $
  6.  Last amended by $Author: pvspain $
  7.  $State: Exp $
  8.  XP_OTAUtils:
  9.  Utility methods and base classes for OpenTools API
  10.  Copyright (c) 2001,2002 by The Excellent Programming Company Pty Ltd
  11.  (ABN 27 005 394 918). All rights reserved.
  12.  Contact Paul Spain via email: paul@xpro.com.au
  13.  This unit is free software; you can redistribute it and/or
  14.  modify it under the terms of the GNU Lesser General Public
  15.  License as published by the Free Software Foundation; either
  16.  version 2.1 of the License, or (at your option) any later version.
  17.  This unit is distributed in the hope that it will be useful,
  18.  but WITHOUT ANY WARRANTY; without even the implied warranty of
  19.  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20.  Lesser General Public License for more details.
  21.  You should have received a copy of the GNU Lesser General Public
  22.  License along with this unit; if not, the license can be viewed at:
  23.  http://www.gnu.org/copyleft/lesser.html
  24.  or write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  25.  Boston, MA  02111-1307  USA
  26.  }
  27. interface
  28. {$I JEDI.inc}
  29. uses
  30.   ToolsAPI, SysUtils;
  31. function ExtractWhiteSpace(const AString: string): string;
  32. function ExtractFileStem(const AFileName: string): string;
  33. procedure MessageViewAdd(AMessage: string);
  34. procedure MessageViewAddFmt(const MessageFormat: string;
  35.   const Args: array of const);
  36. procedure EventLogAdd(AMessage: string);
  37. procedure EventLogAddFmt(const MessageFormat: string;
  38.   const Args: array of const);
  39. function IsMetaModule(const AModule: IOTAModule): boolean;
  40. function GetCurrentUnitName(out AbsoluteFileSpec: string): boolean;
  41. function GetCurrentProjectName(out AbsoluteFileSpec: string): boolean;
  42. function GetCurrentProjectGroupName(out AbsoluteFileSpec: string): boolean;
  43. function GetCurrentSourceEditor(out SourceEditor: IOTASourceEditor): boolean;
  44. // Returns true for at least one editor found. Parameters are nil if not found
  45. function GetCurrentEditors(out SourceEditor: IOTASourceEditor;
  46.   out FormEditor: IOTAFormEditor): boolean;
  47. function GetTopView(out EditView: IOTAEditView): boolean;
  48. function EditPosToFilePos(const View: IOTAEditView;
  49.   EditPos: TOTAEditPos): longint;
  50. function GetCurrentProject(out Project: IOTAProject): boolean;
  51. function GetCurrentProjectGroup(out ProjectGroup: IOTAProjectGroup): boolean;
  52. function CreateModule(const Creator: IOTACreator): boolean;
  53. function AddWizard(const Wizard: IOTAWizard; out Handle: integer): boolean;
  54. procedure DeleteWizard(const Handle: integer);
  55. {$IFDEF DEBUG}
  56. procedure DebugMessage(const AMessage: string);
  57. procedure DebugMessageFmt(const AMessageFormat: string;
  58.   const Args: array of const);
  59. {$ENDIF}
  60. //////////////////////////////////////////////////////////////////////////////
  61. ///     TXP_OTAFile declaration
  62. //////////////////////////////////////////////////////////////////////////////
  63. type
  64.   IXP_OTAFile = interface(IOTAFile)
  65.     ['{709205C1-C959-48EA-A58B-F74DE1059F50}']
  66.     function GetFileName: string;
  67.     procedure SetFileName(const AFileName: string);
  68.     property FileName: string
  69.       read GetFileName write SetFileName;
  70.   end;
  71.   TXP_OTAFile = class (TInterfacedObject, IOTAFile, IXP_OTAFile)
  72.   protected
  73.     FFileName: string;
  74.     function GetSource: string; virtual; abstract;
  75.     function GetAge: TDateTime; virtual;
  76.     function GetFileName: string; virtual;
  77.     procedure SetFileName(const AFileName: string); virtual;
  78.   public
  79.     constructor Create(const AFileName: string = ''); virtual;
  80.   end;
  81. //////////////////////////////////////////////////////////////////////////////
  82. ///     TXP_OTAMessage declaration
  83. //////////////////////////////////////////////////////////////////////////////
  84.   TXP_OTAMessage = class (TInterfacedObject, IOTACustomMessage)
  85.   protected
  86.     FLineText: string;
  87.     FFileName: string;
  88.     FLineNumber: integer;
  89.     FColumnNumber: integer;
  90.     function GetColumnNumber: Integer; virtual;
  91.     function GetFileName: string; virtual;
  92.     function GetLineNumber: Integer; virtual;
  93.     function GetLineText: string; virtual;
  94.     procedure ShowHelp; virtual;
  95.   public
  96.     constructor Create(const ALineText: string; const AFileName: string = '';
  97.       const ALineNumber: integer = 0; const AColumnNumber: integer = 0); virtual;
  98.   end;
  99. //////////////////////////////////////////////////////////////////////////////
  100. ///     TXP_OTANotifier declaration
  101. //////////////////////////////////////////////////////////////////////////////
  102.   TXP_OTANotifier = class (TInterfacedObject, IOTANotifier)
  103.   public
  104.     constructor Create;
  105.     destructor Destroy; override;
  106.   protected
  107.     procedure AfterSave; virtual;
  108.     procedure BeforeSave; virtual;
  109.     procedure Destroyed; virtual;
  110.     procedure Modified; virtual;
  111.   end;
  112. implementation
  113. {$IFNDEF DELPHI6_UP}
  114. uses
  115.   FileCtrl;                  // ForceDirectories
  116. {$ENDIF}
  117. const
  118.   CVSID: string = '$Header: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/DelphiExperts/Common/XP_OTAUtils.pas,v 1.2 2004/05/03 15:07:15 pvspain Exp $';
  119. {$IFDEF DEBUG}
  120. procedure DebugMessage(const AMessage: string);
  121. begin
  122.   EventLogAdd(AMessage);
  123. end;
  124. procedure DebugMessageFmt(const AMessageFormat: string;
  125.   const Args: array of const);
  126. begin
  127.   EventLogAddFmt(AMessageFormat, Args);
  128. end;
  129. {$ENDIF}
  130. function ExtractWhiteSpace(const AString: string): string;
  131. var
  132.   Src, Dst: pchar;
  133. begin
  134.   System.SetLength(Result, System.Length(AString));
  135.   if System.Length(Result) > 0 then
  136.   begin
  137.     Src := @AString[1];
  138.     Dst := @Result[1];
  139.     while Src^ <> #0 do
  140.     begin
  141.       if not (Src^ in [#09..#13, #32]) then
  142.       begin
  143.         Dst^ := Src^;
  144.         System.Inc(Dst);
  145.       end;
  146.       System.Inc(Src);
  147.     end;
  148.     // Copy null terminator (#0);
  149.     Dst^ := Src^;
  150.     // Copy to new string, length based on position of null terminator
  151.     Result := pchar(Result);
  152.   end;
  153. end;
  154. function ExtractFileStem(const AFileName: string): string;
  155. begin
  156.   Result := SysUtils.ChangeFileExt( SysUtils.ExtractFileName(AFileName), '' );
  157. end;
  158. procedure MessageViewAdd(AMessage: string);
  159. var
  160.   MessageServices: IOTAMessageServices;
  161. begin
  162.   if SysUtils.Supports(BorlandIDEServices, IOTAMessageServices,
  163.     MessageServices) then
  164.     MessageServices.AddTitleMessage(AMessage);
  165. end;
  166. procedure MessageViewAddFmt(const MessageFormat: string;
  167.   const Args: array of const);
  168. begin
  169.   MessageViewAdd(SysUtils.Format(MessageFormat, Args));
  170. end;
  171. procedure EventLogAdd(AMessage: string);
  172. var
  173.   DebuggerServices: IOTADebuggerServices;
  174. begin
  175.   if SysUtils.Supports(BorlandIDEServices, IOTADebuggerServices,
  176.     DebuggerServices) then
  177. {$IFDEF DELPHI7_UP}
  178.     DebuggerServices.LogString(AMessage, litDefault);
  179. {$ELSE}
  180.     DebuggerServices.LogString(AMessage);
  181. {$ENDIF}
  182. end;
  183. procedure EventLogAddFmt(const MessageFormat: string;
  184.   const Args: array of const);
  185. begin
  186.   EventLogAdd(SysUtils.Format(MessageFormat, Args));
  187. end;
  188. function IsMetaModule(const AModule: IOTAModule): boolean;
  189. var
  190.   Project: IOTAProject;
  191.   ProjectGroup: IOTAProjectGroup;
  192. begin
  193.   Result := SysUtils.Supports(AModule, IOTAProject, Project)
  194.     or SysUtils.Supports(AModule, IOTAProjectGroup, ProjectGroup);
  195. end;
  196. function GetCurrentUnitName(out AbsoluteFileSpec: string): boolean;
  197. var
  198.   SourceEditor: IOTASourceEditor;
  199. begin
  200.   Result := GetCurrentSourceEditor(SourceEditor);
  201.   if Result then
  202.     AbsoluteFileSpec := SourceEditor.FileName
  203.   else
  204.     AbsoluteFileSpec := '';
  205. end;
  206. function GetCurrentProjectName(out AbsoluteFileSpec: string): boolean;
  207. var
  208.   Project: IOTAProject;
  209. begin
  210.   Result := GetCurrentProject(Project);
  211.   if Result then
  212.     AbsoluteFileSpec := Project.FileName
  213.   else
  214.     AbsoluteFileSpec := '';
  215. end;
  216. function GetCurrentProjectGroupName(out AbsoluteFileSpec: string): boolean;
  217. var
  218.   idx: integer;
  219.   ProjectGroup: IOTAProjectGroup;
  220.   SourceEditor: IOTASourceEditor;
  221. begin
  222.   if GetCurrentProjectGroup(ProjectGroup) then
  223.   begin
  224.     idx := ProjectGroup.GetModuleFileCount - 1;
  225.     // Iterate over modules till we find a source editor or list exhausted
  226.     while not ((idx < 0)
  227.       or SysUtils.Supports(ProjectGroup.GetModuleFileEditor(idx),
  228.       IOTASourceEditor, SourceEditor)) do
  229.       System.Dec(idx);
  230.     // Success if list wasn't ehausted.
  231.     if idx >= 0 then
  232.     begin
  233.       AbsoluteFileSpec := SourceEditor.FileName;
  234.       Result := true;
  235.       exit;
  236.     end;
  237.   end;
  238.   Result := false;
  239.   AbsoluteFileSpec := '';
  240. end;
  241. function GetCurrentSourceEditor(out SourceEditor: IOTASourceEditor): boolean;
  242. var
  243.   ModuleServices: IOTAModuleServices;
  244.   Module: IOTAModule;
  245.   idx: integer;
  246. begin
  247.   Result := false;
  248.   SourceEditor := nil;
  249.   if SysUtils.Supports(BorlandIDEServices, IOTAModuleServices,
  250.     ModuleServices) then
  251.   begin
  252.     Module := ModuleServices.CurrentModule;
  253.     if System.Assigned(Module) then
  254.     begin
  255.       idx := Module.GetModuleFileCount - 1;
  256.       // Iterate over modules till we find a source editor or list exhausted
  257.       while not ((idx < 0) or SysUtils.Supports(Module.GetModuleFileEditor(idx),
  258.         IOTASourceEditor, SourceEditor)) do
  259.         System.Dec(idx);
  260.       // Success if list wasn't ehausted.
  261.       Result := idx >= 0;
  262.     end;
  263.   end;
  264. end;
  265. function GetCurrentEditors(out SourceEditor: IOTASourceEditor;
  266.   out FormEditor: IOTAFormEditor): boolean;
  267. var
  268.   ModuleServices: IOTAModuleServices;
  269.   Module: IOTAModule;
  270.   idx: integer;
  271. begin
  272.   SourceEditor := nil;
  273.   FormEditor := nil;
  274.   if SysUtils.Supports(BorlandIDEServices, IOTAModuleServices,
  275.     ModuleServices) then
  276.   begin
  277.     Module := ModuleServices.CurrentModule;
  278.     if System.Assigned(Module) then
  279.       for idx := Module.GetModuleFileCount - 1 downto 0 do
  280.         if not SysUtils.Supports(Module.GetModuleFileEditor(idx),
  281.           IOTASourceEditor, SourceEditor) then
  282.           SysUtils.Supports(Module.GetModuleFileEditor(idx),
  283.             IOTAFormEditor, FormEditor);
  284.   end;
  285.   Result := Assigned(SourceEditor) or Assigned(FormEditor);
  286. end;
  287. function GetTopView(out EditView: IOTAEditView): boolean;
  288. var
  289.   EditorServices: IOTAEditorServices;
  290. begin
  291.   // EditorServices.TopView AV's if there are no buffers open. Workaround is to
  292.   // check for EditorServices.TopBuffer first.
  293.   Result := SysUtils.Supports(
  294.     BorlandIDEServices, IOTAEditorServices, EditorServices)
  295.     and System.Assigned(EditorServices.TopBuffer);
  296.   if Result then
  297.     EditView := EditorServices.TopView
  298.   else
  299.     EditView := nil;
  300. end;
  301. function EditPosToFilePos(const View: IOTAEditView;
  302.   EditPos: TOTAEditPos): longint;
  303. var
  304.   CharPos: TOTACharPos;
  305. begin
  306.   if System.Assigned(View) then
  307.   begin
  308.     View.ConvertPos(true, EditPos, CharPos);
  309.     Result := View.CharPosToPos(CharPos);
  310.   end
  311.   else
  312.     Result := 0;
  313.   
  314. end;
  315. function GetCurrentProject(out Project: IOTAProject): boolean;
  316. var
  317.   ProjectGroup: IOTAProjectGroup;
  318. begin
  319.   if GetCurrentProjectGroup(ProjectGroup) then
  320.     Project := ProjectGroup.GetActiveProject
  321.   else
  322.     Project := nil;
  323.   Result := System.Assigned(Project);
  324. end;
  325. function GetCurrentProjectGroup(out ProjectGroup: IOTAProjectGroup): boolean;
  326. var
  327.   ModuleServices: IOTAModuleServices;
  328.   idx: integer;
  329. begin
  330.   Result := false;
  331.   ProjectGroup := nil;
  332.   if SysUtils.Supports(BorlandIDEServices, IOTAModuleServices,
  333.     ModuleServices) then
  334.   begin
  335.     idx := ModuleServices.ModuleCount - 1;
  336.     // Iterate over modules till we find a project group or list exhausted
  337.     while not ((idx < 0) or SysUtils.Supports(ModuleServices.Modules[idx],
  338.       IOTAProjectGroup, ProjectGroup)) do
  339.       System.Dec(idx);
  340.     // Success if list wasn't ehausted.
  341.     Result := idx >= 0;
  342.   end;
  343. end;
  344. function CreateModule(const Creator: IOTACreator): boolean;
  345. var
  346.   ModuleServices: IOTAModuleServices;
  347. begin
  348.   Result :=  SysUtils.Supports(ToolsAPI.BorlandIDEServices, IOTAModuleServices,
  349.     ModuleServices) and System.Assigned(Creator);
  350.   if Result then
  351.     ModuleServices.CreateModule(Creator);
  352. end;
  353. function AddWizard(const Wizard: IOTAWizard; out Handle: integer): boolean;
  354. var
  355.   WizardServices: IOTAWizardServices;
  356. begin
  357.   Result :=  SysUtils.Supports(ToolsAPI.BorlandIDEServices, IOTAWizardServices,
  358.     WizardServices) and System.Assigned(Wizard);
  359.   if Result then
  360.     Handle := WizardServices.AddWizard(Wizard);
  361. end;
  362. procedure DeleteWizard(const Handle: integer);
  363. var
  364.   WizardServices: IOTAWizardServices;
  365. begin
  366.   if SysUtils.Supports(ToolsAPI.BorlandIDEServices, IOTAWizardServices,
  367.     WizardServices) then
  368.     WizardServices.RemoveWizard(Handle);
  369. end;
  370. { TXP_OTAFile }
  371. constructor TXP_OTAFile.Create(const AFileName: string);
  372. begin
  373.   inherited Create;
  374.   SetFileName(AFileName);
  375. end;
  376. function TXP_OTAFile.GetAge: TDateTime;
  377. begin
  378.   // New file
  379.   Result := -1;
  380. end;
  381. function TXP_OTAFile.GetFileName: string;
  382. begin
  383.   Result := FFileName
  384. end;
  385. procedure TXP_OTAFile.SetFileName(const AFileName: string);
  386. begin
  387.   FFileName := AFileName;
  388. end;
  389. { TXP_OTAMessage }
  390. constructor TXP_OTAMessage.Create(const ALineText, AFileName: string;
  391.   const ALineNumber, AColumnNumber: integer);
  392. begin
  393.   inherited Create;
  394.   FLineText := ALineText;
  395.   FFileName := AFileName;
  396.   FLineNumber := ALineNumber;
  397.   FColumnNumber := AColumnNumber;
  398. end;
  399. function TXP_OTAMessage.GetColumnNumber: Integer;
  400. begin
  401.   Result := FColumnNumber;
  402. end;
  403. function TXP_OTAMessage.GetFileName: string;
  404. begin
  405.   Result := FFileName;
  406. end;
  407. function TXP_OTAMessage.GetLineNumber: Integer;
  408. begin
  409.   Result := FLineNumber;
  410. end;
  411. function TXP_OTAMessage.GetLineText: string;
  412. begin
  413.   Result := FLineText;
  414. end;
  415. procedure TXP_OTAMessage.ShowHelp;
  416. begin
  417.   // Do nothing;
  418. end;
  419. { TXP_OTANotifier }
  420. procedure TXP_OTANotifier.AfterSave;
  421. begin
  422.   {$IFDEF DEBUG}
  423.   DebugMessageFmt('%s: TXP_OTANotifier.AfterSave.', [ClassName]);
  424.   {$ENDIF}
  425. end;
  426. procedure TXP_OTANotifier.BeforeSave;
  427. begin
  428.   {$IFDEF DEBUG}
  429.   DebugMessageFmt('%s: TXP_OTANotifier.BeforeSave.', [ClassName]);
  430.   {$ENDIF}
  431. end;
  432. constructor TXP_OTANotifier.Create;
  433. begin
  434.   {$IFDEF DEBUG}
  435.   DebugMessageFmt('%s: Entering TXP_OTANotifier.Create.', [ClassName]);
  436.   {$ENDIF}
  437.   inherited;
  438. end;
  439. destructor TXP_OTANotifier.Destroy;
  440. begin
  441.   {$IFDEF DEBUG}
  442.   DebugMessageFmt('%s: Entering TXP_OTANotifier.Destroy.', [ClassName]);
  443.   {$ENDIF}
  444.   inherited;
  445. end;
  446. procedure TXP_OTANotifier.Destroyed;
  447. begin
  448.   {$IFDEF DEBUG}
  449.   DebugMessageFmt('%s: TXP_OTANotifier.Destroyed.', [ClassName]);
  450.   {$ENDIF}
  451. end;
  452. procedure TXP_OTANotifier.Modified;
  453. begin
  454.   {$IFDEF DEBUG}
  455.   DebugMessageFmt('%s: TXP_OTANotifier.Modified.', [ClassName]);
  456.   {$ENDIF}
  457. end;
  458. end.