myidestream.pas

一个非常好用的DELPHI源码格式化工具.

{+--------------------------------------------------------------------------+
| Class:       TIDEStream
| Created:     9.97
| Author:      Martin Waldenburg
| Copyright    1997, all rights reserved.
| Description: A simple and effective interface to the IDE's text buffer
|              You can retrive the text of the IDE's text buffer either
|              as PChar or as string list.
|              You can manipulate it in any way and then replace the
|              whole text with the result of your manipulation.
| Version:     1.1
| Status:      FreeWare
|   Modified to access not only the current file
   by  Egbert van Nes
   Modified to use the Open Tools API by Greg Eytcheson
| Disclaimer:
| This is provided as is, expressly without a warranty of any kind.
| You use it at your own risc.
+--------------------------------------------------------------------------+}
unit MyIDEStream;

interface

uses
 Windows, SysUtils, Messages, Classes, ToolsAPI{$IFDEF CS_TRACE}, CodeSiteLogging{$ENDIF};

type
 TIDEStream = class(TMemoryStream)
 private
  FLines: TStringList;
  FFileName: string;
  function GetAsPChar: PChar;
  procedure LoadLines;
  function GetLines: TStringList;
  procedure SetLines(NewValue: TStringList);
  function GetStreamTextLen: Longint;
 protected
 public
  constructor Create(AFileName: string);
  destructor Destroy; override;
  procedure WriteText(Text: PChar);
  property Capacity;
  property AsPChar: PChar read GetAsPChar;
  function GetText: PChar;
  procedure SetMemPointer(Ptr: Pointer; Size: Longint);
  property StreamTextLen: Longint read GetStreamTextLen;
  property Lines: TStringList read GetLines write SetLines;
  property FileName: string read FFileName;
 published
  procedure Clear;
 end;
 
function GetProjectName: string;
function GetProjectFileNames(ProjectFiles: TStrings): Integer;
function GetCurrentFile: string;
function GetOpenFileList(OpenFiles: TStrings): Integer;
function IsReadonlyBuffer(FileName: string): Boolean;
procedure SaveFile(AFileName: string);
function IsFileOpen(FileName: string): Boolean;

implementation
uses Dialogs, Forms, Menus, StdCtrls, ComCtrls;

procedure SaveFile(AFileName: string);
var
 ToolServices: IOTAActionServices;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'SaveFile' );{$ENDIF}
 
 if AFileName = '' then exit;
 ToolServices := BorlandIDEServices as IOTAActionServices;
 if Assigned(ToolServices) then
  begin
   try
    ToolServices.SaveFile(AFileName);
   except
    raise Exception.Create('Unabled to save file ' + AFileName);
   end;
  end;
// ToolServices := nil;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'SaveFile' );{$ENDIF}
end;

function GetProjectName: string;
var
 prjGrp: IOTAProject;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'GetProjectName' );{$ENDIF}
 Result := '';
 prjGrp := GetActiveProject;
 if prjGrp <> nil then
  begin
   try
    Result := prjGrp.FileName;
   except
    Result := '';
   end;
  end;
// prjGrp := nil;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'GetProjectName' );{$ENDIF}
end; { GetProjectName }

function GetProjectFileNames(ProjectFiles: TStrings): Integer;
var
 j: Integer;
 prjGrp: IOTAProject;
 fileInfo: IOTAModuleInfo;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'GetProjectFileNames' );{$ENDIF}
 Result := 0;
 prjGrp := GetActiveProject;
 if not Assigned(prjGrp) then Exit;
 try
  for j := 0 to prjGrp.GetModuleCount - 1 do
   begin
    fileInfo := prjGrp.GetModule(j);
    if Assigned(fileInfo) then
     begin
      if AnsiCompareText(ExtractFileExt(fileInfo.FileName), '.pas') = 0 then
       ProjectFiles.Add(fileInfo.FileName);
     end;
   end;
  Result := ProjectFiles.Count;
 except
 end;
// FileInfo := nil;
// prjGrp := nil;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'GetProjectFileNames' );{$ENDIF}
end;

function GetCurrentFile: string;
var
 i: integer;
 ModuleServices: IOTAModuleServices;
 Module: IOTAModule;
 Intf: IOTAEditor;
 Editor: IOTASourceEditor;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'GetCurrentFile' );{$ENDIF}
 Result := '';
 try
  ModuleServices := BorlandIDEServices as IOTAModuleServices;
  if ModuleServices = nil then Exit;
  Module := ModuleServices.CurrentModule;
  if Module = nil then exit;
  for I := 0 to Module.GetModuleFileCount - 1 do
   begin
    Intf := Module.GetModuleFileEditor(I);
    if Intf.QueryInterface(IOTASourceEditor, Editor) = S_OK then
     Break;
   end;
  if editor = nil then exit;
  Result := Editor.FileName;
  if Result <> '' then
   if AnsiCompareText(ExtractFileExt(Result), '.pas') <> 0 then
    Result := '';
 except
 end;
// Editor := nil;
// Intf := nil;
// Module := nil;
// ModuleServices := nil;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'GetCurrentFile' );{$ENDIF}
end; { GetCurrentFile }

function GetOpenFileList(OpenFiles: TStrings): Integer;
var
 i, k: integer;
 ModuleServices: IOTAModuleServices;
 Module: IOTAModule;
 Intf: IOTAEditor;
 Editor: IOTASourceEditor;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'GetOpenFileList' );{$ENDIF}
 Result := 0;
 if not assigned(OpenFiles) then raise Exception.Create('Create the Filelist first!');
 try
  OpenFiles.Clear;
  ModuleServices := BorlandIDEServices as IOTAModuleServices;
  if ModuleServices = nil then Exit;
  for i := 0 to ModuleServices.ModuleCount - 1 do
   begin
    Module := ModuleServices.Modules[i];
    if Assigned(Module) then
     begin
      for k := 0 to Module.GetModuleFileCount - 1 do
       begin
        Editor := nil;
        Intf := Module.GetModuleFileEditor(k);
        if Intf.QueryInterface(IOTASourceEditor, Editor) = S_OK then
         Break;
       end;
      if Assigned(Editor) then
       begin
        If AnsiCompareText(ExtractFileExt(Editor.FileName), '.pas') = 0 then
         OpenFiles.Add(Editor.FileName);
        Editor := nil;
       end;
     end;
   end;
  Result := OpenFiles.Count;
 except
 end;
// Editor := nil;
// Intf := nil;
// Module := nil;
// ModuleServices := nil;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'GetOpenFileList' );{$ENDIF}
end;

function IsFileOpen(FileName: string): Boolean;
var
 Mods: IOTAModuleServices;
 j: Integer;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'IsFileOpen' );{$ENDIF}
 Result := False;
 Mods := BorlandIDEServices as IOTAModuleServices;
 if Mods = nil then exit;
 try
  for j := 0 to Mods.ModuleCount - 1 do
   begin
    if AnsiCompareStr(Mods.GetModule(j).FileName, FileName) = 0 then
     begin
      Result := True;
      Break;
     end;
   end;
 except Result := False;
 end;
// Mods := nil;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'IsFileOpen' );{$ENDIF}
end;

function IsReadonlyBuffer(FileName: string): Boolean;
//var
// I, J: Integer;
var
 i, k: integer;
 ModuleServices: IOTAModuleServices;
 Module: IOTAModule;
 Intf: IOTAEditor;
 EditorIntf: IOTASourceEditor;
 Editor: IOTAEditBuffer;
 
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( 'IsReadonlyBuffer' );{$ENDIF}
 Result := False;
 ModuleServices := BorlandIDEServices as IOTAModuleServices;
 if ModuleServices = nil then Exit;
 for i := 0 to ModuleServices.ModuleCount - 1 do
  begin
   if AnsiCompareStr(ModuleServices.GetModule(i).FileName, FileName) = 0 then
    begin
     Module := ModuleServices.GetModule(i);
     Break;
    end;
  end;
 
 if Assigned(Module) then
  begin
   for k := 0 to Module.GetModuleFileCount - 1 do
    begin
     Editor := nil;
     Intf := Module.GetModuleFileEditor(k);
     if Intf.QueryInterface(IOTASourceEditor, EditorIntf) = S_OK then
      if Intf.QueryInterface(IOTAEditBuffer, Editor) = S_OK then
       Break;
    end;
   if Assigned(Editor) then
    Result := Editor.IsReadOnly;
  end;
 //   end;
 
 // Result := False; {default value}
 // try
 //  if Application <> nil then
 //   with Application do
 //    for I := 0 to ComponentCount - 1 do
 //     if Components[I] is TForm then
 //      if CompareText(ExtractFileName(TForm(Components[I]).Caption),
 //       ExtractFileName(FileName)) = 0 then
 //       with Components[I] do
 //        for J := 0 to ComponentCount - 1 do
 //         if Components[J] is TStatusBar then
 //          Result := TStatusBar(Components[J]).Panels[2].Text =
 //           'Read only';
 // except
 //  Result := False;
 // end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( 'IsReadonlyBuffer' );{$ENDIF}
end;

constructor TIDEStream.Create(AFileName: string);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Create' );{$ENDIF}
 inherited Create;
 if AFileName = '' then
  begin
   FFileName := GetCurrentFile;
  end
 else
  FFileName := AFileName;
 if LowerCase(ExtractFileExt(FFileName)) <> '.pas' then
  raise Exception.Create('Sorry, must be a .pas file');
 FLines := TStringList.Create;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Create' );{$ENDIF}
end; { Create }

procedure TIDEStream.Clear;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Clear' );{$ENDIF}
 FLines.Clear;
 inherited Clear;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Clear' );{$ENDIF}
end; { Clear }

destructor TIDEStream.Destroy;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'Destroy' );{$ENDIF}
 FLines.Free;
 inherited Destroy;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'Destroy' );{$ENDIF}
end; { Destroy }

function TIDEStream.GetAsPChar: PChar;
const
 TheEnd: Char = #0;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetAsPChar' );{$ENDIF}
 Position := Size;
 Write(TheEnd, 1);
 SetPointer(Memory, Size - 1);
 Result := Memory;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetAsPChar' );{$ENDIF}
end; { GetAsPChar }

procedure TIDEStream.SetMemPointer(Ptr: Pointer; Size: Longint);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetMemPointer' );{$ENDIF}
 SetPointer(Ptr, Size);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetMemPointer' );{$ENDIF}
end; { SetMemPointer }

function TIDEStream.GetStreamTextLen: Longint;
const
 {BuffLen = 16383;}
 BuffLen = $FF;
var
 TextBuffer: PChar;
 Readed, BuffPos, TextLen: Longint;
 i: Integer;
 ModuleServices: IOTAModuleServices;
 Module: IOTAModule;
 Intf: IOTAEditor;
 Editor: IOTASourceEditor;
 Reader: IOTAEditReader;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetStreamTextLen' );{$ENDIF}
 TextLen := 0;
 Getmem(TextBuffer, BuffLen + 1);
 BuffPos := 0;
 ModuleServices := BorlandIDEServices as IOTAModuleServices;
 Module := ModuleServices.FindModule(FileName);
 if Module = nil then
  begin
   Result := 0;
   Exit;
  end;
 for I := 0 to Module.GetModuleFileCount - 1 do
  begin
   Intf := Module.GetModuleFileEditor(I);
   if Intf.QueryInterface(IOTASourceEditor, Editor) = S_OK then
    Break;
  end;
 Reader := Editor.CreateReader;
 
 try
  repeat
   Readed := Reader.GetText(BuffPos, TextBuffer, BuffLen);
   TextLen := TextLen + Readed;
   inc(BuffPos, Readed);
  until Readed < BuffLen;
 finally
  Freemem(TextBuffer, BuffLen + 1);
 end;
 Result := TextLen;
// Reader := nil;
// Editor := nil;
// Intf := nil;
// Module := nil;
// ModuleServices := nil;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetStreamTextLen' );{$ENDIF}
end; { GetStreamTextLen }

function TIDEStream.GetText: PChar;
const
 BuffLen = $FF;
var
 TextBuffer: PChar;
 Readed, BuffPos: Longint;
 i: Integer;
 ModuleServices: IOTAModuleServices;
 Module: IOTAModule;
 Intf: IOTAEditor;
 Editor: IOTASourceEditor;
 Reader: IOTAEditReader;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetText' );{$ENDIF}
 Clear;
 Getmem(TextBuffer, BuffLen + 1);
 BuffPos := 0;
 ModuleServices := BorlandIDEServices as IOTAModuleServices;
 Module := ModuleServices.FindModule(FileName);
 if Module = nil then
  begin
   Result := '';
   Exit;
  end;
 for I := 0 to Module.GetModuleFileCount - 1 do
  begin
   Intf := Module.GetModuleFileEditor(I);
   if Intf.QueryInterface(IOTASourceEditor, Editor) = S_OK then
    Break;
  end;
 Reader := Editor.CreateReader;
 try
  repeat
   Readed := Reader.GetText(BuffPos, TextBuffer, BuffLen);
   Write(TextBuffer^, Readed);
   inc(BuffPos, Readed);
  until Readed < BuffLen;
 finally
  Freemem(TextBuffer, BuffLen + 1);
 end;
 Result := AsPChar;
// Reader := nil;
// Editor := nil;
// Intf := nil;
// Module := nil;
// ModuleServices := nil;

  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetText' );{$ENDIF}
end; { GetText }

procedure TIDEStream.WriteText(Text: PChar);
var
 TextLen: Longint;
 i: Integer;
 ModuleServices: IOTAModuleServices;
 Module: IOTAModule;
 Intf: IOTAEditor;
 Editor: IOTASourceEditor;
 Writer: IOTAEditWriter;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'WriteText' );{$ENDIF}
 if Size = 0 then
  TextLen := GetStreamTextLen
 else
  TextLen := Size;
 ModuleServices := BorlandIDEServices as IOTAModuleServices;
 Module := ModuleServices.FindModule(FileName);
 if Module = nil then Exit;
 for I := 0 to Module.GetModuleFileCount - 1 do
  begin
   Intf := Module.GetModuleFileEditor(I);
   if Intf.QueryInterface(IOTASourceEditor, Editor) = S_OK then
    Break;
  end;
 Writer := Editor.CreateWriter;
 if (Writer <> nil) and (Text <> nil) then
  try
   if TextLen > 0 then
    begin
     Writer.CopyTo(0);
     Writer.DeleteTo(TextLen - 2);
    end;
   Writer.Insert(Text);
  finally
  end;
// Writer := nil;
// Editor := nil;
// Intf := nil;
// Module := nil;
// ModuleServices := nil;

  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'WriteText' );{$ENDIF}
end; { WriteText }

procedure TIDEStream.LoadLines;
var
 Run, LineStart, LineEnd: PChar;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'LoadLines' );{$ENDIF}
 LineStart := GetText;
 Run := LineStart;
 while Run^ <> #0 do
  begin
   Run := LineStart;
   while not (Run^ in [#0, #10, #13]) do
    inc(Run);
   LineEnd := Run;
   if Run^ <> #0 then
    begin
     inc(Run);
     if Run^ in [#10, #13] then inc(Run);
    end;
   LineEnd^ := #0;
   FLines.Add(LineStart);
   LineStart := Run;
  end;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'LoadLines' );{$ENDIF}
end; { LoadLines }

function TIDEStream.GetLines: TStringList;
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'GetLines' );{$ENDIF}
 if FLines.Count = 0 then LoadLines;
 Result := FLines;
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'GetLines' );{$ENDIF}
end; { GetLines }

procedure TIDEStream.SetLines(NewValue: TStringList);
begin
  {$IFDEF CS_TRACE}CodeSite.EnterMethod( Self, 'SetLines' );{$ENDIF}
 FLines.Assign(NewValue);
  {$IFDEF CS_TRACE}CodeSite.ExitMethod( Self, 'SetLines' );{$ENDIF}
end; { SetLines }

end.