Go to English page

Neuigkeiten

Downloadbeschreibung:

This is the latest version of OIDplus 2.0!

Source code: https://github.com/danielmarschall/oidplus
Daniel Marschall
ViaThinkSoft Mitbegründer
unit Deutschland_Feiertage;

// Basierend auf:
// https://www.swissdelphicenter.ch/de/showcode.php?id=1278

// Angepasst durch Daniel Marschall, ViaThinkSoft,
// um alle Bundesländer korrekt zu behandeln
// Aktuelle Version unter https://www.viathinksoft.de/codelib/207

// Diese Unit arbeitet mit Jahreszahlen nach 1584

interface

uses
  Windows, SysUtils;

type
  TFeiertag = record
    Date: TDateTime;
    Name: string;
  end;
  TFeiertagTable = array of TFeiertag;

function IstDeutscherFeiertag(tag: TDateTime; plz: integer): boolean;
function DeutschlandFeiertage(Jahr: Word; plz: integer): TFeiertagTable;

implementation

uses
  DateUtils;

{$REGION 'Bundesländer'}

// Wie wurden die Bundesländer extrahiert?
// 1. Spalten von https://cebus.net/de/plz-bundesland.htm in Plaintext-Datei kopiert
// 2. Whitespace mit Tab ersetzen, mit TextPad RegEx:
//    Suche:   " "
//    Ersetze: "\t"
// 3. In Excel einfügen
// 4. In Excel sortieren nach Name (Spalte 2), Markierung erweitern
// 5. PLZ-Range (erste Spalte) aus Excel in TextPad kopieren
// 6. Delphi Code mit folgendem TextPad RegEx erzeugen:
//    Suche:   "(.+)\-(.+)"
//    Ersetze: "    \(\(plz >= \1\) and \(plz <= \2\)\) or // \1-\2"

function IstBadenWuerttemberg(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 63928) and (plz <= 63928)) or // 63928-63928
    ((plz >= 64754) and (plz <= 64754)) or // 64754-64754
    ((plz >= 68001) and (plz <= 68312)) or // 68001-68312
    ((plz >= 68520) and (plz <= 68549)) or // 68520-68549
    ((plz >= 68701) and (plz <= 69234)) or // 68701-69234
    ((plz >= 69240) and (plz <= 69429)) or // 69240-69429
    ((plz >= 69434) and (plz <= 69434)) or // 69434-69434
    ((plz >= 69435) and (plz <= 69469)) or // 69435-69469
    ((plz >= 69489) and (plz <= 69502)) or // 69489-69502
    ((plz >= 69510) and (plz <= 69514)) or // 69510-69514
    ((plz >= 70001) and (plz <= 74592)) or // 70001-74592
    ((plz >= 74594) and (plz <= 76709)) or // 74594-76709
    ((plz >= 77601) and (plz <= 79879)) or // 77601-79879
    ((plz >= 88001) and (plz <= 88099)) or // 88001-88099
    ((plz >= 88147) and (plz <= 88147)) or // 88147-88147
    ((plz >= 88181) and (plz <= 89079)) or // 88181-89079
    ((plz >= 89081) and (plz <= 89085)) or // 89081-89085
    ((plz >= 89090) and (plz <= 89198)) or // 89090-89198
    ((plz >= 89501) and (plz <= 89619)) or // 89501-89619
    ((plz >= 97861) and (plz <= 97877)) or // 97861-97877
    ((plz >= 97893) and (plz <= 97896)) or // 97893-97896
    ((plz >= 97897) and (plz <= 97900)) or // 97897-97900
    ((plz >= 97911) and (plz <= 97999));   // 97911-97999
end;

function IstBayern(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 63701) and (plz <= 63774)) or // 63701-63774
    ((plz >= 63776) and (plz <= 63928)) or // 63776-63928
    ((plz >= 63930) and (plz <= 63939)) or // 63930-63939
    ((plz >= 74594) and (plz <= 74594)) or // 74594-74594
    ((plz >= 80001) and (plz <= 87490)) or // 80001-87490
    ((plz >= 87493) and (plz <= 87561)) or // 87493-87561
    ((plz >= 87571) and (plz <= 87789)) or // 87571-87789
    ((plz >= 88101) and (plz <= 88146)) or // 88101-88146
    ((plz >= 88147) and (plz <= 88179)) or // 88147-88179
    ((plz >= 89081) and (plz <= 89081)) or // 89081-89081
    ((plz >= 89087) and (plz <= 89087)) or // 89087-89087
    ((plz >= 89201) and (plz <= 89449)) or // 89201-89449
    ((plz >= 90001) and (plz <= 96489)) or // 90001-96489
    ((plz >= 97001) and (plz <= 97859)) or // 97001-97859
    ((plz >= 97888) and (plz <= 97892)) or // 97888-97892
    ((plz >= 97896) and (plz <= 97896)) or // 97896-97896
    ((plz >= 97901) and (plz <= 97909));   // 97901-97909
end;

function IstBerlin(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 10001) and (plz <= 14330)); // 10001-14330
end;

function IstBrandenburg(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 01941) and (plz <= 01998)) or // 01941-01998
    ((plz >= 03001) and (plz <= 03253)) or // 03001-03253
    ((plz >= 04891) and (plz <= 04938)) or // 04891-04938
    ((plz >= 14401) and (plz <= 14715)) or // 14401-14715
    ((plz >= 14723) and (plz <= 16949)) or // 14723-16949
    ((plz >= 17258) and (plz <= 17258)) or // 17258-17258
    ((plz >= 17261) and (plz <= 17291)) or // 17261-17291
    ((plz >= 17309) and (plz <= 17309)) or // 17309-17309
    ((plz >= 17321) and (plz <= 17321)) or // 17321-17321
    ((plz >= 17326) and (plz <= 17326)) or // 17326-17326
    ((plz >= 17335) and (plz <= 17335)) or // 17335-17335
    ((plz >= 17337) and (plz <= 17337)) or // 17337-17337
    ((plz >= 19307) and (plz <= 19357));   // 19307-19357
end;

function IstBremen(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 27501) and (plz <= 27580)) or // 27501-27580
    ((plz >= 28001) and (plz <= 28779));   // 28001-28779
end;

function IstHamburg(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 20001) and (plz <= 21037)) or // 20001-21037
    ((plz >= 21039) and (plz <= 21170)) or // 21039-21170
    ((plz >= 22001) and (plz <= 22113)) or // 22001-22113
    ((plz >= 22115) and (plz <= 22143)) or // 22115-22143
    ((plz >= 22145) and (plz <= 22145)) or // 22145-22145
    ((plz >= 22147) and (plz <= 22786)) or // 22147-22786
    ((plz >= 27499) and (plz <= 27499));   // 27499-27499
end;

function IstHessen(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 34001) and (plz <= 34329)) or // 34001-34329
    ((plz >= 34355) and (plz <= 34355)) or // 34355-34355
    ((plz >= 34356) and (plz <= 34399)) or // 34356-34399
    ((plz >= 34441) and (plz <= 36399)) or // 34441-36399
    ((plz >= 37194) and (plz <= 37195)) or // 37194-37195
    ((plz >= 37201) and (plz <= 37299)) or // 37201-37299
    ((plz >= 55240) and (plz <= 55252)) or // 55240-55252
    ((plz >= 59969) and (plz <= 59969)) or // 59969-59969
    ((plz >= 60001) and (plz <= 63699)) or // 60001-63699
    ((plz >= 63776) and (plz <= 63776)) or // 63776-63776
    ((plz >= 64201) and (plz <= 64753)) or // 64201-64753
    ((plz >= 64754) and (plz <= 65326)) or // 64754-65326
    ((plz >= 65327) and (plz <= 65391)) or // 65327-65391
    ((plz >= 65392) and (plz <= 65556)) or // 65392-65556
    ((plz >= 65583) and (plz <= 65620)) or // 65583-65620
    ((plz >= 65627) and (plz <= 65627)) or // 65627-65627
    ((plz >= 65701) and (plz <= 65936)) or // 65701-65936
    ((plz >= 68501) and (plz <= 68519)) or // 68501-68519
    ((plz >= 68601) and (plz <= 68649)) or // 68601-68649
    ((plz >= 69235) and (plz <= 69239)) or // 69235-69239
    ((plz >= 69430) and (plz <= 69431)) or // 69430-69431
    ((plz >= 69434) and (plz <= 69434)) or // 69434-69434
    ((plz >= 69479) and (plz <= 69488)) or // 69479-69488
    ((plz >= 69503) and (plz <= 69509)) or // 69503-69509
    ((plz >= 69515) and (plz <= 69518));   // 69515-69518
end;

function IstMecklenburgVorpommern(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 17001) and (plz <= 17256)) or // 17001-17256
    ((plz >= 17258) and (plz <= 17259)) or // 17258-17259
    ((plz >= 17301) and (plz <= 17309)) or // 17301-17309
    ((plz >= 17309) and (plz <= 17321)) or // 17309-17321
    ((plz >= 17321) and (plz <= 17322)) or // 17321-17322
    ((plz >= 17328) and (plz <= 17331)) or // 17328-17331
    ((plz >= 17335) and (plz <= 17335)) or // 17335-17335
    ((plz >= 17337) and (plz <= 19260)) or // 17337-19260
    ((plz >= 19273) and (plz <= 19273)) or // 19273-19273
    ((plz >= 19273) and (plz <= 19306)) or // 19273-19306
    ((plz >= 19357) and (plz <= 19417)) or // 19357-19417
    ((plz >= 23921) and (plz <= 23999)); // 23921-23999
end;

function IstNiedersachsen(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 19271) and (plz <= 19273)) or // 19271-19273
    ((plz >= 21202) and (plz <= 21449)) or // 21202-21449
    ((plz >= 21522) and (plz <= 21522)) or // 21522-21522
    ((plz >= 21601) and (plz <= 21789)) or // 21601-21789
    ((plz >= 26001) and (plz <= 27478)) or // 26001-27478
    ((plz >= 27607) and (plz <= 27809)) or // 27607-27809
    ((plz >= 28784) and (plz <= 29399)) or // 28784-29399
    ((plz >= 29431) and (plz <= 31868)) or // 29431-31868
    ((plz >= 34331) and (plz <= 34353)) or // 34331-34353
    ((plz >= 34355) and (plz <= 34355)) or // 34355-34355
    ((plz >= 37001) and (plz <= 37194)) or // 37001-37194
    ((plz >= 37197) and (plz <= 37199)) or // 37197-37199
    ((plz >= 37401) and (plz <= 37649)) or // 37401-37649
    ((plz >= 37689) and (plz <= 37691)) or // 37689-37691
    ((plz >= 37697) and (plz <= 38479)) or // 37697-38479
    ((plz >= 38501) and (plz <= 38729)) or // 38501-38729
    ((plz >= 48442) and (plz <= 48465)) or // 48442-48465
    ((plz >= 48478) and (plz <= 48480)) or // 48478-48480
    ((plz >= 48486) and (plz <= 48488)) or // 48486-48488
    ((plz >= 48497) and (plz <= 48531)) or // 48497-48531
    ((plz >= 49001) and (plz <= 49459)) or // 49001-49459
    ((plz >= 49551) and (plz <= 49849));   // 49551-49849
end;

function IstNordrheinWestfalen(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 32001) and (plz <= 33829)) or // 32001-33829
    ((plz >= 34401) and (plz <= 34439)) or // 34401-34439
    ((plz >= 37651) and (plz <= 37688)) or // 37651-37688
    ((plz >= 37692) and (plz <= 37696)) or // 37692-37696
    ((plz >= 40001) and (plz <= 48432)) or // 40001-48432
    ((plz >= 48466) and (plz <= 48477)) or // 48466-48477
    ((plz >= 48481) and (plz <= 48485)) or // 48481-48485
    ((plz >= 48489) and (plz <= 48496)) or // 48489-48496
    ((plz >= 48541) and (plz <= 48739)) or // 48541-48739
    ((plz >= 49461) and (plz <= 49549)) or // 49461-49549
    ((plz >= 50101) and (plz <= 51597)) or // 50101-51597
    ((plz >= 51601) and (plz <= 53359)) or // 51601-53359
    ((plz >= 53581) and (plz <= 53604)) or // 53581-53604
    ((plz >= 53621) and (plz <= 53949)) or // 53621-53949
    ((plz >= 57001) and (plz <= 57489)) or // 57001-57489
    ((plz >= 58001) and (plz <= 59966)) or // 58001-59966
    ((plz >= 59969) and (plz <= 59969));   // 59969-59969
end;

function IstRheinlandPfalz(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 51598) and (plz <= 51598)) or // 51598-51598
    ((plz >= 53401) and (plz <= 53579)) or // 53401-53579
    ((plz >= 53614) and (plz <= 53619)) or // 53614-53619
    ((plz >= 54181) and (plz <= 55239)) or // 54181-55239
    ((plz >= 55253) and (plz <= 56869)) or // 55253-56869
    ((plz >= 57501) and (plz <= 57648)) or // 57501-57648
    ((plz >= 65326) and (plz <= 65326)) or // 65326-65326
    ((plz >= 65391) and (plz <= 65391)) or // 65391-65391
    ((plz >= 65558) and (plz <= 65582)) or // 65558-65582
    ((plz >= 65621) and (plz <= 65626)) or // 65621-65626
    ((plz >= 65629) and (plz <= 65629)) or // 65629-65629
    ((plz >= 66461) and (plz <= 66509)) or // 66461-66509
    ((plz >= 66841) and (plz <= 67829)) or // 66841-67829
    ((plz >= 76711) and (plz <= 76891));   // 76711-76891
end;

function IstSaarland(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 66001) and (plz <= 66459)) or // 66001-66459
    ((plz >= 66511) and (plz <= 66839));   // 66511-66839
end;

function IstSachsen(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 01001) and (plz <= 01936)) or // 01001-01936
    ((plz >= 02601) and (plz <= 02999)) or // 02601-02999
    ((plz >= 04001) and (plz <= 04579)) or // 04001-04579
    ((plz >= 04641) and (plz <= 04889)) or // 04641-04889
    ((plz >= 07919) and (plz <= 07919)) or // 07919-07919
    ((plz >= 07919) and (plz <= 07919)) or // 07919-07919
    ((plz >= 07951) and (plz <= 07951)) or // 07951-07951
    ((plz >= 07952) and (plz <= 07952)) or // 07952-07952
    ((plz >= 07982) and (plz <= 07982)) or // 07982-07982
    ((plz >= 07985) and (plz <= 07985)) or // 07985-07985
    ((plz >= 08001) and (plz <= 09669));   // 08001-09669
end;

function IstSachsenAnhalt(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 06001) and (plz <= 06548)) or // 06001-06548
    ((plz >= 06601) and (plz <= 06928)) or // 06601-06928
    ((plz >= 14715) and (plz <= 14715)) or // 14715-14715
    ((plz >= 29401) and (plz <= 29416)) or // 29401-29416
    ((plz >= 38481) and (plz <= 38489)) or // 38481-38489
    ((plz >= 38801) and (plz <= 39649));   // 38801-39649
end;

function IstSchleswigHolstein(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 21039) and (plz <= 21039)) or // 21039-21039
    ((plz >= 21451) and (plz <= 21521)) or // 21451-21521
    ((plz >= 21524) and (plz <= 21529)) or // 21524-21529
    ((plz >= 22113) and (plz <= 22113)) or // 22113-22113
    ((plz >= 22145) and (plz <= 22145)) or // 22145-22145
    ((plz >= 22145) and (plz <= 22145)) or // 22145-22145
    ((plz >= 22801) and (plz <= 23919)) or // 22801-23919
    ((plz >= 24001) and (plz <= 25999)) or // 24001-25999
    ((plz >= 27483) and (plz <= 27498));   // 27483-27498
end;

function IstThueringen(plz: integer): boolean;
begin
  // Extrahiert von https://cebus.net/de/plz-bundesland.htm
  result :=
    ((plz >= 04581) and (plz <= 04639)) or // 04581-04639
    ((plz >= 06551) and (plz <= 06578)) or // 06551-06578
    ((plz >= 07301) and (plz <= 07919)) or // 07301-07919
    ((plz >= 07919) and (plz <= 07919)) or // 07919-07919
    ((plz >= 07920) and (plz <= 07950)) or // 07920-07950
    ((plz >= 07952) and (plz <= 07952)) or // 07952-07952
    ((plz >= 07953) and (plz <= 07980)) or // 07953-07980
    ((plz >= 07985) and (plz <= 07985)) or // 07985-07985
    ((plz >= 07985) and (plz <= 07989)) or // 07985-07989
    ((plz >= 36401) and (plz <= 36469)) or // 36401-36469
    ((plz >= 37301) and (plz <= 37359)) or // 37301-37359
    ((plz >= 96501) and (plz <= 96529)) or // 96501-96529
    ((plz >= 98501) and (plz <= 99998));   // 98501-99998
end;

{$ENDREGION}

{$REGION 'Feiertage in Bundesländern in vereinzelten Teilen'}

function BayernHatMariaeHimmelfahrt(plz: integer): boolean;
begin
  (*
  TODO, laut https://www.dgb.de/gesetzliche-feiertage-deutschland:
  - In Bayern nur in den derzeit ca. 1700 Gemeinden mit überwiegend katholischer Bevölkerung,
    in den restlichen ca. 350 bayerischen Gemeinden kein gesetzlicher Feiertag.
  *)
  result := true; // da 81% von Bayern den Feiertag hat, machen wir true
end;

function ThueringenHatFronleichnam(plz: integer): boolean;
begin
  (*
  Laut https://www.dgb.de/gesetzliche-feiertage-deutschland :
  In Thüringen nur im im Landkreis Eichsfeld
  sowie in folgenden Gemeinden des Unstrut-Hainich-Kreises und des Wartburgkreises:
  Anrode (nur in den Ortsteilen Bickenriede und Zella),
  Brunnhartshausen (nur in den Ortsteilen Föhlritz und Steinberg),
  Buttlar,
  Dünwald (nur in den Ortsteilen Beberstedt und Hüpstedt),
  Geisa,
  Rodeberg (nur im Ortsteil Struth),
  Schleid,
  Südeichsfeld und
  Zella/Rhön.
  *)

  result :=

    // Landkreis Eichsfeld
    // https://home.meinestadt.de/kreis-eichsfeld/postleitzahlen
    (plz = 37318) or // Wüstheuterode, Kreis Eichsfeld, Thüringen
    (plz = 37308) or // Volkerode, Kreis Eichsfeld, Thüringen
    (plz = 37339) or // Ferna, Kreis Eichsfeld, Thüringen
    (plz = 37339) or // Leinefelde-Worbis, Kreis Eichsfeld, Thüringen
    (plz = 37327) or // (ebenso)
    (plz = 37339) or // Breitenworbis, Kreis Eichsfeld, Thüringen
    (plz = 37355) or // (ebenso)
    (plz = 37359) or // Küllstedt, Kreis Eichsfeld, Thüringen
    (plz = 37327) or // Wingerode, Kreis Eichsfeld, Thüringen
    (plz = 37327) or // Niederorschel, Kreis Eichsfeld, Thüringen
    (plz = 37355) or // (ebenso)
    (plz = 37351) or // Silberhausen, Kreis Eichsfeld, Thüringen
    (plz = 37355) or // Kleinbartloff, Kreis Eichsfeld, Thüringen
    (plz = 37345) or // Am Ohmberg, Kreis Eichsfeld, Thüringen

    // Gemeinden des Unstrut-Hainich-Kreises und des Wartburgkreises (PLZ von Google, Wikipedia, etc.):
                     // TODO: Anrode (nur in den Ortsteilen Bickenriede und Zella),
                     // TODO: Brunnhartshausen (nur in den Ortsteilen Föhlritz und Steinberg),
    (plz = 36419) or // Buttlar
                     // TODO: Dünwald (nur in den Ortsteilen Beberstedt und Hüpstedt)
    (plz = 36419) or // Geisa
                     // TODO: Rodeberg (nur im Ortsteil Struth)
    (plz = 36419) or // Schleid
    (plz = 99988) or // Südeichsfeld
    (plz = 36452);   // Zella/Rhön
end;

function SachsenHatFronleichnam(plz: integer): boolean;
begin
  (*
  Laut https://www.dgb.de/gesetzliche-feiertage-deutschland:
  In Sachsen nur in folgenden katholisch geprägten Gemeinden des sorbischen Siedlungsgebietes im Landkreis Bautzen:
  Bautzen (nur in den Ortsteilen Bolbritz und Salzenforst),
  Crostwitz,
  Göda (nur im Ortsteil Prischwitz),
  Großdubrau (nur im Ortsteil Sdier),
  Hoyerswerda (nur im Ortsteil Dörgenhausen),
  Königswartha (nicht im Ortsteil Wartha),
  Nebelschütz,
  Neschwitz (nur in den Ortsteilen Neschwitz und Saritsch),
  Panschwitz-Kuckau,
  Puschwitz,
  Räckelwitz,
  Radibor,
  Ralbitz-Rosenthal,
  Wittichenau
  *)

  result :=
    // (PLZ von Google, Wikipedia, etc.)
                     // TODO: Bautzen (nur in den Ortsteilen Bolbritz und Salzenforst)
    (plz = 01920) or // Crostwitz
                     // TODO: Göda (nur im Ortsteil Prischwitz)
                     // TODO: Großdubrau (nur im Ortsteil Sdier)
                     // TODO: Hoyerswerda (nur im Ortsteil Dörgenhausen)
                     // TODO: Königswartha (nicht im Ortsteil Wartha)
    (plz = 01920) or // Nebelschütz
                     // TODO: Neschwitz (nur in den Ortsteilen Neschwitz und Saritsch)
    (plz = 01906) or // Panschwitz-Kuckau
    (plz = 01920) or // (ebenso)
    (plz = 02699) or // Puschwitz
    (plz = 01920) or // Räckelwitz
    (plz = 02627) or // Radibor
    (plz = 02694) or // (ebenso)
    (plz = 01920) or // Ralbitz-Rosenthal
    (plz = 02997);   // Wittichenau
end;

function IstAugsburgStadtgebiet(plz: integer): boolean;
begin
  // Extrahiert von https://www.suche-postleitzahl.org/augsburg-plz-86150-86199.35f2
  result :=
    (plz = 86159) or // Antonsviertel
    (plz = 86199) or // Bergheim
    (plz = 86156) or // Bärenkeller
    (plz = 86169) or // Firnhaberau
    (plz = 86199) or // Göggingen
    (plz = 86169) or // Hammerschmiede
    (plz = 86179) or // Haunstetten-Siebenbrunn
    (plz = 86199) or
    (plz = 86159) or // Hochfeld
    (plz = 86161) or //
    (plz = 86163) or // Hochzoll
    (plz = 86150) or // Innenstadt
    (plz = 86152) or //
    (plz = 86153) or //
    (plz = 86159) or //
    (plz = 86161) or //
    (plz = 86199) or // Inningen
    (plz = 86156) or // Kriegshaber     
    (plz = 86157) or //
    (plz = 86165) or // Lechhausen     
    (plz = 86167) or //
    (plz = 86169) or //
    (plz = 86154) or // Oberhausen     
    (plz = 86156) or //
    (plz = 86156) or // Pfersee
    (plz = 86157) or //
    (plz = 86161) or // Spickel-Herrenbach     
    (plz = 86159) or // Universitätsviertel
    (plz = 86161);
end;

{$ENDREGION}

{$REGION 'Spezielle Datumsberechnungen'}

function DritterMittwochImNovember(Jahr: integer): TDateTime;
begin
  result := EncodeDate(Jahr, 11, 1);
  result := result + ((11 - DayOfWeek(result)) mod 7) + 14;
end;

function Ostersonntag(Jahr: integer): TDateTime;
var
  A, B, C, D, E, F, G, H, I, K, L, M, N, P: Word;
  Tag, Monat: Word;
begin
  a := Jahr mod 19;
  b := Jahr div 100;
  c := Jahr mod 100;
  d := b div 4;
  e := b mod 4;
  f := (b + 8) div 25;
  g := (b - f + 1) div 3;
  h := (19 * a + b - d - g + 15) mod 30;
  i := c div 4;
  k := c mod 4;
  l := (32 + 2 * e + 2 * i - h - k) mod 7;
  m := (a + 11 * h + 22 * l) div 451;
  n := (h + l - 7 * m + 114) div 31;
  p := (h + l - 7 * m + 114) mod 31 + 1;
  Tag := p;
  Monat := n;
  Result := EncodeDate(Jahr, Monat, Tag);
end;

{$ENDREGION}

function IstDeutscherFeiertag(tag: TDateTime; plz: integer): boolean;
var
  ht: TFeiertagTable;
  h: TFeiertag;
begin
  ht := DeutschlandFeiertage(YearOf(tag), plz);
  for h in ht do
  begin
    if SameDate(tag, h.Date) then
    begin
      result := true;
      exit;
    end;
  end;
  result := false;
end;

function DeutschlandFeiertage(Jahr: Word; plz: integer): TFeiertagTable;

  // Funktion, um einen Feiertag über seinen Tag\Monat hinzuzufügen
  procedure AddFeiertag(DD, MM: Word; HDName: string); overload;
  begin
    SetLength(Result, High(Result) + 2);
    with Result[High(Result)] do
    begin
      Date := EncodeDate(Jahr, MM, DD);
      Name := HDName;
    end;
  end;

  //Funktion, um den Feiertag über die Datumsseriennummer hinzuzufügen
  procedure AddFeiertag(HDDate: TDateTime; HDName: string); overload;
  begin
    SetLength(Result, High(Result) + 2);
    with Result[High(Result)] do
    begin
      Date := HDDate;
      Name := HDName;
    end;
  end;

begin
  // siehe https://www.dgb.de/gesetzliche-feiertage-deutschland

  AddFeiertag(1, 1, 'Neujahr');

  if IstBadenWuerttemberg(plz) or
     IstBayern(plz) or
     IstSachsenAnhalt(plz) then
  begin
    AddFeiertag(6, 1, 'Heilige Drei Könige');
  end;

  if IstBerlin(plz) then
  begin
    AddFeiertag(8, 3, 'Internationaler Frauentag');
  end;

  AddFeiertag(OsterSonntag(Jahr) - 2, 'Karfreitag');

  if IstBrandenburg(plz) then
  begin
    AddFeiertag(OsterSonntag(Jahr), 'Ostersonntag');
  end;

  AddFeiertag(OsterSonntag(Jahr) + 1, 'Ostermontag');

  AddFeiertag(1, 5, 'Tag der Arbeit');

  AddFeiertag(OsterSonntag(Jahr) + 39, 'Christi Himmelfahrt');

  if IstBrandenburg(plz) then
  begin
    AddFeiertag(OsterSonntag(Jahr) + 49, 'Pfingstsonntag');
  end;

  AddFeiertag(OsterSonntag(Jahr) + 50, 'Pfingstmontag');

  if IstBadenWuerttemberg(plz) or
     IstBayern(plz) or
     IstHessen(plz) or
     IstNordrheinWestfalen(plz) or
     IstRheinlandPfalz(plz) or
     IstSaarland(plz) or
     SachsenHatFronleichnam(plz) or
     ThueringenHatFronleichnam(plz) then
  begin
    AddFeiertag(OsterSonntag(Jahr) + 60, 'Fronleichnam');
  end;

  if IstAugsburgStadtgebiet(plz) then
  begin
    (*
    Laut https://www.dgb.de/gesetzliche-feiertage-deutschland:
    - Nur im Stadtgebiet von Augsburg (nicht jedoch im angrenzenden Umland).
    *)
    AddFeiertag(8, 8, 'Augsburger Friedensfest');
  end;

  if IstSaarland(plz) or
     BayernHatMariaeHimmelfahrt(plz) then
  begin
    AddFeiertag(15, 8, 'Mariä Himmelfahrt');
  end;

  if IstThueringen(plz) then
  begin
    AddFeiertag(20, 9, 'Weltkindertag');
  end;

  AddFeiertag(3, 10, 'Tag der deutschen Einheit');

  if IstBrandenburg(plz) or
     IstBremen(plz) or
     IstHamburg(plz) or
     IstMecklenburgVorpommern(plz) or
     IstNiedersachsen(plz) or
     IstSachsen(plz) or
     IstSachsenAnhalt(plz) or
     IstSchleswigHolstein(plz) or
     IstThueringen(plz) then
  begin
    AddFeiertag(31, 10, 'Reformationstag');
  end;

  if IstBadenWuerttemberg(plz) or
     IstBayern(plz) or
     IstNordrheinWestfalen(plz) or
     IstRheinlandPfalz(plz) or
     IstSaarland(plz) then
  begin
    AddFeiertag(1, 11, 'Allerheiligen');
  end;

  if IstSachsen(plz) then
  begin
    // Ermittelt den 3. Mitwoch im November
    AddFeiertag(DritterMittwochImNovember(Jahr), 'Buß- und Bettag');
  end;

  // AddFeiertag(24, 12, 'Heiligabend');

  AddFeiertag(25, 12, '1. Weihnachtsfeiertag');

  AddFeiertag(26, 12, '2. Weihnachtsfeiertag');

  // AddFeiertag(31, 12, 'Silvester');
end;

end.
Daniel Marschall
ViaThinkSoft Mitbegründer
Downloadbeschreibung:

This is a retro-coding product of OIDplus, written in TurboPascal, aiming for DOS. It is just a small gimmick / fun-project and should not be used for productive use! Please use the latest version of OIDplus (2.0)!

Source code: https://github.com/danielmarschall/oidplus_dos
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:

VGWhoIs is a fork of the tool GWhoIs (currently not actively developed). It allows users to find information about domains, IP addresses, ASN numbers etc by querying the best fitting WhoIs service automatically. The information about the whois services is stored in a pattern file and can be altered or extended by new pattern files.

The usage is pretty simple:

vgwhois example.com
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:

Der YouTube Downloader ist ein Tool für Linux. Es basiert auf dem Tool youtube-dl und bietet etliche Zusatzfunktionen.

Ein paar Besonderheiten:
- Herunterladen aller Videos eines Kanals oder einer Playlist
- Vollautomatisches Suchen innerhalb von Kanälen oder ganz YouTube
- Es können sowohl Videos als auch Audio-Dateien heruntergeladen werden.
- Youtube-IDs können in die ID-Tags von heruntergeladenen MP3-Dateien eingebunden werden
- Eine automatisch verwaltete Liste mit bereits heruntergeladenen Videos erlaubt es, die heruntergeladenen Dateien zu verschieben, ohne dass die Videos neu heruntergeladen werden.
- Eine automatisch verwaltete Liste mit fehlgeschlagenen Downloads verhindert, dass ein nicht mehr verfügbares Video immer wieder erneut versucht wird.
- Erzeugen von SFV- und/oder MD5-Prüfsummen-Dateien.
- YouTube Downloader ist vollständig kommandozeilenbasiert und für Cronjobs optimiert.

Anforderungen:
- PHP CLI
- Paket "youtube-dl"
- Falls MP3-Dateien extrahiert werden sollen: "avconv" oder "ffmpeg", sowie optional "id3v2"
- Ein Youtube API-Key (hier kostenlos beantragen)
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:

Konvertiert Object-Identifier (OIDs) in die DER Form und umgekehrt.

Online demo
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:



VNag (ViaThinkSoft Nagios) ist ein Framework für PHP, das es erlaubt, Plugins für Nagios-kompatible Systeme (z.B. auch Icinga2) gemäß den Richtlinien zu erstellen.

Das Download-Paket enthält Dokumentation und Beispiele und eine Vielzahl an neuen Plugins, z.B. um eine WordPress-Installation auf Updates zu überprüfen.

VNag ermöglicht es nicht nur, normale Nagios/Icinga-Plugins zu entwickeln (PHP wird über CLI aufgerufen), sondern erlaubt auch, ein Plugin über das Web zur Verfügung zu stellen:

  • Das ist PHP geschriebene Plugin kann über einen HTTP-Daemon (z.B. Apache) im Browser angezeigt werden. Neben der Anzeige der Nagios-Ausgabe (Summary, Verbose information, Performance data) können beliebige HTML-Ausgaben hinzugefügt werden, um z.B. noch Diagramme zu präsentieren. Es ist nur eine Codebasis erforderlich!

  • Die Web-Ausgabe enthält einen maschinenlesbaren (unsichtbaren) Teil, der mit Hilfe des "web reader"-Plugins von VNag ausgelesen und in das Standardformat für die Überwachung mit einer lokalen Nagios Instanz umgewandelt werden kann. Somit ist es z.B. möglich, mittels Nagios bestimmte Dinge (z.B. eine WordPress-Version) auf einem entfernten System, bei dem kein Shell-Zugriff möglich oder kein Nagios installiert ist, zu überwachen.

  • Es ist auch möglich, Webseiten zu erzeugen, die nur einen unsichtbaren maschinenlesbaren Teil besitzen (bzw. Sie können eine VNag Ausgabe in Ihre bestehende Webseite einbinden), jedoch ohne visuellen Teil. Dieser maschinenlesbare Teil kann optional signiert und/oder verschlüsselt werden.

Im Download-Paket von VNag sind folgende Plugins enthalten:

  • 4images_version: Checks 4images installations for updates.
  • disk_running: Checks if harddisks which do not have SMART capability are online
  • file_timestamp: Warns when files are not modified withhin a specific interval/age.
  • gitlab_version: Checks GitLab install~ations for updates.
  • hp_smartarray: Checks disk and controller status of HP SmartArray RAID controllers.
  • ipfm: Checks the log files of the tool "ipfm" and warns when the measured traffic exceeds a given limit.
  • joomla_version: checks Joomla installations for updates.
  • last: Checks the output of the tool "last" and warns when logins from suspicious IP adresses are detected.
  • mdstat: Parses the output of "/proc/mdstat" and warns when drives inside a RAID array have failed.
  • mediawiki_version: Checks MediaWiki installations for updates.
  • net2ftp_version: Checks net2ftp installations for updates.
  • nextcloud_version: Checks Nextcloud installations for updates.
  • nocc_version: Checks NOCC webmail installations for updates.
  • openbugbounty: Checks if your domains are listed at OpenBugBounty.org.
  • owncloud_version: Checks ownCloud installations for updates.
  • phpbb_version: Checks phpBB installations for updates.
  • phpmyadmin_version: Checks phpMyAdmin installations for updates.
  • ping: Pings a hostname or IP address.
  • pmwiki_version: Checks PmWiki installations for updates.
  • roundcube_version: Checks RoundCube installations for updates.
  • smart: Checks the SMART attributes of harddrives and warns when bad attributes are detected.
  • virtual_mem: Checks the amount of virtual memory (physical memory + swap).
  • webreader: Reads the output of another VNag plugin transferred over HTTP.
  • wordpress_version: Checks WordPress installations for updates.
  • x509_expire: Warns when X.509 (PEM) certificate files reach a specific age.
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:

- Generate an UUID (according to RFC 4122):
- ... Time based (version 1) UUID
- ... DCE Security (version 2) UUID
- ... Name-based (version 3/5) UUID
- ... Random (version 4) UUID
- Interprete ("decode") an UUID
- Interprete a MAC address
Daniel Marschall
ViaThinkSoft Mitbegründer
unit Cabinet;

// Source: http://delfusa.main.jp/delfusafloor/archive/www.nifty.ne.jp_forum_fdelphi/samples/00814.html
//         http://delfusa.main.jp/delfusafloor/archive/www.nifty.ne.jp_forum_fdelphi/samples/01338.html
// Very important bugfixes (e.g. forgotten cdecl and modern Delphi compatibility) by Daniel Marschall, ViaThinkSoft
// Revision : 18 August 2022
// published at https://www.viathinksoft.de/codelib/206

interface

{$IFDEF UNICODE}
// Note that the CAB API does only support ANSI names!
// Although Microsoft recommends using full paths, I would choose
// relative paths, because this way you avoid problems if the files
// are stored in a Non-ANSI folder name.
{$DEFINE USE_ANSISTRINGS}
{$ENDIF}

uses
  Windows, SysUtils, Classes{$IFDEF USE_ANSISTRINGS}, AnsiStrings{$ENDIF};

const
  CB_MAX_DISK_NAME = 256;
  CB_MAX_CABINET_NAME = 256;
  CB_MAX_CAB_PATH = 256;

  cpuUNKNOWN = -1;
  cpu80286 = 0;
  cpu80386 = 1;

type
  USHORT = WORD;

  TERF = record
    erfOper, erfType: Integer;
    fError: BOOL;
  end;
  // ERF = TERF;
  PERF = ^TERF;

  TCCAB = record
    cb: ULONG;
    cbFolderThresh: ULONG;
    cbReserveCFHeader: UINT;
    cbReserveCFFolder: UINT;
    cbReserveCFData: UINT;
    iCab: Integer;
    iDisk: Integer;
    fFailOnIncompressible: Integer;
    setID: USHORT;
    szDisk: array[0..CB_MAX_DISK_NAME-1] of AnsiChar;
    szCab: array[0..CB_MAX_CABINET_NAME-1] of AnsiChar;
    szCabPath: array[0..CB_MAX_CAB_PATH-1] of AnsiChar;
  end;
  // CCAB = TCCAB;
  PCCAB = ^TCCAB;

  TFDICABINETINFO = record
    cbCabinet: Longint;
    cFolders: USHORT;
    cFiles: USHORT;
    setID: USHORT;
    iCabinet: USHORT;
    fReserve: BOOL;
    hasprev: BOOL;
    hasnext: BOOL;
  end;
  // FDICABINETINFO = TFDICABINETINFO;
  PFDICABINETINFO = ^TFDICABINETINFO;

  TFDINOTIFICATIONTYPE = (fdintCABINET_INFO, fdintPARTIAL_FILE,
    fdintCOPY_FILE, fdintCLOSE_FILE_INFO, fdintNEXT_CABINET,
    fdintENUMERATE);
  // FDINOTIFICATIONTYPE = TFDINOTIFICATIONTYPE;

  TFCIERROR = (FCIERR_NONE, FCIERR_OPEN_SRC, FCIERR_READ_SRC, FCIERR_ALLOC_FAIL,
    FCIERR_TEMP_FILE, FCIERR_BAD_COMPR_TYPE, FCIERR_CAB_FILE, FCIERR_USER_ABORT,
    FCIERR_MCI_FAIL, FCIERR_CAB_FORMAT_LIMIT);

  TFDIERROR = (FDIERROR_NONE, FDIERROR_CABINET_NOT_FOUND,
    FDIERROR_NOT_A_CABINET, FDIERROR_UNKNOWN_CABINET_VERSION,
    FDIERROR_CORRUPT_CABINET, FDIERROR_ALLOC_FAIL,
    FDIERROR_BAD_COMPR_TYPE, FDIERROR_MDI_FAIL, FDIERROR_TARGET_FILE,
    FDIERROR_RESERVE_MISMATCH, FDIERROR_WRONG_CABINET,
    FDIERROR_USER_ABORT);

  tcompTYPE = (tcompTYPE_NONE, tcompTYPE_MSZIP);

  TFDINOTIFICATION = record
    cb: Longint;
    psz1: PAnsiChar;
    psz2: PAnsiChar;
    psz3: PAnsiChar;
    pv: Pointer;
    hf: Integer;
    date: USHORT;
    time: USHORT;
    attribs: USHORT;
    setID: USHORT;
    iCabinet: USHORT;
    iFolder: USHORT;
    fdie: TFDIERROR;
  end;
  // FDINOTIFICATION = TFDINOTIFICATION;
  PFDINOTIFICATION = ^TFDINOTIFICATION;

// define a function to call from Cabinet.DLL
function FCICreate(var erf: TERF; fnFiledest, fnAlloc, fnFree, fnOpen,
  fnRead, fnWrite, fnClose, fnSeek, fnDelete, fnfcigtf: Pointer;
  var ccab: TCCAB; pv: Pointer): THandle; cdecl;
function FCIDestroy(THandle: THandle): BOOL; cdecl;
function FCIAddFile(THandle: THandle; pszSourceFile, pszFileName: PAnsiChar;
 fExecute: BOOL; pfnfcignc, pfnfcis, pfnfcigoi: Pointer;
 typeCompress: WORD): BOOL; cdecl;
function FCIFlushCabinet(THandle: THandle; fGetNextCab: BOOL;
  pfnfcignc, pfnfcis: Pointer): BOOL; cdecl;
function FCIFlushFolder(fci: THandle;
  GetNextCab, pfnProgress: Pointer): BOOL; cdecl;
function FDICreate(fnAlloc, fnFree, fnOpen, fnRead, fnWrite, fnClose,
  fnSeek: Pointer; cpuType: Integer; var erf: TERF): THandle; cdecl;
function FDIDestroy(THandle: THandle): BOOL; cdecl;
function FDIIsCabinet(THandle: THandle; hf: Integer;
  pfdici: PFDICABINETINFO): BOOL; cdecl;
function FDICopy(THandle: THandle; pszCabinet: PAnsiChar; pszCabPath: PAnsiChar;
  flags: Integer; pfnfdin, pfnfdid: Pointer; pvUser: Pointer): BOOL; cdecl;

procedure CabinetAddFiles(Cabinet: AnsiString; Files: TStrings);
procedure CabinetExtractFile(Cabinet, Item, ExtractName: AnsiString);

implementation // This is the code to write in the implementation part from here

// define a function to call from Cabinet.DLL
const CAB_DLL = 'CABINET.DLL';
function FCICreate; external CAB_DLL name 'FCICreate';
function FCIDestroy; external CAB_DLL name 'FCIDestroy';
function FCIAddFile; external CAB_DLL name 'FCIAddFile';
function FCIFlushCabinet; external CAB_DLL name 'FCIFlushCabinet';
function FCIFlushFolder; external CAB_DLL name 'FCIFlushFolder';
function FDICreate; external CAB_DLL name 'FDICreate';
function FDIDestroy; external CAB_DLL name 'FDIDestroy';
function FDIIsCabinet; external CAB_DLL name 'FDIIsCabinet';
function FDICopy; external CAB_DLL name 'FDICopy';

// Here is an example callback function for context construction
function fnFilePlaced(var ccab: TCCAB; pszFile: PAnsiChar; cbFile: Longint;
  fContinuation: BOOL; pv: Pointer): THandle; cdecl;
begin
  Result := 0;
end;

function fnAlloc(Size: ULONG): Pointer; cdecl;
begin
  GetMem(Result, Size);
end;

procedure fnFree(memory: Pointer); cdecl;
begin
  FreeMem(memory);
end;

function fnOpen(pszFile: PAnsiChar; oflag: Integer; pmode: Integer;
  err: PInteger; pv: Pointer): Integer; cdecl;
const
  O_RDONLY = $0000;
  O_WRONLY = $0001;
  O_RDWR = $0002;
  O_CREAT = $0100;
  O_EXCL = $0400;
var
  Style: UINT;
  os: OFSTRUCT;
begin
  if(oflag and O_CREAT) <> 0 then
    Style := OF_CREATE
  else
    case(oflag and 3)of
      0: Style := OF_Read;
      1: Style := OF_Write;
      else Style := OF_ReadWrite;
    end;
  if(oflag and O_EXCL) <> 0 then
    Style := Style or OF_Share_Exclusive;
  Result := OpenFile(pszFile, os, Style); // save lines and use old API
end;

function fnRead(hf: Integer; memory: Pointer; cb: UINT; err: PInteger;
  pv: Pointer): UINT; cdecl;
begin
  Result := _lread(hf, memory, cb);
end;

function fnWrite(hf: Integer; memory: Pointer; cb: UINT; err: PInteger;
  pv: Pointer): UINT; cdecl;
begin
  Result := _lwrite(hf, memory, cb);
end;

function fnClose(hf: Integer; err, pv: Pointer): Integer; cdecl;
begin
  Result := _lclose(hf);
end;

function fnSeek(hf: Integer; dist: Longint; seektype: Integer; err: PInteger;
  pv: Pointer): Longint; cdecl;
begin
  Result := _llseek(hf, dist, seektype);
end;

function fnDelete(pszFile: PAnsiChar; err: PInteger; pv: Pointer): Integer; cdecl;
begin
  Result := Integer(DeleteFileA(pszFile));
end;

function fnFciGTF(pszTempName: PAnsiChar; cbTempName: Integer; pv: Pointer): BOOL; cdecl;
var
  pPath: array[0..MAX_PATH-1] of AnsiChar;
begin
  Result := (GetTempPathA(sizeof(pPath), pPath) <> 0) and
            (GetTempFileNameA(pPath, 'cab', 0, pszTempName) <> 0);
end;

function fnGetNextCabinet(var ccab: TCCAB; cbPrevCab: ULONG;
  pv: Pointer): BOOL; cdecl;
begin
  result := false; // TODO?
end;

function fnStatus(typeStatus: UINT; cb1, cb2: ULONG; pv: Pointer):
  Longint; cdecl;
begin
  result := 0; // TODO?
end;

function fnOpenInfo(pszName: PAnsiChar; var pDate: WORD; var pTime: WORD;
  var pAttrib: WORD; err: PInteger; pv: Pointer): Integer; cdecl;
var
  LocalTime: FILETIME;
  CreationTime: FILETIME;
  LastAccessTime: FILETIME;
  LastWriteTime: FILETIME;
  fh: THandle;
begin // Originally get the attributes of the file here
  pAttrib := GetFileAttributesA(pszName);

  fh := CreateFileA(
      PAnsiChar(pszName),
      GENERIC_READ{ or GENERIC_WRITE},
      FILE_SHARE_READ,
      nil,
      OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL,
      0
  );

  if fh <> INVALID_HANDLE_VALUE then
  begin
    GetFileTime(fh, @CreationTime, @LastAccessTime, @LastWriteTime);

    FileTimeToLocalFileTime(LastWriteTime, LocalTime);
    FileTimeToDosDateTime(LocalTime, pDate, pTime);

    // CloseHandle(handle);
  end;

  Result := fh;
end;

// I tried to combine it into two functions for easy use
// CabinetAddFiles : Compress the files in the list into CAB
// CabinetExtractFile : Extract file from CAB

procedure CabinetAddFiles(Cabinet: AnsiString; Files: TStrings);
var
  fci: THandle;
  erf: TERF;
  ccab: TCCAB;
  i: Integer;
begin
  ZeroMemory(@erf, sizeof(erf));
  ZeroMemory(@ccab, sizeof(ccab));

  ccab.cb := $7FFFFFFF {2GB}; // "the maximum size, in bytes, of a cabinet created by FCI"
  ccab.iDisk := 1;
  {$IFDEF USE_ANSISTRINGS}AnsiStrings.{$ENDIF}StrPCopy(ccab.szDisk, PAnsiChar(AnsiString('DISK1')));
  {$IFDEF USE_ANSISTRINGS}AnsiStrings.{$ENDIF}StrPCopy(ccab.szCab, PAnsiChar(AnsiString(ExtractFileName(Cabinet))));
  {$IFDEF USE_ANSISTRINGS}AnsiStrings.{$ENDIF}StrPCopy(ccab.szCabPath, PAnsiChar(AnsiString(ExtractFilePath(Cabinet))));

  // use a callback function to build the context
  fci := FCICreate(erf, @fnFilePlaced, @fnAlloc, @fnFree,
    @fnOpen, @fnRead, @fnWrite, @fnClose, @fnSeek, @fnDelete,
    @fnFciGTF, ccab, nil);
  if fci <> 0 then
  try
    for i := 0 to Files.Count-1 do
    begin                                                    
      if not FCIAddFile(fci, PAnsiChar(AnsiString(Files[i])), PAnsiChar(AnsiString(ExtractFileName(Files[i]))), FALSE{Execute},
        @fnGetNextCabinet, @fnStatus, @fnOpenInfo, Ord(tcompTYPE_MSZIP)) then
      begin
        raise Exception.CreateFmt('FCIAddFile %d', [erf.erfOper]);
      end;
    end;

    if FCIFlushCabinet(fci, FALSE, @fnGetNextCabinet, @fnStatus) = FALSE then
    begin
      raise Exception.CreateFmt('FCIFlushCabinet %d', [erf.erfOper]);
    end;
  finally
    // dispose of used context
    FCIDestroy(fci);
  end;
end;

const
  _A_NORMAL = $00;
  _A_RDONLY = $01;
  _A_HIDDEN = $02;
  _A_SYSTEM = $04;
  _A_SUBDIR = $10;
  _A_ARCH   = $20;

procedure CabinetExtractFile(Cabinet, Item, ExtractName: AnsiString);
type
  TMyParam = record
    Item: AnsiString;
    ExtractName: AnsiString;
  end;
  PMyParam = ^TMyParam;

  function fnFDINotify(fdint: TFDINOTIFICATIONTYPE;
    pfdin: PFDINOTIFICATION): Integer; cdecl;
  var
    os: OFSTRUCT;
    Param: PMyParam;
    datetime: TFileTime;
    local_filetime: TFileTime;
    handle: THandle;
    attrs: Cardinal;
  begin
    Param := pfdin.pv;
    case(fdint)of
      fdintCABINET_INFO:
      begin
        result := 0; // TODO?
      end;
      fdintPARTIAL_FILE:
      begin
        result := 0; // TODO?
      end;
      fdintCOPY_FILE:
      begin
        if {$IFDEF USE_ANSISTRINGS}AnsiStrings.{$ENDIF}SameText(pfdin^.psz1, Param^.Item) then
          Result := OpenFile(PAnsiChar(Param^.ExtractName), os, OF_CREATE)
        else
          Result := 0;
        if Result = -1 then RaiseLastOSError;
      end;
      fdintCLOSE_FILE_INFO:
      begin // Originally set file attributes here
        _lclose(pfdin^.hf);

        (*
         * Set date/time
         *
         * Need Win32 type handle for to set date/time
         *)
        handle := CreateFileA(
            PAnsiChar(Param^.ExtractName),
            GENERIC_READ{ or GENERIC_WRITE},
            FILE_SHARE_READ,
            nil,
            OPEN_EXISTING,
            FILE_ATTRIBUTE_NORMAL,
            0
        );
        if handle <> INVALID_HANDLE_VALUE then
        begin
          if (DosDateTimeToFileTime(
              pfdin^.date,
              pfdin^.time,
              datetime) = TRUE) then
          begin
            if (LocalFileTimeToFileTime(
                datetime,
                local_filetime) = TRUE) then
            begin
              SetFileTime(
                  handle,
                  @local_filetime,
                  nil,
                  @local_filetime
              );
            end;
          end;

          CloseHandle(handle);
        end;

        (*
         * Mask out attribute bits other than readonly,
         * hidden, system, and archive, since the other
         * attribute bits are reserved for use by
         * the cabinet format.
         *)
        attrs := pfdin^.attribs and (_A_RDONLY or _A_HIDDEN or _A_SYSTEM or _A_ARCH);
        SetFileAttributesA(
            PAnsiChar(Param^.ExtractName),
            attrs
        );

        // TODO: Commented out, because for some reason sometimes cb=1 although it was packed with Execute=FALSE
        // if pfdin^.cb = 1 then WinExec(PAnsiChar(Param^.ExtractName), SW_NORMAL); // Execute files with the "Execute" flag (set by FCIAddFile)

        Result := Integer(TRUE);
      end;
      fdintNEXT_CABINET:
      begin
        Result := 0; // TODO?
      end;
      fdintENUMERATE:
      begin
        Result := 0; // TODO?
      end
      else
      begin
        Result := 0; // Should not happen
      end;
    end;
  end;

var
  fdi: THandle;
  erf: TERF;
  Param: TMyParam;
begin
  ZeroMemory(@erf, sizeof(erf));
  // use a callback function to build the context
  fdi := FDICreate(@fnAlloc, @fnFree, @fnOpen, @fnRead, @fnWrite, @fnClose, @fnSeek, cpuUNKNOWN, erf);
  if fdi <> 0 then
  try
    Param.Item := Item;
    Param.ExtractName := ExtractName;
    if FDICopy(fdi, PAnsiChar(AnsiString(ExtractFileName(Cabinet))),
      PAnsiChar(AnsiString(ExtractFilePath(Cabinet))), 0, @fnFDINotify, nil, @Param) = FALSE then
    begin
      raise Exception.CreateFmt('FDICopy %d', [erf.erfOper]);
    end;
  finally
    // dispose of used context
    FDIDestroy(fdi);
  end;
end;

end.

Example how to use:

procedure TForm1.Button1Click(Sender: TObject);
var
  Files: TStringList;
begin
  Files := TStringList.Create;
  Files.Add('Setup.exe');
  CabinetAddFiles('TEST.CAB', Files);
  Files.Free;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  CabinetExtractFile('TEST.CAB', 'Setup.exe', 'Setup.exe');
end;
Daniel Marschall
ViaThinkSoft Mitbegründer

uses
  WinSock, ActiveX, ComObj;

function OleVariantToText(aVar:OleVariant):string;
// mostly quickdump for WMI researchpurposes
var
    i : integer;
begin
  Result:='';
  if not VarIsNull(aVar) then
    if VarIsArray(aVar) then
      begin
        result:='{';
        for i :=VarArrayLowBound(aVar,1) to vararrayhighbound(aVar,1)  do
          begin
            if i<>0 then
              result:=result+',';
            result:=result+OleVariantToText(vararrayget(aVar,[i]));
          end;
        result:=result+'}';
      end
    else
      Result:=VarToStr(aVar);
end;

Function GetMultiString_FromArray( ArrayString:OleVariant; separator:string):string;
begin
    If varisnull ( ArrayString ) Then
        result:= ''
    else
        result := OleVariantToText(arraystring); // arraystring.items[0]; // Join( ArrayString, Seprator )
end;

function GetWMIObject(const objectName: String): IDispatch;
var
  chEaten: Integer;
  BindCtx: IBindCtx;//for access to a bind context
  Moniker: IMoniker;//Enables you to use a moniker object
begin
  OleCheck(CreateBindCtx(0, bindCtx));
  OleCheck(MkParseDisplayName(BindCtx, StringToOleStr(objectName), chEaten, Moniker));//Converts a string into a moniker that identifies the object named by the string
  OleCheck(Moniker.BindToObject(BindCtx, nil, IDispatch, Result));//Binds to the specified object
end;

function GetWMIarray(wmiHost, root, wmiClass, wmiProperty, Separator: string): string;
var
  objWMIService : OLEVariant;
  colItems      : OLEVariant;
  colItem       : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin
  objWMIService := GetWMIObject(Format('winmgmts:\\%s\%s',[wmiHost,root]));
  colItems      := objWMIService.ExecQuery(Format('SELECT * FROM %s',[wmiClass]),'WQL',0);
  oEnum         := IUnknown(colItems._NewEnum) as IEnumVariant;
  while oEnum.Next(1, colItem, iValue) = 0 do
  begin
     Result:=GetMultiString_FromArray(colItem.Properties_.Item(wmiProperty, 0).Value,Separator); //you can improve this code  ;) , storing the results in an TString.
     if Result <> '' then break;
  end;
end;

function GetWMIstring(wmiHost, root, wmiClass, wmiProperty: string): string;
var
  objWMIService : OLEVariant;
  colItems      : OLEVariant;
  colItem       : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin
  objWMIService := GetWMIObject(Format('winmgmts:\\%s\%s',[wmiHost,root]));
  colItems      := objWMIService.ExecQuery(Format('SELECT * FROM %s',[wmiClass]),'WQL',0);
  oEnum         := IUnknown(colItems._NewEnum) as IEnumVariant;
  while oEnum.Next(1, colItem, iValue) = 0 do
  begin
     Result:=colItem.Properties_.Item(wmiProperty, 0); //you can improve this code  ;) , storing the results in an TString.
     if Result <> '' then break;
  end;
end;

function SendArp(DestIP,SrcIP:ULONG;pMacAddr:pointer;PhyAddrLen:pointer) : DWord; StdCall; external 'iphlpapi.dll' name 'SendARP';

function GetRouterMac(debug: boolean=false): string;

  function GetMacAddr(const IPAddress: string; var ErrCode : DWORD): string;
  var
    MacAddr    : Array[0..5] of Byte;
    DestIP     : ULONG;
    PhyAddrLen : ULONG;
    WSAData    : TWSAData;
  begin
    // https://stackoverflow.com/questions/4550672/delphi-get-mac-of-router
    Result    :='';
    WSAStartup($0101, WSAData);
    try
      ZeroMemory(@MacAddr,SizeOf(MacAddr));
      DestIP    :=inet_addr(PAnsiChar(AnsiString(IPAddress)));
      PhyAddrLen:=SizeOf(MacAddr);
      ErrCode   :=SendArp(DestIP,0,@MacAddr,@PhyAddrLen);
      if ErrCode = S_OK then
       Result:=Format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',[MacAddr[0], MacAddr[1],MacAddr[2], MacAddr[3], MacAddr[4], MacAddr[5]])
    finally
      WSACleanup;
    end;
  end;

var
  gateway: string;
  ec: DWORD;
  macrouter: string;
  sl: TStringList;
  serr: string;
const
  DELIM = ',';
begin
  result := '';

  gateway := GetWMIarray('.', 'root\CIMV2', 'Win32_NetworkAdapterConfiguration', 'DefaultIPGateway', DELIM);
  gateway := StringReplace(gateway,'{','',[rfReplaceAll]);
  gateway := StringReplace(gateway,'}','',[rfReplaceAll]);

  sl := TStringList.Create;
  try
    sl.Delimiter := DELIM;
    sl.DelimitedText := gateway;
    if sl.Count = 0 then
    begin
      if debug then
        macrouter := 'ERR_NO_ADAPTERS'
      else
        macrouter := '';
    end
    else
    begin
      try
        macrouter := GetMacAddr(sl[0],ec);
      except
        on E: Exception do
        begin
          if debug then
            macrouter := 'ERR_EXCEPT_'+E.Message
          else
            macrouter := '';
        end;
      end;

      if ec = ERROR_BAD_NET_NAME then
        serr := 'ERROR_BAD_NET_NAME'
      else if ec = ERROR_BUFFER_OVERFLOW then
        serr := 'ERROR_BUFFER_OVERFLOW'
      else if ec = ERROR_GEN_FAILURE then
        serr := 'ERROR_GEN_FAILURE'
      else if ec = ERROR_INVALID_PARAMETER then
        serr := 'ERROR_INVALID_PARAMETER'
      else if ec = ERROR_INVALID_USER_BUFFER then
        serr := 'ERROR_INVALID_USER_BUFFER'
      else if ec = 1168(*ERROR_NOT_FOUND*) then
        serr := 'ERROR_NOT_FOUND'
      else if ec = ERROR_NOT_SUPPORTED then
        serr := 'ERROR_NOT_SUPPORTED'
      else if ec = ERROR_NETWORK_UNREACHABLE then // not documented in MSDN WinApi
        serr := 'ERROR_NETWORK_UNREACHABLE'
      else if ec <> S_OK then
        serr := 'ERROR_' + IntToStr(ec);

      if ec <> 0 then
      begin
        if debug then
          macrouter := serr
        else
          macrouter := '';
      end;
    end;
  finally
    FreeAndNil(sl);
  end;

  result := macrouter;
end;

procedure TForm6.Button1Click(Sender: TObject);
begin
  showmessage(GetRouterMac(true));
end;

initialization
  CoInitialize(nil);
finalization
  CoUnInitialize;
end.
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:



Abstract

ViaThinkSoft Currency Converter is a library developed by Daniel Marschall which converts currencies. The latest exchange data is automatically downloaded and cached.

To use ViaThinkSoft Currency Converter, you need an API key from CurrencyLayer.com. Keys with limited access are available for free, and there are paid subscriptions available, too.

Usage for online applications, with PHP

Download framework and example script from the SVN

Try it now! Use the online tool

For Windows users

If you are not a developer, you can download the ready-to-use demo EXE file.

Download Windows demo application, written in Delphi



For Windows developers

The Currency Converter is implemented as a Windows DLL (Source code for Delphi), which can be used by most other programming languages as well as VBA (Visual Basic for Applications). Therefore, you can use Currency Calculator in Microsoft Office products.

Download compiled DLL for Win32 and Win64

Download source code for usage in ...

Before using the DLL, please place the API key in your registry:

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\ViaThinkSoft\CurrencyConverter]
"APIKey"="....."

Specification of the exported DLL methods
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:



Abstract

ViaThinkSoft Currency Converter is a library developed by Daniel Marschall which converts currencies. The latest exchange data is automatically downloaded and cached.

To use ViaThinkSoft Currency Converter, you need an API key from CurrencyLayer.com. Keys with limited access are available for free, and there are paid subscriptions available, too.

Usage for online applications, with PHP

Download framework and example script from the SVN

Try it now! Use the online tool

For Windows users

If you are not a developer, you can download the ready-to-use demo EXE file.

Download Windows demo application, written in Delphi



For Windows developers

The Currency Converter is implemented as a Windows DLL (Source code for Delphi), which can be used by most other programming languages as well as VBA (Visual Basic for Applications). Therefore, you can use Currency Calculator in Microsoft Office products.

Download compiled DLL for Win32 and Win64

Download source code for usage in ...

Before using the DLL, please place the API key in your registry:

Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\ViaThinkSoft\CurrencyConverter]
"APIKey"="....."

Specification of the exported DLL methods
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:



Das leistungsfähige webbasierte Organisationstalent hilft Ihnen, Ihre tägliche Arbeit zu vereinfachen, indem es Ihnen die Möglichkeit gibt, Termine, Kontakte, Dokumente, Dateien, Links, E-Mail-Postfächer, Zugangsdaten u.v.m. in übersichtlicher Form zu organisieren. Ein Modulsystem erlaubt es, Personal WebBase beliebig zu erweitern. Da die Modulstruktur sehr einfach ist, können auch unerfahrenere PHP-Entwickler einfach eigene Komponenten erstellen.

Weitere Informationen, Module und Designs finden Sie auf der Webseite von Personal WebBase!
www.personal-webbase.de
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:

Aufgrund eines Projektes habe ich eine Funktion gebraucht, die von einer Papierkorbdatei den Originaldateinamen ausliest. Nach einigen Recherchen bin ich auf Publikationen und Forensik-Freeware gestoßen, die die Struktur von Papierkorbindexdateien analysieren bzw. beschreiben. Leider muss ich sagen, dass alle Publikationen, die ich gefunden habe, (teilweise fatal) fehlerhaft waren und die Analyseprogramme, die ich fand, nicht mit allen Typen von Papierkorbindexdateien (verschiedene Windows Versionen) zurecht kamen. Ich habe mich deswegen daran gemacht, verschiedene Papierkorbstrukturdateien zu analysieren (Windows NT/95 bis Windows 10) und eine Delphi-Unit inkl. Beispielprogramm zu schreiben. Natürlich will ich der Gemeinschaft etwas Gutes tun und mache diese Unit OpenSource. Die Betreiber oder Verfasser der Publikationen/Webseiten habe ich auch nebenbei auf einige Fehler hingewiesen. Microsoft macht natürlich keine Äußerung zu dem Aufbau von Windows Strukturdateien.

Benötigt mindestens Delphi 4, jedoch ist RecyclerGetDateTime() erst ab Delphi 6 freigeschaltet.

Erfolgreich getestet wurde das Programm mit Windows NT4, 95 (mit und ohne IE4 ShellExtensions), 98, 2000, XP, Vista, 7, 10 und 11 sowie ReactOS.
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:

Filter Foundry is a compatible replacement for Adobe Filter Factory. For information about how to use the Filter Factory-compatible interface, see The Filter Factory Programming Guide. Several example effects come with Filter Factory.

Initially written by Toby Thain in 2003 - 2009, the development has been continued by Daniel Marschall / ViaThinkSoft since 2018. Several advancements and improvements have been made, and a 64-bit Windows version was created. The Macintosh version could not be taken over because Apple removed the "Carbon" API.

Filter Foundry full documentation

Here you can find a few filters by ViaThinkSoft which were created using Filter Foundry.
Daniel Marschall
ViaThinkSoft Mitbegründer
Projektbeschreibung:

Filter Foundry is a compatible replacement for Adobe Filter Factory. For information about how to use the Filter Factory-compatible interface, see The Filter Factory Programming Guide. Several example effects come with Filter Factory.

Initially written by Toby Thain in 2003 - 2009, the development has been continued by Daniel Marschall / ViaThinkSoft since 2018. Several advancements and improvements have been made, and a 64-bit Windows version was created. The Macintosh version could not be taken over because Apple removed the "Carbon" API.

Filter Foundry full documentation

Here you can find a few filters by ViaThinkSoft which were created using Filter Foundry.
Daniel Marschall
ViaThinkSoft Mitbegründer
function GetOwnBuildTimestamp: TDateTime;
var
  fs: TFileStream;
  unixTime: integer;
  peOffset: Integer;
begin
  try
    fs := TFileStream.Create(ParamStr(0), fmOpenRead or fmShareDenyNone);
    try
      fs.Seek($3C, soFromBeginning);
      fs.Read(peOffset, 4);

      fs.Seek(peOffset+8, soFromBeginning);
      fs.Read(unixTime, 4);

      // TODO: If required, convert UTC zu your local time zone.
      result := UnixToDateTime(unixTime); // requires DateUtils
    finally
      FreeAndNil(fs);
    end;
  except
    // Should not happen
    FileAge(ParamStr(0), result);
  end;
end;
Daniel Marschall
ViaThinkSoft Mitbegründer
Zuerst benötigen Sie folgende Zeilen:

DECLARE @AllConnections TABLE(
    SPID INT,
    Status VARCHAR(MAX),
    LOGIN VARCHAR(MAX),
    HostName VARCHAR(MAX),
    BlkBy VARCHAR(MAX),
    DBName VARCHAR(MAX),
    Command VARCHAR(MAX),
    CPUTime INT,
    DiskIO INT,
    LastBatch VARCHAR(MAX),
    ProgramName VARCHAR(MAX),
    SPID_1 INT,
    REQUESTID INT
)

INSERT INTO @AllConnections EXEC sp_who2

Wenn Sie wissen möchten, ob ein anderer Computer auf die Datenbank zugreift:

SELECT * FROM @AllConnections WHERE DBName = ( select DBName from @AllConnections where SPID_1 = @@spid )
and LOGIN+'@'+HostName not in ( select LOGIN+'@'+HostName from @AllConnections where SPID_1 = @@spid )

Wenn Sie wissen möchten, ob irgendeine andere Verbindung offen ist (selbst wenn sie von diesem Computer oder dieser Anwendung kommt), dann verwenden Sie:

SELECT * FROM @AllConnections WHERE DBName = ( select DBName from @AllConnections where SPID_1 = @@spid )
and SPID_1 <> @@spid
Daniel Marschall
ViaThinkSoft Mitbegründer
uses
  ShellAPI;

procedure PerformSoftwareUpdate;
var
  sl: TStringList;
const
  DOWNLOAD_ZIP = 'software_update.zip';
  VBS_SCRIPTNAME = 'software_update.vbs';
begin
  CopyFile('d:\test\TEST - Kopie.zip', PChar(IncludeTrailingPathDelimiter((ExtractFilePath(ParamStr(0))))+DOWNLOAD_ZIP), false); // TODO: Die Datei z.B. von einem Webserver herunterladen

  OwnParameters := '';
  for i := 1 to ParamCount do
  begin
    OwnParameters := OwnParameters + ParamStr(i) + ' ';
  end;
  OwnParameters := Trim(OwnParameters);

  sl := TStringList.Create;
  sl.Add('');
  sl.Add(''' Automatische Programmaktualisierung');
  sl.Add(''' (C) 2022 Daniel Marschall, ViaThinkSoft');
  sl.Add('');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add(''' Konstanten (werden durch das aufrufende Programm gesetzt)');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add('');
  sl.Add('ZipFile="'+IncludeTrailingPathDelimiter((ExtractFilePath(ParamStr(0))))+DOWNLOAD_ZIP+'"');
  sl.Add('ExtractTo="'+IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0)))+'"');
  sl.Add('StartApp="'+ExtractFileName(ParamStr(0))+'"');
  sl.Add('Params="'+OwnParameters+'"');
  sl.Add('');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add(''' Warte etwas (sichergehen, dass das Hauptprogramm geschlossen ist)');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add('');
  sl.Add('WScript.Sleep 1000');
  sl.Add('');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add(''' Nun die Programmdateien entpacken und ggf. überschreiben');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add('');
  sl.Add('Set fso = CreateObject("Scripting.FileSystemObject")');
  sl.Add('''If the extraction location does not exist create it.');
  sl.Add('If NOT fso.FolderExists(ExtractTo) Then');
  sl.Add(' fso.CreateFolder(ExtractTo)');
  sl.Add('End If');
  sl.Add('''Extract the contants of the zip file.');
  sl.Add('set objShell = CreateObject("Shell.Application")');
  sl.Add('set FilesInZip=objShell.NameSpace(ZipFile).items');
  sl.Add('objShell.NameSpace(ExtractTo).CopyHere FilesInZip, 16 ''16=NoOverwriteConfirmation');
  sl.Add('Set fso = Nothing');
  sl.Add('Set objShell = Nothing');
  sl.Add('');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add(''' Programm wieder starten');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add('');
  sl.Add('Set objShell = CreateObject("Shell.Application")');
  sl.Add('objShell.ShellExecute ExtractTo+StartApp, Params, ExtractTo, "open", 1 ''1=normal');
  sl.Add('Set objShell = Nothing');
  sl.Add('');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add(''' Dieses Script und die ZIP-Datei löschen!');
  sl.Add(''' ----------------------------------------------------------');
  sl.Add('');
  sl.Add('Set fso = CreateObject("Scripting.FileSystemObject")');
  sl.Add('fso.DeleteFile(ZipFile)');
  sl.Add('fso.DeleteFile(WScript.ScriptFullName)');
  sl.Add('Set fso = Nothing');
  sl.Add('');
  sl.SaveToFile(VBS_SCRIPTNAME);
  FreeAndNil(sl);
  ShellExecute(handle, 'open', VBS_SCRIPTNAME, '', PChar(ExtractFilePath(ParamStr(0))), SW_NORMAL);
  Application.Terminate; // Wichtig! Wir haben nur 1 Sekunde Zeit für das Beenden.
end;
Daniel Marschall
ViaThinkSoft Mitbegründer