source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/EmbeddedED/KS_procs.pas@ 541

{ ******************************************** }
{       KS_Procs ver 1.2 (Jan. 16, 2004)       }
{                                              }
{       For Delphi 4, 5 and 6                  }
{                                              }
{       Copyright (C) 1999-2004, Kurt Senfer.  }
{       All Rights Reserved.                   }
{                                              }
{       Support@ks.helpware.net                }
{                                              }
{       Documentation and updated versions:    }
{                                              }
{       http://KS.helpware.net                 }
{                                              }
{ ******************************************** }
{
    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}
  
unit KS_Procs;

interface

uses
  Windows, ShellAPI, Messages, SysUtils, math, classes ;

Var
  ActualAppName: string = '';
  ShowDeveloperMessages: boolean = false;
  DeveloperMessagesCanceled: boolean = false;
  DeveloperMessagesLog: string = '';
  ActualWinDir: string = '';

const
  NoShowError: Boolean = False; // NoShowError, NoCache, NoHtmlFile
  ShowError: Boolean = true;
  NoCache: Boolean = true;
  NoHtmlFile: Boolean = true;

const
  { several important ASCII codes }
//  NULL = #0;
  BACKSPACE = #8;
  TAB = #9;
  LF = #10;
  CR = #13;
  EOF_ = #26;
  ESC = #27;
  Space = #32;
  BlackSpace = [#33..#255];
  CrLf: String = #13+#10;
  DblCrLf: String = #13+#10+#13+#10;

const
  { digits as chars }
  ZERO = '0';
  ONE = '1';
  TWO = '2';
  THREE = '3';
  FOUR = '4';
  FIVE = '5';
  SIX = '6';
  SEVEN = '7';
  EIGHT = '8';
  NINE = '9';
  DIGITS: set of Char = [ZERO..NINE];

  cSilent: boolean = true;
  cNotSilent: boolean = false;


type
  TMonth = (NoneMonth, January, February, March, April, May, June, July,
    August, September, October, November, December);

type
  TDayOfWeek = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);

type
  TBit = 0..31;

type
  TFileTimeComparision = (ftError, ftFileOneIsOlder, ftFileTimesAreEqual, ftFileTwoIsOlder);

type
  TTimeOfWhat = (ftCreationTime, ftLastAccessTime, ftLastWriteTime);

type
  TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM, dtRAM);


type
  TVolumeInfo = record
    Name: string;
    SerialNumber: DWORD;
    MaxComponentLength: DWORD;
    FileSystemFlags: DWORD;
    FileSystemName: string;
  end;                        // TVolumeInfo

type
  PFixedFileInfo = ^TFixedFileInfo;
  TFixedFileInfo = record
    dwSignature: Cardinal;
    dwStrucVersion: Cardinal;
    wFileVersionMS: WORD;     // Minor Version
    wFileVersionLS: WORD;     // Major Version
    wProductVersionMS: WORD;  // Build Number
    wProductVersionLS: WORD;  // Release Version
    dwFileFlagsMask: Cardinal;
    dwFileFlags: Cardinal;
    dwFileOS: Cardinal;
    dwFileType: Cardinal;
    dwFileSubtype: Cardinal;
    dwFileDateMS: Cardinal;
    dwFileDateLS: Cardinal;
  end;                        // TFixedFileInfo

procedure KSProcessMessages;
procedure KSWait(aTime: Cardinal);

function CopyCursor(cur: HCURSOR): HCURSOR;
function _GetExeOpen(const Ext: string; var Exefil: string; sielent: boolean = true): Boolean;
Function GetModuleName(aFile: string = ''): String;
Function GetFileDateTime(aFile: string): String;
Function GetShortDateTime(aTime: TDateTime; Seconds: boolean = false): String;
function GetAbsolutePath(ActualPath: string; var RelativePath: string): boolean;
function KSMessage(aMessage: string; aBoxHead: string; Params: integer): integer;
function KSQuestion(aMessage: string; aBoxHead: string = ''; Params: integer = MB_ICONQUESTION or MB_YESNO): integer;
Procedure KSMessageW(aMessage: string; aBoxHead: string = '');
Procedure KSMessageE(aMessage: string; aBoxHead: string = '');
Procedure KSMessageQ(aMessage: string; aBoxHead: string = '');
Procedure KSMessageI(aMessage: string; aBoxHead: string = '');
Procedure KSMessageT(aMessage: string; aBoxHead: string = '');
procedure DeveloperMessage(aMessage: string);
function CloseDeveloperMessagesLog(afile: string): boolean;
function SaveDeveloperMessagesLog(afile: string): boolean;
procedure OpenDeveloperMessagesLog;
          
function IsAlNum(C: char): bool;
function RegisterAxLib(FileName: string; Unreg: Boolean = False): boolean;
procedure SearchForFiles(path, mask: AnsiString; var Value: TStringList; Recurse: Boolean = False);

function StringIsInteger(Const S: String): boolean;
function _StringIsInteger(Const S: String; var I: Integer): boolean;
function KSDelete(var S: String; DeleteString: String; All: Boolean = False): boolean;
{Deletes one or more instances of S}

function GetFileDateAsString(aFile: string): String;
function DosLocalTimeToDosUTCTime(aDosFileTime: Integer): Integer;
function GetUTCFileDateAsString(aFile: string): String;
function UTCFileAge(const FileName: string): Integer;
function KSSetCurrentDir(const Dir: string): Boolean;
function KSEmptyDir( aDir: string): Boolean;
function DelDir(aDir: string): boolean;
function Squish(const Search: string): string;
{squish() returns a string with all whitespace not inside single
quotes deleted.}
function Before(const Search, Find: string): string;
{before() returns everything before the first occurance of Find
in Search. If Find does not occur in Search, Search is returned.}
function beforeX(const Search, Find: string): string;
{before() returns everything before the first occurance of Find
in Search. If Find does not occur in Search, An empty string is returned.}
function After(const Search, Find: string): string;
{after() returns everything after the first occurance of Find
in Search. If Find does not occur in Search, a null string is returned.}
function RPos(const Find, Search: string): Integer;
{RPos() returns the index of the first character of the last occurance
of Find in Search. Returns 0 if Find does not occur in Search.
Like Pos() but searches in reverse.}

function LastChar(const Search: string; const Find: char): Integer;
{LastChar() returns the index of the last character of Find in Search.
 Returns 0 if Find does not occur in Search.}

function AfterLastToken(const StrInd, Token: string): string;

function KsSameText(S1, S2: string; MaxLen: Cardinal): boolean;
//same as AnsiSameText but the string are only compared up to MaxLen

function BeforLastToken(const StrIn, Token: string): string;
function BeforeFirstToken(const S: string; Token: Char): string;
//Returnerer alt før Token som Result

function strMake(C: Char; Len: Integer): string;
//Returns a string with a specified number of a specified Char
function strPadChL(const S: string; C: Char; Len: Integer): string;
//Fills leading Char's into a string up to a specified length

//Fills leading Zeroes into a string up to a specified length
function strPosAfter(const aSubstr, S: string; aOfs: Integer): Integer;
//Returns the posision of the first occurence of a substring in a string after a specified offset
function strChange(var S: string; const Src, Dest: string): boolean;
//Changes every ocuranc of a text in a string with new text
function strEndSlash(const S: string): string;
//Returns a string with a trailing slash (\)
function strEndSlashX(const S: string): string;
//returns a string with a trailing slash (/)
function NoEndBackSlash(const S: string): string;
//Returns a string without a traling slash (\)

function NoStartSlash(const S: string): string;
//Returns a string without a leading slash (/)

function SplitAtToken(var S: string; Token: Char): string;
function SplitAtTokenStr(var S: string; Token: string): string;
//returnerer alt før Token som Result, og alt efter Token i S
function strTokenCount(S: string; Token: Char): Integer;
//Returnerer antal token i S
function AfterTokenNr(const S: string; Token: Char; Nr: Integer): string;
//Returns the right part of an string after token (Char) Nr.
function BeforeTokenNr(const S: string; Token: Char; Nr: Integer): string;
//Returns the left part of an string before token (Char) Nr.

function strLastCh(const S: string): string;
//Returns the last char in a string

type                          { Search and Replace options }
  TSROption = (srWord, srCase, srAll);
  TSROptions = set of TsrOption;

function DropLastDir(path: string): string;
//fjerner sidste directory fra stien i path

type
  TCharSet = set of Char;


{ Integer functions }
function intMax(a, b: Integer): Integer;
//Returns the highest value
function intMin(a, b: Integer): Integer;
//Returns the lowest value

{ date functions }
Function DateStrToDateTime(aDate: string): TDateTime;
Function TimeStrToDateTime(aDateTime: string): TDateTime;
//function dateYear(D: TDateTime): Integer;

function fileSizeEx(const Filename: string): Longint;
//returns the size of a file in bytes

function KSForceDirectories(Dir: string): Boolean;

function GetShareFromURN(const URN: string; var Share: string; aPath: string = ''): boolean;

function ExecuteFile(handle: HWND; const FileName, Params, DefaultDir: string; ShowCmd: Integer; Silent: boolean = true): THandle;
//run an exefile

function fileCopy(const SourceFile, TargetFile: string): Boolean;
//copy a file (with date info)
function fileMove(const SourceFile, TargetFile: string): Boolean;
function fileTemp(const aExt: string = ''): string;
//Returns a unique temparary filename
function fileTempEx(const aName: string): string;
//Returns a unique temparary filename based on the suplied filename

function KSGetCurrentDirectory: string;
//Returns the current directory for the current process

function DirExists(const Name: string): Boolean;
function GetLogicalPathFromUNC(var aUNC :string): Boolean;
//returns a normal filepath fore a UNC-filepath
Function GetFirstNetworkDrive: string;
//returns the UNC-filepath fore the first network-drive
function KSGetTempPath: string;
//Returns the path of the directory designated for temporary files
function KSGetLogicalDrives: string;
//Returns a string that contains the currently available disk drives
function GetFirstAviableDriveLetter: string;

function KSGetFileTime(const FileName: string; ComparisonType: TTimeOfWhat): TFileTime;
// Returns the date and time that a file was created, last accessed, or last modified

function KSCompareFileTime(const FileNameOne, FileNameTwo: string; ComparisonType: TTimeOfWhat): TFileTimeComparision;
//Compares two files timestamps
function FileDifferent(const Sourcefile: string; TargetPath: string): Boolean;
//Returnere true hvis de to filer har forskellig dato eller størrelse
function KSFileGetDateTime(const aFile: string): TDateTime;
//Returnere TdateTime for en fils dato
function GetFileTimeEx(const FileName: string; ComparisonType: TTimeOfWhat): TDateTime;
// Returns the date and time that a file was created, last accessed, or last modified as TDateTime

Function GetFreeDiskSize(TheDrive: String):Int64;
//Returns the amount of free space on the specified disk
function ShortFileNameToLFN(ShortName: String): String;
function GetFullPathNameEx(const Path: string): string;
//Returns the full path and filename of a specified file
function fileExec(const aCmdLine: string; const aAppName: string = ''; aHide: Boolean = True;
           aWait: Boolean = False; bWait: Boolean = False): Boolean;
//Executes a file and wait as specified

{ system functions }
function GetWindir: string;
//Returns the windows directory
procedure WinExecError(iErr: Word; const sCmdLine: string);
//Returns a dialogbox with the explanation of an WinExecError

procedure PrintWordDoc(const fil: string; handle: HWND);

{System Information }
function KSGetUserName(Uppercase: boolean = true): string;
function GetNetUserName(const aResource: string = ''): string;
function KSGetNetUserName(const aResource: string = '?'): string;
function GetUserCookie: string;
//returns current username
Function GetFileAsText(const afile: String): String;
function SaveTextAsFile(const afile, Text: String): Boolean;

function KSGetSystemDirectory: string;
//Returns system directory

// Time Functions
function KSGetSystemTime: string;
//returns date and time

function GetWindowFromText(const WindowText: string): Hwnd;
{returnere en handle til vinduet hvis det findes}


function CtrlDown: Boolean;


function GetSystemErrorMessage(var aFmtStr: String; ErrorAccept: Integer = ERROR_SUCCESS): boolean;
function GetErrorString(var aFmtStr: String; ErrorCode: Integer): boolean;

function GetLastErrorStr: string;
function ShowLastErrorIfAny(anError: Integer; Handle: Hwnd = 0): Boolean;

implementation

uses RegFuncs;

//------------------------------------------------------------------------------
function CopyCursor(cur: HCURSOR): HCURSOR;
begin
   result := HCURSOR(CopyIcon(HICON(cur)));
   { The typecasts are actually not necessary in Delphi since all handle type
     are compatible with each other, since they all are aliases for DWORD }
end;
//------------------------------------------------------------------------------
function _StringIsInteger(Const S: String; var I: Integer): boolean;
{
var
  Err: Integer;
begin
  Val(S, I, Err);
  Result := (Err = 0);   This raises an error i debugging
end;
}

var a: Integer;
begin
  //asm int 3 end; //trap
  result := FALSE;
  I := 0;

  if (length(s) > 0) and (s[1] in ['+','-','0'..'9'])
     then begin
        for a := 2 to length(s) do
           if not (s[a] in ['0'..'9'])
              then begin
                 if (a > 3) or //min two good numbers before the trird that is bad
                    ((a = 2) and (not (s[1] in ['+','-']))) //first number is good
                    then I := StrToInt(Copy(S, 1, a -1));
                 exit;
              end;

        result := true;
        I := StrToInt(S);
     end;
end;
//------------------------------------------------------------------------------
function StringIsInteger(Const S: String): boolean;
var
  I: Integer;
begin
  //asm int 3 end; //trap
  result := _StringIsInteger(S, I);
end;
//------------------------------------------------------------------------------
{ bit manipulating }

//------------------------------------------------------------------------------
function strMake(C: Char; Len: Integer): string;
//Returns a string with a specified number of a specified Char
begin
  //asm int 3 end; //KS trap
  Result := strPadChL('', C, Len);
end;
//------------------------------------------------------------------------------
function strPadChL(const S: string; C: Char; Len: Integer): string;
//Fills leading Char's into a string up to a specified length
begin
  //asm int 3 end; //KS trap
  Result := S;
  while Length(Result) < Len
    do Result := C + Result;
end;
//------------------------------------------------------------------------------
function strEndSlash(const S: string): string;
//returns a string with a trailing slash (\)
begin
  //asm int 3 end; //trap
  Result := S;
  if strLastCh(Result) <> '\'
    then Result := Result + '\';
end;
//------------------------------------------------------------------------------
function strEndSlashX(const S: string): string;
//returns a string with a trailing slash (/)
begin
  //asm int 3 end; //trap
  Result := S;
  if strLastCh(Result) <> '/'
    then Result := Result + '/';
end;
//------------------------------------------------------------------------------
function NoEndBackSlash(const S: string): string;
//Returns a string without a traling slash (\)
begin 
  //asm int 3 end; //trap
  Result := S;
  if strLastCh(Result) = '\'
    then Delete(Result, Length(Result), 1);
end;
//------------------------------------------------------------------------------
function NoStartSlash(const S: string): string;
//Returns a string without a leading slash (/)
begin
  //asm int 3 end; //KS trap
  Result := S;
  if (length(Result) > 0) and  (Result[1] = '/')
    then Delete(Result, 1, 1);
end;
//------------------------------------------------------------------------------
function SplitAtToken(var S: string; Token: Char): string;
//Splits up a string at a specified substring
//Returnerer alt før Token som Result, og alt efter Token i S
var
  I: Word;
begin
  //asm int 3 end; //trap
  I := Pos(Token, S);
  if I <> 0
    then begin
      Result := System.Copy(S, 1, I - 1);
      System.Delete(S, 1, I);
    end
  else begin                  //der er ingen token
      Result := S;
      S := '';
    end;
end;
//------------------------------------------------------------------------------
function BeforeFirstToken(const S: string; Token: Char): string;
//Returnerer alt før Token som Result
var
  I: Word;
begin
  //asm int 3 end; //trap
  I := Pos(Token, S);
  if I <> 0
    then Result := System.Copy(S, 1, I - 1)
     else Result := S;                 //der er ingen token
end;
//------------------------------------------------------------------------------
function SplitAtTokenStr(var S: string; Token: string): string;
//Splits up a string at a specified substring
//Returnerer alt før Token som Result, og alt efter Token i S
var
  I: Word;
begin
  //asm int 3 end; //trap
  I := Pos(Token, S);
  if I <> 0
    then begin
      Result := System.Copy(S, 1, I - 1);
      System.Delete(S, 1, I + length(Token)-1);
    end
  else begin                  //der er ingen token
      Result := S;
      S := '';
    end;
end;
//------------------------------------------------------------------------------
function strTokenCount(S: string; Token: Char): Integer;
//Returns the number of Char in S
var
  //s1: string;
  i: Integer;
begin
  //asm int 3 end; //trap
  Result := 0;
  I := pos(Token, S);
  if i = 0
    then exit;

  repeat
    Inc(Result);
    s := copy(S, i + 1, length(s));
    I := pos(Token, S);
    if i = 0
      then break;
  until false;

end;
//------------------------------------------------------------------------------
function AfterTokenNr(const S: string; Token: Char; Nr: Integer): string;
//Returns the right part of an string after token (Char) Nr.
var
  j, i: Integer;
begin
  //asm int 3 end; //KS trap
  Result := '';
  j := 1;
  i := 0;

  while (i <= Nr) and (j <= Length(S))
    do begin
      if S[j] = Token
        then begin
          Inc(i);
          if i = Nr
            then break;
        end;
      Inc(j);
    end;                      //while

  Result := copy(s, j + 1, length(S));
end;
//------------------------------------------------------------------------------
function BeforeTokenNr(const S: string; Token: Char; Nr: Integer): string;
//Returns the left part of an string before token (Char) Nr.
var
  j, i: Integer;
begin
  //asm int 3 end; //KS trap
  Result := '';
  j := 1;
  i := 0;

  while (i <= Nr) and (j <= Length(S))
    do begin
      if S[j] = Token
        then begin
          Inc(i);
          if i = Nr
            then break;
        end;
      Inc(j);
    end;                      //while

  Result := copy(s, 0, j - 1);

end;
//------------------------------------------------------------------------------
function strPosAfter(const aSubstr, S: string; aOfs: Integer): Integer;
//Returns the posision of the first occurence of a substring in a string
//after a specified offset
begin
  //asm int 3 end; //trap
  Result := Pos(aSubStr, Copy(S, aOfs, (Length(S) - aOfs) + 1));
  if (Result > 0) and (aOfs > 1)
    then Inc(Result, aOfs - 1);
end;
//------------------------------------------------------------------------------
function strChange(var S: string; const Src, Dest: string): boolean;
//Changes every ocuranc of a text in a string with new text
var
  Org: String;
begin
  //asm int 3 end; //trap
  Org := S;
  S := StringReplace(S, Src, Dest,  [rfReplaceAll]);
  result := not AnsiSameText(Org,  S);
end;
//------------------------------------------------------------------------------
function strLastCh(const S: string): string;
//Returns the last char in a string
var
  i: integer;
begin
  //asm int 3 end; //trap
  i := Length(S);
  if i > 0
    then Result := S[Length(S)]
  else Result := '';
end;
//------------------------------------------------------------------------------
{ Integer stuff }
//------------------------------------------------------------------------------
function IntMax(a, b: Integer): Integer;
//Returns the highest value
begin
  //asm int 3 end; //trap
  if a > b
    then Result := a
  else Result := b;
end;
//------------------------------------------------------------------------------
function IntMin(a, b: Integer): Integer;
//Returns the lowest value
begin
  //asm int 3 end; //KS trap
  if a < b
    then Result := a
  else Result := b;
end;
//------------------------------------------------------------------------------
function ExecuteFile(handle: HWND; const FileName, Params, DefaultDir: string; ShowCmd: Integer; Silent: boolean = true): THandle;
begin
  //asm int 3 end; //trap
  {a caling procedure can normally get a hanle like this: Application.MainForm.Handle }
  Result := ShellExecute(handle, nil,
    Pchar(FileName), Pchar(Params), Pchar(DefaultDir), ShowCmd);

  if (Result < 32) and (ShowDeveloperMessages or (not silent))
     then WinExecError(Result, Filename);
end;
//------------------------------------------------------------------------------
function fileCopy(const SourceFile, TargetFile: string): Boolean;
begin
  //asm int 3 end; //trap
  Result := CopyFile(Pchar(SourceFile), Pchar(TargetFile), False);
  //                       Existing file      Copy of file
end;
//------------------------------------------------------------------------------
function fileMove(const SourceFile, TargetFile: string): Boolean;
begin 
  //asm int 3 end; //KS trap
  Result := MoveFile(Pchar(SourceFile), Pchar(TargetFile));
  //                       Existing file      New file
end;
//------------------------------------------------------------------------------
function fileTemp(const aExt: string = ''): string;
//Returns a unique temparary filename
var
  Buffer: array[0..1023] of Char;
  aFile: string;
begin

  //asm int 3 end; //KS trap
  GetTempPath(Sizeof(Buffer) - 1, Buffer);
  GetTempFileName(Buffer, 'TMP', 0, Buffer);
  SetString(aFile, Buffer, StrLen(Buffer));

  if length(aExt) > 0
     then begin
        Result := ChangeFileExt(aFile, aExt);
        RenameFile(aFile, Result);
     end
     else result := aFile;
end;
//------------------------------------------------------------------------------
function fileTempEx(const aName: string): string;
//Returns a unique temparary filename based on the suplied filename
var
  Buffer: array[0..1023] of Char;
  aFile: string;
  aPath: string;
  aExt: string;
begin 
  //asm int 3 end; //KS trap
  aPath := ExtractFilePath(aName);
  if length(aPath) = 0
     then begin
        GetTempPath(Sizeof(Buffer) - 1, Buffer);
        aPath := Buffer;
     end;

  aExt := ExtractFileName(aName);
  aFile := SplitAtToken(aExt, '.');

  while true do
     begin
        GetTempFileName(Pchar(aPath), '_', 0, Buffer);
        result := aPath + aFile + ChangeFileExt(ExtractFileName(Buffer), '.'+aExt);
        if not FileExists(result)
           then break;
     end;
end;
//------------------------------------------------------------------------------
function fileExec(const aCmdLine: string; const aAppName: string = ''; aHide: Boolean = True;
           aWait: Boolean = False; bWait: Boolean = False): Boolean;
//Executes a file and wait as specified
//aWait = vent på inputidle, bWait = vent på at programmet stopper igen
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  dwI : Cardinal;
  dwCreationFlags: Cardinal;
  S, S1: string;
  //lpExitCode: DWORD;
  //Msg: TMsg;
begin 
  //asm int 3 end; //trap
  result := false;

  //dont try to start a non existing program - can cause troubles
  if (Length(aCmdLine) = 0) and (Length(aAppName) = 0)
     then exit;

  if not (fileExists(aCmdLine) or fileExists(aAppName))
     then begin
        //try to get rid og params in aCmdLine
        if Length(aCmdLine) > 0
           then begin
              S1 := aCmdLine;
              if S1[1] = '"'
                 then begin
                    S := SplitAtTokenStr(S1, '" ');
                    delete(S, 1, 1);//drop leading "
                 end
                 else S := SplitAtToken(S1, ' ');

              if not fileExists(S)
                 then exit;
           end
           else exit;
     end;

  {setup the startup information for the application }
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  with StartupInfo
    do begin
      cb := SizeOf(TStartupInfo);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_FORCEONFEEDBACK;

      if aHide
        then wShowWindow := SW_HIDE
      else wShowWindow := SW_SHOWNORMAL;
    end;
  //prevents delphi from locking the app but also from starting the app
  //dwCreationFlags := DEBUG_ONLY_THIS_PROCESS or NORMAL_PRIORITY_CLASS or CREATE_NEW_PROCESS_GROUP;
  //dwCreationFlags := NORMAL_PRIORITY_CLASS or CREATE_NEW_PROCESS_GROUP;
  //dwCreationFlags := CREATE_DEFAULT_ERROR_MODE + NORMAL_PRIORITY_CLASS;
  dwCreationFlags := CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS;
  //dwCreationFlags := NORMAL_PRIORITY_CLASS;
  try
     if aAppName = ''
        then Result := CreateProcess(nil,             PChar(aCmdLine), nil, nil, False, dwCreationFlags, nil, nil, StartupInfo, ProcessInfo)
        else Result := CreateProcess(PChar(aAppName), PChar(aCmdLine), nil, nil, False, dwCreationFlags, nil, nil, StartupInfo, ProcessInfo);

     if not result
        then exit;

     if aWait
        then begin
           dwI := WaitForInputIdle(ProcessInfo.hProcess, INFINITE);
           if dwI = $FFFFFFFF
              then GetExitCodeProcess(ProcessInfo.hProcess, dwI)
              else begin
                 if bWait
                    then while WaitForSingleObject(ProcessInfo.hProcess,100) = WAIT_TIMEOUT do
                       KSProcessMessages;
              end;
       end;
  finally
     CloseHandle(ProcessInfo.hProcess); //close handles or we get a mem-leak !
     CloseHandle(ProcessInfo.hThread);
  end;
end;
//------------------------------------------------------------------------------
{ date calculations }

type
  TDateOrder = (doMDY, doDMY, doYMD);

function CurrentYear: Word;
var
  SystemTime: TSystemTime;
begin
  //asm int 3 end; //KS trap
  GetLocalTime(SystemTime);
  Result := SystemTime.wYear;
end;
//------------------------------------------------------------------------------
function GetDateOrder(const DateFormat: string): TDateOrder;
var
  I: Integer;
begin 
  //asm int 3 end; //KS trap
  Result := doMDY;
  I := 1;
  while I <= Length(DateFormat) do
  begin
    case Chr(Ord(DateFormat[I]) and $DF) of
      'E': Result := doYMD;
      'Y': Result := doYMD;
      'M': Result := doMDY;
      'D': Result := doDMY;
    else
      Inc(I);
      Continue;
    end;
    Exit;
  end;
  Result := doMDY;
end;
//------------------------------------------------------------------------------
procedure ScanToNumber(const S: string; var Pos: Integer);
begin
  //asm int 3 end; //KS trap
  while (Pos <= Length(S)) and not (S[Pos] in ['0'..'9']) do
  begin
    if S[Pos] in LeadBytes then Inc(Pos);
    Inc(Pos);
  end;
end;
//------------------------------------------------------------------------------
function GetEraYearOffset(const Name: string): Integer;
var
  I: Integer;
begin
  //asm int 3 end; //KS trap
  Result := 0;
  for I := Low(EraNames) to High(EraNames) do
  begin
    if EraNames[I] = '' then Break;
    if AnsiStrPos(PChar(EraNames[I]), PChar(Name)) <> nil then
    begin
      Result := EraYearOffsets[I];
      Exit;
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure ScanBlanks(const S: string; var Pos: Integer);
var
  I: Integer;
begin
  //asm int 3 end; //KS trap
  I := Pos;
  while (I <= Length(S)) and (S[I] = ' ') do Inc(I);
  Pos := I;
end;
//------------------------------------------------------------------------------
function ScanNumber(const S: string; var Pos: Integer;
  var Number: Word; var CharCount: Byte): Boolean;
var
  I: Integer;
  N: Word;
begin 
  //asm int 3 end; //KS trap
  Result := False;
  CharCount := 0;
  ScanBlanks(S, Pos);
  I := Pos;
  N := 0;
  while (I <= Length(S)) and (S[I] in ['0'..'9']) and (N < 1000) do
  begin
    N := N * 10 + (Ord(S[I]) - Ord('0'));
    Inc(I);
  end;
  if I > Pos then
  begin
    CharCount := I - Pos;
    Pos := I;
    Number := N;
    Result := True;
  end;
end;
//------------------------------------------------------------------------------
function ScanString(const S: string; var Pos: Integer;
  const Symbol: string): Boolean;
begin
  //asm int 3 end; //KS trap
  Result := False;
  if Symbol <> '' then
  begin
    ScanBlanks(S, Pos);
    if AnsiCompareText(Symbol, Copy(S, Pos, Length(Symbol))) = 0 then
    begin
      Inc(Pos, Length(Symbol));
      Result := True;
    end;
  end;
end;
//------------------------------------------------------------------------------
function ScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
begin 
  //asm int 3 end; //KS trap
  Result := False;
  ScanBlanks(S, Pos);
  if (Pos <= Length(S)) and (S[Pos] = Ch) then
  begin
    Inc(Pos);
    Result := True;
  end;
end;
//------------------------------------------------------------------------------
function DoEncodeDate(Year, Month, Day: Word; var Date: TDateTime): Boolean;
var
  I: Integer;
  DayTable: PDayTable;
begin 
  //asm int 3 end; //KS trap
  Result := False;
  DayTable := @MonthDays[IsLeapYear(Year)];
  if (Year >= 1) and (Year <= 9999) and (Month >= 1) and (Month <= 12) and
    (Day >= 1) and (Day <= DayTable^[Month]) then
  begin
    for I := 1 to Month - 1 do Inc(Day, DayTable^[I]);
    I := Year - 1;
    Date := I * 365 + I div 4 - I div 100 + I div 400 + Day - DateDelta;
    Result := True;
  end;
end;
//------------------------------------------------------------------------------
function ScanDate(const S: string; var Pos: Integer;
  var Date: TDateTime): Boolean;
var
  DateOrder: TDateOrder;
  N1, N2, N3, Y, M, D: Word;
  L1, L2, L3, YearLen: Byte;
  EraName : string;
  EraYearOffset: Integer;
  CenturyBase: Integer;

  function EraToYear(Year: Integer): Integer;
  begin
    if SysLocale.PriLangID = LANG_KOREAN then
    begin
      if Year <= 99 then
        Inc(Year, (CurrentYear + Abs(EraYearOffset)) div 100 * 100);
      if EraYearOffset > 0 then
        EraYearOffset := -EraYearOffset;
    end
    else
      Dec(EraYearOffset);
    Result := Year + EraYearOffset;
  end;

begin  
  //asm int 3 end; //KS trap
  Y := 0;
  M := 0;
  D := 0;
  YearLen := 0;
  Result := False;
  DateOrder := GetDateOrder(ShortDateFormat);
  EraYearOffset := 0;
  if ShortDateFormat[1] = 'g' then  // skip over prefix text
  begin
    ScanToNumber(S, Pos);
    EraName := Trim(Copy(S, 1, Pos-1));
    EraYearOffset := GetEraYearOffset(EraName);
  end
  else
    if AnsiPos('e', ShortDateFormat) > 0 then
      EraYearOffset := EraYearOffsets[1];
  if not (ScanNumber(S, Pos, N1, L1) and ScanChar(S, Pos, DateSeparator) and
    ScanNumber(S, Pos, N2, L2)) then Exit;
  if ScanChar(S, Pos, DateSeparator) then
  begin
    if not ScanNumber(S, Pos, N3, L3) then Exit;
    case DateOrder of
      doMDY: begin Y := N3; YearLen := L3; M := N1; D := N2; end;
      doDMY: begin Y := N3; YearLen := L3; M := N2; D := N1; end;
      doYMD: begin Y := N1; YearLen := L1; M := N2; D := N3; end;
    end;
    if EraYearOffset > 0 then
      Y := EraToYear(Y)
    else if (YearLen <= 2) then
    begin
      CenturyBase := CurrentYear - TwoDigitYearCenturyWindow;
      Inc(Y, CenturyBase div 100 * 100);
      if (TwoDigitYearCenturyWindow > 0) and (Y < CenturyBase) then
        Inc(Y, 100);
    end;
  end else
  begin
    Y := CurrentYear;
    if DateOrder = doDMY then
    begin
      D := N1; M := N2;
    end else
    begin
      M := N1; D := N2;
    end;
  end;
  ScanChar(S, Pos, DateSeparator);
  ScanBlanks(S, Pos);
  if SysLocale.FarEast and (System.Pos('ddd', ShortDateFormat) <> 0) then
  begin     // ignore trailing text
    if ShortTimeFormat[1] in ['0'..'9'] then  // stop at time digit
      ScanToNumber(S, Pos)
    else  // stop at time prefix
      repeat
        while (Pos <= Length(S)) and (S[Pos] <> ' ') do Inc(Pos);
        ScanBlanks(S, Pos);
      until (Pos > Length(S)) or
        (AnsiCompareText(TimeAMString, Copy(S, Pos, Length(TimeAMString))) = 0) or
        (AnsiCompareText(TimePMString, Copy(S, Pos, Length(TimePMString))) = 0);
  end;
  Result := DoEncodeDate(Y, M, D, Date);
end;
//------------------------------------------------------------------------------
function DoEncodeTime(Hour, Min, Sec, MSec: Word; var Time: TDateTime): Boolean;
begin  
  //asm int 3 end; //KS trap
  Result := False;
  if (Hour < 24) and (Min < 60) and (Sec < 60) and (MSec < 1000) then
  begin
    Time := (Hour * 3600000 + Min * 60000 + Sec * 1000 + MSec) / MSecsPerDay;
    Result := True;
  end;
end;
//------------------------------------------------------------------------------
function ScanTime(const S: string; var Pos: Integer;
  var Time: TDateTime): Boolean;
var
  BaseHour: Integer;
  Hour, Min, Sec, MSec: Word;
  Junk: Byte;
begin
  //asm int 3 end; //KS trap
  Result := False;
  BaseHour := -1;
  if ScanString(S, Pos, TimeAMString) or ScanString(S, Pos, 'AM') then
    BaseHour := 0
  else if ScanString(S, Pos, TimePMString) or ScanString(S, Pos, 'PM') then
    BaseHour := 12;
  if BaseHour >= 0 then ScanBlanks(S, Pos);
  if not ScanNumber(S, Pos, Hour, Junk) then Exit;
  Min := 0;
  if ScanChar(S, Pos, TimeSeparator) then
    if not ScanNumber(S, Pos, Min, Junk) then Exit;
  Sec := 0;
  if ScanChar(S, Pos, TimeSeparator) then
    if not ScanNumber(S, Pos, Sec, Junk) then Exit;
  MSec := 0;
  if ScanChar(S, Pos, DecimalSeparator) then
    if not ScanNumber(S, Pos, MSec, Junk) then Exit;
  if BaseHour < 0 then
    if ScanString(S, Pos, TimeAMString) or ScanString(S, Pos, 'AM') then
      BaseHour := 0
    else
      if ScanString(S, Pos, TimePMString) or ScanString(S, Pos, 'PM') then
        BaseHour := 12;
  if BaseHour >= 0 then
  begin
    if (Hour = 0) or (Hour > 12) then Exit;
    if Hour = 12 then Hour := 0;
    Inc(Hour, BaseHour);
  end;
  ScanBlanks(S, Pos);
  Result := DoEncodeTime(Hour, Min, Sec, MSec, Time);
end;
//------------------------------------------------------------------------------

Function DateStrToDateTime(aDate: string): TDateTime;
var
  OldDateSeparator: Char;
  OldShortDateFormat: string;
  Pos: Integer;
  //S: string;
begin
  //asm int 3 end; //KS trap
  OldDateSeparator := DateSeparator;
  OldShortDateFormat := ShortDateFormat;
  DateSeparator := '.';
  ShortDateFormat := 'dd.mm.yy';

  try
     Pos := 1;
     if not ScanDate(aDate, Pos, Result) or (Pos <= Length(aDate))
        then result := 0;
  finally
     DateSeparator := OldDateSeparator;
     ShortDateFormat := OldShortDateFormat;
  end;
end;

//------------------------------------------------------------------------------
Function TimeStrToDateTime(aDateTime: string): TDateTime;
var
  OldDateSeparator: Char;
  OldTimeSeparator: Char;
  OldShortDateFormat: string;
  Pos: Integer;
  Date, Time: TDateTime;
begin 
  //asm int 3 end; //KS trap
  OldDateSeparator := DateSeparator;
  OldShortDateFormat := ShortDateFormat;
  OldTimeSeparator := TimeSeparator;
  DateSeparator := '.';
  ShortDateFormat := 'dd.mm.yy';
  TimeSeparator := ':';
  Result := 0;

  try             
     try
        Pos := 1;
        Time := 0;
        if not ScanDate(aDateTime, Pos, Date) or
           not ((Pos > Length(aDateTime)) or
           ScanTime(aDateTime, Pos, Time))
           then begin   // Try time only
              Pos := 1;
              if not ScanTime(aDateTime, Pos, Result) or (Pos <= Length(aDateTime))
                 then result := 0;
           end
           else begin
              if Date >= 0
                 then Result := Date + Time
                 else Result := Date - Time;
           end;
     except
        Result := 0;
     end;
  finally
     DateSeparator := OldDateSeparator;
     ShortDateFormat := OldShortDateFormat;
     TimeSeparator := OldTimeSeparator;
  end;
end;
//------------------------------------------------------------------------------
function DirExists(const Name: string): Boolean;
var
  Code: Integer;
begin
  //asm int 3 end; //trap
  {$RANGECHECKS OFF}
  Code := GetFileAttributes(PChar(Name));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
//------------------------------------------------------------------------------
function KSGetTempPath: string;
//Returns the path of the directory designated for temporary files
var
  Buffer: array[0..1023] of Char;
begin
  //asm int 3 end; //trap
  SetString(Result, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
  //Fixes a bug in Windows 2000
  //Strg.MakeLongName(result);
  //problems
  (*
  if (result = '') or (not DirExists(result))
     then begin
        result := GetWinDir + '\TEMP\';
        MkDir(result);
     end;
  *)
end;
//------------------------------------------------------------------------------
procedure WinExecError(iErr: Word; const sCmdLine: string);
//Returns a dialogbox with the explanation of an WinExecError
var
  S: string;
begin
  //asm int 3 end; //KS trap
  case iErr of
    (* nye ting og sager fra win32
    SE_ERR_ACCESSDENIED Windows 95 only: The operating system denied access to the specified file.
    SE_ERR_ASSOCINCOMPLETE      The filename association is incomplete or invalid.
    SE_ERR_DDEBUSY      The DDE transaction could not be completed because other DDE transactions were being processed.
    SE_ERR_DDEFAIL      The DDE transaction failed.
    SE_ERR_DDETIMEOUT   The DDE transaction could not be completed because the request timed out.
    SE_ERR_DLLNOTFOUND  Windows 95 only: The specified dynamic-link library was not found.
    SE_ERR_FNF  Windows 95 only: The specified file was not found.
    SE_ERR_NOASSOC      There is no application associated with the given filename extension.
    SE_ERR_OOM  Windows 95 only: There was not enough memory to complete the operation.
    SE_ERR_PNF  Windows 95 only: The specified path was not found.
    SE_ERR_SHARE        A sharing violation occurred.
    *)

     0:
        S := 'The operating system is out of memory or resources,'+CrLf+
             'the executable file was corrupt, or'+CrLf+
             'relocations were invalid';
     ERROR_FILE_NOT_FOUND:
        S := 'The specified file was not found' + CrLf + sCmdLine;
     ERROR_PATH_NOT_FOUND:
        S := 'The specified path was not found' + CrLf + sCmdLine;
     //ERROR_TOO_MANY_OPEN_FILES:
     5:
        S := 'Attempt was made to dynamically link to a task, or there'
             + ' was a sharing or network-protection error.';
     6:
        S := 'Library required separate data segments for each task.';
     8:
        S := 'There was insufficient memory to start the application.';
     10:
        S := 'Windows version was incorrect.';
     ERROR_BAD_FORMAT:
        S := 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image)';
     12:
        S := 'Application was designed for a different operating system.';
     13:
        S := 'Application was designed for MS-DOS 4.0.';
     14:
        S := 'Type of executable file was unknown.';
     15:
        S := 'Attempt was made to load a real-mode application'
             + ' (developed for an earlier version of Windows).';
     16:
        S := 'Attempt was made to load a second instance of an'
             + ' executable file containing multiple data segments'
             + ' that were not marked read-only.';
     19:
        S := 'Attempt was made to load a compressed executable file.'
             + ' The file must be decompressed before it can be loaded.';
     20:
        S := 'Dynamic-link library (DLL) file was invalid.  One of the'
             + ' DLLs required to run this application was corrupt.';
     21:
        S := 'Application requires 32-bit extensions.';
  end;

  KSMessageE(S, 'Win Exe Error');
end;
//------------------------------------------------------------------------------
procedure PrintWordDoc(const fil: string; handle: HWND);
var
  Hwnd: Thandle;
begin
  //asm int 3 end; //KS trap
  Hwnd := GetWindowFromText('Microsoft Word');
  // Hvis word er aktiv så minimer > så kan der printes i baggrunden
  if hwnd > 0
    then ShowWindow(hwnd, SW_HIDE); //hvis word ikke er aktiv må vi finde os i forgrunds-print

  Hwnd := ShellExecute(handle, 'Print', Pchar(Fil), nil, nil, SW_HIDE);
  if Hwnd < 32
    then WinExecError(Hwnd, ExtractFileName(fil)); {vis fejlen}

end;
//------------------------------------------------------------------------------
Function GetFileAsText(const afile: String): String;
var
  iFileHandle: Integer;
  iFileLength: Integer;
begin
  //asm int 3 end; //trap
  result := '';
  if FileExists(afile)
     then begin
        iFileHandle := FileOpen(afile, fmOpenRead);
        try
           iFileLength := FileSeek(iFileHandle, 0, 2);
           FileSeek(iFileHandle, 0, 0);
           SetLength(Result, iFileLength);
           FileRead(iFileHandle, Result[1], iFileLength);
          finally
            FileClose(iFileHandle);
          end;

          if length(Trim(Result)) > 500
              then DeveloperMessage('Reading file: ' +afile+ DblCrLf + Trim(Copy(Result, 1, 500) + DblCrLf +'{ Snip }'))
              else DeveloperMessage('Reading file: ' +afile+ DblCrLf + Trim(Result));
     end
     else DeveloperMessage('Failed to read file: ' +afile);
end;
//------------------------------------------------------------------------------
function SaveTextAsFile(const afile, Text: String): Boolean;
var
  //F: TextFile;
  aHandle: THandle;
  dwRead: DWORD;
begin 
  //asm int 3 end; //KS trap
  result := false;

  aHandle := CreateFile(Pchar(afile), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, 0,0);

  if aHandle = INVALID_HANDLE_VALUE
     then begin
        KSMessageE('Failed to create file: '+CrLf+afile);
        exit;
     end;
  try
     result := WriteFile(aHandle, PChar(Text)^, Length(Text), dwRead, nil);
     if not result
        then begin
           KSMessageE('Failed to write to file: '+CrLf+afile);
           exit;
        end;
  finally
     if not CloseHandle(aHandle)
        then KSMessageE('Failed to close file handle: '+CrLf+afile);
  end;

(*
  AssignFile(F, afile);
  try
     Rewrite(F);
     Write(F, Text);
  finally
     CloseFile(F);
  end;
  *)
end;
//------------------------------------------------------------------------------
function GetUserCookie: string;
begin 
  //asm int 3 end; //KS trap
  Result := Trim(GetFileAsText(GetWinDir + 'KSUserCookie'));
end;
//------------------------------------------------------------------------------
var
  NetUserName: string = '';

//------------------------------------------------------------------------------
function KSGetNetUserName(const aResource: string = '?'): string;
begin
  //asm int 3 end; //trap
  if Length(NetUserName) = 0  //not initialized
     then GetNetUserName(aResource);

  Result := NetUserName;
end;
//------------------------------------------------------------------------------
function KSGetUserName(Uppercase: boolean = true): string;
var
  pcUser: PChar;
  dwUSize: Cardinal;

  //-----------------------------------------------
  function GetCaseUserName: string;
  begin
     if Uppercase
        then Result := AnsiUpperCase(NetUserName)
        else result := NetUserName;

     //if Pos('\', result) > 0     //a win 95 returns NetUserName without "domain\"
        //then SplitAtToken(result, '\');
  end;
  //-----------------------------------------------
begin 
  //asm int 3 end; //KS trap
  if Length(NetUserName) > 0  //already initialized
     then begin
        result := GetCaseUserName;
        exit;
     end;

  //first try NetUser
  NetUserName := GetNetUserName('?');   //this returns Domaine\user for users
  if length(NetUserName) > 0            //from a forign domaine
     then begin
        result := GetCaseUserName;
        exit;
     end;

  //then try PC-user
  dwUSize := 21;              // user name can be up to 20 characters
  GetMem(pcUser, dwUSize);
  try
     if GetUserName(pcUser, dwUSize)
        then begin
           NetUserName := Trim(pcUser);
           if length(NetUserName) > 0
              then begin
                 result := GetCaseUserName;
                 exit;
              end;
        end;
  finally
    FreeMem(pcUser);
  end;

  //we only come heir if NetUser and PC-user is not getting any result
  //get User from "Cookie"
  NetUserName := GetUserCookie;

  if Length(NetUserName) > 0
     then Result := GetCaseUserName
     else KSMessageE('This computer dos''ent return any'+ CrLf +
                     'NetUser- or PC-user name.'+ DblCrLf +
                     'You must put a user name in:'+ CrLf +
                     GetWinDir+'KSUserCookie');
end;
//------------------------------------------------------------------------------
Function GetFirstNetworkDrive: string;
var
  dtDrive: TDriveType;
  AllDrives: string;
  I: Integer;
begin
  //asm int 3 end; //trap
  Result := '';

  AllDrives := KSGetLogicalDrives;

  for I := 1 to Length(AllDrives) do
     begin
        dtDrive := TDriveType(GetDriveType(PChar(AllDrives[i]+':\')));

        if dtDrive = dtNetwork  // it's a connected network drive
           then begin
               Result := AllDrives[i]+':';
               break;
           end;
     end;
end;
//------------------------------------------------------------------------------
function GetNetUserName(const aResource: string = ''): string;
// aResource = drive to get Log In Name from - if blank we use the first net-drive
var
  pcUser: PChar;
  dwUSize: Cardinal;
  _aResource: String;
begin 
  //asm int 3 end; //trap
  if ((length(aResource) = 0) or (aResource = '?'))and
     (length(NetUserName) > 0)    //no need to call net more than once
     then begin
        result := NetUserName;
        exit;
     end;


  Result := '';
  dwUSize := 21;              // user name can be up to 20 characters
  GetMem(pcUser, dwUSize);    // allocate memory for the string
  try
     if aResource = '?'
        then _aResource := GetFirstNetworkDrive
        else _aResource := aResource;

     if NO_ERROR = WNetGetUser(Pchar(_aResource), pcUser, dwUSize)
        then begin
           Result := Trim(pcUser);

           if (aResource = '?')  //if no drive letter used then save default NetUserName
              then begin
                 NetUserName := Result;

                 //at siemens the network-user is returned like this SIEDK\KS
                 //if (Pos('\', Result) > 0)
                    //then Result := afterLastToken(Result, '\');
              end;
        end;
  finally
    FreeMem(pcUser);
  end;
end;
//------------------------------------------------------------------------------
function GetWinDir: string;
//Returns the windows directory
var
  pcWindowsDirectory: PChar;
  dwWDSize: Cardinal;
begin
  //asm int 3 end; //trap
  if length(ActualWinDir)= 0
     then begin
        dwWDSize := MAX_PATH + 1;
        GetMem(pcWindowsDirectory, dwWDSize); // allocate memory for the string
        try
          if Windows.GetWindowsDirectory(pcWindowsDirectory, dwWDSize) <> 0
            then ActualWinDir := strEndSlash(pcWindowsDirectory);
        finally
          FreeMem(pcWindowsDirectory); // now free the memory allocated for the string
        end;
     end;

  result := ActualWinDir;
end;
//------------------------------------------------------------------------------
function KSGetSystemDirectory: string;
//Returns system directory
var
  pcSystemDirectory: PChar;
  dwSDSize: Cardinal;
begin
  //asm int 3 end; //KS trap
  dwSDSize := MAX_PATH + 1;
  GetMem(pcSystemDirectory, dwSDSize); // allocate memory for the string
  try
    if Windows.GetSystemDirectory(pcSystemDirectory, dwSDSize) <> 0
      then Result := strEndSlash(pcSystemDirectory);
  finally
    FreeMem(pcSystemDirectory); // now free the memory allocated for the string
  end;
end;
//------------------------------------------------------------------------------
function KSGetSystemTime: string;
//returns date and time
var
  stSystemTime: TSystemTime;
begin
  //asm int 3 end; //trap
  Windows.GetSystemTime(stSystemTime);
  Result := DateTimeToStr(SystemTimeToDateTime(stSystemTime));
end;
//------------------------------------------------------------------------------
function KSFileGetDateTime(const aFile: string): TDateTime;
begin 
  //asm int 3 end; //KS trap
  Result := FileDateToDateTime(FileAge(aFile));
end;
//------------------------------------------------------------------------------
function KSCompareFileTime(const FileNameOne, FileNameTwo: string; ComparisonType:
  TTimeOfWhat): TFileTimeComparision;
//Compares two files timestamps
// NB der er vistnok vrøvl med alt andet end ftLastWriteTime
var
  FileOneFileTime: TFileTime;
  FileTwoFileTime: TFileTime;
begin
  //asm int 3 end; //trap
  Result := ftError;

  if FileExists(FileNameOne) and FileExists(FileNameTwo)
     then begin
        FileOneFileTime := KSGetFileTime(FileNameOne, ComparisonType);
        FileTwoFileTime := KSGetFileTime(FileNameTwo, ComparisonType);

        case Windows.CompareFileTime(FileOneFileTime, FileTwoFileTime) of
          - 1: Result := ftFileOneIsOlder;
          0: Result := ftFileTimesAreEqual;
          1: Result := ftFileTwoIsOlder;
        end;
     end
     else Result := ftError;
end;
//------------------------------------------------------------------------------
function GetFileTimeEx(const FileName: string; ComparisonType: TTimeOfWhat): TDateTime;
// Returns the date and time that a file was created, last accessed, or last modified as TDateTime
// NB der er vistnok vrøvl med alt andet end ftLastWriteTime
var
  SystemTime: TSystemTime;
  FileTime: TFileTime;
begin  
  //asm int 3 end; //KS trap
  Result := StrToDate('31' + DateSeparator + '12' + DateSeparator + '9999');

  FileTime := KSGetFileTime(FileName, ComparisonType);
  if FileTimeToSystemTime(FileTime, SystemTime)
    then Result := SystemTimeToDateTime(SystemTime); // Convert to TDateTime and return

end;
//------------------------------------------------------------------------------
function GetLogicalPathFromUNC(var aUNC :string): Boolean;
var
  S,S1: string;
  I: Integer;
  UNC: string;
begin
  //asm int 3 end; //KS trap
  Result := False;

  UNC := Lowercase(aUNC);

  S := KSGetLogicalDrives;

  for I := 1 to Length(S) do
     begin
        S1 := Lowercase(ExpandUNCFileName(S[i]+':\'));
        if pos(s1, UNC) = 1
           then begin
              Delete(aUNC, 1, Length(S1)-1);
              Insert(S[i]+':', aUNC, 1);
              result := True;
              break;
           end;
     end;
end;
//------------------------------------------------------------------------------
function KSGetFileTime(const FileName: string; ComparisonType: TTimeOfWhat): TFileTime;
// Returns the date and time that a file was created, last accessed, or last modified
// NB der er vistnok vrøvl med alt andet end ftLastWriteTime
var
  FileTime, LocalFileTime: TFileTime;
  hFile: THandle;
  //AFileName: string;
begin 
  //asm int 3 end; //trap
  // initialize TFileTime record in case of error
  Result.dwLowDateTime := 0;
  Result.dwHighDateTime := 0;

  hFile := FileOpen(FileName, fmOpenRead{fmShareDenyNone});
  try
    if hFile <> 0
      then begin
        case ComparisonType of
          ftCreationTime: Windows.GetFileTime(hFile, @FileTime, nil, nil);
          ftLastAccessTime: Windows.GetFileTime(hFile, nil, @FileTime, nil);
          ftLastWriteTime: Windows.GetFileTime(hFile, nil, nil, @FileTime);
        end;                  // case FileTimeOf

        // Change the file time to local time
        FileTimeToLocalFileTime(FileTime, LocalFileTime);
        Result := LocalFileTime;
      end;                    // if hFile <> 0
  finally
    FileClose(hFile);
  end;                        // try
end;
//------------------------------------------------------------------------------
Function GetFreeDiskSize(TheDrive: String):Int64;
//NB husk C:\
var
  TheSize : int64;
begin
  //asm int 3 end; //KS trap
  GetDiskFreeSpaceEx(Pchar(TheDrive), Result, TheSize, nil);
end;
//------------------------------------------------------------------------------
function KSGetCurrentDirectory: string;
//Returns the current directory for the current process
var
  nBufferLength: Cardinal;       // size, in characters, of directory buffer
  lpBuffer: PChar;            // address of buffer for current directory
begin
  //asm int 3 end; //KS trap
  GetMem(lpBuffer, MAX_PATH + 1);
  nBufferLength := 100;
  try
    if Windows.GetCurrentDirectory(nBufferLength, lpBuffer) > 0
      then Result := strEndSlash(lpBuffer);
  finally
    FreeMem(lpBuffer);
  end;                        // try
end;
//------------------------------------------------------------------------------
function FileSizeEx(const FileName: string): LongInt;
//returns the size of a file in bytes
var
 (*
  hFile: THandle;             // handle of file to get size of
  lpFileSizeHigh: Cardinal;      // address of high-order word for file size

  f: file of Byte;
  fileSize: Integer;
  *)
  //ret: Integer;
  sResult: TSearchRec;
begin
  //asm int 3 end; //KS trap
  if 0 = SysUtils.FindFirst(filename, faAnyFile, sResult)
     then result := sResult.Size
     else result := -1;

  SysUtils.FindClose(sResult);

 (*
  Result := -1;
  hFile := FileOpen(FileName, fmOpenRead);
  try
    if hFile <> 0
      then begin
        Result := Windows.GetFileSize(hFile, @lpFileSizeHigh);
        //if result = -1
           //then KSMessageE(GetLastErrorStr);

      end;
  finally
    FileClose(hFile);
  end;
 *)
end;
//------------------------------------------------------------------------------
function ShortFileNameToLFN(ShortName: String):String;
var
  temp: TWIN32FindData;
  searchHandle: THandle;
begin
  //asm int 3 end; //KS trap
  searchHandle := FindFirstFile(PChar(ShortName), temp);

  if searchHandle <> ERROR_INVALID_HANDLE
     then result := String(temp.cFileName)
     else result := '';

  Windows.FindClose(searchHandle);
end;
//------------------------------------------------------------------------------
function GetFullPathNameEx(const Path: string): string;
//Returns the full path and filename of a specified file
var
  nBufferLength: Cardinal;       // size, in characters, of path buffer
  lpBuffer: PChar;            // address of path buffer
  lpFilePart: PChar;          // address of filename in path
begin
  //asm int 3 end; //KS trap
  Result := '';
  nBufferLength := MAX_PATH + 1;
  GetMem(lpBuffer, MAX_PATH + 1);
  GetMem(lpFilePart, MAX_PATH + 1);
  try
    if Windows.GetFullPathName(PChar(Path), nBufferLength, lpBuffer, lpFilePart) <> 0
      then Result := lpBuffer;
  finally
    FreeMem(lpBuffer);
    FreeMem(lpFilePart);
  end;
end;
//------------------------------------------------------------------------------
function GetFirstAviableDriveLetter: string;
//Returns the first available disk drives letter
var
  S: string;
  I: Integer;
begin 
  //asm int 3 end; //KS trap
  Result := '';
  S := UpperCase(KSGetLogicalDrives); //this is used letters

  while (Length(S) > 0) and (S[1] in ['A'..'C']) do
     Delete(S, 1, 1); //skip A, B and C

  for I := 1 to Length(S) do   
     if (Ord(S[I]) - 67) <> I  //first posible char = D ~ 68
        then begin
           Result := Succ(S[I -1]); //first letter after last letter "in sync"
           break;
        end;
end;
//------------------------------------------------------------------------------
function KSGetLogicalDrives: string;
//Returns a string that contains the currently available disk drives
var
  drives: set of 0..25;
  drive: integer;
begin 
  //asm int 3 end; //trap
  Result := '';
  Cardinal(drives) := Windows.GetLogicalDrives;
  for drive := 0 to 25
    do
    if drive in drives
      then Result := Result + Chr(drive + Ord('A'));
end;
//------------------------------------------------------------------------------
function KSDelete(var S: String; DeleteString: String; All: Boolean = False): boolean;
var
  I: Integer;
begin 
  //asm int 3 end; //trap
  i := Pos(DeleteString, S);
  if I > 0
     then begin
        delete(S, i, length(DeleteString));
        Result := True;
     end
     else Result := False;

  if all and result  //se if there is more to delete
     then begin
        i := Pos(DeleteString, S);
        while I > 0 do
           begin
              delete(S, i, length(DeleteString));
              i := Pos(DeleteString, S);
           end;
     end;
end;
//------------------------------------------------------------------------------
function squish(const Search: string): string;
{squish() returns a string with all whitespace not inside single
quotes deleted.}
var
  Index: byte;
  InString: boolean;
begin
  //asm int 3 end; //trap
  InString := False;
  Result := '';
  for Index := 1 to Length(Search)
    do begin
      if InString or (Search[Index] in BlackSpace)
        then AppendStr(Result, Search[Index]);
      InString := ((Search[Index] = '''') and (Search[Index - 1] <> '\')) xor InString;
    end;
end;
//------------------------------------------------------------------------------
function before(const Search, Find: string): string;
{before() returns everything before the first occurance of Find
in Search. If Find does not occur in Search, Search is returned.}
var
  index: byte;
begin
  //asm int 3 end; //trap
  index := Pos(Find, Search);
  if index = 0
    then Result := Search
  else Result := Copy(Search, 1, index - 1);
end;
//------------------------------------------------------------------------------
function beforeX(const Search, Find: string): string;
{before() returns everything before the first occurance of Find
in Search. If Find does not occur in Search, An empty string is returned.}
var
  index: byte;
begin
  //asm int 3 end; //trap
  index := Pos(Find, Search);
  if index = 0
    then Result := ''
  else Result := Copy(Search, 1, index - 1);
end;
//------------------------------------------------------------------------------
function after(const Search, Find: string): string;
{after() returns everything after the first occurance of Find
in Search. If Find does not occur in Search, a null string is returned.}
var
  index: byte;
begin 
  //asm int 3 end; //trap
  index := Pos(Find, Search);
  if index = 0
    then Result := ''
  else Result := Copy(Search, index + Length(Find), Length(Search));
end;
//------------------------------------------------------------------------------
function LastChar(const Search: string; const Find: char): Integer;
begin 
  //asm int 3 end; //KS trap
  Result := Length(Search);

  while (Result > 0) and (Search[Result] <> Find) do
     Dec(Result);
end;
//------------------------------------------------------------------------------
function RPos(const Find, Search: string): Integer;
{RPos() returns the index of the first character of the last occurance
of Find in Search. Returns 0 if Find does not occur in Search.
Like Pos() but searches in reverse.}
var
 Quit    : Boolean;
 Pos,Len : Integer;
begin
  //asm int 3 end; //trap
   result := 0;
   Len := Length(Find);
   if (Len = 0) or (length(Search) = 0)  
     then exit;

   Quit:= False;
   
   Pos := Length(Search)+ 1 - Len;
   while not Quit do
     begin
        if (Search[pos] = Find[1]) and //speed it up
           (Copy(Search,Pos,Len) = Find)
           then begin
              result := Pos;
              Quit:= True;
           end;

        if Pos = 1     //not found
           then Quit:= True;

        Dec(Pos,1);
   end;

end;
//------------------------------------------------------------------------------
function AfterLastToken(const StrInd, Token: string): string;
//Returns the right part of StrInd that comes after Token
begin
  //asm int 3 end; //trap
  result := copy(StrInd, RPos(Token, StrInd) + 1, length(StrInd));
end;
//------------------------------------------------------------------------------
function KSSameText(S1, S2: string; MaxLen: Cardinal): boolean;
begin
  Result := 2 = CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE,
                              PChar(S1), MaxLen, PChar(S2), MaxLen);
end;
//------------------------------------------------------------------------------
function BeforLastToken(const StrIn, Token: string): string;
//Returns the left part of StrInd that comes before last Token
//if no token found then StrInd is returned
var
  I: Integer;
begin  
  //asm int 3 end; //trap
  i := Rpos(Token, StrIn);//LastDelimiter(Token, StrIn);
  if I = 0
     then result := StrIn
     else result := copy(StrIn, 1, I-1);
end;
//------------------------------------------------------------------------------
type
  TFindHwndRec = record
    FoundWnd: HWND;
    WindowTekst: array[0..50] of Char;
    LenWindowTekst: Word;
  end;

  PFindHwndRec = ^TFindHwndRec;
//------------------------------------------------------------------------------
function EnumWindowsProc(WndBeingChecked: HWND; rec: PFindHwndRec): Bool; export; stdcall;
{callback funktionen som window kalder tilbage til efter EnumWindows}
var
  p: array[0..100] of Char;
begin
  //asm int 3 end; //KS trap
  Result := True;

  if (GetWindowText(WndBeingChecked, p, 99) >= rec^.LenWindowTekst)
    and (pos(rec^.WindowTekst, p) > 0)
    then begin                //(strCompLeft(rec^.WindowTekst, p)
      rec^.FoundWnd := WndBeingChecked;
      Result := False;
    end;                      {afbryd, windows-handle er nu fundet}

end;
//------------------------------------------------------------------------------
function GetWindowFromText(const WindowText: string): Hwnd;
{returnere en handle til vinduet hvis WindowText findes i caption}
var
  rec: TFindHwndRec;
begin
  //asm int 3 end; //KS trap
  {gem søgestrengen så callback-funktionen kan læse den}
  StrPcopy(rec.WindowTekst, WindowText);
  rec.LenWindowTekst := word(Length(WindowText));
  if rec.LenWindowTekst > 48
    then KSMessageE('It is maximum posible to search for 49 characters [function GetWindowFromText])');
  rec.FoundWnd := 0;          {rturværdi hvis window ikke findes}

  EnumWindows(@EnumWindowsProc, Longint(@rec));

  Result := rec.FoundWnd
end;
//------------------------------------------------------------------------------
function DropLastDir(path: string): string;
//fjerner sidste directory fra stien i path
begin
  //asm int 3 end; //KS trap
  if path[Length(path)] = '\'
    then Delete(path, Length(path), 1);

  Result := Copy(path, 1, RPos('\', path));
end;
//------------------------------------------------------------------------------
function CtrlDown: Boolean;
var
  State: TKeyboardState;
begin
  //asm int 3 end; //KS trap
  GetKeyboardState(State);
  Result := ((State[vk_Control] and 128) <> 0);
end;
//------------------------------------------------------------------------------
function FileDifferent(const Sourcefile: string; TargetPath: string): Boolean;
var
  TargetFil: string;
begin
  //asm int 3 end; //KS trap
  Result := True;

  if not Fileexists(Sourcefile)
    then exit;

  TargetPath := strEndSlash(TargetPath);
  TargetFil := TargetPath + ExtractFileName(Sourcefile);

  if not Fileexists(TargetFil)
    then exit;

  if ftFileTimesAreEqual <> KSCompareFileTime(TargetFil, Sourcefile, ftLastWriteTime)
    then exit;

  //hvis de er ens skifter Result til False og funktionen returnere med false
  Result := fileSizeEx(Sourcefile) <> fileSizeEx(TargetFil);
end;
//------------------------------------------------------------------------------
function GetErrorString(var aFmtStr: String; ErrorCode: Integer): boolean;
var
  Buf: array [Byte] of Char;
begin
  //asm int 3 end; //KS trap
  Result := (0 = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, ErrorCode,
                             LOCALE_USER_DEFAULT, Buf, sizeof(Buf), nil));
  if result
     then aFmtStr := 'Call to FormatMessage failed in:'+CrLf+'function GetErrorString'
     else aFmtStr := Buf;

end;
//------------------------------------------------------------------------------
function GetSystemErrorMessage(var aFmtStr: String; ErrorAccept: Integer = ERROR_SUCCESS): boolean;
//returns true if an error is found
var
  ErrorCode: Integer;
begin
  //asm int 3 end; //KS trap
  aFmtStr := '';
  ErrorCode := GetLastError;
  result := (ErrorCode <> ERROR_SUCCESS) and (ErrorCode <> ErrorAccept);

  if result
     then GetErrorString(aFmtStr, ErrorCode);
end;
//------------------------------------------------------------------------------
function GetLastErrorStr: string;
var
  S: string;
begin 
  //asm int 3 end; //KS trap
  GetSystemErrorMessage(S);
  result := S;
end;
//------------------------------------------------------------------------------
function ShowLastErrorIfAny(anError: Integer; Handle: Hwnd = 0): Boolean;
begin 
  //asm int 3 end; //KS trap
  Result := True;
  if anError > 32
     then exit
     else Result := False;

  KSMessageE(GetLastErrorStr);
end;
//------------------------------------------------------------------------------
function KSSetCurrentDir(const Dir: string): Boolean;
begin
  //asm int 3 end; //trap
  result := DirExists(Dir);
  if result
     then Result := SetCurrentDirectory(PChar(Dir));
end;
//------------------------------------------------------------------------------
function DelDir(aDir: string): boolean;
//Remove a directory including all content
var
  SHFileOpStruct: TSHFileOpStruct;
begin
  fillchar(SHFileOpStruct, sizeof(TSHFileOpStruct), 0);
  with SHFileOpStruct do
     begin
        Wnd := 0; {form1.handle}
        wFunc := FO_DELETE;
        pFrom := pchar(NoEndBackSlash(aDir) + #0#0);
        pTo := nil;
        fFlags := FOF_NOCONFIRMATION or FOF_SILENT;
        lpszProgressTitle := nil; {'Deleting '+path;}
     end;

  result := SHFileOperation(SHFileOpStruct) = 0;
end;
//------------------------------------------------------------------------------
function KSEmptyDir(aDir: string): Boolean;
//Clears all files and subdirectories from directory
var
  SearchRec : TSearchRec;
begin
  //asm int 3 end; //trap

  result := (0 = findfirst(aDir + '\*.*', faAnyFile, SearchRec)); {first always '.' }

  While (findnext(SearchRec) = 0) Do
     if not(SearchRec.Name = '..')                 {skip '..' to}
        then begin
           if (SearchRec.Attr and faDirectory) > 0
              then result := result and DelDir(aDir + '\' + Searchrec.name)
              else result := result and Deletefile(aDir + '\' + SearchRec.name);
        end;

  FindClose(SearchRec);
end;
//------------------------------------------------------------------------------
function KSForceDirectories(Dir: string): Boolean;
begin
  //asm int 3 end; //trap
  if Length(Dir) = 0
     then begin
        KSMessageE('Cant create directory');
        Result := False;
     end
     else begin
        Result := True;

        Dir := ExcludeTrailingBackslash(Dir);
        if (Length(Dir) < 3) or DirExists(Dir) or (ExtractFilePath(Dir) = Dir)
           then Exit; // avoid 'xyz:\' problem.

        Result := KSForceDirectories(ExtractFilePath(Dir)) and CreateDir(Dir);
     end;
end;
//------------------------------------------------------------------------------
function GetShareFromURN(const URN: string; var Share: string; aPath: string = ''): boolean;
begin
  //asm int 3 end; //KS trap
    if pos('\\', URN) = 1
     then begin { \\bupb0f4a\program\.....  }
        result := true;
        Share := BeforeTokenNr(URN, '\', 4) + '\'+ aPath;
     end
     else result := False;
end;
//------------------------------------------------------------------------------
function GetFileDateAsString(aFile: string): String;
begin
  //asm int 3 end; //KS trap
  result := IntToStr(FileAge(aFile))
end;
//------------------------------------------------------------------------------
function GetUTCFileDateAsString(aFile: string): String;
begin
  //asm int 3 end; //KS trap
  result := IntToStr(UTCFileAge(aFile))
end;
//------------------------------------------------------------------------------
function UTCFileAge(const FileName: string): Integer;
//get UTC-based file time (no conversion to local time)
var
  Handle: THandle;
  FindData: TWin32FindData;
  //LocalFileTime: TFileTime;
  //S, S1: String;
begin
    //asm int 3 end; //KS trap

  Handle := FindFirstFile(PChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE
     then begin
        Windows.FindClose(Handle);
        if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0
           then begin
             (*
              FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
              FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi, LongRec(Result).Lo);
              S := DateTimeToStr(FileDateToDateTime(Result));  //local time
              //exit;

              FileTimeToDosDateTime(FindData.ftLastWriteTime, LongRec(Result).Hi, LongRec(Result).Lo);
              S1 := DateTimeToStr(FileDateToDateTime(Result));  //UTC time
              *)
              if FileTimeToDosDateTime(FindData.ftLastWriteTime, LongRec(Result).Hi, LongRec(Result).Lo)
                 then Exit;
           end;
     end;

  Result := -1;
end;
//------------------------------------------------------------------------------
function DosLocalTimeToDosUTCTime(aDosFileTime: Integer): Integer;
var
  aFileTime: TFileTime;
  aLocalFileTime: TFileTime;
begin
  //asm int 3 end; //KS trap

  //convert to UTC time
  //S := DateTimeToStr(FileDateToDateTime(aDosFileTime));
  DosDateTimeToFileTime(LongRec(aDosFileTime).Hi, LongRec(aDosFileTime).Lo, aLocalFileTime);
  LocalFileTimeToFileTime(aLocalFileTime, aFileTime);
  FileTimeToDosDateTime(aFileTime, LongRec(result).Hi, LongRec(result).Lo);
  //S := DateTimeToStr(FileDateToDateTime(result));

  //result is now UTC filetime

end;
//------------------------------------------------------------------------------
Function GetShortDateTime(aTime: TDateTime; Seconds: boolean = false): String;
var
  OldShortDateFormat: string;
begin
  //asm int 3 end; //KS trap

  OldShortDateFormat := ShortDateFormat;
  ShortDateFormat := 'dd.mm.yy';
  try
     result := DateTimeToStr(aTime);
     if not Seconds
        then result := BeforLastToken(result, TimeSeparator); //drop seconds
  finally
     ShortDateFormat := OldShortDateFormat;
  end;
end;
//------------------------------------------------------------------------------
Function GetFileDateTime(aFile: string): String;
//var
  //OldShortDateFormat: string;
begin
  //asm int 3 end; //KS trap
  if Not FileExists(aFile)
     then result := 'Error'
     else result := GetShortDateTime(FileDateToDateTime(FileAge(aFile)));
end;
//------------------------------------------------------------------------------
Function GetModuleName(aFile: string = ''): String;
var
  ModuleName: array[0..255] of Char;
begin
  //asm int 3 end; //trap
  if length(aFile) = 0
     then GetModuleFileName(GetModuleHandle(Nil), ModuleName, SizeOf(ModuleName))
     else GetModuleFileName(GetModuleHandle(Pchar(aFile)), ModuleName, SizeOf(ModuleName));
  result := ModuleName;
end;
//------------------------------------------------------------------------------
function GetBoxHead(aBoxHead, aDefault: string): string;
begin
  //asm int 3 end; //trap
  if length(ActualAppName) = 0 //only set default one time
     then ActualAppName := LowerCase(ExtractFileName(GetModuleName));

  if length(aBoxHead) = 0
     then result := ActualAppName + ': ' + aDefault
     else result := ActualAppName + ': ' + aBoxHead;
end;
//------------------------------------------------------------------------------
function KSMessage(aMessage: string; aBoxHead: string; Params: integer): integer;
begin 
  //asm int 3 end; //trap
result := MessageBox(0, Pchar(aMessage), Pchar(aBoxHead), Params or
                       MB_TASKMODAL or MB_TOPMOST or MB_SETFOREGROUND);

  { posible button flags:
    MB_ABORTRETRYIGNORE, MB_OK, MB_OKCANCEL, MB_RETRYCANCEL, MB_YESNO, MB_YESNOCANCEL
    MB_DEFBUTTON2, MB_DEFBUTTON3, MB_DEFBUTTON4 - MB_DEFBUTTON1 is default

    MB_ICONWARNING, MB_ICONINFORMATION, MB_ICONQUESTION, MB_ICONERROR.

    posible resulte:
    IDABORT, IDCANCEL, IDIGNORE, IDNO, IDOK, IDRETRY, IDYES }
end;

//------------------------------------------------------------------------------
function KSQuestion(aMessage: string; aBoxHead: string = ''; Params: integer = MB_ICONQUESTION or MB_YESNO): integer;
begin 
  //asm int 3 end; //trap
  result := KSMessage(aMessage, GetBoxHead(aBoxHead, 'Question'), Params);
end;
//------------------------------------------------------------------------------
Procedure KSMessageI(aMessage: string; aBoxHead: string = '');
begin
  KSMessage(aMessage, GetBoxHead(aBoxHead, 'Information'), MB_ICONINFORMATION or MB_OK)
end;
//------------------------------------------------------------------------------
Procedure KSMessageQ(aMessage: string; aBoxHead: string = '');
begin
  KSMessage(aMessage, GetBoxHead(aBoxHead, 'Question'), MB_ICONQUESTION or MB_OK);
end;
//------------------------------------------------------------------------------
Procedure KSMessageE(aMessage: string; aBoxHead: string = '');
begin
  KSMessage(aMessage, GetBoxHead(aBoxHead, 'Error'), MB_ICONERROR or MB_OK);
end;
//------------------------------------------------------------------------------
Procedure KSMessageW(aMessage: string; aBoxHead: string = '');
begin
  KSMessage(aMessage, GetBoxHead(aBoxHead, 'Warning'), MB_ICONWARNING or MB_OK);
end;
//------------------------------------------------------------------------------
Procedure KSMessageT(aMessage: string; aBoxHead: string = '');
begin
  KSMessageI(aMessage, aBoxHead);
end;
//------------------------------------------------------------------------------
const
  NewBlock: string = '-----------------------------------------'+ #13+#10+#13+#10;

//------------------------------------------------------------------------------
function SaveDeveloperMessagesLog(afile: string): boolean;
begin
  //asm int 3 end; //KS trap
  result := SaveTextAsFile(afile, DeveloperMessagesLog);
  if result
     then DeveloperMessagesLog := '';
end;
//------------------------------------------------------------------------------
function CloseDeveloperMessagesLog(afile: string): boolean;
begin
  //asm int 3 end; //KS trap
  if ShowDeveloperMessages
     then begin
        DeveloperMessagesLog := DeveloperMessagesLog+ 'Log ended at: '+ DateTimeToStr(now)+ DblCrLf+ NewBlock;

        result := SaveTextAsFile(afile, DeveloperMessagesLog);
        if result
           then DeveloperMessagesLog := ''
           else KsMessageE('"Developer messages log" could not be saved to:'+CrLf+ afile);
     end
     else result := false;
end;
//------------------------------------------------------------------------------
procedure DeveloperMessage(aMessage: string);

begin
  //asm int 3 end; //trap
  if ShowDeveloperMessages
     then begin
        if length(DeveloperMessagesLog) = 0
           then begin
              DeveloperMessagesLog := 'Developer messages log for:'+CrLf+
                                      'Appe name: '+ActualAppName+ CrLf+
                                      'User: '+ KSGetUserName+CrLf+
                                      'Log started at: '+ GetShortDateTime(now) + DblCrLf+
                                      //DateTimeToStr(now)
                                       NewBlock;

           end;

        DeveloperMessagesLog := DeveloperMessagesLog + aMessage + DblCrLf + NewBlock;

        //by instalation DeveloperMessagesCanceled := True; is set at program start
        //i.e. in the beginning of KnowHow.dpr

        if DeveloperMessagesCanceled
           then exit;

        DeveloperMessagesCanceled := (IDCANCEL = KSQuestion('Developer message' + DblCrLf+ aMessage, 'Information',
                                      MB_ICONINFORMATION or MB_OKCANCEL));
     end;
end;
//------------------------------------------------------------------------------
procedure OpenDeveloperMessagesLog;
const
  Stars: string = '*****************************************'+ #13+#10;
var
  tmpFile: String;
begin
  //asm int 3 end; //KS trap
  if ShowDeveloperMessages
     then begin
        tmpFile := fileTemp('.txt');
        DeveloperMessagesLog := DeveloperMessagesLog + 'Log opened at: '+
                                DateTimeToStr(now)+ DblCrLf+ Stars + Stars+ NewBlock;

        if SaveTextAsFile(tmpFile, DeveloperMessagesLog)
           then ExecuteDefaultOpen('txt', tmpFile)
           else KSMessageE('Creation of '+tmpFile+' failed');
     end
     else KSMessageI('Developer messages log is not open');
end;
//------------------------------------------------------------------------------
function IsAlNum(C: char): bool;
begin
  //asm int 3 end; //trap
  result := C in ['0'..'9', 'A'..'Z', 'a'..'z', 'À'..'ÿ'];
end;
//------------------------------------------------------------------------------
procedure SearchForFiles(path, mask: AnsiString; var Value: TStringList; Recurse: Boolean = False);
//path = rootdir
//fileMask = *.db, *.*, ....osv
//value = stringlist til at modtage resultate af søgningen
//Recurse = True -> recursering af foldere under path
var
srRes : TSearchRec;
iFound : Integer;
begin
  //asm int 3 end; //KS trap
if (Recurse) // First, we must search the directories
        then begin
        if path[Length(path)] <> '\' then path := path +'\';
        iFound := FindFirst(path + '*.*', faAnyfile, srRes);
        while iFound = 0 
        do begin
                if (srRes.Name <> '.') and (srRes.Name <> '..')
                then if srRes.Attr and faDirectory > 0
                then SearchForFiles(path + srRes.Name, mask, Value, Recurse);//recurse folder
                iFound := FindNext(srRes);
        end;
    FindClose(srRes);
  end;

// Now, we don't treat the directories anymore

if path[Length(path)] <> '\' then path := path +'\';

iFound := FindFirst(path + mask, faAnyFile-faDirectory {any file but not folders}, srRes);
while iFound = 0 {0 ~ true}
        do begin
        if (srRes.Name <> '.') and (srRes.Name <> '..') and (srRes.Name <> '')
        then Value.Add(path + srRes.Name);
        iFound := FindNext(srRes);
  end;

FindClose(srRes);

end;
//------------------------------------------------------------------------------
type
  TRegProc = function : HResult; stdcall;
//------------------------------------------------------------------------------
function RegisterAxLib(FileName: string; Unreg: Boolean = False): boolean;
var
  LibHandle: THandle;
  RegProc: TRegProc;
  DllProc: String;
begin
  //asm int 3 end; //KS trap
  Result := False;

  LibHandle := LoadLibrary(PChar(FileName));
  if LibHandle = 0
     then begin
        KSMessageE('Failed to load:'+DblCrLf+FileName);
        exit;
     end;
  try
     if Unreg
        then DllProc := 'DllUnregisterServer'
        else DllProc := 'DllRegisterServer';

     @RegProc := GetProcAddress(LibHandle, Pchar(DllProc));
     if @RegProc = Nil
        then KSMessageE(DllProc+' procedure not found in:'+DblCrLf+FileName)
        else if RegProc <> 0    //run register process
           then KSMessageE('Call to '+DllProc+' failed in:'+DblCrLf+FileName)
           else Result := True; //success - the dll is Reg- / Unregistered
  finally
    FreeLibrary(LibHandle);
  end;
end;
//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
procedure KSWait(aTime: Cardinal);
//waits unthil aTime (in miliseconds) is elapsed
var
  T: Cardinal;
begin
  //asm int 3 end; //trap
  T := GetTickCount + aTime;
  while T > GetTickCount do
     KSProcessMessages;
end;
//------------------------------------------------------------------------------
procedure KSProcessMessages;
var
  Msg: TMsg;

  //-----------------------
  function ProcessMessage(var Msg: TMsg): Boolean;
  begin
     Result := False;
     if PeekMessage(Msg, 0, 0, 0, PM_REMOVE)
        then begin
           Result := True;
           if Msg.Message = WM_QUIT
              then begin
                 {Re-post quit message so main message loop will terminate}
                 PostQuitMessage(Msg.WParam)
              end
              else begin
                 TranslateMessage(Msg);
                 DispatchMessage(Msg);
              end;
        end;
  end;
  //-----------------------
begin
  //asm int 3 end; //trap
  while ProcessMessage(Msg) do
     {loop};
end;
//------------------------------------------------------------------------------
function _GetExeOpen(const Ext: string; var Exefil: string; sielent: boolean = true): Boolean;
{ find app associated with the extension of filename.
  Since file must exist we create a dummy file}
var
        Dir, Name: string;
  res: array[1..250] of char;
  err: integer;
  F: TFileStream;
  //dummyFileCreated: boolean;
  filename: string;
begin
  //asm int 3 end; //KS trap

  filename := KSGetTempPath + '~~~~~~~~.'+Ext;
  F:= TFileStream.create (filename, fmCreate);
  F.free;

        Dir:= extractFilePath(FileName) + #0;
  Name:= extractFileName(FileName) +  #0;
  fillchar(res,SizeOf(res),' ');
  res[250]:= #0;
  err:= FindExecutable(@Name[1],@Dir[1],@res);
  if err >= 32
     then begin
        Exefil := strPas(@res);
        result := true;
     end
           else begin
        if not Sielent
           then KSMessageE('No default program for "'+Ext+'"');
           result:= false;
        Exefil := '';
     end;

  deletefile(filename);
end;
//------------------------------------------------------------------------------
function GetAbsolutePath(ActualPath: string; var RelativePath: string): boolean;
var
  S: string;
  ActualForSlashes: Boolean;
  ActualP: String;
  RelativeP: String;
  NewPath: String;
begin 
  //asm int 3 end; //KS trap
  result := false;

  if pos('/', ActualPath) > 0
     then begin
        ActualForSlashes := true;
        ActualP := StringReplace(ActualPath, '/', '\',  [rfReplaceAll]);
                    //ChangeAllToken(ActualPath, '/', '\');
     end
     else begin
        ActualForSlashes := False;
        ActualP := ActualPath;
     end;

  ActualP := NoEndBackSlash(ActualP);

  if pos('/', RelativePath) > 0
     then RelativeP := StringReplace(ActualPath, '/', '\',  [rfReplaceAll])
     else RelativeP := RelativePath;

  RelativeP := NoEndBackSlash(RelativeP);

  if pos('..\', RelativeP) = 1
     then begin
        result := true;
        S := BeforLastToken(NoEndBackSlash(ActualP), '\');  //go up one level
        NewPath := after(RelativeP, '\');    //go up one level

        While pos('..\', NewPath) > 0  do
           begin
              S := BeforLastToken(S, '\');     //go up one level
              NewPath := after(NewPath, '\');    //go up one level
           end;

       NewPath := S +'\'+ NewPath;
     end
     else begin
        if RelativeP[1] = '\'
           then begin
              NewPath := ActualP + RelativeP;
              result := true;
           end
           else NewPath := RelativeP;
     end;

  if result
     then begin
        if ActualForSlashes
           then RelativePath := StringReplace(NewPath, '\', '/',  [rfReplaceAll])
                                   //ChangeAllToken(NewPath, '\', '/')
           else RelativePath := NewPath;
    end;
end;
//------------------------------------------------------------------------------

end.