//*********************************************************************
//*                  Dialog_Functions 2021-10-24                      *
//*                    >> OBSaveM & OBSendM <<                        *
//*                                                                   *
//*     DIESES SCRIPT ENTHAELT ERWEITERTE FUNKTIONEN FUER DIALOG      *
//*                                                                   *
//* Funktionalitaet: [x] neutral                                      *
//*                  [ ] nur Basis_Modul                              *
//*                  [ ] nur Pathfinder                               *
//*                                                                   *
//* Datum     : ueberarbeitet am: 24.10.2021                          *
//* Autor     : Thomas Barghahn                                       *
//*                                                                   *
//*********************************************************************

type
  // this holds the date and time for a file
  tFileTime = record
    dwLowDateTime: integer;
    dwHighDateTime: integer;
  end;

  // and this holds the actual, readable stuff
  tSystemTime = record
    wYear: Word;
    wMonth: Word;
    wDayOfWeek: Word;
    wDay: Word;
    wHour: Word;
    wMinute: Word;
    wSecond: Word;
    wMilliseconds: Word;
  end;

const

  // createFile() constants
  GENERIC_READ = $80000000;
  FILE_SHARE_READ = $00000001;
  FILE_ATTRIBUTE_NORMAL = $00000080;
  OPEN_EXISTING = 3;

   //
   // Flags to indicate the buttons contained in the message box:
   //

   MB_OK = 0;                  // 1 button:  OK.
   MB_OKCancel = 1;            // 2 buttons: OK and Cancel.
   MB_AbortRetryIgnore = 2;    // 3 buttons: Abort, Retry, and Ignore.
   MB_VbYesNoCancel = 3;       // 3 buttons: Yes, No, and Cancel.
   MB_YesNo = 4;               // 2 buttons: Yes and No.
   MB_RetryCancel = 5;         // 2 buttons: Retry and Cancel.
   IDYES = 6;
   IDNO = 7;

   //
   // Flags to display an icon in the message box:
   //

   MB_IconCritical = 16;       // stop sign
   MB_IconQuestion = 32;       // question mark
   MB_IconExclamation = 48;    // exclamation point 
   MB_IconInformation = 64;    // lowercase i in a circle
   
function CreateFile(lpFileName: PChar; dwDesiredAccess, dwShareMode: integer;
   lpSecurityAttributes: pchar; dwCreationDisposition, dwFlagsAndAttributes: integer;
   hTemplateFile: THandle): THandle; 
   external 'CreateFileA@kernel32.dll stdcall';

function CloseHandle(hObject: THandle): boolean; 
   external 'CloseHandle@kernel32.dll stdcall';

function GetFileTime(hFile: integer;
   var lpCreationTime, lpLastAccessTime, lpLastWriteTime: tFileTime): boolean; 
   external 'GetFileTime@kernel32.dll stdcall';

function FileTimeToSystemTime(lpFileTime: TFileTime; 
   var lpSystemTime: TSystemTime): boolean;
   external 'FileTimeToSystemTime@kernel32.dll stdcall';

function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation: pchar;
   var lpUniversalTime, lpLocalTime: TSystemTime): boolean;
   external 'SystemTimeToTzSpecificLocalTime@kernel32.dll stdcall';

function MsgBox( hWnd : Cardinal; lpText, lpCaption : PChar; uType : longword ) : Integer;
   external 'MessageBoxA@user32.dll stdcall';

Function PlaySound( Filename: PChar; Options: LongWord ): Boolean;
   external 'sndPlaySoundA@winmm.dll stdcall'; 
   
//--[ Function GetHeaderLine ]-----------------------------------------------
// Gibt die Zeile eines bestimmten Headers zurück

Function GetHeaderLine(H : String; M : TStringList) : Integer;

// H: [Header]  Name des gesuchten Headers
// M: [Message] Die komplette Nachricht

Var
   i : Integer;
Begin
   Result := -1;
   For i := 0 To M.IndexOf('') Do
   Begin
      If AnsiPos(LowerCase(H), LowerCase(M[i])) = 1 Then
      Begin
         Result := i;
         Exit;
      End;
   End;
End;

//--[ Function RemoveHeader ]------------------------------------------------
// Entfernt einen bestimmten Header

Function RemoveHeader(H : String; M : TStringList) : TStringList;

// M: [Message] Die komplette Nachricht
// H: [Header]  Name des zu entfenenden Headers

Var
   i : Integer;
Begin
   i := GetHeaderLine(H, M);
   If i > -1 Then Repeat M.Delete(i);
   Until (Trim(Copy(M[i], 1, 1)) <> '') Or (i = M.IndexOf(''));
   Result := M;
End;

//--[ Function GetHeader ]---------------------------------------------------
// Gibt den Wert eines bestimmten Headers zurück

Function GetHeader(H : String; M : TStringList) : String;

// H: [Header]  Name des gesuchten Headers
// M: [Message] Die komplette Nachricht

Var
   i : Integer;
Begin
   i := GetHeaderLine(H, M);
   If i > -1 Then
   Begin
      Result := Trim(Copy(M[i], AnsiPos(' ', M[i]) + 1, Length(M[i])));
      i := i + 1;
      While Trim(Copy(M[i], 1, 1)) = '' Do
      Begin
         If i = M.IndexOf('') Then Exit;
         Result := Result + ' ' + Trim(M[i]);
         i := i + 1;
      End;
   End
   Else Result := '';
End;

//--------------------------------------------------------------------

Function IsInDirekt(REF, tmp : String; DepthforInDirektAnswers : Byte):Boolean;
Var
   i,
   Counter : Integer;
   RefList : TStringList;
   Dummy   : String; 
Begin                     
   Result  := False;
   RefList := TStringList.Create;
   Repeat                   
      If Pos('<',REF) > 0 Then Begin
         Dummy := Copy(REF, Pos('<',REF),Pos('>',REF));
         REF   := Copy(REF, Pos('>',REF)+1,Length(REF));
         RefList.Add(Dummy);   
      End Else Dummy:='';
   Until  Dummy = '';
   If DepthforInDirektAnswers > RefList.Count then
      Counter := RefList.Count
   else 
      Counter := DepthforInDirektAnswers;
   For I :=  1 to Counter do
   Begin
      If  Pos(tmp,RefList.Strings[RefList.Count-i]) > 0 Then Begin 
         Result := True;
         break;
      End; // If
   End;   
   RefList.Free;                                                                         
End; // Function

//-------------------------------------------------------------------------------------------- 

Function Write_Ini(IniFileName,IniTitel,IniName,IniValue:String):Boolean;
Var I              : Integer;  
    IniFileContent : TStringList;
    Pair           : String;
Begin             
    Result         := False;              // Hört sich schlimm an,es wurde aber ja noch nichts gemacht.
    IniFileContent := TStringList.Create; // Wir brauchen erst mal Platz für die Daten der Datei
    If Pos(' ',IniValue) > 0 Then         // Leerzeichen im Eintrag?
    IniValue := '"' + IniValue + '"';     // dann packen wir den mal in '"'
    IniTitel := '[' + IniTitel + ']';     // Den Titel passen wir dem Standard an [Rubrik]
    Pair     := IniName + '=' + IniValue; // Hier wächst zusammen, was zusammen gehört :)
    With IniFileContent Do
    Begin
      Try
       LoadFromFile  (IniFileName);     // Dann holen wir uns erst mal die gewünschte Datei..
       If IndexOfName(IniName) > -1     // Namen gefunden? 
       Then Values[IniName]:= IniValue  // Dann nur Eintrag bearbeiten  
       Else If   Pos(IniTitel,Text) = 0 // Name nicht gefunden und die Rubrik auch nicht :(
            Then Insert(0,IniTitel + #13#10 + Pair) // Dann legen wir besser beides neu an
                                                    // und schreiben den Eintrag gleich dazu.:)
            Else Begin                        // Rubrik doch vorhanden? 
                     For I := 0 To Count-1 Do // Dann schauen wir mal wo sie genau ist...  
                     Begin
                        If Strings[i] = IniTitel Then // und schreiben den neuen Eintrag 
                        Insert(i + 1, Pair);          // unter die Rubrik.
                        Break;                        // schnell wieder raus hier
                                                      // der Rest interessiert uns nicht :)
                     End;               
                 End; 
       SaveToFile(IniFileName);  // speichern nicht vergessen, 
                                 // sonst wär ja alles für die Katz gewesen :)
       Result := True; // Tja, das haben wir fein gemacht :)
      Finally
       Free; // Eine nette Funktion räumt natürlich den Speicher wieder auf
      End;
    End;
End; // Was? Das war's schon? :( Na ja, bis zum nächsten Mal.   

// FileName: IniRead_Include - Stand 13.01.2009 
//---------------------------------------------------------------------
// IniFileName = Name der Datei z.B. settings.ini 
// IniTitel    = Überschrift der Rubrik in der IniDatei  
// IniName     = Name des Eintrags in der Ini
//                                    
// Wird IniName gefunden wird der Inhalt zürückgegeben ansonsten ''.                                   
//----------------------------------------------------------------------

Function Read_Ini(IniFileName,IniTitel,IniName:String):String;
Var
   IniFile : TextFile;
   Search  : String;           
   FoundRubrik ,FoundName: Boolean;
Begin
    Result := '';      
    FoundName  := False;
    FoundRubrik:= False; 
    IniTitel   := '[' + IniTitel + ']'  // IniTitel auf Standard Rubrik Format trimmen
    AssignFile(IniFile,IniFileName); Reset(IniFile);  // Gewünschte Datei öffnen
    // Suche Rubrik
    Repeat
         TextReadLn(IniFile,Search);
         If IniTitel = Trim(Search) Then FoundRubrik := True; // Rubrik gefunden, dann weiter bei
                                                              // Namen suchen....
    Until Eof(IniFile) or FoundRubrik;                  
    If FoundRubrik Then    // Wenn Rubrik gefunden, dann...
    Begin                  
       Repeat
          TextReadLn(IniFile,Search);    // suchen wir innerhalb der Rubrik nach dem 
                                         // nach dem gewünschten Namen.
          If Pos(IniName,Search) = 1 Then FoundName := True;  // gefunden, dann weiter zur
                                                              // Ergebnisaufbereitung
       Until Eof(IniFile) or  // Stop wenn Ende der Datei erreicht ist oder
       FoundName          or  // das Gewünschte gefunden wurde oder
       (Pos('[',Search) > 0); // eine neue Rubrik beginnt
        
       If FoundName Then      // Name wurde gefunden - ResultString mit dem Ergebnis
       Begin                  // wird aufbereitet...
          Search := Trim( Copy( Search, Pos('=',Search) + 1, Length(Search) ));
          If Pos('"',Search) > 0 Then Search := StringReplace(Search,'"','',[rfReplaceAll]);
          Result := Search;   // fertiges Ergebnis im Rückgabestring
       End;
    End;
     CloseFile(IniFile);  // Datei wieder schliessen und fertig.
End;                

//--[ Function CAL_ReverseStr ]----------------------------------------

Function CAL_ReverseStr(S : String) : String;
Var
   i : Integer;
Begin
   Result := '';
   For i := Length(S) DownTo 1 Do Result := Result + Copy(S, i, 1);
End;

//--[ Function CAL_CountChar ]-----------------------------------------

Function CAL_CountChar(S : String; C : Char) : Integer;
Var
   i : Integer;
Begin
   Result := 0;
   For i := 1 To Length(S) Do If S[i] = C Then Result := Result + 1;
End;