david
e4d0fcb01d
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@46 b6239004-a887-0f4b-9937-50029ccdca16
415 lines
11 KiB
ObjectPascal
415 lines
11 KiB
ObjectPascal
unit uEWOTAHelpers;
|
|
|
|
{$I Everwood.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF DELPHI5}ComObj,{$ENDIF}
|
|
ToolsAPI, Classes;
|
|
|
|
function GetDelphiVersion: Integer;
|
|
|
|
function GetDllPath: String;
|
|
|
|
function ModuleServices: IOTAModuleServices;
|
|
function CurrentProject: IOTAProject;
|
|
function ProjectByName(const aName: string): IOTAProject;
|
|
function CurrentProjectGroup: IOTAProjectGroup;
|
|
|
|
function GetUniqueProjectFilename(aProject: IOTAProject; aName: string): string;
|
|
|
|
function FindModuleByUnitName(const aProject: IOTAProject; const aModuleName: string): IOTAModule;
|
|
|
|
function RemoveInitialT(const aString:string):string;
|
|
function AddInitialT(const aString:string):string;
|
|
|
|
function ProjectName: string;
|
|
|
|
function LoadStringFromFile(iFilename:string):string;
|
|
procedure SaveStringToFile(const iFilename,iString:string);
|
|
|
|
function ReplaceVariables(const aString: string; aVariables: TStrings): string;
|
|
|
|
function ReadModuleSource(const aModule: IOTAModule): string;
|
|
procedure WriteModuleSource(const aModule: IOTAModule; const aCode, aHeader: string);
|
|
procedure AddOrReplaceNamedModule(const aProject: IOTAProject; aName, aCode: string);
|
|
|
|
function LanguageFromPersonality(aProject: IOTAProject): string;
|
|
function LanguageFromPersonalityEx(aProject: IOTAProject): string;
|
|
|
|
implementation
|
|
|
|
uses {$IFDEF MSWINDOWS}Windows, ActiveX, {$ENDIF} SysUtils, Forms, uEWHelpers;
|
|
|
|
function LoadStringFromFile(iFilename:string):string;
|
|
{$IFDEF DELPHI2009UP}
|
|
begin
|
|
With TStringList.Create do try
|
|
LoadFromFile(iFilename);
|
|
Result := Text;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
var t:text;
|
|
s:string;
|
|
begin
|
|
try
|
|
AssignFile(t,iFilename);
|
|
Reset(t);
|
|
try
|
|
result := '';
|
|
while not Eof(t) do begin
|
|
Readln(t,s);
|
|
result := result+s+#13#10;
|
|
end;
|
|
finally
|
|
CloseFile(t);
|
|
end;
|
|
except
|
|
on E:Exception do
|
|
raise EInOutError.Create('Error loading file '+iFilename+' ('+E.ClassName+': '+E.Message+')');
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure SaveStringToFile(const iFilename,iString:string);
|
|
{$IFDEF DELPHI2009UP}
|
|
begin
|
|
With TStringList.Create do try
|
|
Text := iString;
|
|
SaveToFile(iFilename);
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
var t:TextFile;
|
|
begin
|
|
try
|
|
AssignFile(t,iFilename);
|
|
Rewrite(t);
|
|
try
|
|
Write(t,iString);
|
|
finally
|
|
CloseFile(t);
|
|
end;
|
|
except
|
|
on E:Exception do
|
|
raise EInOutError.Create('Error saving file '+iFilename+' ('+E.ClassName+': '+E.Message+')');
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function NewGuid:TGUID;
|
|
begin
|
|
{$IFDEF MSWINDOWS}
|
|
CoCreateGuid(result);
|
|
{$ENDIF MSWINDOWS}
|
|
{$IFDEF LINUX}
|
|
CreateGuid(result);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function NewGuidAsString:string;
|
|
begin
|
|
result := GuidToString(NewGuid());
|
|
end;
|
|
|
|
function NewGuidAsStringNoBrackets:string;
|
|
begin
|
|
result := GuidToString(NewGuid());
|
|
result := Copy(result,2,Length(result)-2);
|
|
end;
|
|
|
|
function ReplaceVariables(const aString: string; aVariables: TStrings): string;
|
|
var
|
|
i:integer;
|
|
begin
|
|
{ No, this isn't efficient code. But given the fact that this is used at designtime and
|
|
in a place where the execution is abolutely not time-critical, clarity is preferable to
|
|
efficiency, imho. mh. }
|
|
|
|
result := aString;
|
|
if Assigned(aVariables) then begin
|
|
for i := 0 to aVariables.Count-1 do begin
|
|
result := StringReplace(result,'$('+aVariables.Names[i]+')',aVariables.Values[aVariables.Names[i]],[rfReplaceAll,rfIgnoreCase]);
|
|
end;
|
|
end;
|
|
result := StringReplace(result,'$(NewID)',NewGuidAsString(),[rfReplaceAll,rfIgnoreCase]);
|
|
result := StringReplace(result,'$(NewID2)',NewGuidAsStringNoBrackets(),[rfReplaceAll,rfIgnoreCase]);
|
|
end;
|
|
|
|
function ProjectName: string;
|
|
var
|
|
lProjectName:string;
|
|
begin
|
|
if Assigned(CurrentProject()) then begin
|
|
lProjectName := (CurrentProject as IOTAModule).FileName;
|
|
lProjectName := ChangeFileExt(ExtractFileName(lProjectName),'');
|
|
end
|
|
else begin
|
|
lProjectName := '';
|
|
end;
|
|
result := lProjectName;
|
|
end;
|
|
|
|
function RemoveInitialT(const aString:string):string;
|
|
begin
|
|
result := aString;
|
|
if (result <> '') and (result[1] = 'T') then Delete(result,1,1);
|
|
end;
|
|
|
|
function AddInitialT(const aString:string):string;
|
|
begin
|
|
result := aString;
|
|
if (result <> '') and (result[1] <> 'T') then result := 'T'+result;
|
|
end;
|
|
|
|
function GetDllPath: String;
|
|
var TheFileName : array[0..MAX_PATH] of char;
|
|
begin
|
|
FillChar(TheFileName, SizeOf(TheFileName), #0);
|
|
{$IFDEF KYLIX}System.{$ENDIF}GetModuleFileName(hInstance, TheFileName, sizeof(TheFileName));
|
|
Result := ExtractFilePath(TheFileName);
|
|
end;
|
|
|
|
function ModuleServices: IOTAModuleServices;
|
|
begin
|
|
result := (BorlandIDEServices as IOTAModuleServices);
|
|
end;
|
|
|
|
function CurrentProject: IOTAProject;
|
|
var
|
|
services: IOTAModuleServices;
|
|
module: IOTAModule;
|
|
project: IOTAProject;
|
|
projectgroup: IOTAProjectGroup;
|
|
multipleprojects: Boolean;
|
|
i: Integer;
|
|
begin
|
|
result := nil;
|
|
|
|
multipleprojects := False;
|
|
services := ModuleServices;
|
|
|
|
if (services = nil) then Exit;
|
|
|
|
for I := 0 to (services.ModuleCount - 1) do begin
|
|
module := services.Modules[I];
|
|
if (module.QueryInterface(IOTAProjectGroup, ProjectGroup) = S_OK) then begin
|
|
result := ProjectGroup.ActiveProject;
|
|
Exit;
|
|
end
|
|
|
|
else if module.QueryInterface(IOTAProject, Project) = S_OK then begin
|
|
if (result = nil) then
|
|
result := Project // Found the first project, so save it
|
|
else
|
|
multipleprojects := True; // It doesn't look good, but keep searching for a project group
|
|
end;
|
|
end;
|
|
|
|
if multipleprojects then result := nil;
|
|
end;
|
|
|
|
function ProjectByName(const aName: string): IOTAProject;
|
|
var
|
|
services: IOTAModuleServices;
|
|
module: IOTAModule;
|
|
project: IOTAProject;
|
|
i: Integer;
|
|
begin
|
|
result := nil;
|
|
|
|
services := ModuleServices;
|
|
|
|
if (services = nil) then Exit;
|
|
|
|
for I := 0 to (services.ModuleCount - 1) do begin
|
|
module := services.Modules[I];
|
|
if module.QueryInterface(IOTAProject, Project) = S_OK then begin
|
|
if module.FileName = aName then begin
|
|
result := Project;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function CurrentProjectGroup: IOTAProjectGroup;
|
|
var
|
|
services: IOTAModuleServices;
|
|
i: Integer;
|
|
begin
|
|
Result := nil;
|
|
services := ModuleServices;
|
|
for i := 0 to ModuleServices.ModuleCount - 1 do begin
|
|
if Supports(ModuleServices.Modules[i], IOTAProjectGroup, Result) then begin
|
|
Break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetUniqueProjectFilename(aProject: IOTAProject; aName: string): string;
|
|
var
|
|
lBaseName, lName: string;
|
|
lCount: integer;
|
|
|
|
function ProjectHasFile: boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := false;
|
|
for i := 0 to aProject.GetModuleCount-1 do begin
|
|
if (aProject.GetModule(i).Name = lName) or (aProject.GetModule(i).Name = ChangeFileExt(lName, '')) then begin
|
|
result := true;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
lName := aName;
|
|
lBaseName := ChangeFileExt(aName, '');
|
|
lCount := 0;
|
|
while ProjectHasFile() do begin
|
|
inc(lCount);
|
|
lName := lBaseName+IntToStr(lCount)+ExtractFileExt(aName);
|
|
end;
|
|
result := lName;
|
|
end;
|
|
|
|
function FindModuleByUnitName(const aProject: IOTAProject; const aModuleName: string): IOTAModule;
|
|
var
|
|
i: integer;
|
|
begin
|
|
result := nil;
|
|
for i := 0 to aProject.GetModuleCount - 1 do
|
|
if (CompareText(ExtractFileName(aModuleName), ExtractFileName(aProject.GetModule(i).FileName)) = 0) then begin
|
|
result := aProject.GetModule(i).OpenModule;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
|
|
const
|
|
MaxSourceSize = 10000;
|
|
|
|
function ReadModuleSource(const aModule: IOTAModule): String;
|
|
var
|
|
l, i: integer;
|
|
editor: IOTASourceEditor;
|
|
reader: IOTAEditReader;
|
|
lSource: AnsiString;
|
|
begin
|
|
result := '';
|
|
with aModule do
|
|
for i := 0 to GetModuleFileCount - 1 do begin
|
|
if Supports(GetModuleFileEditor(i), IOTASourceEditor, editor) then begin
|
|
// TODO: find a way not to depend on files smaller than 10k... I only use this for DPRs so it's fine for now
|
|
SetLength(lSource, MaxSourceSize);
|
|
//l := 0; to remove warning
|
|
|
|
reader := editor.CreateReader;
|
|
l := reader.GetText(0, @lSource[1], MaxSourceSize);
|
|
reader := nil;
|
|
SetLength(lSource, l);
|
|
|
|
result := {$IFDEF DELPHI2009UP}UTF8ToString{$ENDIF}(lSource);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure WriteModuleSource(const aModule: IOTAModule; const aCode, aHeader: string);
|
|
var
|
|
i: integer;
|
|
lEditor: IOTASourceEditor;
|
|
writer: IOTAEditWriter;
|
|
begin
|
|
with aModule do begin
|
|
for i := 0 to GetModuleFileCount - 1 do begin
|
|
if Supports(GetModuleFileEditor(i), IOTASourceEditor, lEditor) then begin
|
|
if LowerCase(ExtractFileExt(GetModuleFileEditor(i).FileName)) = '.h' then begin
|
|
if aHeader <> '' then begin
|
|
writer := lEditor.CreateWriter;
|
|
writer.DeleteTo(MaxInt);
|
|
writer.Insert(PAnsiChar({$IFDEF DELPHI2009UP}UTF8Encode{$ENDIF}(aHeader)));
|
|
writer := nil;
|
|
end;
|
|
end
|
|
else begin
|
|
writer := lEditor.CreateWriter;
|
|
writer.DeleteTo(MaxInt);
|
|
writer.Insert(PAnsiChar({$IFDEF DELPHI2009UP}UTF8Encode{$ENDIF}(aCode)));
|
|
writer := nil;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure AddOrReplaceNamedModule(const aProject: IOTAProject; aName, aCode: string);
|
|
var
|
|
lModule: IOTAModule;
|
|
begin
|
|
lModule := FindModuleByUnitName(aProject, aName);
|
|
if assigned(lModule) then begin
|
|
WriteModuleSource(lModule, aCode, '');
|
|
end
|
|
else begin
|
|
aName := ExtractFilePath(CurrentProject.FileName)+aName;
|
|
SaveStringToFile(aName, aCode);
|
|
CurrentProject.AddFile(aName, true);
|
|
lModule := FindModuleByUnitName(CurrentProject, aName);
|
|
{$IFDEF DELPHI9UP}
|
|
if assigned(lModule) then lModule.Show();
|
|
{$ENDIF DELPHI9UP}
|
|
end;
|
|
end;
|
|
|
|
function GetDelphiVersion: Integer;
|
|
begin
|
|
{$IFDEF DELPHI5}
|
|
result := 5;
|
|
{$ELSE}
|
|
{$IFDEF DELPHI2007}
|
|
result := 11;
|
|
{$ELSE}
|
|
result := Trunc(RTLVersion)-8;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function LanguageFromPersonality(aProject: IOTAProject): string;
|
|
{$IFDEF BDS}
|
|
var s: string;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF BDS}
|
|
s := aProject.Personality;
|
|
if s = sDelphiPersonality then result := 'Delphi for Win32'
|
|
else if s = sDelphiDotNetPersonality then result := 'Delphi for .NET'
|
|
else if s = sCSharpPersonality then result := 'C#'
|
|
else if s = sVBPersonality then result := 'Visual Basic'
|
|
else if s = sCBuilderPersonality then result := 'C++'
|
|
else result := 'Unknown';
|
|
{$ELSE}
|
|
result := 'Delphi for Win32';
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function LanguageFromPersonalityEx(aProject: IOTAProject): string;
|
|
begin
|
|
result := LanguageFromPersonality(aProject);
|
|
{$IFDEF BDS}
|
|
if result = 'Delphi for .NET' then
|
|
result := result+'/'+IntToStr(GetDelphiVersion);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
end.
|