unit FileFunctions;

{
[FileFunctions] [6.0]
Delphi 2005
December 2005

LICENSE

The contents of this file are subject to the Mozilla Public License Version
1.1 (the "License"); you may not use this file except in compliance with
the License. You may obtain a copy of the License at
"http://www.mozilla.org/MPL/"

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is "[FileFunctions.pas]".

The Initial Developer of the Original Code is Martin Holmes (Victoria,
BC, Canada, "http://www.mholmes.com/"). Copyright (C) 2005 Martin Holmes 
and the University of Victoria Computing and Media Centre. The code was 
co-developed for university and personal projects, and rights are shared
by Martin Holmes and the University of Victoria. All Rights Reserved.
}

{
  This is a mass of general-purpose file-related functions developed over the
  years in various projects. Caveat user: many are obsolete or untested.

  Dependencies:

  JEDI Code Library (JCL) jclUnicode.
  ShBrowseU (Alan G. Lloyd)
  TntUnicodeControls (Troy Wolbrink)

}
interface

uses Windows, Forms, SysUtils, Classes, ShellAPI, Dialogs, FileCtrl, ShlObj,
		URLMon, jclUnicode, TntClasses, ShBrowseU, TntDialogs, TntSysUtils;

var
Win2K: Boolean;

function LoadFileToString(InFile: string; var OutString: string): Boolean;
function SaveStringToFile(OutFile: string; InString: string): Boolean;

function WLoadFileToString(InFile: string; var OutString: Widestring): Boolean;
function WSaveStringToFile(OutFile: string; InString: WideString): Boolean;
function WSaveStringToFileUTF8(OutFile: string; InString: WideString): Boolean;
function WSaveStringToFileUTF8NoBOM(OutFile: string; InString: WideString): Boolean;

function GetFileSize(FName: string): integer;
function CompareTextFiles(FileName1, FileName2: string): integer;

function LaunchFile(Path: string): Boolean;
function LaunchFileW2K(Path: string): Boolean;
function RunFile(FilePath: string; Wait: Boolean): Boolean;
function LaunchWebsite(Path: string): Boolean;
function GetRelativePath(SourcePath, TargetPath: string): string;
function GetFullPathFromRelative(RootPath, RelativePath: string; var OutString: string): Boolean;
function WGetFullPathFromRelative(RootPath, RelativePath: WideString; var OutString: WideString): Boolean;

function MDHGetWindowsDir: string; // wrapper for GetWindowsDirectory API
function MakePath(InString: string): string;
function RemoveSlash(InString: string): string;
function CreateDirPath(TargetPath: string): Boolean; //Parses a string into cascading dirs and creates each one in turn
procedure GetWindowsVersion(var Major : integer; var Minor : integer);
procedure SetWin2K;
function GetFolder(var FolderPath: string; DialogTitle: string): Boolean;
function GetFolder2(var FolderPath: string; DialogTitle: string): Boolean;
function GetFolder3(var FolderPath: string; DialogTitle: WideString; LeftTop: TPoint): Boolean;
function GetFileFromWeb(WebFile, SaveFile: string): Boolean;
function ExecNewProcess(ProgramName: string; WaitFor: Boolean): Boolean;
function ExecNewProcessTimed(ProgramName: string; WaitTime: integer): Boolean;
function ExecCmdLine(const CmdLine: string; WindowState: Word): Boolean;


function CopyFilesInDir(const Source, Dest, Mask: string; Subdirs: Boolean): Boolean;
procedure GetFiles(const ADirectory: string; Mask: string; Files: TStringList; SubFolders: Boolean);
procedure GetFoldersInDir(const ADirectory: string; var Folders: TStringList);
function LoadSourceFile(Dir, FName: string; var Contents: string): Boolean;
function HasWebPageExtension(FName: string): Boolean;
function MakeWebFileName(FName: string): string;

//This sets the current filename for a target dialog based on the input filename,
//by changing its extension, meanwhile preserving the target dialog's current directory
//if it has one.
procedure SetParallelFileName(dlgTarget: TTntOpenDialog; ModelFileName: WideString);

var
msgFailedToRunProgram: string = 'Unable to run the program and load the file. Please try yourself to open this file:';

function GetVersionEx(lpOs : pointer) : BOOL; stdcall; external 'kernel32.dll' name 'GetVersionExA';

implementation

//Loads a file and puts it into a string variable.
//Returns true if successful.
function LoadFileToString(InFile: string; var OutString: string): Boolean;
var
InList: TStringList;
i: integer;
begin
	InList := TStringList.Create;
  try
  	try
     	InList.LoadFromFile(InFile);
        OutString := '';
        for i := 0 to InList.Count - 1 do
        	begin
           	Application.ProcessMessages;
        		OutString := OutString + InList[i] + #13#10;
           end;
        Result := True;
     except
     	Result := False;
     end;
  finally
  	InList.Free;
  end;
end;

//Loads a unicode text file
function WLoadFileToString(InFile: string; var OutString: Widestring): Boolean;
var
InList: TTntStringList;

begin
	InList := TTntStringList.Create;
  try
  	try
     	InList.LoadFromFile(InFile);
        OutString := InList.Text;
        Result := True;
     except
     	Result := False;
     end;
  finally
  	InList.Free;
  end;
end;

//Saves a string to a text file
function SaveStringToFile(OutFile: string; InString: string): Boolean;
var
OutList: TStringList;
TokenPosition: integer;
StartPoint: integer;

begin
	OutList := TStringList.Create;
  try
//Work through the string
     TokenPosition := Pos(#13#10, InString);
     while TokenPosition > 0 do
        begin

//Get the string
				OutList.Add(Copy(InString, 1, TokenPosition - 1));

//Remove it from InString
        	StartPoint := TokenPosition + 2;
        	InString := Copy(InString, StartPoint, Length(InString) - (StartPoint - 1));

     		TokenPosition := Pos(#13#10, InString);
     	end;

//Add the last bit
		if Length(InString) > 0 then
			OutList.Add(InString);

  	try
  		OutList.SaveToFile(OutFile);
  		Result := True;
  	except
  		Result := False;
  	end;
  finally
  	OutList.Free;
  end;

end;

//Saves a widestring to a Unicode text file
function WSaveStringToFile(OutFile: string; InString: WideString): Boolean;
var
OutList: TTntStringList;

begin
	OutList := TTntStringList.Create;
  try
  	OutList.Text := InString;
//This property missing from latest TTntStringList (was present in previous TTntWideStringList)
//     OutList.SaveUnicode := True;
  	try
  		OutList.SaveToFile(OutFile);
  		Result := True;
  	except
  		Result := False;
  	end;
  finally
  	OutList.Free;
  end;

end;

function WSaveStringToFileUTF8(OutFile: string; InString: WideString): Boolean;
var
OutList: TTntStringList;

begin
	OutList := TTntStringList.Create;
  try
  	OutList.Text := InString;
//This property missing from latest TTntStringList (was present in previous TTntWideStringList)
//     OutList.SaveUnicode := True;
  	try
  		OutList.AnsiStrings.SaveToFileEx(OutFile, CP_UTF8);
  		Result := True;
  	except
  		Result := False;
  	end;
  finally
  	OutList.Free;
  end;

end;

function WSaveStringToFileUTF8NoBOM(OutFile: string; InString: WideString): Boolean;
var
OutList: TStringList;
OutString: string;

begin
  Result := False; //default
  OutList := TStringList.Create;
  try
    try
      OutList.Text := WideStringToUTF8(InString);
      OutList.SaveToFile(OutFile);
      Result := True;
    except
//Returning false is sufficient
    end
  finally
    FreeAndNil(OutList);
  end;
end;

function GetFileSize(FName: string): integer;
var
SearchRec: TSearchRec;
begin
  Result := 0;//default
  if FindFirst(FName, faAnyFile, SearchRec) = 0 then
     Result := SearchRec.Size;
end;

function CompareTextFiles(FileName1, FileName2: string): integer;
var
Text1, Text2: string;
Size1, Size2: integer;
i: integer;

begin
//First check to see if we can do this by size alone, which is quicker
  Size1 := GetFileSize(FileName1);
  Application.ProcessMessages;
  Size2 := GetFileSize(FileName2);
  Application.ProcessMessages;
  Result := Size1 - Size2;
  Application.ProcessMessages;
  if Result = 0 then
     begin
        LoadFileToString(FileName1, Text1);
        Application.ProcessMessages;
        LoadFileToString(FileName2, Text2);
        Application.ProcessMessages;
        Result := Length(Text1) - Length(Text2);
        if (Result = 0) and (Length(Text1) > 0) then
           for i := 1 to Length(Text1) do
              begin
                 Application.ProcessMessages;
                 if Text1[i] <> Text2[i] then
                    begin
                       Result := Ord(Text1[i]) - Ord(Text2[i]);
                       Exit;
                    end;
              end;
     end;
end;

//Tries to launch a file
function LaunchFile(Path: string): Boolean;
var
rc: Integer;
i: integer;
p: Array[0..255] of Char;

begin
  {if Win2K then
  	begin
     	Result := LaunchFileW2K(Path);
        Exit;
     end; }
	Result := False;

  Application.ProcessMessages;

	if not(FileExists(Path)) then
     begin
        MessageDlg(msgFailedToRunProgram + #13#10#13#10 + Path, mtWarning, [mbOK], 0);
        Exit;
     end;

  Application.ProcessMessages;

  StrPCopy(p, Path);

  rc := ShellExecute(0, 'open', p, nil, PChar(ExtractFilePath(Path)), SW_SHOWNORMAL);

  if rc <= 32 then
  	raise Exception.Create(
            Format(msgFailedToRunProgram + #13#10#13#10 + ' %s. %s',
                [path, SysErrorMessage(rc)]))
  else
  	Result := True;
end;

//Tries to launch a file on Windows 2000
function LaunchFileW2K(Path: string): Boolean;
var
rc: integer;
i: integer;
DestSize: integer;
PWPath: PWideChar;

begin
	Result := False;
{	if not(FileExists(Path)) then
  	begin
    		raise Exception.Create(msgFailedToRunProgram + #13#10#13#10 + Path);
        Exit;
     end;

	DestSize := 512;
  PWPath := StringToWideChar(Path, PWPath, DestSize);

  Application.ProcessMessages;

  rc := ShellExecute(0, nil, PWPath, nil, nil, 0);

  if rc <= 32 then
  	raise Exception.Create(
            Format(msgFailedToRunProgram + #13#10#13#10 + ' %s. %s',
                [path, SysErrorMessage(rc)]))
  else
  	Result := True;     }
end;

function RunFile(FilePath: string; Wait: Boolean): Boolean;
var sei: TShellExecuteInfo;
begin
  try
  	FillChar(sei, sizeof(sei), 0);
    	sei.cbSize := sizeof(sei);
    	sei.fMask := SEE_MASK_NOCLOSEPROCESS;
    	sei.Wnd := Application.Handle;
    	sei.lpVerb := StrNew(pchar('open'));
    	sei.lpFile := StrNew(pchar(FilePath));
    	sei.lpParameters := StrNew(pchar(''));
    	sei.nShow := sw_Normal;

    	if ShellExecuteEx(@sei) then
    		begin
      		WaitForSingleObject(sei.hProcess,INFINITE);
      		Result := True;
    		end
    	else
     	begin
//      		ShowMessage(SysErrorMessage(GetLastError));
      		Result := False;
    		end;
 	finally
  	StrDispose(sei.lpVerb);
     StrDispose(sei.lpFile);
     StrDispose(sei.lpParameters);
  end;
end;

//Tries to launch a browser and go to a Website
function LaunchWebsite(Path: string): Boolean;
var
p:  array [0..255] of Char;
rc: Integer;

begin

	Result := False;

  StrPCopy(p, path);

  rc := ShellExecute(GetDesktopWindow, nil, p, nil, nil, SW_SHOWNORMAL);

  if rc <= 32 then
  	raise Exception.Create(
            Format(msgFailedToRunProgram + #13#10#13#10 + ' %s. %s',
                [path, SysErrorMessage(rc)]))
  else
  	Result := True;
end;

function GetRelativePath(SourcePath, TargetPath: string): string;
var
DirCount: integer;
OutPath: string;
i: integer;

begin
	Result := '';
	if UpperCase(SourcePath[1]) <> UpperCase(TargetPath[1]) then
  	begin
//     	MessageDlg('These files are on different drives, so no relative path can be created.', mtWarning, [mbOK], 0);
        for i := 1 to Length(TargetPath) do
        	if TargetPath[i] = '\' then
           	Result := Result + '/'
           else
           	Result := Result + TargetPath[i];
        Exit;
     end;

  i := 1;
  while UpperCase(SourcePath[i]) = UpperCase(TargetPath[i]) do
  	inc(i);
//Fix added here:  " or (TargetPath[i] <> '\')" -- on 09/02/05
  while (SourcePath[i] <> '\') or (TargetPath[i] <> '\') do
  	dec(i);

  SourcePath := Copy(SourcePath, i+1, Length(SourcePath) - i);
  TargetPath := Copy(TargetPath, i+1, Length(TargetPath) - i);

  DirCount := 0;

  for i := 1 to Length(SourcePath) do
  	if SourcePath[i] = '\' then
     	inc(DirCount);

  for i := 1 to DirCount do
  	OutPath := OutPath + '../';

  for i := 1 to Length(TargetPath) do
  	if TargetPath[i] = '\' then
     	OutPath := OutPath + '/'
     else
     	OutPath := OutPath + TargetPath[i];

  GetRelativePath := OutPath;

end;

//This function uses a SysUtils function to re-compose a full path
//from a relative path, and the path it's relative to. It returns
//true if it's able to perform the operation and a valid path to an
//existing file results.
function GetFullPathFromRelative(RootPath, RelativePath: string; var OutString: string): Boolean;
var
CurDir: string;
RootDir: string;
i: integer;

begin
//Default return
	Result := False;

//Check that the root path is valid
	if not FileExists(RootPath) then
  	Exit;

//Save the current directory, because we'll have to change it
	CurDir := GetCurrentDir;

//Get the directory of the root path
	RootDir := ExtractFilePath(RootPath);

//Set the current directory to the root path
	ChDir(RootDir);

//Change any forward slashes to backslashes in the relative path
//(in case it's relative in the URL sense)
	for i := 1 to Length(RelativePath) do
  	if RelativePath[i] = '/' then
     	RelativePath[i] := '\';

//Call the function to get the path
	OutString := ExpandFileName(RelativePath);

//Check the validity of the return path
	if FileExists(OutString) then
  	Result := True;

//Set the current directory back to what it was
	ChDir(CurDir);
end;

function WGetFullPathFromRelative(RootPath, RelativePath: WideString; var OutString: WideString): Boolean;
var
CurDir: WideString;
RootDir: WideString;
i: integer;

begin
//Default return
	Result := False;

//Check that the root path is valid
	if not FileExists(RootPath) then
  	Exit;

//Save the current directory, because we'll have to change it
	CurDir := GetCurrentDir;

//Get the directory of the root path
	RootDir := ExtractFilePath(RootPath);

//Set the current directory to the root path
	ChDir(RootDir);

//Change any forward slashes to backslashes in the relative path
//(in case it's relative in the URL sense)
	for i := 1 to Length(RelativePath) do
  	if RelativePath[i] = WideChar('/') then
     	RelativePath[i] := WideChar('\');

//Call the function to get the path
	OutString := ExpandFileName(RelativePath);

//Check the validity of the return path
	if FileExists(OutString) then
  	Result := True;

//Set the current directory back to what it was
	ChDir(CurDir);
end;

function MDHGetWindowsDir: string;
var
WD: PChar;
i: integer;

begin
WD := StrAlloc(255);
	i := GetWindowsDirectory(WD, 255);
  if i = 0 then
  	Result := ''
  else
  	Result := StrPas(WD);
  StrDispose(WD);
end;

function MakePath(InString: string): string;
begin
	if Length(InString) < 1 then Exit;
	if InString[Length(InString)] <> '\' then
  	InString := InString + '\';

  MakePath := InString;
end;

function RemoveSlash(InString: string): string;
begin
	if InString[Length(InString)] = '\' then
  	InString := Copy(InString, 1, Length(InString) - 1);
  Result := InString;
end;

function CreateDirPath(TargetPath: string): Boolean;
//Parses a string into cascading dirs and creates each one in turn
var
DirList: TStringList;
FirstPos: integer;
begin
	Result := True;
  if DirectoryExists(TargetPath) then
  	Exit;
	DirList := TStringList.Create;
  try
  	FirstPos := Pos('\', TargetPath) + 1;
     while FirstPos <= Length(TargetPath) do
     	begin
           if TargetPath[FirstPos] = '\' then
           	if not DirectoryExists(Copy(TargetPath, 1, FirstPos -1)) then
              	try
                 	CreateDir(Copy(TargetPath, 1, FirstPos -1));
                 except
                 	MessageDlg('Unable to create directory: ' + Copy(TargetPath, 1, FirstPos -1), mtWarning, [mbOK], 0);
                 	Result := False;
                 end;
           inc(FirstPos);
        end;
     if TargetPath[FirstPos] = '\' then
			if not DirectoryExists(TargetPath) then
           try
     			CreateDir(TargetPath);
        	except
        		MessageDlg('Unable to create directory: ' + TargetPath, mtWarning, [mbOK], 0);
           	Result := False;
        	end;
  finally
  	DirList.Free;
  end;
end;

procedure GetWindowsVersion(var Major : integer; var Minor : integer);
var
lpOS, lpOS2 : POsVersionInfo;

begin

   GetMem(lpOS, SizeOf(TOsVersionInfo)); 
   lpOs^.dwOSVersionInfoSize := SizeOf(TOsVersionInfo); 
   while getVersionEx(lpOS) = false do
   	begin
        GetMem(lpos2, lpos^.dwOSVersionInfoSize + 1);
        lpOs2^.dwOSVersionInfoSize := lpOs^.dwOSVersionInfoSize + 1;
        FreeMem(lpOs, lpOs^.dwOSVersionInfoSize);
        lpOS := lpOs2;
   	end;
   Major := lpOs^.dwMajorVersion; 
   Minor := lpOs^.dwMinorVersion; 
   FreeMem(lpOs, lpOs^.dwOSVersionInfoSize);
end;

procedure SetWin2K;
var
Major, Minor: integer;

begin
	GetWindowsVersion(Major, Minor);
  Win2K := (Major > 4);
end;

function GetFolder(var FolderPath: string; DialogTitle: string): Boolean;
var
  lpItemID : PItemIDList;
  BrowseInfo : TBrowseInfo;
  DisplayName : array[0..MAX_PATH] of char;
  TempPath : array[0..MAX_PATH] of char;
begin
	Result := False;
  try
     FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
     BrowseInfo.hwndOwner := Application.Handle;
     BrowseInfo.pszDisplayName := @DisplayName;
     BrowseInfo.lpszTitle := PChar(DialogTitle);
     BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
     lpItemID := SHBrowseForFolder(BrowseInfo);
     if lpItemId <> nil then begin
       SHGetPathFromIDList(lpItemID, TempPath);
       FolderPath := MakePath(TempPath);
       Result := True;
       GlobalFreePtr(lpItemID);
     end;
  except
//do nothing -- result is false
  end;
end;

function GetFolder2(var FolderPath: string; DialogTitle: string): Boolean;
var
ShBrowse: TShBrowse;

begin
  Result := False;
  ShBrowse := TShBrowse.Create;
  try
     with ShBrowse do
        begin
           UserMessage := DialogTitle;
           InitFolder := FolderPath;
           if Execute then
              begin
                 FolderPath := MakePath(Folder);
                 Result := True;
              end;
        end;
  finally
     ShBrowse.Free;
  end;
end;

function GetFolder3(var FolderPath: string; DialogTitle: WideString; LeftTop: TPoint): Boolean;
var
ShBrowse: TShBrowse;

begin
  Result := False;
  ShBrowse := TShBrowse.Create;
  try
    with ShBrowse do
      begin
        Options := Options + [sboNewDialogStyle];
//        Options := Options + [sboEditBox];
        Options := Options - [sboNoNewFolderButton];
        Left := LeftTop.X;
        Top := LeftTop.Y;
        UserMessage := DialogTitle;
        if Length(FolderPath) > 0 then
          InitFolder := FolderPath;
        if Execute then
          begin
            FolderPath := MakePath(Folder);
            Result := True;
          end;
      end;
  finally
    ShBrowse.Free;
  end;
end;

function GetFileFromWeb(WebFile, SaveFile: string): Boolean;
begin
	Result := False;
  if URLDownloadToFile(nil, PChar(WebFile), PChar(SaveFile), 0, nil) <> 0 then 
    MessageBox(Application.Handle, 'An error ocurred while downloading the file.', PChar(Application.Title),
                              MB_ICONERROR or MB_OK)
  else
  	Result := True;
end;

function ExecNewProcess(ProgramName : string; WaitFor : Boolean): Boolean;
var
StartInfo : TStartupInfo;
ProcInfo : TProcessInformation;
CreateOK : Boolean;
begin

{ fill with known state }
	FillChar(StartInfo,SizeOf(TStartupInfo),#0);
	FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
	StartInfo.cb := SizeOf(TStartupInfo);

	CreateOK := CreateProcess(nil, PChar(ProgramName), nil, nil,False,
									CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
									nil, nil, StartInfo, ProcInfo);

// check to see if successful }
// and if we should wait for it to finish
	if CreateOK and WaitFor then
// wait for child processe to finish
		WaitForSingleObject(ProcInfo.hProcess, INFINITE);

	ExecNewProcess := CreateOK;
end;

function ExecNewProcessTimed(ProgramName: string; WaitTime: integer): Boolean;
var
StartInfo : TStartupInfo;
ProcInfo : TProcessInformation;
CreateOK : Boolean;
begin

{ fill with known state }
	FillChar(StartInfo,SizeOf(TStartupInfo),#0);
	FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
	StartInfo.cb := SizeOf(TStartupInfo);

//Make sure it starts minimized
  StartInfo.dwFlags     := STARTF_USESHOWWINDOW;
  StartInfo.wShowWindow := SW_HIDE;

	CreateOK := CreateProcess(nil, PChar(ProgramName), nil, nil,False,
									CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
									nil, nil, StartInfo, ProcInfo);

// check to see if successful }
// and if we should wait for it to finish
	if CreateOK then
// wait for child processe to finish
		while WaitForSingleObject(ProcInfo.hProcess, WaitTime) = WAIT_TIMEOUT do
        Application.ProcessMessages;

  CloseHandle(ProcInfo.hProcess);
	ExecNewProcessTimed := CreateOK;
end;

function ExecCmdLine(const CmdLine: string; WindowState: Word): Boolean;
var
  SUInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
begin
  { Enclose filename in quotes to take care of
    long filenames with spaces. }
  FillChar(SUInfo, SizeOf(SUInfo), #0);
  with SUInfo do
  begin
    cb := SizeOf(SUInfo);
    dwFlags := STARTF_USESHOWWINDOW;
    wShowWindow := WindowState;
  end;
  Result := CreateProcess(nil, PChar(CmdLine), nil, nil, False,
    CREATE_NEW_CONSOLE or
    NORMAL_PRIORITY_CLASS, nil,
    nil {PChar(ExtractFilePath(Filename))},
    SUInfo, ProcInfo);
end;

function CopyFilesInDir(const Source, Dest, Mask: string; Subdirs: Boolean): Boolean;
var
ts: TSearchRec;

  function FileWithPath(const Dir, FName: string): string;
  begin
    if (Length(Dir) > 0) and (Copy(Dir, Length(Dir), 1) <> '\' ) then
      Result := Dir + '\' + FName
    else
      Result := Dir + FName;
  end;

begin
  Result := DirectoryExists(Dest);
  if not Result then
  	Result := CreateDir(Dest);
  if not Result then
  	Exit;
  if FindFirst(FileWithPath(Source, Mask), faAnyFile, ts) = 0 then
    	repeat
       	if not ((ts.name='.') or (ts.name='..')) then
       		begin
         		if ts.Attr and faDirectory > 0 then
         			begin
           			if SubDirs then
             				Result := CopyFilesInDir(FileWithPath(Source, ts.name),
                              FileWithPath(Dest, ts.name), Mask, SubDirs);
         	end
        else
           Result := CopyFile(PChar(FileWithPath(Source, ts.name)),
                            PChar(FileWithPath(Dest, ts.name)), False);
        if not Result then
           break;
       end;
    until
      FindNext(ts) <> 0;
  FindClose(ts);
end;

procedure GetFiles(const ADirectory: string; Mask: string; Files: TStringList; SubFolders: Boolean);
	// Helper function to remove any slashes or add them if needed
  function SlashSep(const Path, S: string): string;
  begin
    if Path[Length(Path)] <> '\' then
      Result := Path + '\' + S
    else
      Result := Path + S;
  end;
var
  SearchRec: TSearchRec;
  nStatus: Integer;
begin
// First find all the files fitting the mask in the current directory

//Set the mask in case it's not specified corrently
	if Length(Mask) < 3 then
  	Mask := '*.*';

  nStatus := FindFirst(PChar(SlashSep(ADirectory, Mask)),  0, SearchRec);
  while nStatus = 0 do
     begin
       Files.Add(SlashSep(ADirectory, SearchRec.Name));
       nStatus := FindNext(SearchRec);
     end;
  FindClose(SearchRec);

// Next look for subfolders and search them if required to do so
  if SubFolders then
     begin
       nStatus := FindFirst(PChar(SlashSep(ADirectory, Mask)), faDirectory,
         SearchRec);
       while nStatus = 0 do
       begin
         // If it is a directory, then use recursion
         if ((SearchRec.Attr and faDirectory) <> 0) then
         begin
           if ( (SearchRec.Name <> '.') and (SearchRec.Name <> '..') )  then
             GetFiles(SlashSep(ADirectory, SearchRec.Name), Mask, Files, SubFolders);
         end;
         nStatus := FindNext(SearchRec)
       end;
       FindClose(SearchRec);
     end;
end;

procedure GetFoldersInDir(const ADirectory: string; var Folders: TStringList);
	// Helper function to remove any slashes or add them if needed
  function SlashSep(const Path, S: string): string;
  begin
    if Path[Length(Path)] <> '\' then
      Result := Path + '\' + S
    else
      Result := Path + S;
  end;
var
  SearchRec: TSearchRec;
  Path: string;
  nStatus: integer;

begin
//Add a slash to the directory if there isn't one there
	Path := SlashSep(ADirectory, '*');


// First find all the files fitting the mask in the current directory

  nStatus := FindFirst(PChar(Path), faDirectory, SearchRec);
  while nStatus = 0 do
     begin
        if SearchRec.Attr and faDirectory > 0 then
//Don't include the folder itself or its parent
        	if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
       			Folders.Add(SlashSep(ADirectory, SearchRec.Name));
       	nStatus := FindNext(SearchRec);
     end;
  FindClose(SearchRec);
end;

function LoadSourceFile(Dir, FName: string; var Contents: string): Boolean;
begin
  Result := True;
  if FileExists(Dir + FName) then
     LoadFileToString(Dir+FName, Contents)
  else
     if FileExists(ExtractFilePath(Application.ExeName) + '\source\' + FName) then
        LoadFileToString(ExtractFilePath(Application.ExeName) + '\source\' + FName, Contents)
     else
        if FileExists(ExtractFilePath(Application.ExeName) + '\srcbackup\' + FName) then
           LoadFileToString(ExtractFilePath(Application.ExeName) + '\srcbackup\' + FName, Contents)
        else
           Result := False;
end;

function HasWebPageExtension(FName: string): Boolean;
var
WebExts, Ext: string;

begin
  Result := False;
  WebExts := '.htm.html.shtml.xhtml.xml.php.asp.aspx.jsp.php3.php4.php5.';
  Ext := ExtractFileExt(FName) + '.';
  if Length(Ext) > 3 then
     if Pos(Ext, WebExts) > 0 then
        Result := True;
end;

function MakeWebFileName(FName: string): string;
begin
  Result := FName;
  if HasWebPageExtension(FName) = False then
     Result := FName + '.htm';
end;

procedure SetParallelFileName(dlgTarget: TTntOpenDialog; ModelFileName: WideString);
var
Dir, NewName: WideString;

  function AddSlash(InPath: WideString): WideString;
  begin
    Result := InPath;
    if Length(InPath) > 0 then
      if InPath[Length(InPath)] <> WideChar('\') then
        Result := InPath + '\';
  end;

begin
  NewName := WideExtractFileName(WideChangeFileExt(ModelFileName, '.' + dlgTarget.DefaultExt));
  if Length(dlgTarget.FileName) > 0 then
    begin
      Dir := AddSlash(WideExtractFileDir(dlgTarget.FileName));
      dlgTarget.FileName := Dir + NewName;
    end
  else
    begin
      if Length(dlgTarget.InitialDir) > 0 then
        begin
          dlgTarget.FileName := AddSlash(dlgTarget.InitialDir) + NewName;
        end
      else
        begin
          dlgTarget.FileName := AddSlash(WideExtractFileDir(ModelFileName)) + NewName;
        end;
    end;
end;

initialization
	SetWin2k;

finalization

end.