'description: X: Include: Div. Tools
'usedby: always

'********************************************************************************************
sub delete_records(atable as string, afield as string, astring as string, along as long)

'Löscht alle Records die das übergebene Argument astring oder along in dem ebenfalls
'übergebenen Argument afield enthalten.
'atable:  Table die bearbeitet werden soll
'afield:  Feld auf das referenziert wird
'astring: Löschkriterum als string übergeben, wenn afield ein stringfeld ist
'along:   Löschkriterum als long übergeben, wenn afield ein longfeld ist

  opentable("PATH\" + atable, "dlttbl")
  if astring <> "" then 
    findfirst("dlttbl", afield, astring) 
    do while (getfield("dlttbl", afield) = astring) and (eof("dlttbl") = 0) 
      deleterecord("dlttbl")
    loop
  else
    findfirst("dlttbl", afield, along) 
    do while (getfield("dlttbl", afield) = along) and (eof("dlttbl") = 0) 
      deleterecord("dlttbl")
    loop
  end if
  closetable("dlttbl")
end sub


'*******************************************************************************************
sub copy_table(from_verz as string, from_alias as string, from_tbl as string, to_verz as string, to_alias as string, to_tbl as string)
'Kopiert die angegeben Tabellen
dim from_table as string
dim to_table as string
dim i as long

  if from_alias <> "" then
    from_table = ":" + from_alias + ":" + from_tbl
  else
    from_table = chr$(34) + from_verz + "\" + from_tbl + chr$(34)
  end if
  if to_alias <> "" then
    to_table = ":" + to_alias + ":" + to_tbl
  else
    to_table = chr$(34) + to_verz + "\" + to_tbl + chr$(34)
  end if

  openquery( "SQL")
  addsql( "SQL", "INSERT INTO " + to_table + " SELECT * FROM " + from_table + ";")
  execsql( "SQL")
  closetable("SQL") 


'  Dieses Konstrukt kopiert ganze Tabellen wie SELECT * FROM jedoch analysiert es die Zieltabelle
'  und fügt die Daten der Quelltabelle Feld für Feld in die Zieltabelle ein. Dadurch wird das
'  Kopieren einer Tabelle unempfindlich gegen vertauschte Feldreihenfolgen in den Tabellen.
'  Funktioniert sehr gut ist jedoch äußerst langsam.
'  openquery( "SQL")
'  opentable(to_tbl, "tabelle")
'  addsql( "SQL", "INSERT INTO " + to_table + " (")
'  i = 1
'  do while field( "tabelle", i) <> ""
'    addsql( "SQL", mid$( field( "tabelle", i), 1, instr( 1, field( "tabelle", i), "#") - 1))    
'    if field( "tabelle", i + 1) <> "" then
'      addsql( "SQL", ",")
'    end if
'    i = i + 1
'  loop
'  addsql( "SQL", ") SELECT ")
'  i = 1
'  do while field( "tabelle", i) <> ""
'    addsql( "SQL", mid$( field( "tabelle", i), 1, instr( 1, field( "tabelle", i), "#") - 1))    
'    if field( "tabelle", i + 1) <> "" then
'      addsql( "SQL", ",")
'    end if
'    i = i + 1
'  loop
'  closetable("tabelle")
'  addsql( "SQL", " FROM " + from_table + ";")
'  execsql( "SQL")
'  closetable("SQL") 
end sub


'*******************************************************************************************
sub copy_all_tables(from_database as string, to_database as string)
'kopiert alle Tabellen einer Datenbank in eine andere

dim i as long
dim j as long
dim tablename as string
dim abbruch as long

  j = 1
  if table("", 0) = "DUMMY" then end 
  do while table("", j) <> ""
    j = j + 1
  loop

  abbruch = 0
  i = 1
  do while table("", i) <> ""
    tablename = upper$( table("", i))
    abbruch = screeninfo( replace("Kopiere Tabelle: %1", tablename), j, i, 0)
    openquery( "SQL")
    addsql( "SQL", "INSERT INTO " + chr$(34) + to_database + tablename + chr$(34) + " SELECT * FROM " + chr$(34) + from_database + tablename + chr$(34) + ";")
    execsql( "SQL")
    closetable("SQL") 
    i = i + 1
  loop
  abbruch = screeninfo( "", 0, 0, 0)
end sub


'*******************************************************************************************
sub empty_table(tbl as string)
'Cleart die angegeben Tabelle
'tbl: Zu clearende Tabelle 

  openquery( "cltbl")
  addsql( "cltbl", "Delete from " + tbl + " WHERE MANDANT = '" + upper$( CompanyName) + "';")
  execsql( "cltbl")
  closetable("cltbl")
end sub


'*******************************************************************************************
sub empty_all_tables
'Cleart alle Tabelle einer Datenbank
dim i as long
dim j as long
dim abbruch as long

  j = 1
  if table("", 0) = "DUMMY" then end
  do while table("", j) <> ""
    j = j + 1
  loop

  abbruch = 0
  i = 1
  do while table("" ,i) <> ""
    abbruch = screeninfo( replace("Leere Tabelle: %1", upper$( table("", i))), j, i, 0)
    empty_table(upper$( table("", i)))
    i = i + 1
  loop
  abbruch = screeninfo( "", 0, 0, 0)
end sub


'*******************************************************************************************
sub empty_table_belegzeitraum(tbl as string, bz_field as string, bz_anfang as long, bz_ende as long)
'Cleart die angegeben Tabelle
'tbl: Zu clearende Tabelle 

  openquery( "SQL")
  addsql( "SQL", "DELETE FROM " + tbl + " WHERE " + bz_field + " >= " + str$(bz_anfang) + " AND " + bz_field + " <= " + str$(bz_ende) + " AND MANDANT = '" + upper$( CompanyName) + "';")
  execsql( "SQL")
  closetable("SQL") 
end sub


'*******************************************************************************************
sub delete_table(tbl as string)
'Löscht die angegeben Tabelle
'tbl: Zu löschende Tabelle 
  openquery( "SQL")
  addsql( "SQL", "DROP TABLE " + tbl + ";")
  execsql( "SQL")
  closetable("SQL")
  commit 
end sub


'*******************************************************************************************
sub delete_all_tables
'Löscht alle Tabelle einer Datenbank
dim i as long
dim j as long
dim tablename as string
dim abbruch as long

  j = 1
  if table("", 0) = "DUMMY" then end
  do while table("", j) <> ""
    j = j + 1
  loop

  abbruch = 0
  i = 1
  do while table("", i) <> ""
    tablename = upper$( table( "",i))
    abbruch = screeninfo( replace("Lösche Tabelle: %1", tablename), j, i, 0)
    delete_table(tablename)
    i = i + 1
  loop
  abbruch = screeninfo( "", 0, 0, 0)
end sub


'*****************************************************************************************
sub kopiere_mandantendaten(from_mandant as string, to_mandant as string, welche_tabelle as string)
dim i as long
dim j as long
dim anzahl as long
dim abbruch as long
dim tabelle as string
dim paradoxpfad as string
dim paradoxextention as string
dim hilf as string
dim datensaetze as long
dim k as long
dim rueckgabewert as long

  i = 0
  j = 0
  anzahl = 0
  abbruch = 0
  tabelle = ""
  paradoxpfad = ""
  paradoxextention = ""
  hilf = ""
  datensaetze = 0
  k = 0
  rueckgabewert = 0

  if fileexist(DatabaseName + "\xmandant.db") = 1 then 
    paradoxpfad = chr$(34) + DatabaseName + "\"
    paradoxextention = ".db" + chr$(34)
  end if

' Wird der Procedure keine Tabelle (Variable: welche_Tablelle) übergeben, so werden alle Tabellen kopiert
  if welche_tabelle = "" then 
    anzahl = 1
    if table("", 0) = "DUMMY" then end
    do while table("", anzahl) <> ""
      anzahl = anzahl + 1
    loop
    j = 1
    do while table("", j) <> ""
      tabelle = upper$( table( "", j))
      abbruch = screeninfo( replace("Kopiere Tabelle : %1", tabelle), anzahl, j, 0)
      if paradoxpfad = "" then
        rueckgabewert = 1
        if get_property("", "MANDANT:", tabelle) = "TRUE" then goto kopiere_tabelleninhalt
        kopiere_tabelleninhalt_1:
        commit
      end if
      if paradoxpfad <> "" then
        rueckgabewert = 1
        if get_property("", "MANDANT:", tabelle) = "TRUE" then goto k_t_paradox
        k_t_paradox_1:
      end if
      j = j + 1
    loop
    abbruch = screeninfo( "", 0, 0, 0)
    exit sub
  end if

' Wird der Procedure eine Tabelle übergeben so wird nur diese Tabelle kopiert
  tabelle = welche_tabelle
  if paradoxpfad = "" then
    if get_property("", "MANDANT:", tabelle) = "TRUE" then goto kopiere_tabelleninhalt
  end if
  if paradoxpfad <> "" then
    if get_property("", "MANDANT:", tabelle) = "TRUE" then goto k_t_paradox
  end if
  exit sub


  kopiere_tabelleninhalt:
    openquery( "SQL")
    opentable(tabelle, "tabelle")
    addsql( "SQL", "INSERT INTO " + tabelle + " (")
    i = 1
    do while field( "tabelle", i) <> ""
      addsql( "SQL", mid$( field( "tabelle", i), 1, instr( 1, field( "tabelle", i), "#") - 1))    
      if field( "tabelle", i + 1) <> "" then
        addsql( "SQL", ",")
      end if
      i = i + 1
    loop
    addsql( "SQL", ") SELECT ")
    i = 1
    do while field( "tabelle", i) <> ""
      if instr(1, field( "tabelle", i), "MANDANT") = 0 then
        addsql( "SQL", mid$( field( "tabelle", i), 1, instr( 1, field( "tabelle", i), "#") - 1))    
        if field( "tabelle", i + 1) <> "" then
          addsql( "SQL", ",")
        end if
      else
        addsql( "SQL", "'" + to_mandant + "', ")    
      end if
      i = i + 1
    loop
    closetable("tabelle")
    addsql( "SQL", " FROM " + paradoxpfad + tabelle + paradoxextention + " WHERE MANDANT = '" + from_mandant + "';")
    execsql( "SQL")
    closetable("SQL") 
    if rueckgabewert = 1 then goto kopiere_tabelleninhalt_1
  exit sub


  k_t_paradox:
    opentable(tabelle, "tabelle")
    opentable(tabelle, "TO")
    i = 1
    abbruch = 999
    do while field( "tabelle", i) <> ""
      hilf = mid$( field( "tabelle", i), 1, instr( 1, field( "tabelle", i), "#") - 1)
      if (hilf = "MANDANT") and (i < 4) then
        openquery( "cltbl")
        addsql( "cltbl", "Delete from " + tabelle + " WHERE MANDANT = '" + upper$( to_mandant) + "';")
        execsql( "cltbl")
        closetable("cltbl")

'        companyname = from_mandant            'neu

        opentable(DatabaseName + "\" + tabelle, "FROM")
        setrangestart("from", "MANDANT", from_mandant)
        setrangeend("from", "MANDANT", from_mandant)
'        companyname = to_mandant              'neu

        abbruch = 0
      end if
      i = i + 1
    loop
    if abbruch = 0 then 
      k = 1
      datensaetze = reccount("from")
      do while eof("from") = 0
        abbruch = screeninfo( replace("Kopiere Datensatz: %1 in Tabelle : %2", str$(k), tabelle), datensaetze, k, 0)
        appendblank("to")
        i = 1
        do while field( "tabelle", i) <> ""
          hilf = mid$( field( "tabelle", i), 1, instr( 1, field( "tabelle", i), "#") - 1)
          if hilf <> "MANDANT" then
            putfield("TO", hilf, getfield("FROM", hilf))
          end if
          i = i + 1
        loop
        store("to")  
        skip("from", 1)
        k = k + 1
      loop
      if welche_tabelle <> "" then
        abbruch = screeninfo( "", 0, 0, 0)
      end if
      closetable("FROM")
    end if
    closetable("tabelle")
    closetable("TO")
    if rueckgabewert = 1 then goto k_t_paradox_1
  exit sub
end sub


'*******************************************************************************************
function get_quartal_begin(quartal as long) as long
dim monat as long
dim monat_str as string

  Monat = 0
  monat_str = ""
  Monat = Quartal * 3 - 3 + val(mid$(str$(belegzeitraum_anfang), 5, 2))
  if monat > 12 then
    monat = monat - 12
    monat_str = str$(monat)
    if len(monat_str) < 2 then
      monat_str = "0" + monat_str
    end if
    get_quartal_begin = val(mid$(str$(belegzeitraum_ende), 1, 4) + monat_str + "01")
    exit function
  end if
  if monat <= 12 then
    monat_str = str$(monat)
    if len(monat_str) < 2 then
      monat_str = "0" + monat_str
    end if
    get_quartal_begin = val(mid$(str$(belegzeitraum_anfang), 1, 4) + monat_str + "01")
    exit function
  end if
end function


'*******************************************************************************************
function get_quartal_end(quartal as long) as long
dim monat as long
dim monat_str as string

  Monat = 0
  monat_str = ""
  Monat = Quartal * 3 - 1 + val(mid$(str$(belegzeitraum_anfang), 5, 2))
  if monat > 12 then
    monat = monat - 12
    monat_str = str$(monat)
    if len(monat_str) < 2 then
      monat_str = "0" + monat_str
    end if
    get_quartal_end = val(mid$(str$(belegzeitraum_ende), 1, 4) + monat_str + "31")
    exit function
  end if
  if monat <= 12 then
    monat_str = str$(monat)
    if len(monat_str) < 2 then
      monat_str = "0" + monat_str
    end if
    get_quartal_end = val(mid$(str$(belegzeitraum_anfang), 1, 4) + monat_str + "31")
    exit function
  end if
end function


'*******************************************************************************************
function get_quartal(monat as long) as long
'Achtung funktioniert nur bei geraden Wirtschftsjahren!

  get_quartal = trunc((monat /3) + 0.99)
end function


'*******************************************************************************************
function perioden_anfang_ende(monat as long, ende as long) as long
'Errechnet das Anfangsdatum bzw. Endedatum einer übergebenen Periode (Monat) auch 
'mit abweichenden Wirtschaftsjahr
dim Tag as string

  tag = ""
  if ende = 0 then
    tag = "01"
  else
    Tag = "31"
  end if
  if (mid$(str$(belegzeitraum_anfang), 5, 4) = "0101") or (val(mid$(str$(belegzeitraum_anfang), 5, 2)) <= monat) then
    if monat <= 9 then
      perioden_anfang_ende = trunc(val(mid$(str$(belegzeitraum_anfang), 1, 4) + "0" + str$(monat) + tag))
    else
      perioden_anfang_ende = trunc(val(mid$(str$(belegzeitraum_anfang), 1, 4) + str$(monat) + tag))
    end if
    exit function
  end if

  if val(mid$(str$(belegzeitraum_anfang), 5, 2)) > monat then
    if monat <= 9 then
      perioden_anfang_ende = trunc(val(mid$(str$(belegzeitraum_ende), 1, 4) + "0" + str$(monat) + tag))
    else
      perioden_anfang_ende = trunc(val(mid$(str$(belegzeitraum_ende), 1, 4) + str$(monat) + tag))
    end if
  end if
end function


'****************************************************************************
function get_mandantpath(pfad as string) as string
  if instr(1, pfad, ":\") = 0 then
    get_mandantpath = ApplicationPath + pfad
  end if
  if instr(1, pfad, ":\") > 0 then
    get_mandantpath = pfad
  end if
end function


'**********************************************************************************************
function check_table(atable as string) as long
dim vgl as string
dim i as long

  check_table = 0
  i = 1
  vgl = ""
  database("", DatabaseName, aliasname)
  if table("", 0) = "DUMMY" then exit function
  do while (table("", i) <> "") and (vgl <> upper$(atable))
    vgl = upper$( table( "", i))
    i = i + 1
  loop
  if vgl = upper$(atable) then check_table = 1
end function


'**********************************************************************************************
function check_field(atable as string, afield as string) as long
dim vgl as string
dim i as long

  check_field = 0
  i = 1
  vgl = ""
  database("", DatabaseName, aliasname)
  if table("", 0) = "DUMMY" then exit function
  do while (table("", i) <> "") and (vgl <> upper$(atable))
    vgl = upper$( table( "", i))
    i = i + 1
  loop
  if vgl = upper$(atable) then
    opentable(vgl, "feldchecktabelle", "DESIGN")
    i = 1
    do while field( "feldchecktabelle", i) <> ""
      vgl = upper$(field( "feldchecktabelle", i))
      if upper$(afield) = mid$( vgl, 1, instr( 1, vgl, "#") - 1) then check_field = 1
      i = i + 1
    loop
    closetable("feldchecktabelle")
  end if
end function


'****************************************************************************
function get_von_bis_konto(selector as string) as string
dim hilf as string

  hilf = ""
  opentable("xfkto", "selectkonten")
  setfilter("selectkonten", "bz_anfang = " + str$(Belegzeitraum_anfang))
  findfirst("selectkonten", "kto_nr", selector, "bz_anfang", Belegzeitraum_anfang)
  hilf = &selectkonten.kto_nr 
  findfirst("selectkonten", "kto_nr", selector + chr$(255), "bz_anfang", Belegzeitraum_anfang)
  if mid$(&selectkonten.kto_nr, 1, 1) <> selector then skip("selectkonten", -1)
  get_von_bis_konto = hilf + "|" + &selectkonten.kto_nr 
  closetable("selectkonten")
end function


'********************************************************************************************
sub store_user_akt_mandant(amandant as string)
dim erg as long
  erg = rts( "READUSER", 1)
  opentable( "\rts\tbl\user", "USER", "TEMPORARY")
  if findkey( "USER", "USER", userid, "NAME", "MANDANT") = 0 then
    appendblank( "USER")
  end if
  &USER.USER = userid
  &USER.NAME = "MANDANT"
  &USER.RECORD = amandant 
  store( "USER")
  closetable( "USER")
  erg = rts( "READUSER", 0)
end sub


'********************************************************************************************
sub set_caption
  if ApplicationName = "FLIG" then
    ApplicationCaption = "GPE AS/1 " + "Erfassung Buchhaltung" + " - " + mid$(str$(belegzeitraum_ende), 1, 4)
  end if
  if ApplicationName = "WAWI" then
    ApplicationCaption = "GPE AS/1 " + "Warenwirtschaft" + " - " + CompanyName + "/" + mid$(str$(belegzeitraum_ende), 1, 4) + " - " + userid
  end if
  if ApplicationName = "FIBU" then
    ApplicationCaption = "GPE AS/1 " + "Finanzbuchhaltung" + " - " + CompanyName + "/" + mid$(str$(belegzeitraum_ende), 1, 4) + " - " + userid
  end if
  if ApplicationName = "ANBU" then
    ApplicationCaption = "GPE AS/1 " + "Anlagenbuchhaltung" + " - " + CompanyName + "/" + mid$(str$(belegzeitraum_ende), 1, 4) + " - " + userid
  end if
  if ApplicationName = "KORE" then
    ApplicationCaption = "GPE AS/1 " + "Kostenrechnung" + " - " + CompanyName + "/" + mid$(str$(belegzeitraum_ende), 1, 4) + " - " + userid
  end if
  if ApplicationName = "BEMA" then
    ApplicationCaption = "GPE AS/1 " + "Beziehungsmanagement" + " - " + CompanyName + "/" + mid$(str$(belegzeitraum_ende), 1, 4) + " - " + userid
  end if
  if ApplicationName = "START" then
    ApplicationCaption = "GPE AS/1 " + "ERP" + " - " + CompanyName + "/" + mid$(str$(belegzeitraum_ende), 1, 4) + " - " + userid
  end if
  if ApplicationName = "SYVE" then
    ApplicationCaption = "GPE AS/1 " + "Systemverwaltung" + " - " + CompanyName + "/" + mid$(str$(belegzeitraum_ende), 1, 4) + " - " + userid
  end if
end sub


'******************************************************************************************
sub set_linktable(tabelle as string, feld as string, wert_original as string, wert_neu as string, autofield as string)
dim erg as long
  erg = 0
  opentable(tabelle, "ORGIGINAL")
  opentable(tabelle, "NEU")
  if autofield <> "" then SETAUTOFIELD( "NEU", autofield, 0)
  setfilter("ORGIGINAL", feld + " = '" + wert_original + "'")
  do while eof("ORGIGINAL") = 0
    appendblank("NEU")
    erg = rts("ASSIGNRECORD", "ORGIGINAL", "NEU")
    putfield("NEU", feld, wert_neu)
    store("NEU")
    skip("ORGIGINAL", 1)
  loop
  closetable("ORGIGINAL")
  closetable("NEU")
  erg = rts("REFRESH")
end sub


'******************************************************************************************
sub delete_linktable(tabelle as string, feld as string, wert as string)
dim erg as long
  erg = 0
  openquery( "cltbl")
  addsql( "cltbl", "Delete from " + tabelle + " WHERE " + feld + " = '" + wert + "' AND MANDANT = '" + upper$( CompanyName) + "';")
  execsql( "cltbl")
  closetable("cltbl")
  erg = rts("REFRESH")
end sub


'******************************************************************************************
function zusatzwert(Tabelle as string, art as string, datensatz as string) as string
  zusatzwert = ""
  openquery( "cltbl")
  addsql( "cltbl", "select wert from xzuswert where tabelle = '" + tabelle + "' AND datensatz = '" + datensatz + "' and art = '" + art + "' AND MANDANT = '" + upper$( CompanyName) + "';")
  opensql( "cltbl")
  zusatzwert = &cltbl.WERT
  closetable("cltbl")
end function


'******************************************************************************************
function text_to_field(textvorgabe as string) as string
dim s, tabelle, feld as string
dim klammer1, klammer2, punkt as long
  s = textvorgabe
  klammer1 = 0
  klammer2 = 0
  punkt = 0
  do while instr(1, s, "[") > 0
    klammer1 = instr(1, s, "[")
    punkt = instr(klammer1, s, ".")
    klammer2 = instr(klammer1, s, "]")
    Tabelle = mid$(s, klammer1 + 1, punkt - klammer1 - 1)
    Feld = mid$(s, punkt + 1, klammer2 - punkt - 1)
    findreplace(s, "[" + Tabelle + "." + Feld + "]", "%1", 0, 1)
    s = replace(s, getfield(tabelle, feld))
  loop
  text_to_field = s
end function

'$include \rts\bas\tblinc