(*
/*

CLASS {System_functions|_Delphi_FPC},
NATIVE, UNTESTED, BYTES, BITWISE, STOPPING,
ABSTRACT :


IMPORT: {String_functions}, {File_path} .
IMPORT: {Configuration} .
IMPORT, ANYWAY: {NATIVE_process} .

NATIVE: @
"uses {$IFDEF LINUX} crt, Process,"
"	  {$ELSE} "
"		Windows, shlobj, ShellAPI, ActiveX, //ShlObj, SHFolder,"   
"	  {$ENDIF}"
"	  {$IFDEF KOL}KOLMath, "
"	  {$ELSE}"
"		 Math,"
"	  {$ENDIF} "
"	  System_functions, NATIVE_process;" .
        
        
NATIVE: "var test_command_line: String = '';" .

NATIVE: "///COPY AL4_options.inc" .
NATIVE: "///copy System_functions.pas" .

*/
*)

unit System_functions;

interface

uses AL4, All_classes
{$IFDEF LINUX} , SysUtils, Process, Classes, crt
{$ELSE} 
			{$IFDEF KOL}, KOL
						  {$IFNDEF NOERR} , err 
						  {$ENDIF}
			{$ELSE} , SysUtils 
			{$ENDIF}
			, Windows, shlobj, ShellAPI, ActiveX, MMSystem
			{$IFnDEF _D5orHigher}{$IFnDEF KOL} , Classes {$ENDIF}{$ENDIF}
{$ENDIF};

{$IFDEF VER90}
              {$DEFINE _D2}
              {$DEFINE _D2orD3}
              {$DEFINE _D2orD3orD4}
{$ENDIF}

{$IFDEF VER100}
              {$DEFINE _D3}
              {$DEFINE _D3orHigher}
              {$DEFINE _D2orD3}
              {$DEFINE _D2orD3orD4}
              {$DEFINE _D3orD4}
{$ENDIF}

{$IFDEF VER120}
              {$DEFINE _D3orHigher}
              {$DEFINE _D3orD4}
              {$DEFINE _D4}
              {$DEFINE _D4orHigher}
              {$DEFINE _D2orD3orD4}
                  {$IFnDEF KOL_MCK}
                           {$DEFINE INPACKAGE}
                  {$ENDIF}
{$ENDIF}

{$IFDEF VER130}
              {$DEFINE _D3orHigher}
              {$DEFINE _D4orHigher}
              {$DEFINE _D5}
              {$DEFINE _D5orHigher}
{$ENDIF}

{$IFDEF VER140}
              {$DEFINE _D3orHigher}
              {$DEFINE _D4orHigher}
              {$DEFINE _D5orHigher}
              {$DEFINE _D6}
              {$DEFINE _D6orHigher}
{$ENDIF}

{$IFDEF VER150}
              {$DEFINE _D3orHigher}
              {$DEFINE _D4orHigher}
              {$DEFINE _D5orHigher}
              {$DEFINE _D6orHigher}
              {$DEFINE _D7}
              {$DEFINE _D7orHigher}
{$WARN UNIT_DEPRECATED OFF}
{$WARN SYMBOL_PLATFORM OFF}
{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CAST OFF}
{$WARN UNSAFE_CODE OFF}
{$ENDIF}

function Do_Get_environment_var(const Name:string): string;

{$IFnDEF LINUX}

//---------------------------------------------- 'WINDOWS'    
const																	//
  shell32 = 'shell32.dll';												//

function SHGetFolderPathA(
	hwnd: HWND; csidl: Integer; hToken: THandle; dwFlags: DWord; 
	pszPath: PAnsiChar): HRESULT; stdcall;
external 'SHFolder.dll' name 'SHGetFolderPathA';
	
function Do_Get_os_name_version_info: String;                        	//

//------------------------------------------------------------
	
{$ENDIF}	

function get_param_count: Integer;
function get_parameter(i: Integer): String;

{$IFDEF KOL}
function ExpandFileName(const FileName: string): string;
{$ENDIF}
function Do_execute_program(
	const X_App, X_Param: String; X_Redirect: Integer): String;

var parameters: {$IFDEF KOL} PStrList {$ELSE} TStringList {$ENDIF};

function Do_Get_absolute_path(const X_Rel: String): String;

{$IFnDEF _D6orHigher}
{$IFnDEF FPC}
function DirectoryExists(const Directory: string): Boolean;
{$ENDIF}
{$ENDIF}

function Play_audiofile(
	const afile: String; command: Integer; position: Integer): String;


implementation

//{$IFDEF KOL}
uses unitC_System_functions;
//{$ENDIF}

{$IFnDEF _D6orHigher}
{$IFnDEF FPC}
function DirectoryExists(const Directory: string): Boolean;
var
  Code: Integer;
begin
  Code := GetFileAttributes(PChar(Directory));
  Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;
{$ENDIF}
{$ENDIF}

(*
/*


FUN Platform_info|rmation ==> STR :
	RESULT = main_platform_info
	SILENT:
		DEBUG:
			STR a|dditional = additional_platform_info
			CASE a != "" ? RESULT << ";" a ;
		;
	; .
	
    	
FUN platform_info|_lowered ==> STR, PUBLIC :
    RESULT = Platform_info.Lower .	
	
	
FUN main_platform_info|rmation ==> STR, NATIVE :
    STR win_v|ersion = Windows_ver // get_os_name_version_info
    NATIVE @
"{$IFDEF KOL}"
"   RESULT := 'Pascal;Delphi(KOL);Win32;' + X_win_v;" 
"{$ELSE}"
"	{$IFDEF LINUX}"
"		RESULT := 'Pascal;Free Pascal(FPC);Linux';"
"	{$ELSE}"     
"	    {$IFDEF FPC}"
"       	RESULT := 'Pascal;Free Pascal(FPC);Windows(' + X_win_v + ')';"
"	    {$ELSE}"
"       	RESULT := 'Pascal;Delphi(VCL);Win32;Windows(' + X_win_v + ')';"
"		{$ENDIF}"     
"	{$ENDIF}"
"{$ENDIF}" .

FUN additional_platform_info|rmation ==> STR, NATIVE :
    NATIVE @
"{$IFDEF BGRABITMAP}"
"	{$IFDEF BGRABITMAP_CANVAS}"
"	RESULT := RESULT + 'BGRABITMAP_CANVAS';"
"	{$ELSE}"
"	RESULT := RESULT + 'BGRABITMAP';"
"	{$ENDIF}"
"{$ENDIF}"
"{$IFDEF DIRECT_DRAW_CANVAS}"
"	if RESULT <> '' then RESULT := RESULT + ';';"
"	RESULT := RESULT + 'DIRECT_DRAW_CANVAS';"
"{$ENDIF}"
"{$IFDEF RXGIF}"
"	if RESULT <> '' then RESULT := RESULT + ';';"
"	RESULT := RESULT + 'RXGIF';"
"{$ENDIF}"
.

FUN Is_int32 ==> BOOL, NATIVE : @
"{$IFDEF INT_32} RESULT := true; {$ENDIF}" .

FUN Is_int64 ==> BOOL := ! Is_int32 .


FUN Windows_ver|sion ==> STR :
    RESULT = get_os_name_version_info 
    //DEBUG: "RESULT=[" RESULT "]"#NL ;
    CASE RESULT IN ["Win8;", "Win10;"] ? 
         {Config} reg|istry_temp = New_read_config(
			     	"", 'MACHINE', "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\"
			     	"Windows NT\CurrentVersion")
			     	
	     RESULT = "Windows " reg.Int("CurrentMajorVersionNumber").S 
	     	"." reg.Int("CurrentMinorVersionNumber").S
    ;
    .

FUN get_os_name_version_info ==> STR, NATIVE :
@	"{$IFnDEF LINUX}"
    " RESULT := Do_Get_os_name_version_info;"
    "{$ENDIF}" .
    
FUN TEST|_stage ==> BOOL, NATIVE :
@   "   RESULT := Is_TEST_stage();" .

FUNCTION Maximum_recursion|_deep ==> INT, NATIVE :
@	"	RESULT := AL4.Max_recursion_deep;" .

FUN Set_maximum_recursion|_deep(
	INT Desired|_value), NATIVE :
	CASE Desired > 10240 ? INT value|_to_set = 10240
	ELSE value = Desired ;
	NATIVE @
	"	AL4.Max_recursion_deep := X_value;" .

*/
*)
        
{$IFnDEF LINUX}

function Do_Get_os_name_version_info: String;
var MajorVersion, MinorVersion: Byte;
    dwVersion: Integer;
begin
    dwVersion := GetVersion;
    MajorVersion := LoByte( dwVersion );
    MinorVersion := HiByte( LoWord( dwVersion ) );
    if dwVersion >= 0 then
    begin
      Result := 'NT;';
      if (MajorVersion >= 8) then
      	  Result := 'Win10;' // only if an application has manifest
      else if (MajorVersion >= 6) then begin
      	if (MinorVersion >= 3) then
      		Result := 'Win8.1;' // only with mainfest
      	else if (MinorVersion >= 2) then
      		Result := 'Win8;'
        else if (MinorVersion >= 1) then
        	Result := 'Win7;'
        else
        	Result := 'Vista;';
      end else begin
             if MajorVersion >= 5 then
                if MinorVersion >= 1 then
                begin
                     Result := 'XP;';
                     if MinorVersion >= 2 then
                       Result := 'Server2003;';
                end
                else Result := 'Win2000;';
           end;
    end
      else
    begin
      Result := 'Win95;';
      if (MajorVersion > 4) or
         (MajorVersion = 4) and (MinorVersion >= 10)  then
      begin
        Result := 'Win98;';
        if (MajorVersion = 4) and (MinorVersion >= $5A) then
          Result := 'WinME;';
      end
        else
      if MajorVersion <= 3 then
        Result := 'Win3.1;';
    end;
end;

{$ENDIF}


//?{Fake_parameters}
	{$DEFINE PARSE_PARAMS}
//.
{$IFDEF LINUX}
	{$DEFINE PARSE_PARAMS}
{$ENDIF}

(*
/*


--------------------------------------------------- 'end console colors'

FUNCTION Get_command_line ==> STR, NATIVE, 
	DEPRECATED(
	'Count_param, Parameter (GetCommandLine is platform dependent)'):
@	"{$IFDEF LINUX}"
	"	RESULT := ParamStr(0);"
	"{$ELSE}"
   	"    if test_command_line <> '' then"
    "       RESULT := test_command_line"
    "    else RESULT := GetCommandLine;"
    "{$ENDIF}" .
    
FUN parse_parameters, CALLBACK :
	STR p|arameters_scanned[] << Parameter(0)
	------------- 'p[] here should not be empty to prevent recursion !!!'
    STR s|trings_1_parameter = Parameter(-1).Trim
	FOR i|dummy IN [0 TO s.Len-1] :
	    CASE s.Len == 0 ? BREAK i ;
	    CASE s.[0] == #QU ? 
	         s = s.[1 TO *]
	    	 CASE #QU IN s ? 
	    	      STR p_next|_parameter = s.[0 TO s.Find(#QU)-1]
	    	      p[] << p_next
	    	      s = s.[s.Find(#QU)+1 TO *].Trim
	    	 ELSE p[] << #QU s
	    	   	  s = "" ;
	    ELSE
	    	 CASE " " IN s ? 
	    	      p_next = s.[0 TO s.Find(" ")-1]
	    	      p[] << p_next
	    	      s = s.[s.Find(" ")+1 TO *].Trim
	    	 ELSE p[] << s
	    	 	  s = "" ;
	    ;
	;
	Set_parameters(p[]) .

-------------------------------- 'command line, environment variables'

FUN Set_parameters(STR P|arameters_array[]), NATIVE : @
   "var i: Integer;"
   "	parameters.Free;"
   "	{$IFDEF KOL} parameters := NewStrList;"
   "	{$ELSE} parameters := TStringList.Create;"
   "	{$ENDIF}"     
   "    for i := 0 to X_P.Count()-1 do"
   "        parameters.Add(X_P.GetStrings(i));" .

	FUN Count_param|eters_in_command_line ==> INT, NATIVE :
@   "   RESULT := get_param_count;" .

	*/
	*)
	function get_param_count: Integer;
	begin
		{$IFDEF PARSE_PARAMS}
		{$IFDEF LINUX}
			if ((parameters = nil) or (parameters.Count = 0)) 
			and (ParamCount = 1) then
				unitC_System_functions.M_parse_parameters;
		{$ENDIF}
		if (parameters <> nil) and (parameters.Count > 0) then
			Result := parameters.Count
		else 
		{$ENDIF}
		Result := ParamCount + 1;
	end;
	(*
	/*

FUN Parameter|_in_command_line_by_index(
    INT Index|_of_parameter) ==> STR
    :
    RESULT = do_get_param(Index)
    CASE Index == 0 && RESULT.[0] == #QU && RESULT.[*] == #QU ?
         RESULT = RESULT.[1 TO *-1]
    ; .
             
FUN do_get_param(
    INT Index|_of_parameter_or_0_to_get_application_path) ==> STR,
    NATIVE:
@	"		RESULT := get_parameter(X_Index);"
	. 
	*/
	*)
	function get_parameter(i: Integer): String;
	begin
		Result := '';
		{$IFDEF PARSE_PARAMS}
		if i = -1 then begin
			Result := ParamStr(1); Exit;
		end;
		if i = 0 then begin
			Result := ParamStr(0); Exit;
		end;
		get_param_count;
		if (parameters <> nil) and (parameters.Count > 0) then begin
			if (i < 0) or (i >= parameters.Count) then Exit;
			Result := parameters {$IFDEF KOL} .Items {$ENDIF} [i]; Exit;
		end;
		{$ENDIF}
		if (i < 0) or (i >= get_param_count) then Exit
		else Result := ParamStr(i); 
	end;
	(*
	/*

FUN Get_windows_dir|ectory ==> STR, NATIVE,
	DEPRECATED('Platform dependent') :
   @"var Buffer: array[0..MAX_PATH] of Char;"
   	"	{$IFDEF LINUX}"
   	"	{$ELSE}"
    "    Windows.GetWindowsDirectory(Buffer, Sizeof(Buffer));"
    "    RESULT := Buffer;"
    "	{$ENDIF}" .

    
FUNCTION Application_name || App_name ==> STR :
    RESULT = Start_dir Parameter(0).Extract_file_name
    RESULT = RESULT.Extract_file_name .
    //CASE RESULT[*] == Path_sep ? RESULT = RESULT[0 TO *-1] ;
    //RESULT = RESULT[RESULT.Find_last(Path_sep)+1 TO *] .

FUNCTION Get_application_data_dir ==> STR :

    RESULT = (Get_special_dir(APPLICATION_DATA).Trailing_slash
    "" Application_name).Trailing_slash .
            
FUN Get_recent_files_dir ==> STR :
    RESULT = Get_special_dir(RECENT).Trailing_slash .

FUN Get_temp_dir
    ||Get_temporary_dir|ectory ==> STR
    :
	RESULT = Get_environment_var("Temp")
	CASE RESULT == "" ? RESULT = Get_environment_var("Tmp") ;
	CASE RESULT == "" ? RESULT = Get_environment_var("TmpDir") ;
	CASE RESULT == "" ? RESULT = Path_sep "tmp" ;
	RESULT = RESULT.Trailing_slash .

CONST INT {special_folders} :
      PROGRAMS = 2
      PRINTERS = 4
      MY_DOCUMENTS = 5
      STARTUP|_DIRECTORY = 7
      RECENT|_FILES = 8
      SEND_TO|_DIRECTORY = 9
      RECYCLE_BIN = 10
      START_MENU = 11
      DESKTOP_DIR|ECTORY = 16
      NETWORK_SHORTCUTS = 19
      FONTS|_DIRECTORY = 20
      COMMON_START_MENU = 22
      COMMON_STARTUP = 24
      COMMON_DESKTOP_DIR|ECTORY = 25
      APPLICATION_DATA = 26
      COMMON_APP|LICATION_DATA = 35
      PRINT_HOOD = 27
      LOCAL_APPLICATION_DATA = 28
      NON_LOCALIZED_STATUP = 29
      COMMON_FAVORITES = 31
      COMMON_PROGRAMS = 32
      INTERNET_CACHE = 32
      COOKIES|_DIRECTORY = 33
      HISTORY|_DIRECTORY = 34
      COMMON_APPLICATION_DATE = 35
      WINDOWS|_DIRECTORY = 36
      SYSTEM|_DIRECTORY = 37
      MY_PICTURES = 39
      USER_PROFILE = 40
      COMMON_DOCUMENTS = 46
      .
      

FUN Get_special_dir|ectory(
	INT Sp|ecial_filder_index ) ==> STR, 
    NATIVE, IF Sp IS CONST, THEN Sp IN {special_folders} : @
	"var buf: array[0..MAX_PATH] of Char;"
	"{$IFDEF LINUX}"
    "   case X_Sp of"
    "   5: // MY_DOCUMENTS --> User's HOME directory"
    "		RESULT := ExpandFileName('~/') + 'Documents';"
    "   16: // DESKTOP_DIR|ECTORY --> User's HOME directory"
    "       RESULT := GetEnvironmentVariable('HOME');"
    "	26: // APPLICATION_DATA"
    "		RESULT := ExtractFilePath(GetAppConfigFile(false));"
    "   end;"
	"{$ELSE}"
	"	buf[0] := #0;"
    "	if SHGetFolderPathA(0, X_SP, 0, 0, buf) = S_OK then"
    "		Result := buf;"
	"{$ENDIF}" 
	.


CONST INT : 
	EXECUTE_REDIRECT_OUT || REDIR_OUT = 1
	EXECUTE_REDIRECT_ERR || REDIR_ERR = 2
	EXECUTE_REDIRECT_IN  || REDIR_IN = 4
	EXECUTE_HIDDEN|_AS_POSSIBLE || EXEC_HIDDEN = 8
	EXECUTE_RUNAS || EXECUTE_RUN_AS = 16
	.
        
FUN Execute_program(
	STR App|lication_path,
	STR Param|eters,
	INT Redirect|_output_error) ==> STR, NATIVE,
	DEPRECATED('Platform dependent') :
@	"RESULT := Do_execute_program(X_App, X_Param, X_Redirect);" .
	
*/
*)

function Do_execute_program(
	const X_App, X_Param: String; X_Redirect: Integer): String;
var {$IFDEF LINUX}
    AProcess: TProcess;
    OutputStream: TStream;
    BytesRead: longint;
    Buffer: array[0..1023] of byte;
    TempStrings: TStringList;
    {$ELSE WINDOWS}
    SA: TSecurityAttributes;
    SI: TStartupInfo;
    PI: TProcessInformation;
    buf: array[ 0..1023 ] of char;
    res: Boolean;
    redword: {$IFDEF _D5orHigher} Cardinal {$ELSE} DWORD {$ENDIF};
    rPipe, wPipe: THandle;
    cDir: String;
    ok: Boolean;
    {$ENDIF WINDOWS}
begin
{$IFDEF LINUX}
	Result := '';
    AProcess := TProcess.Create(nil);
 		   //writeln('aprocess created');
    //AProcess.Executable := X_App;
    //AProcess.Parameters.Add(X_Param);
    AProcess.CommandLine := X_App + ' ' + X_Param;
    if X_Redirect <> 0 then
 	   AProcess.Options := [poUsePipes]
    else
 	   AProcess.Options := [poWaitOnExit];
//writeln('aprocess executing [' + X_App + '],' + IntToStr(X_Redirect));
try
    AProcess.Execute;
except on E: Exception do
	   begin
		   writeln('exception: ' + E.Message);
		   Exit;
	   end;
end;
 		   //writeln('aprocess executed');
    if X_Redirect <> 0 then
    begin
 	   OutputStream := TMemoryStream.Create;
 		   //writeln('output stream created');
 	   repeat
 		   BytesRead := AProcess.Output.Read(Buffer, 1024);
 		   //writeln('read 1024: ' + IntToStr(BytesRead));
 		   OutputStream.Write(Buffer, BytesRead);
 	   until BytesRead = 0;
 		   //writeln('output stream filled: ' + 
 		   //IntToStr(OutputStream.Size));
    end else OutputStream := nil;
    AProcess.Free;
 		   //writeln('aprocess freed');
    if Assigned(OutputStream) then
    begin
 	   OutputStream.Position := 0;
 	   TempStrings := TStringList.Create;
 	   TempStrings.LoadFromStream(OutputStream);
 		   //writeln('tempstrings loaded: lines = ' + 
 		   //IntToStr(TempStrings.Count));
 	   Result := TempStrings.Text;
 		   //writeln('result got strings');
 	   OutputStream.Free;
 	   TempStrings.Free;
    end;
 		   //writeln('finish execute process');
    
{$ELSE WINDOWS}
	{$IFNDEF NOERR}
    try
    {$ENDIF}
    FillChar(SA, Sizeof(SA), 0);
    SA.nLength := sizeof(SA);
    SA.bInheritHandle := TRUE;

	rPipe := INVALID_HANDLE_VALUE;
	wPipe := INVALID_HANDLE_VALUE;
	if X_Redirect <> 0 then
       CreatePipe(rPipe, wPipe, @SA, 0);

    FillChar(PI, Sizeof(PI), 0);
    FillChar(SI, Sizeof(SI), 0);
    SI.cb := Sizeof(SI);
    if X_Redirect <> 0 then
       SI.dwFlags := STARTF_USESTDHANDLES;
    if X_Redirect and 1 <> 0 then
       SI.hStdOutput := wPipe;
    if X_Redirect and 2 <> 0 then
       SI.hStdError := wPipe;

    {$IFDEF KOL}
    cDir := GetWorkDir;
    {$ELSE}
    cDir := GetCurrentDir;
    {$ENDIF}
    
    CreateProcess(nil, PChar(X_App + ' ' + X_Param), nil, nil, 
        TRUE, NORMAL_PRIORITY_CLASS, nil, PChar(cDir), SI, PI);
    if wPipe <> INVALID_HANDLE_VALUE then
       ok := CloseHandle(wPipe)
    else ok := true;

    Result := '';
    if ok and (X_Redirect <> 0) then
    REPEAT
       res := ReadFile(rPipe, buf, Sizeof(buf)-1, redword, nil);
       buf[redword] := #0;
       Result := Result + buf;
    UNTIL not res
    else WaitForSingleObject(PI.hThread, INFINITE);
    if rPipe <> INVALID_HANDLE_VALUE then
       CloseHandle(rPipe);
    CloseHandle(PI.hThread);
    CloseHandle(PI.hProcess);
    {$IFNDEF NOERR}
    except {$IFNDEF NOERR} on E: Exception do {$ENDIF}
       begin
           {$IFNDEF NOERR} Any_exception(E); {$ENDIF}
       end
    end;
    {$ENDIF}
{$ENDIF WINDOWS}
end;


(*
/*

FUN Start_program(
	STR App|lication_path, STR Param|eters), NATIVE :
    CASE TEST ? STOP "In TEST mode, can not start external programs" ;
    NATIVE:
@	"Do_start_program(X_App, X_Param, true, false);" .

FUN Program_run_as(
	STR App|lication_path, STR Param|eters), NATIVE :
    CASE TEST ? STOP "In TEST mode, can not start external programs" ;
    NATIVE:
@	"Do_start_program(X_App, X_Param, true, true);" .


FUN Start_program_hidden(
	STR App|lication_path, STR Param|eters), NATIVE :
    CASE TEST ? STOP "In TEST mode, can not start external programs" ;
    NATIVE:
@	"Do_start_program(X_App, X_Param, false, false);" .

FUN Start_program_ok(
	STR App|lication_path, STR Param|eters) ==> BOOL, NATIVE :
    CASE TEST ? STOP "In TEST mode, can not start external programs" ;
    NATIVE:
@	"RESULT := Do_start_program(X_App, X_Param, true, false) <> 0;" .


FUN Start_file|_not_necessary_executable(
        STR Dok|ument_path), NATIVE
        :
    ----------------------------------------------------- ''
    CASE TEST ? STOP "In TEST mode, can not start external programs" ;
    NATIVE: @     
@	"Do_start_program(X_Dok, '', true, false);" .

FUN Ref_count({Object} Obj|ect_inspecting) ==> INT, NATIVE :
    "Result := X_Obj.Count;" .


FUN Stop_if_test(STR T|est_must_be_present) :
    CASE TEST ?
	     CASE "test" IN T.Lower ? ==> ;
	     
	     STOP "In test mode files can not be changed unless these have "
	          "'test' substring in a name or a path"
    ; .

                 
------------------ 'profiler helper'

FUN Profiler_save_reset|_counters, NATIVE : @
"	Profiler_save_reset();" .

FUN Get_environment_var|iable_value(
    STR Name|_of_variable) ==> STR, NATIVE :
@	"    RESULT := Do_Get_environment_var(X_Name);" .
*/
*)

function Do_Get_environment_var(
	const Name:string): string;
{$IFDEF LINUX}{$ELSE}
var Buf: array[ 0..1023 ] of Char;
{$ENDIF}
begin
	{$IFDEF LINUX}
	Result := GetEnvironmentVariable(Name);
	{$ELSE}
    Buf[0] := #0;
    GetEnvironmentVariable(PChar(Name), Buf, Sizeof(Buf));
    Result := Buf;
    {$ENDIF}
end;

(*
/*

FUN Set_working_dir|ectory(STR Path|_directory),
NATIVE, DEPRECATED('Platform dependent') :
@	"    {$IFDEF KOL}"
    "    SetCurrentDirectory(PChar(X_Path));"
    "    {$ELSE}"
    "    SetCurrentDir({$IFDEF FPC} Str_X_Path {$ELSE} X_Path {$ENDIF});" 
    "    {$ENDIF}" .

FUN Get_working_dir|ectory ==> STR :
	RESULT = get_working_dir.Trailing_slash .
	
FUN Work_dir ==> STR := Get_working_dir .
	
FUN get_working_dir|ectory ==> STR, NATIVE :
    "    {$IFDEF KOL}"
    "    RESULT := GetWorkDir;"
    "    {$ELSE}"
    "        RESULT := GetCurrentDir;"
    "	     {$IFDEF LINUX}"
    "	     {$ELSE}"
    "	     if RESULT[Length(RESULT)] <> '\' then RESULT := RESULT + '\';"
    "	     {$ENDIF}"
    "    {$ENDIF}" .

FUNCTION Start_dir|ectory ==> STR, NATIVE :
   @"    Result := ExtractFilePath(ParamStr(0));" .
   
---------------------------------------- 'environment'

FUNCTION Computer_name ==> STR, NATIVE,
	DEPRECATED('Platform dependent') :
@   "var buf: array[ 0..MAX_PATH ] of Char;"
    "var Sz: DWORD;"
    "	{$IFDEF LINUX}"
    "		Result := GetEnvironmentVariable('HOSTNAME');"
    "	{$ELSE}"
    "    		Sz := MAX_PATH;"
    "    		GetComputerName(buf, Sz);"
    "    		RESULT := buf;"
    "	{$ENDIF}" .
    
FUNCTION User_name ==> STR, NATIVE,
	DEPRECATED('Platform dependent') :
@   "var buf: array[ 0..MAX_PATH ] of Char;"
    "var Sz: DWORD;"
    "	{$IFDEF LINUX}"
    "		Result := GetEnvironmentVariable('USER');"
    "	{$ELSE}"
    "    		Sz := MAX_PATH;"
    "    		GetUserName(buf, Sz);"
    "    		RESULT := buf;"
    "	{$ENDIF}" .
    

FUN Allocate_bytes(
	BYTE Buffer|_bytes[], INT Size|_allocate ), NATIVE :
	INT add_size = Size - Buffer[].Count
	CASE add_size == 0 ? ==> ;
	CASE add_size < 0 ? 
	     FOR i IN [Buffer[].Count DOWNTO Size+1] :
	         Buffer[].Delete(i-1) ;
	     ==>
	;
	NATIVE @
    "    X_Buffer.Extend(0, X_add_size);" .
    
--------------- 'sound'

FUN System_beep, NATIVE : @
"{$IFDEF LINUX}"
"	SysUtils.Beep();"
"{$ELSE}"
"	Windows.Beep(500, 500);"
"{$ENDIF}" 
.

FUN System_tone_beep(
INT Freq|uency, INT Dur|ation), NATIVE : @
"{$IFDEF LINUX}"
"	SysUtils.Beep();"
"{$ELSE}"
"	Windows.Beep(X_Freq, X_Dur);" 
"{$ENDIF}" 
.
    
    
FUNCTION Sleep|_milliseconds(INT M|illiseconds), NATIVE :
    "    Sleep(X_M);" .
    
FUN Save_strings_to_file( STR S|trings_to_save[], STR Path|_file ),
    NATIVE :
   @"var dir: String;"
    "var SL: {$IFDEF KOL}PStrList{$ELSE}TStringList{$ENDIF};"
    "var i: Integer;"
    "    dir := ExtractFilePath({$IFDEF FPC} Str_X_Path{$ELSE}X_Path{$ENDIF});"
    "    if (dir <> '') and not DirectoryExists(dir) then"
    "        CreateDir(dir);"
    "    if (dir <> '') and not DirectoryExists(dir) then exit;"
    "    SL := {$IFDEF KOL}NewStrList{$ELSE}TStringList.Create{$ENDIF};"
    "    try"
    "        for i := 0 to X_S.Count()-1 do"
    "            SL.Add(X_S.GetStrings(i));"
    "        SL.SaveToFile(X_Path);"
    "    finally SL.Free;"
    "    end;" .
    
    
FUN Total_obj_index(
	{Object} Obj|ect_of_any_class ) ==> INT,
    NATIVE :
   @"    RESULT := X_Obj.Obj.TOTAL_obj_index;" .
   
FUN Absolute_path(
	STR Rel|ative_path ) ==> STR, NATIVE : @
	"RESULT := Do_Get_absolute_path(X_Rel);" .
	
FUN Short_path(STR Path|_to_short) ==> STR, NATIVE : @
   "var len: Integer;"
   "var apath, rpath: AnsiString;"     
   "{$IFDEF LINUX}"
   "    RESULT := X_Path;"
   "{$ELSE}"     
   "    RESULT := '';"
   "		//this code works both in Delphi and Free Pascal well." 
   "		//----------------------------------------------------"     
   "		apath := X_Path;"     
   "        len := GetShortPathName(PAnsiChar(apath), nil, 0);"
   "        if len=0 then Exit;"
   "        SetLength(rpath, len-1);"     
   "        len := GetShortPathName(PAnsiChar(apath), PAnsiChar(rpath), len);"
   "		RESULT := rpath;"     
   "{$ENDIF}" .
	
	
*/
*)

type TGetLongPathName = function(
	ShortPath, LongPath: PAnsiChar; LenBuf: DWORD): DWORD; stdcall;
	
var GetLongPathName: TGetLongPathName;

function Do_Get_absolute_path(const X_Rel: String): String;
 var buf: PAnsiChar;
 var len: Integer;
 var Lib: THandle;
begin
 RESULT := ExpandFileName(X_Rel);
 {$IFDEF LINUX}
 {$ELSE}
	if not Assigned(GetLongPathName) then
	begin
		Lib := LoadLibrary('kernel32.dll');
		GetLongPathName := TGetLongPathName(
			GetProcAddress(Lib, 'GetLongPathNameA'));
		if not Assigned(GetLongPathName) then Exit;
	end;
 	len := GetLongPathName(@RESULT[1], nil, 0);
 	if len = 0 then Exit;
 	GetMem(buf, len+1);
 	GetLongPathName(@RESULT[1], buf, len+1);
 	RESULT := buf;
 	FreeMem(buf);
 {$ENDIF}
end;

{$IFDEF KOL}
function ExpandFileName(const FileName: string): string;
var
  FName: PChar;
  Buffer: array[0..MAX_PATH - 1] of Char;
begin
  SetString(Result, Buffer, GetFullPathName(PChar(FileName), 
  	SizeOf(Buffer), Buffer, FName));
end;
{$ENDIF}

(*
/*
           
FUN Trace_levels ==> INT, NATIVE :
@	"	RESULT := Get_trace_levels();" .

FUN Trace_fun|ction(
	INT Level|_of_stack_0_is_current_function_Trace_fun) ==> STR,
	NATIVE :
@	"	RESULT := Get_trace_fun(X_Level);" .

FUN Trace_counter(
	INT Level|_of_stack_0_is_current_function_Trace_fun) ==> INT,
	NATIVE :
@	"	RESULT := Get_trace_counter(X_Level);" .

FUN Trace_stack(INT Max_levels) ==> STR :
	FOR i IN [0 TO Trace_levels-1] :
	    CASE i >= Max_levels ? ==> ;
	    CASE RESULT != "" ? RESULT = _ #NL ;
	    RESULT = _ Trace_fun(i) #TAB Trace_counter(i).Str ; .
	
//FUN Byte|_from_integer(
//INT Value|_to_get_lower_byte_only) ==> BYTE,
//    NATIVE : @ "    RESULT := X_Value;" .

FUN Copy_bytes|_from_one_array_to_another(
BYTE Dest|ination_array[*],
BYTE Source|_array[*]), NATIVE : @
"	X_Dest.Copy(0, X_Source);" .
	
FUN Copy_int|egers_from_one_array_to_another(
INT Dest|ination_array[*],
INT Source|_array[*]), NATIVE : @
"	X_Dest.Copy(0, X_Source);" .
	
FUN Fill_bytes(
BYTE Dest|ination_array[*],
BYTE Value|_to_fill_with), NATIVE : @
"	X_Dest.Fill(0, X_Value, X_Dest.Count());" .

FUN Fill_int|egers(
INT Dest|ination_array[*],
INT Value|_to_fill_with), NATIVE : @
"	X_Dest.Fill(0, X_Value, X_Dest.Count());" .
        
FUN System_last_error ==> STR, NATIVE,
DEPRECATED('Platform dependent') : @
"var Len: Integer; {$IFDEF WINDOWS}Buffer: array[0..255] of Char;{$ENDIF}"
"{$IFDEF KOL}"
"	{$IFnDEF SMALLER_CODE}"
"	Len := 0; if Len=0 then;"     
"	{$ENDIF}"     
"	RESULT := SysErrorMessage(GetLastError);"
"{$ELSE}"
"	{$IFDEF WINDOWS}"
"       Len := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or"
"         FORMAT_MESSAGE_ARGUMENT_ARRAY, nil, GetLastError, 0, Buffer,"
"         SizeOf(Buffer), nil);"
"       while (Len > 0) and ((Buffer[Len - 1] <= ' ')) do Dec(Len);"
"       SetString(Result, Buffer, Len);"
"	{$ENDIF}"     
"{$ENDIF}" .

	    
FUN Real_as_array_of_bytes(
REAL R|eal_value, BYTE A|rray_bytes|_preallocated_8_items[]), NATIVE : @
"var B: PByte; i: Integer;"
"	B := PByte(@X_R);"
"	for i := 0 to 7 do"
"	begin"
"		X_A.SetBytes(i, B^);"
"		INC(B);"     
"	end;" .     

--------------------- 'debug control'
		
FUN Trace_blocks(INT Deep|_function_level), NATIVE : @
	"if X_Deep > 0 then"
    "	Level_trace_blocks := AL4.Get_SP_fun + X_Deep"
    "else Level_trace_blocks := 0;" .

		--------------------- 'play audio file'
		ENUM {play_command} :
	    'PLAY|_FROM_POSITION_PERCENTS',
	    'PAUSE|_PLAYING_AND_CHANGE_POSITION',
	    'RESUME|_PLAYING',
	    'STOP|_PLAYING',
	    'POSITION_INFO|RMATION_GET_POSITION_PLAYING',
	    'LENGTH_INFO|RMATION_MILLISECONDS',
	    'VOLUME|_GET_SET_PERCENTS' .
		

		FUN Play_audiofile(
		STR Full_path|_file,
		{play_command} Command|_to_execute,
		REAL Pos|ition_to_set
		) ==> REAL
			:
			STR path|_to_work = Full_path
			CASE ?
			["!" IN path] ?     
			     path = Short_path(path) 
			[" " IN path] ?
			     path = Short_path(path) 
			;
			CASE "!" IN path ? ==> ;
            //DEBUG: "command " Command.Name " " path ", Pos=" Pos #NL ;
			CASE Command ? 
			['PLAY']:
			    NONE = do_play_audiofile(path, 'PLAY', -1)
			    STR info|_pos_len
			    STR spl|itted[]
			    INT len|gth_file
			    BOOL then_resume = TRUE
				------------------------ 'reposition', REUSED
				CASE Pos >= 0 ?
				     info = do_play_audiofile(path, 'POSITION_INFO', -1)
				     spl[].Split(info, ";")
				     len = spl[1].Int
				     CASE len > 0 ?
                          //DEBUG: ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>"
                          //       "set position to " (Pos / 100.0 * len).Int.S
                          //       #NL ;
				          NONE = do_play_audiofile(path, 'PAUSE', 0)
				          CASE then_resume ? 
					           NONE = do_play_audiofile(
					              path, 'RESUME', (Pos / 100.0 * len).Int)
				          ;
				     ;
				;
				-------------------------
			['PAUSE']:
			    NONE = do_play_audiofile(path, 'PAUSE', -1)
			    then_resume = FALSE
			    LIKE .................... 'reposition'
			['RESUME']:
				CASE Pos > 0 ? 
				     then_resume = TRUE
				     LIKE .................... 'reposition'
				ELSE NONE = do_play_audiofile(path, 'RESUME', -1) ;
			['STOP']:
			    NONE = do_play_audiofile(path, 'STOP', -1)
			['POSITION_INFO']:
			    info = do_play_audiofile(path, 'POSITION_INFO', -1)
			    spl[].Split(info, ";")
			    len = spl[1].Int
			    RESULT = spl[0].Int * 100.0 / len
                //DEBUG: "position_info: " info " ==> " RESULT #NL ;
			['LENGTH_INFO']:
			    info = do_play_audiofile(path, 'LENGTH_INFO', -1)
			    spl[].Split(info, ";")
			    len = spl[1].Int
			    RESULT = len
			['VOLUME']:
				INT volume|_to_set = (Pos * 10).Int
				CASE volume > 1000 ? volume = 1000 ;
			    info = do_play_audiofile(path, 'VOLUME', volume)
			    RESULT = info.Int
                //DEBUG: "volume_info: " info " ==> " RESULT #NL ;
			; .

		FUN do_play_audiofile(
		STR Path|_file,
		{play_command} Command|_to_execute,
		INT Pos|ition_to_set
		) ==> STR, NATIVE : 
		NATIVE @
		"RESULT := Play_audiofile(X_Path, X_Command, X_Pos);".
		    
		*/
	*)
		
	function Play_audiofile(
		const afile: AnsiString; 
		command: Integer; position: Integer): AnsiString;
	{$IFnDEF LINUX}
	var r: Integer;
		cmd: AnsiString;
		s: array[0..100] of AnsiChar;
	{$ENDIF}
	begin
		RESULT := '';
		{$IFnDEF LINUX}
		if (afile = '') then Exit;
		s[0] := #0;
		case command of
		0:
			begin
			cmd := 'play ' + afile;
			if (position >= 0) then 
				cmd := cmd + ' from ' + i2s(position);
			//writeln('START COMMAND: ' + cmd);
			r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
			end;
		1:
			begin
			cmd := 'pause ' + afile + ' wait';
			r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
			end;
		2:
			if (position >= 0) then
			begin
				cmd := 'set ' + afile + ' time format milliseconds'; 
				r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
				cmd := 'set ' + afile + ' seek exactly on';
				r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
				cmd := 'seek ' + afile + ' to ' 
						+ i2s(position) + ' wait';  
				r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
				cmd := 'play ' + afile + ' from ' + i2s(position); 
				r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
			end
			else begin
				cmd := 'resume ' + afile;  
				r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
			end;
		3:
			begin
			cmd := 'stop ' + afile;
			r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
			cmd := 'close ' + afile;
			r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
			end;
		4, 5:
			begin
			cmd := 'set ' + afile + ' time format milliseconds';
			r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
			cmd := 'status ' + afile + ' position'; 
	    	r := mciSendString(PAnsiChar(cmd), @s[0], 100, 0);
	    	RESULT := s;
	    	cmd := 'status ' + afile + ' length';
	    	r := mciSendString(PAnsiChar(cmd), @s[0], 100, 0);
	    	RESULT := RESULT + ';' + s;
	    	Exit;
	    	end;
	    6:
	    	begin
	    		cmd := 'status ' + afile + ' volume';
		    	r := mciSendString(PAnsiChar(cmd), @s[0], 100, 0);
		    	RESULT := s;
		    	//writeln('got VOLUME: ' + RESULT);
		    	/////////////////////////////////
		    	if (position >= 0) then
		    	begin
                    //writeln('VOLUME ----------------------------------------->' +
                    //    i2s(position));//////////////////////////////////////////
					cmd := 'setaudio ' + afile + ' volume to ' + i2s(position); 
					r := mciSendString(PAnsiChar(cmd), @s[0], 0, 0);
		    	end;
	    	end;
		end; 
		{$ENDIF}
	end;

(*
/*		
		
END
*/
*)
end.

