Artifact 8e8a4dcc9f70f5107a2105f1bdbe1683dc2b9bb3:

• File AddZTMsToHst/Src/Delphi/AddZTMsToHst.dpr — part of check-in [cf608713de] at 2015-07-13 12:15:08 on branch develop — Added new project 'ZTMsToHst', which copies all `*.ztm` files present in the `#ZTHome` directory, as entries in ZTW.HST for the `F12` macro entry history list. (user: tinus size: 4709)

program AddZTMsToHst;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.Classes,
  System.SysUtils,
  System.IOUtils,
  System.Types,
  Winapi.Windows;

var
  gNumFilesPresent, gNumFilesAdded: integer;

{ ------------------------------------------------------------------------------------------------ }
procedure AddZTMsToZTWHST(const ZTPath: string);
var
  PreviousDir: TFileName;
  History: TStringList;
  HistoryFile, TempFile, BackupFile: TFileName;
  ZTMs: TStringDynArray;
  ZTM: string;
begin
  PreviousDir := GetCurrentDir;
  SetCurrentDir(ZTPath);

  HistoryFile := TPath.Combine(ZTPath, 'ZTW.HST');
  History := TStringList.Create;
  try
    History.LoadFromFile(HistoryFile);

    // Get a list of all the ZTM files
    ZTMs := TDirectory.GetFiles(ZTPath, '*.ztm', TSearchOption.soTopDirectoryOnly,
                                function (const Path: string; const SearchRec: TSearchRec): boolean
    var
      Entry: string;
      FileName: TFileName;
    begin
      FileName := TPath.Combine(Path, SearchRec.Name);
      for Entry in History do begin
        if (Entry.Length > 4) and Entry.StartsWith('zf') and (Entry.Substring(3, 1) = '@') then begin
          Result := not SameFileName(FileName, ExpandFileName(Entry.Substring(4)));
          if Result = False then begin
            Inc(gNumFilesPresent);
            WriteLn('Skipping: ', SearchRec.Name);
            Exit;
          end;
        end;
      end;
      Result := True;
    end);

    for ZTM in ZTMs do begin
      History.Add('zf=@' + ZTM);
      Inc(gNumFilesAdded);
      WriteLn('Adding:   ', ExtractFileName(ZTM));
    end;

    if gNumFilesAdded > 0 then begin
      TempFile := ChangeFileExt(HistoryFile, '.~' + ExtractFileExt(HistoryFile).Substring(2));
      History.SaveToFile(TempFile);

      BackupFile := HistoryFile + '.BAK';
      if not ReplaceFile(PChar(HistoryFile), PChar(TempFile), PChar(BackupFile), REPLACEFILE_IGNORE_MERGE_ERRORS, nil, nil) then
        RaiseLastOSError;
    end;
  finally
    History.Free;
  end;

  SetCurrentDir(PreviousDir);
end {AddZTMsToZTWHST};


{ ------------------------------------------------------------------------------------------------ }
// From http://stackoverflow.com/a/1634007/60590
function Is64BitOS: Boolean;
type
  TIsWow64Process = function(Handle:THandle; var IsWow64 : BOOL) : BOOL; stdcall;
var
  hKernel32 : Integer;
  IsWow64Process : TIsWow64Process;
  IsWow64 : BOOL;
begin
  // we can check if the operating system is 64-bit by checking whether
  // we are running under Wow64 (we are 32-bit code). We must check if this
  // function is implemented before we call it, because some older versions
  // of kernel32.dll (eg. Windows 2000) don't know about it.
  // see http://msdn.microsoft.com/en-us/library/ms684139.aspx
  Result := False;
  hKernel32 := LoadLibrary('kernel32.dll');
  if (hKernel32 = 0) then RaiseLastOSError;
  @IsWow64Process := GetProcAddress(hkernel32, 'IsWow64Process');
  if Assigned(IsWow64Process) then begin
    IsWow64 := False;
    if (IsWow64Process(GetCurrentProcess, IsWow64)) then begin
      Result := IsWow64;
    end
    else RaiseLastOSError;
  end;
  FreeLibrary(hKernel32);
end{Is64BitOS};

{ ------------------------------------------------------------------------------------------------ }
function FindZTreeWin: string;
var
  ExeName: string;
  BufferLength: Cardinal;
  PFilenamePart: PChar;
begin
  try
    if Is64BitOS then
      ExeName := 'ZTW64.EXE'
    else
      ExeName := 'ZTW.EXE';
    BufferLength := 32768;
    SetLength(Result, BufferLength - 1);
    SetLength(Result, SearchPath(nil, PChar(ExeName), nil, BufferLength, PChar(Result), PFilenamePart));
//    if Length(Result) = 0 then
//      RaiseLastOSError;

    // TODO: if not found in path, check the registry?
  except
    Exception.RaiseOuterException(Exception.CreateFmt('Could not find %s!', [ExeName]));
  end;
end {FindZTreeWin};




{ ================================================================================================ }
var
  ZTHome: string;
begin
  try
    if ParamStr(1) <> '' then begin
      ZTHome := ParamStr(1)
    end else begin
      ZTHome := ExtractFilePath(FindZTreeWin);
      if ZTHome = '' then begin
        ZTHome := GetCurrentDir;
      end;
    end;
    gNumFilesPresent := 0;
    gNumFilesAdded := 0;
    AddZTMsToZTWHST(ZTHome);
    WriteLn(gNumFilesPresent + gNumFilesAdded, ' files found; ', gNumFilesAdded, ' files added to ZTW.HST.');
  except
    on E: Exception do
      Writeln(ErrOutput, E.ClassName, ': ', E.Message);
  end;
end.