Componentes.Terceros.RemObjects/official/5.0.35.741/Everwood/Source/Delphi/uEWOTAHelpers_laz.pas

unit uEWOTAHelpers_laz;

{$I Everwood.inc}

interface

uses
  LazIDEIntf, ProjectIntf, Classes;

function GetDllPath: String;
function CurrentProject: TLazProject;
function ProjectByName(const aName: string): TLazProject;

function GetUniqueProjectFilename(aProject: TLazProject; aName: string): string;

function FindModuleByUnitName(const aProject: TLazProject; const aModuleName: string): TLazProjectFile;

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: TLazProjectFile): string;
procedure WriteModuleSource(const aModule: TLazProjectFile; const aCode, aHeader: string);
procedure AddOrReplaceNamedModule(const aProject: TLazProject; aName, aCode: string);

implementation

uses {$IFDEF MSWINDOWS}Windows, ActiveX, {$ENDIF} SysUtils;

function LoadStringFromFile(iFilename:string):string;
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;

procedure SaveStringToFile(const iFilename,iString:string);
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;

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;
begin
  if Assigned(CurrentProject) and Assigned(CurrentProject.MainFile) then
    Result := ChangeFileExt(ExtractFileName(CurrentProject.MainFile.Filename),'')
  else
    Result := '';
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;
{$IFDEF MSWINDOWS}
var
  TheFileName : array[0..MAX_PATH] of char;
{$ENDIF}
begin
  {$IFDEF MSWINDOWS}
  {$IFDEF FPC}
  TheFileName[0]:=#0;
  {$ENDIF}
  FillChar(TheFileName, SizeOf(TheFileName), #0);
  GetModuleFileName(hInstance, TheFileName, sizeof(TheFileName));
  Result := ExtractFilePath(TheFileName);
  {$ELSE}
  Result := '';
  {$ENDIF}
end;

function CurrentProject: TLazProject;
begin
  result := LazarusIDE.ActiveProject;
end;

function ProjectByName(const aName: string): TLazProject;
begin
  if CurrentProject.MainFile.Filename = aName then
    Result := CurrentProject
  else
    Result := nil;
end;


function GetUniqueProjectFilename(aProject: TLazProject; aName: string): string;
var
  lBaseName, lName: string;
  lCount: integer;

  function ProjectHasFile: boolean;
  var
    i: integer;
  begin
    result := false;
    for i := 0 to aProject.FileCount - 1 do begin
      if (aProject.Files[i].Filename = lName) or (aProject.Files[i].Filename = 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: TLazProject; const aModuleName: string): TLazProjectFile;
var
  i: integer;
begin
  result := nil;
  for i := 0 to aProject.FileCount - 1 do
    if (CompareText(ExtractFileName(aModuleName), ExtractFileName(aProject.Files[i].Filename)) = 0) then begin
      result := aProject.Files[i];
      Break;
    end;
end;

function ReadModuleSource(const aModule: TLazProjectFile): string;
begin
  result := aModule.GetSourceText;
end;

procedure WriteModuleSource(const aModule: TLazProjectFile; const aCode, aHeader: string);
begin
  aModule.SetSourceText(aCode);
end;

procedure AddOrReplaceNamedModule(const aProject: TLazProject; aName, aCode: string);
var
  lModule: TLazProjectFile;
begin
  lModule := FindModuleByUnitName(aProject, aName);
  if assigned(lModule) then begin
    WriteModuleSource(lModule, aCode, '');
  end
  else begin
    aName :=  ExtractFilePath(CurrentProject.MainFile.Filename)+aName;
    SaveStringToFile(aName, aCode);
    lModule:= CurrentProject.CreateProjectFile(aName);
    CurrentProject.AddFile(lModule, False);
  end;
end;

end.