diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..128db63
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,5 @@
+*.o
+*.ppu
+Software/output/*
+Software/src/general/lib
+Software/src/backup
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..35a775e
--- /dev/null
+++ b/README.md
@@ -0,0 +1,6 @@
+usbavrlab-tool
+==============
+
+USB AVR Lab Tool
+
+Software to upload Firmwares to USB AVR Lab
diff --git a/Software/help/avrispdevicemanager.png b/Software/help/avrispdevicemanager.png
new file mode 100755
index 0000000..483621e
Binary files /dev/null and b/Software/help/avrispdevicemanager.png differ
diff --git a/Software/help/avrispfound.png b/Software/help/avrispfound.png
new file mode 100755
index 0000000..80fc8aa
Binary files /dev/null and b/Software/help/avrispfound.png differ
diff --git a/Software/help/avrstudio1.png b/Software/help/avrstudio1.png
new file mode 100755
index 0000000..b80c6eb
Binary files /dev/null and b/Software/help/avrstudio1.png differ
diff --git a/Software/help/avrstudio2.png b/Software/help/avrstudio2.png
new file mode 100755
index 0000000..7b0d66e
Binary files /dev/null and b/Software/help/avrstudio2.png differ
diff --git a/Software/help/avrstudio5.png b/Software/help/avrstudio5.png
new file mode 100755
index 0000000..3bb880f
Binary files /dev/null and b/Software/help/avrstudio5.png differ
diff --git a/Software/help/i2clogger.png b/Software/help/i2clogger.png
new file mode 100755
index 0000000..9363a0f
Binary files /dev/null and b/Software/help/i2clogger.png differ
diff --git a/Software/help/i2clogger2.png b/Software/help/i2clogger2.png
new file mode 100755
index 0000000..f797f96
Binary files /dev/null and b/Software/help/i2clogger2.png differ
diff --git a/Software/help/i2clogger3.png b/Software/help/i2clogger3.png
new file mode 100755
index 0000000..4ec8a6a
Binary files /dev/null and b/Software/help/i2clogger3.png differ
diff --git a/Software/help/oszinew1.jpg b/Software/help/oszinew1.jpg
new file mode 100755
index 0000000..fe91dc2
Binary files /dev/null and b/Software/help/oszinew1.jpg differ
diff --git a/Software/help/programmer_b.jpg b/Software/help/programmer_b.jpg
new file mode 100755
index 0000000..227a556
Binary files /dev/null and b/Software/help/programmer_b.jpg differ
diff --git a/Software/help/regedit.png b/Software/help/regedit.png
new file mode 100755
index 0000000..80217cb
Binary files /dev/null and b/Software/help/regedit.png differ
diff --git a/Software/help/regedit_stk500.png b/Software/help/regedit_stk500.png
new file mode 100755
index 0000000..f27ee79
Binary files /dev/null and b/Software/help/regedit_stk500.png differ
diff --git a/Software/help/setuplibusb_1bild.jpg b/Software/help/setuplibusb_1bild.jpg
new file mode 100755
index 0000000..927848a
Binary files /dev/null and b/Software/help/setuplibusb_1bild.jpg differ
diff --git a/Software/help/setuplibusb_3bild.jpg b/Software/help/setuplibusb_3bild.jpg
new file mode 100755
index 0000000..daef964
Binary files /dev/null and b/Software/help/setuplibusb_3bild.jpg differ
diff --git a/Software/help/usbavr-isp-firmwaresavrispmkiide.html b/Software/help/usbavr-isp-firmwaresavrispmkiide.html
new file mode 100755
index 0000000..b9a6713
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresavrispmkiide.html
@@ -0,0 +1,2 @@
+USBAVR-ISP-FirmwaresAVRISPmkIIde.txtStatus: fertig
Mit dem AVRISPmkII-Programmer k?nnen Sie direkt aus dem AVR-Studio heraus programmieren. Er nutzt die originale Atmel-Integration im AVR-Studio, keine Zusatzprogramme wie AVRProg oder ?hnliches.
Funktionen
- AVRISPmkII kompatibel (direkt aus AVR-Studio benutzbar)
- Alle AVR?s die ?ber ISP programmierbar sind unterst?tzt
- Gesamter Betriebsspannungsbereich (2,7-5,5V) programmierbar
- Target-Status wird mit LEDs angezeigt (nicht angeschlossen, falsch angeschlossen, korrekt angeschlossen)
- 1 khz - 3 Mhz ISP Frequenz
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.Pinbelegung
MOSI = Pin 1 der 10-poligen Schnittstelle
VCC = Pin 2 der 10-poligen Schnittstelle
RESET = Pin 5 der 10-poligen Schnittstelle
SCK = Pin 7 der 10-poligen Schnittstelle
GND = Pin 8 oder 10 der 10-poligen Schnittstelle
MISO = Pin 9 der 10-poligen Schnittstelle
Benutzung
AVR Studio
Der ISP meldet sich mit dem Jungo-Treiber des AVR-Studios (muss bei der Installation des AVR-Studios mit aktiviert sein) bei Windows XP an.
W?hlen Sie aus dem Men? Tools im AVR-Studio -> Program AVR -> Connect.
Oder den Button 
.
Nachfolgend w?hlen Sie "AVRISPmkII" und USB.
Sollten Sie Probleme beim Flashen einzelner Controller haben, schicken Sie mir bitte ein Log. Eine Anleitung zum Erstellen eines solchen finden Sie hierBascom
Um den Programmer in Bascom nutzen zu k?nnen, muss das AVR-Studio incl. USB-Treiber (!) installiert sein.
Danach muss ein Treiber als Bridge zwischen dem AVR-ISP-mkII-Treiber und Bascom installiert werden. Diesen finden Sie unter dem Namen setuplibusb.exe im Bascom-Ordner.
Danach k?nnen Sie in Bascom den Programmer in Optionen als Elektor Programmer/AVRISPmkII ausw?hlen.
avrdude
Unter Windows muss zur Benutzung eines AVRISPmkII ein LibUSB-basierter Treiber installiert sein. Diesen finden Sie in der WinAVR-Installation im Verzeichnis "utils\libusb\bin".Deinstallieren Sie ggf. vorher den Jungo-Treiber, der vom AVRiStudio (mit)installiert wurde.
Anzeigeelemente
- gr?n-rote-Dual-LED: Sie zeigt den Status der Zielhardware an.
- aus: keine Zielhardware angeschlossen
- gr?n: Zielhardware richtig angeschlossen (wenn Jumper zur Targetversorgung gesetzt ist, leuchtet sie dauern gr?n)
- rot blinkend: Zielhardware falsch angeschlossen
- rot: Programmiervorgang l?uft
- blaue LED: Sie zeigt die PC-Verbindung an.
- dauernd aus: keine Verbindung
- an: Verbindung, aber kein Datentransfer
- sporadisch ausgehend: LED ist w?hrend des Datentransfers aus.
FAQ
Ich kann den Programmer mit der AVRISPmkII-Firmware nicht mehr in den Bootmodus versetzen.
Installieren Sie hierzu bitte bei der Installation des USB AVR Lab Tools den Filtertreiber mit.Achtung! Dieser kann durch Fehler im Windows-USB-Stack zu Problemen
+
mit anderen USB-Ger?ten f?hren, kann aber einfach wieder deinstalliert werden.Wenn dies nicht funktioniert, k?nnen Sie den Treiber von LibUSb-Win32 Filter Treiber installieren.
Betriebsysteme
MaxOS(X)
Linux
Windows XP
Windows XP 64
Windows Server 2008
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresavrstudiologs.html b/Software/help/usbavr-isp-firmwaresavrstudiologs.html
new file mode 100755
index 0000000..f2869bc
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresavrstudiologs.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresAVRStudioLogs.txtSollten bestimmte Controller sich nicht flaschen lassen oder die Verifizierung fehlschlagen,F?hren Sie bitte folgende Schritte aus und senden mir den resultierenden Log.
- 1. ?ffnen Sie den Registrierungseditor in dem Sie "regedit" ausf?hren.
- 2. Gehen Sie zum Pfad: HKEY_CURRENT_USER\Software\Atmel\AVRTools\STK500\
- 3. Erstellen Sie eine neue Zeichenkette (Rechte Maustaste > Neu > Zeichenkette) Namens ?LogFilePath?
- 4. Geben Sie den kompletten Pfad zu Ihrem LogFile ein z.b. "c:\STK500Com.txt" (Rechts-klick "LogFilePath" > ?ndern...
Nun sollte es so aussehen:
Programmieren Sie nun den Controller der fehlschl?gt, schliessen Sie das AVR-Studio und senden Sie mir den Log.
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresbitbangingde.html b/Software/help/usbavr-isp-firmwaresbitbangingde.html
new file mode 100755
index 0000000..e9b34e9
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresbitbangingde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresBitbangingde.txtStatus: fertig
Mit dieser Firmware k?nnen Sie 6 Leitungen des 10-poligen Steckers als vom PC schaltbare Pins benutzen. Als PC-Software kommt AVR-ISP Tool zum Einatz. Sie k?nnen die Bitbanging-Firmware auch aus eigenen Applikationen benutzen. Dazu steht eine passende DLL zur Verf?gung.
Download
DLL und Beschreibung, um die Bitbanging Firmware in eigenen Applikationen zu benutzen
Die Firmware ist im AVR USB-Lab Tool enthalten.Pinbelegung
Bit 1 = Pin 1 der 10-poligen Schnittstelle
Bit 2 = Pin 5 der 10-poligen Schnittstelle
Bit 3 = Pin 7 der 10-poligen Schnittstelle
Bit 4 = Pin 9 der 10-poligen Schnittstelle
Bit 5 = Pin 4 der 10-poligen Schnittstelle
Bit 6 = Pin 6 der 10-poligen Schnittstelle
Anzeigeelemente
- blaue LED: Sie zeigt die PC-Verbindung an
Betriebsysteme
Windows 98
Windows 2000
Windows XP
Windows Server 2008
Windows Vista
Windows 7
Linux
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresdefectfirmwarede.html b/Software/help/usbavr-isp-firmwaresdefectfirmwarede.html
new file mode 100755
index 0000000..015399d
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresdefectfirmwarede.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresDefectfirmwarede.txtEin angeschlossenes Ger?t (Dies muss nicht zwingend ein USB AVR Lab sein)
funktioniert nicht richtig, m?glicherweise haben Sie den Quarz noch nichtauf das USB AVR Lab gel?tet?
Wenn das USB AVR Lab in Ordnung sein sollte, k?nnen Sie es mit dem Pinzettentrick wie er auch in der Produktinformation beschrieben ist in den Bootmodus zwingen.
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresi2c_interfacede.html b/Software/help/usbavr-isp-firmwaresi2c_interfacede.html
new file mode 100755
index 0000000..88d7d99
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresi2c_interfacede.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresI2C_Interfacede.txtStatus: in Entwicklung
Mit dieser Firmware k?nnen Sie auf I2C Ger?te zugreifen. Unter Linux ist seit Kernel 2.6.22 bereits ein Treiber intigriert.Unter Windows wird der Treiber der LibUSB-Win32 benutzt.
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.Es wird in k?rze eine Bibliothek zum ansprechen der Firmware aus eigenen Programmen folgen.
Pinbelegung
SDA = Pin 1 der 10-poligen Schnittstelle
SCL = Pin 5 der 10-poligen Schnittstelle
GND = Pin 10 der 10-poligen Schnittstelle
Anzeigeelemente
- blaue LED: Sie zeigt die PC-Verbindung an
Betriebsysteme
Windows 98
Windows 2000
Windows XP
Windows Server 2008
Windows Vista
Windows 7
Linux
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresi2c_loggerde.html b/Software/help/usbavr-isp-firmwaresi2c_loggerde.html
new file mode 100755
index 0000000..dab3c22
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresi2c_loggerde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresI2C_Loggerde.txtStatus: fertig
Der I2C-Logger kann I2C-Signale bis 200 kHz mitschneiden und I2C-Daten mit 100 kHz senden. Als P- Software kommt hier das AVR-ISP-Tool zum Einsatz.
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.Pinbelegung
SCL = Pin 5 der 10-poligen Schnittstelle
SDA = Pin 1 der 10-poligen Schnittstelle
Benutzung
Zeichen:
- s kennzeichnet eine Startbedingung
- p kennzeichnet eine Stoppbedingung
- n kennzeichnet ein NACK
- a kennzeichnet ein ACK
Alle Datenbytes werden hexadezimal 2-stellig dargestellt.
Screenshots
Anzeigeelemente
- blaue LED: Sie zeigt die PC-Verbindung an
Betriebsysteme
Windows 98
Windows 2000
Windows XP
Windows Server 2008
Windows Vista
Windows 7
Linux
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresjtagde.html b/Software/help/usbavr-isp-firmwaresjtagde.html
new file mode 100755
index 0000000..397f9ea
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresjtagde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresJtagde.txtStatus: fertig
Die JTAG Firmware kann je nach Software als Boundary Scan Interface, Debugger oder Flash-Firmware benutzt werden.
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.
Die PC Software Boundary Scan Tool finden Sie ebenfalls im DownloadbereichPinbelegung
TDO = 1
TRST = 3
TMS = 5
SCK = 7
TDI = 9
GND = 10
Benutzung
Schlie?en Sie ein JTAG-f?higes IC an das Lab an. Im Boundary Scan Tool wird dieses nun angezeigt und Sie k?nnen damit arbeiten.
Screenshots
Betriebsysteme
Windows 98
Windows 2000
Windows XP
Windows Server 2008
Windows Vista
Windows 7
Linux
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresjtagicemkiide.html b/Software/help/usbavr-isp-firmwaresjtagicemkiide.html
new file mode 100755
index 0000000..2b267f8
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresjtagicemkiide.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresJTAGICEmkIIde.txtStatus: fertig
Mit dem JTAGICEmkII-Programmer k?nnen Sie direkt aus dem AVR-Studio heraus programmieren. Die Firmware erm?glicht es, AVR- Controller ?ber JTAG zu programmieren.
Funktionen
- JTAGICEmkII-kompatibel (direkt aus AVR-Studio benutzbar)
- programmieren von allen JTAG-f?higen Tiny und Mega AVR-Controllern (auch zuk?nftigen) (derzeit aber keine XMega)
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.Pinbelegung
TDO = Pin 1 der 10-poligen Schnittstelle (muss an TDI vom Controller angeschlossen werden)
VCC = Pin 2 der 10-poligen Schnittstelle
TRST = Pin 3 der 10-poligen Schnittstelle
TMS = Pin 5 der 10-poligen Schnittstelle
SCK = Pin 7 der 10-poligen Schnittstelle
GND = Pin 8 oder 10 der 10-poligen Schnittstelle
TDI = Pin 9 der 10-poligen Schnittstelle (muss an TDO vom Controller angeschlossen werden)
Benutzung
AVR Studio
Der ISP meldet sich mit dem Jungo-Treiber des AVR-Studios (muss bei der Installation des AVR-Studios mit aktiviert sein) bei Windows XP an.
W?hlen Sie aus dem Men? Tools im AVR-Studio -> Program AVR -> Connect.
Oder den Button .
Nachfolgend w?hlen Sie "JTAGICEmkII" und USB.
FAQ
Ich bekomme weder mit dem AVR-Studio noch mit dem Boundary Scan Tool eine Verbindung zum Controller
Achten Sie darauf, dass TDI vom Controller an TDO vom Lab und TDO vom Controller an TDI vom Lab angeschlossen ist. Mit JTAG kann eine Kette gebildet werden. Es k?nnen also mehrere JTAG-f?hige ICs in einer Kette angeordnet werden (TDI vom vorhergehenden Ger?t an TDO vom nachfolgenden und umgedreht).Betriebsysteme
MaxOS(X)
Linux
Windows XP
Windows XP 64
Windows Server 2008
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresnodriverde.html b/Software/help/usbavr-isp-firmwaresnodriverde.html
new file mode 100755
index 0000000..56f55a3
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresnodriverde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresNoDriverde.txtEs wurde ein USB AVR Lab gefunden, jedoch kann das USB AVR Lab Tool nicht darauf zugreifen.
- Installieren Sie den Treiber, falls Sie das noch nicht getan haben. (nur Windows)
- Pr?fen Sie ob Sie den richtigen Treiber installiert haben (aus dem Verzeichnis \driver\ in Ihrer USB AVR Lab Tool Installation) (nur Windows)
- Signieren Sie die Treiber mit einer Testsignatur unter Windows 7 64 Bit/Vista 64 Bit (Siehe hier)
- Pr?fen Sie ob im Ger?temanager der Treiber mit Fehlern angezeigt wird. (nur Windows)
- Pr?fen Sie ob Sie ausreichende Zugriffsrechte auf USB Ger?te haben (Linux/MacOS(X))
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresnofirmwarede.html b/Software/help/usbavr-isp-firmwaresnofirmwarede.html
new file mode 100755
index 0000000..2464448
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresnofirmwarede.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresNofirmwarede.txt
Es scheint kein USB AVR Lab angeschlossen zu sein.
Sollten Sie ein USB AVR Lab angeschlossen haben,
- ist eine Firmware installiert, die sich nicht finden lässt (AVRISPmkII ohne installierten LibUSB-Filter-Treiber oder JTAGICEmkII)
- oder es liegt ein Defekt ihres USB-Ports
- oder des USB AVR Labs vor.
diff --git a/Software/help/usbavr-isp-firmwaresopenocdde.html b/Software/help/usbavr-isp-firmwaresopenocdde.html
new file mode 100755
index 0000000..cab869e
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresopenocdde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresOpenOCDde.txtStatus: in Entwicklung
Mit dieser Firmware k?nnen Sie mit dem USB AVR Lab Tool ?ber OpenOCD Controller ?ber JTAG Flashen/debuggen. Erstellt von Cahya Wirawan.
Download
Die Firmware ist im AVR USB-Lab Tool enthalten (ab V5.06).
Vorcompilierte OpenOCD Version 0.4.0 f?r Windows
Vorcompilierte OpenOCD Version f?r Windows
Quellen: http://code.google.com/p/usbvlab-jtag/
Pinbelegung
Anzeigeelemente
Betriebsysteme
Alle
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresoszide.html b/Software/help/usbavr-isp-firmwaresoszide.html
new file mode 100755
index 0000000..eaef17a
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresoszide.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresOszide.txtStatus: fertig
Die Oszilloskop-Firmware macht aus dem AVR USB Lab ein einfaches Oszilloskop.Zusammen mit einer PC-Software kann man damit Spannungen messen und Signalverl?ufe aufzeichnen.
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.
Die PC Software finden Sie ebenfalls im Downloadbereich
Produktinformation
Pinbelegung
Messpin = Pin 2 der 10-poligen Schnittstelle (Jumper darf nicht gesteckt sein !!!)
GND = Pin 8 oder 10 der 10-poligen Schnittstelle
Benutzung
Verbinden Sie so viele AVR USB Labs, wie Sie Kan?le haben m?chten, mit Ihrem PC. Auf allen muss die Oszilloskop-Firmware geladen sein. Im AVR-USB-Oszi-Tool sehen Sie nun alle Kan?le und k?nnen f?r diese die entsprechenden Einstellungen vornehmen.
Hardware
Es gibt einen Hardwarevorsatz f?r das USB AVR Lab, der das Lab gegen zu hohe / zu niedrige Spannungen sch?tzt. An seine BNC-Buchse kann man einen handels?blichen Tastkopf anschlie?en. Eine erweiterte Messleiterplatte f?r schnellere Messungen ist in Planung.Alternativ k?nnen Sie die Pins auch direkt mit Ihrem Messeingang verbinden, dann allerdings nur bis 10V messen.Achtung: Ohne Vorsatz k?nnen h?here Eingangsspannungen das Lab zerst?ren.
Software
Die Oszilloskop-Software auf dem PC erkennt automatisch alle angeschlossenen Labs und stellt jedes einzelne als Kanal dar. So k?nnen Sie aus Ihrem AVR USB Lab ganz einfach ein 1,2,3,4,5,6-Strahl-Oszilloskop machen.
Screenshots
Betriebsysteme
Windows 98
Windows 2000
Windows XP
Windows Server 2008
Windows Vista
Windows 7
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresserialfirmwarede.html b/Software/help/usbavr-isp-firmwaresserialfirmwarede.html
new file mode 100755
index 0000000..0760a62
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresserialfirmwarede.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresSerialfirmwarede.txt
Ein Ger?t mit einer Firmware die einen Virtuellen Com Port erstellt ist angeschlossen.
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaressk500v2de.html b/Software/help/usbavr-isp-firmwaressk500v2de.html
new file mode 100755
index 0000000..cc52ba8
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaressk500v2de.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresSK500v2de.txt- redirect USBAVR-ISP-Firmwares/STK500v2/de
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresspi-uartde.html b/Software/help/usbavr-isp-firmwaresspi-uartde.html
new file mode 100755
index 0000000..e0af8c0
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresspi-uartde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresSPI-Uartde.txtStatus: fertig
Diese Firmware kann als SPI-Logger verwendet werden. Sie erstellt einen virtuellen COM-Port. Sie k?nnen ?ber ein beliebiges Terminalprogramm die Daten ?ber die SPI-Schnittstelle anzeigen.
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.Installation
Nachdem das Lab angesteckt wurde, fragt Windows nach einem Treiber. Diesen bringt es selbst mit, allerdings muss mittgeteilt werden, welcher Treiber zu diesem Ger?t geh?rt. Das macht man mit einer INF Datei, die hier heruntergeladen werden kann (enthalten im USB AVR Lab Tool).
W?hlen Sie "Software von einer Liste oder bestimmten Quelle installieren.
W?hlen Sie im n?chsten Dialog das Verzeichnis, in dem Sie die .inf gespeichert haben.
Wenn Sie nun den Anweisungen folgen, sollte nach Abschluss des Assistenten im Ger?temanager ein zus?tzlicher COM-Port zu finden sein.
Nun ist der Wandler bereit.Anzeigeelemente
- blaue LED: Sie zeigt die PC-Verbindung an
Betriebsysteme
Windows XP
Windows XP 64
Windows Server 2008
Windows Vista 32bit
Windows 7 32bit
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresspi-usb-uartbridgede.html b/Software/help/usbavr-isp-firmwaresspi-usb-uartbridgede.html
new file mode 100755
index 0000000..2d5ceb4
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresspi-usb-uartbridgede.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresSPI-USB-UARTBridgede.txt- REDIRECT USBAVR-ISP-Firmwares/SPI-Uart/de
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresstandalonede.html b/Software/help/usbavr-isp-firmwaresstandalonede.html
new file mode 100755
index 0000000..99b6f5c
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresstandalonede.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresStandalonede.txtStatus: in Arbeit
?ber eine leicht erweiterte Hardware k?nnen Targets ohne PC programmiert werden. Das Programm und entsprechende Einstellungen werden dazu in einem EEPROM gespeichert. Mit einem Taster wird der Programmiervorgang gestartet.
Hardware
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresstk500v2de.html b/Software/help/usbavr-isp-firmwaresstk500v2de.html
new file mode 100755
index 0000000..26b2bc7
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresstk500v2de.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresSTK500v2de.txtStatus: fertig
Mit dem STK500v2-Protokoll-Programmer k?nnen Sie direkt aus dem AVR-Studio heraus programmieren. Er nutzt die originale Atmel-Integration im AVR-Studio, keine Zusatzprogramme wie AVRProg oder ?hnliches.
Funktionen
- STK500v2-kompatibel (direkt aus AVR-Studio benutzbar)
- Targetstatus wird mit LEDs angezeigt (nicht angeschlossen, falsch angeschlossen, korrekt angeschlossen)
- Alle AVR?s die ?ber ISP programmierbar sind unterst?tzt
- Gesamter Betriebsspannungsbereich (2,7-5,5V) programmierbar
- 1 khz - 3 Mhz ISP Frequenz
- Firmware kompatibel zu USBasp-Hardware
- Firmware kompatibel zu CCCB Programmierger?t-Hardware
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.Pinbelegung
MOSI = Pin 1 der 10-poligen Schnittstelle
VCC = Pin 2 der 10-poligen Schnittstelle
TxD = Pin 4 der 10-poligen Schnittstelle
RESET = Pin 5 der 10-poligen Schnittstelle
RxD = Pin 6 der 10-poligen Schnittstelle
SCK = Pin 7 der 10-poligen Schnittstelle
GND = Pin 8 oder 10 der 10-poligen Schnittstelle
MISO = Pin 9 der 10-poligen Schnittstelle
Benutzung
AVR Studio
Der ISP meldet sich als virtueller Comport unter Windows XP an.
W?hlen Sie aus dem Men? Tools im AVR-Studio -> Program AVR -> Connect.
Oder den Button .
Nachfolgend w?hlen Sie "STK500 or AVRISP" und Auto oder den Com Port, den der USB AVR-ISP angelegt hat, aus.
Nachdem Sie auf OK geklickt haben, erscheint m?glicherweise diese Nachricht:
Sie besagt, dass die Firmwareversion auf dem Programmer nicht mit der vom AVR Studio mitgelieferten ?bereinstimmt. Damit diese Meldung nicht jedesmal beim Verbinden "nervt", kann man mit dem AVR-ISP Tool die Firmwareversion ?ndern, die dem AVR-Studio mitgeteilt wird (Siehe Terminal-Modus).Um diese Meldung zu umgehen, klicken sie auf Abbrechen.
Nun sollte sich dieses Fenster ?ffnen:
Hier haben Sie nun alle Einstellungen und M?glichkeiten, die Sie mit einem AVRISP oder STK500 auch haben. Genaueres entnehmen Sie bitte der AVR-Studio-Hilfe.
Sollten Sie Probleme beim Flashen einzelner Controller haben, schicken Sie mir bitte ein Log. Eine Anleitung zum Erstellen eines solchen finden Sie hier
Problembehebung
Wenn der Programmer nicht gefunden wird, ist m?glicherweise die Nummer des COM-Ports zu hoch. Das AVR-Studio durchsucht nur bis COM9.
Gehen Sie zum Beheben des Problems in den Ger?temanager, klicken Sie doppelt auf den virtuellen COM-Port.
Dann auf Anschlu?einstellungen
->Erweitert
Nun w?hlen Sie unter COM-Anschlussnummer einen freien Anschluss niedriger als COM 9 aus.
Nun sollte das AVR Studio den Programmer finden.
Bascom
W?hlen Sie in Bascom unter Options->Programmer im Feld Programmer STK500.W?hlen Sie unter COM-Port die Nummer der seriellen Schnittstelle, die der Programmer jetzt hat.Suchen Sie unter STK500 EXE die stk500.exe des AVR Studios (Sie findet sich normalerweise in C:\Programme\Atmel\AVR Tools\STK500\stk500.exe
Anzeigeelemente
- gr?n-rote-Dual-LED: Sie zeigt den Status der Zielhardware an.
- aus: keine Zielhardware angeschlossen
- gr?n: Zielhardware richtig angeschlossen (wenn Jumper zur Targetversorgung gesetzt ist leuchtet sie dauernd gr?n)
- rot blinkend: Zielhardware falsch angeschlossen
- rot: Programmiervorgang l?uft
- blaue LED: Sie Zeigt die PC Verbindung an
- dauernd aus: keine Verbindung
- an: Verbindung, aber kein Datentransfer
- sporadisch ausgehend: LED ist w?hrend des Datentransfers aus.
Installation
Nachdem der Programmer angesteckt wurde, fragt Windows nach einem Treiber. Diesen bringt es selbst mit, allerdings muss mittgeteilt werden, welcher Treiber zu diesem Ger?t geh?rt. Das macht man mit einer INF Datei, die hier heruntergeladen werden kann.
W?hlen Sie "Software von einer Liste oder bestimmten Quelle installieren".
W?hlen Sie im n?chsten Dialog das Verzeichnis, in dem Sie die .inf gespeichert haben.
Wenn Sie nun den Anweisungen folgen, sollte nach Abschluss des Assistenten im Ger?temanager ein zus?tzlicher COM-Port zu finden sein.
Nun ist der Programmer bereit.
ISP Frequenzen
Da der USBAVRISP mit einem 12 Mhz Quarz arbeitet, werden die STK500-Frequenzen folgenderma?en umgesetzt:
| STK500 Frequenz | USB AVR-ISP Frequenz |
| 1,8432 Mhz | 1,5 Mhz |
| 460,8 khz | 375 khz |
| 115,2 khz | 93,75 khz |
| 57,6 khz und kleiner | 1 khz |
Betriebsysteme
Windows XP
Windows XP 64
Windows Server 2008
Windows Vista 32bit
Windows 7 32bit
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwarestaktde.html b/Software/help/usbavr-isp-firmwarestaktde.html
new file mode 100755
index 0000000..1a11a4a
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwarestaktde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresTaktde.txtStatus: fertig
Mit dieser Firmware kann man einen Takt an USIG1 erzeugen, um verfuste AVR Controller wiederzubeleben.
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.Pinbelegung
Takt = Pin 3 der 10-poligen Schnittstelle
GND = Pin 8 oder 10 der 10-poligen Schnittstelle
Anzeigeelemente
- blaue LED: Sie zeigt die PC-Verbindung an
Betriebsysteme
ben?tigt kein Betriebsystem
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwarestranceiverde.html b/Software/help/usbavr-isp-firmwarestranceiverde.html
new file mode 100755
index 0000000..6c75f24
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwarestranceiverde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresTranceiverde.txtHardware
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresuartde.html b/Software/help/usbavr-isp-firmwaresuartde.html
new file mode 100755
index 0000000..6524f60
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresuartde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresUartde.txtStatus: fertig
?ber eine Adapterplatine mit RS232- oder RS485-Wandler k?nnen die entsprechenden Busse direkt ?ber einen virtuellen Com-Port angesprochen werden, den die Firmware bereitstellt.
Pinbelegung
RxD = Pin 6 der 10-poligen Schnittstelle
TxD = Pin 4 der 10-poligen Schnittstelle
GND = Pin 10 der 10-poligen Schnittstelle
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.Installation
Nachdem das Lab angesteckt wurde, fragt Windows nach einem Treiber. Diesen bringt es selbst mit, allerdings muss mitgeteilt werden, welcher Treiber zu diesem Ger?t geh?rt. Das macht man mit einer INF Datei, die hier heruntergeladen werden kann (enthalten im USB AVR Lab Tool).
W?hlen Sie "Software von einer Liste oder bestimmten Quelle installieren.
W?hlen Sie im n?chsten Dialog das Verzeichnis, in dem Sie die .inf gespeichert haben.
Wenn Sie nun den Anweisungen folgen, sollte nach Abschluss des Assistenten im Ger?temanager ein zus?tzlicher COM-Port zu finden sein.
Nun ist der Wandler bereit.Anzeigeelemente
- blaue LED: Sie zeigt die PC-Verbindung an
Betriebsysteme
Windows XP
Windows XP 64
Windows Server 2008
Windows Vista 32bit
Windows 7 32bit
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresusbaspde.html b/Software/help/usbavr-isp-firmwaresusbaspde.html
new file mode 100755
index 0000000..c4b4200
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresusbaspde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresUSBaspde.txtStatus: fertig
Mit dieser Firmware k?nnen Sie ?ber avrdude auf allen Plattformen flashen.
Download
Die Firmware ist im AVR USB-Lab Tool enthalten.Pinbelegung
MOSI = Pin 1 der 10-poligen Schnittstelle
VCC = Pin 2 der 10-poligen Schnittstelle
TxD = Pin 4 der 10-poligen Schnittstelle
RESET = Pin 5 der 10-poligen Schnittstelle
RxD = Pin 6 der 10-poligen Schnittstelle
SCK = Pin 7 der 10-poligen Schnittstelle
GND = Pin 8 oder 10 der 10-poligen Schnittstelle
MISO = Pin 9 der 10-poligen Schnittstelle
Betriebsysteme
Windows 98
Windows 2000
Windows XP
Windows Server 2008
Windows Vista
Windows 7
Linux
MacOS(X)
\ No newline at end of file
diff --git a/Software/help/usbavr-isp-firmwaresuserde.html b/Software/help/usbavr-isp-firmwaresuserde.html
new file mode 100755
index 0000000..aa01858
--- /dev/null
+++ b/Software/help/usbavr-isp-firmwaresuserde.html
@@ -0,0 +1 @@
+USBAVR-ISP-FirmwaresUserde.txtStatus: fertig
Mit dem AVR-Studio-Projekt benutzerdefinierte Firmware k?nnen Sie das AVR USB Lab als Experimentierboard benutzen. Es k?nnen alle LEDs und Pins auf der 10-poligen Stiftleiste frei genutzt werden. Die von Ihnen compilierte Firmware kann einfach ?ber den Bootloader in das Lab eingespielt und ausgetauscht werden. So k?nnen Sie mit 3 Klicks die Firmware tauschen und werden bei der Entwicklung nicht gest?rt. Es sind ca 4,5 kb Flash frei verf?gbar.Die Benutzerfirmware kann wunderbar mit der AVR Tutorialreihe genutzt werden
Download
AVR Studio Projekt benutzerdefinierte Firmware
Betriebsysteme
Alle
\ No newline at end of file
diff --git a/Software/help/usbavrlaboszi.jpg b/Software/help/usbavrlaboszi.jpg
new file mode 100755
index 0000000..eeadf33
Binary files /dev/null and b/Software/help/usbavrlaboszi.jpg differ
diff --git a/Software/help/usbavrlabpinzette.png b/Software/help/usbavrlabpinzette.png
new file mode 100755
index 0000000..45deeda
Binary files /dev/null and b/Software/help/usbavrlabpinzette.png differ
diff --git a/Software/help/usbavrlabserial.png b/Software/help/usbavrlabserial.png
new file mode 100755
index 0000000..c19de78
Binary files /dev/null and b/Software/help/usbavrlabserial.png differ
diff --git a/Software/help/usbavrlabstandalone.jpg b/Software/help/usbavrlabstandalone.jpg
new file mode 100755
index 0000000..6ad0401
Binary files /dev/null and b/Software/help/usbavrlabstandalone.jpg differ
diff --git a/Software/help/usbavrlabtranceiver.jpg b/Software/help/usbavrlabtranceiver.jpg
new file mode 100755
index 0000000..83e63e2
Binary files /dev/null and b/Software/help/usbavrlabtranceiver.jpg differ
diff --git a/Software/help/usbavrlabusbconn1.png b/Software/help/usbavrlabusbconn1.png
new file mode 100755
index 0000000..131d751
Binary files /dev/null and b/Software/help/usbavrlabusbconn1.png differ
diff --git a/Software/help/usbavrlabwithoutcrystal.png b/Software/help/usbavrlabwithoutcrystal.png
new file mode 100755
index 0000000..ca2a1ae
Binary files /dev/null and b/Software/help/usbavrlabwithoutcrystal.png differ
diff --git a/Software/setup/i386-linux/build_all.sh b/Software/setup/i386-linux/build_all.sh
index 8e501fa..f27e15d 100644
Binary files a/Software/setup/i386-linux/build_all.sh and b/Software/setup/i386-linux/build_all.sh differ
diff --git a/Software/setup/x86_64-linux/build.sh b/Software/setup/x86_64-linux/build.sh
new file mode 100755
index 0000000..6ced18c
--- /dev/null
+++ b/Software/setup/x86_64-linux/build.sh
@@ -0,0 +1,74 @@
+#!/bin/bash
+Program=usbavrlabtool
+Widgetset=$1
+if [ "x$Widgetset" = "x" ]; then
+ Widgetset=gtk2
+fi
+Arch=$(fpc -v | grep 'Compiler version' | sed 's/.*for \([^ ]\+\)$/\1/')
+DebianArch=`dpkg --print-architecture`
+#'
+Year=`date +%y`
+Month=`date +%m`
+Day=`date +%d`
+Date=20$Year$Month$Day
+TmpDir=/tmp
+BuildDir=$TmpDir/software_build
+Version=$(sed 's/\x0D$//' ../../src/version.inc).$(sed 's/\x0D$//' ../../src/revision.inc)
+echo "Build directory is $BuildDir"
+if [ x$BuildDir = x/ ]; then
+ echo "ERROR: invalid build directory"
+ exit
+fi
+rm -rf $BuildDir/*
+echo "building general"
+lazbuild ../../src/general/general.lpk
+echo "building hexencode"
+lazbuild ../../src/hexencode.lpr
+echo "building usbavrlab"
+lazbuild ../../src/usbavrlabtool.lpr
+
+echo "creating control file..."
+mkdir -p $BuildDir/DEBIAN
+cat debian/control.control | \
+ sed -e "s/VERSION/$Version/g" \
+ -e "s/ARCH/$DebianArch/g" \
+ > $BuildDir/DEBIAN/control
+echo "copyright and changelog files..."
+mkdir -p $BuildDir/usr/share/doc/$Program
+cp debian/changelog.Debian $BuildDir/usr/share/doc/$Programm
+cp ../../src/changes.txt $BuildDir/usr/share/doc/$Program/changelog
+echo "creating installation..."
+mkdir -p $BuildDir/usr/share/pixmaps/
+mkdir -p $BuildDir/usr/share/applications
+mkdir -p $BuildDir/usr/bin/
+mkdir -p $BuildDir/usr/share/$Program
+mkdir -p $BuildDir/usr/share/$Program/languages
+mkdir -p $BuildDir/usr/share/$Program/data
+#mkdir -p $BuildDir/usr/share/$Program/progdata
+mkdir -p $BuildDir/usr/share/$Program/help
+mkdir -p $BuildDir/etc/udev/rules.d
+install -m 644 general/icon.png $BuildDir/usr/share/pixmaps/$Program.png
+#install -m 644 general/progicon.png $BuildDir/usr/share/pixmaps/usbavrlabavrprogrammer.png
+install -m 644 general/$Program.desktop $BuildDir/usr/share/applications/$Program.desktop
+#install -m 644 general/usbavrlabavrprogrammer.desktop $BuildDir/usr/share/applications/usbavrlabavrprogrammer.desktop
+sh copy_to_builddir.sh $Arch $BuildDir/usr/share/$Program
+#strip --strip-all $BuildDir/usr/share/$Program/$Program
+cp general/$Program.starter $BuildDir/usr/share/$Program/
+chmod 755 $BuildDir/usr/share/$Program/$Program.starter
+#cp general/usbavrlabavrprogrammer.starter $BuildDir/usr/share/$Program/
+#chmod 755 $BuildDir/usr/share/$Program/usbavrlabavrprogrammer.starter
+cp general/15-usbavrlab-udev.rules $BuildDir/etc/udev/rules.d
+ln -s /usr/share/$Program/$Program.starter $BuildDir/usr/bin/$Program
+#ln -s /usr/share/$Program/usbavrlabavrprogrammer.starter $BuildDir/usr/bin/usbavrlabavrprogrammer
+ln -s /usr/share/$Program/usbavrlabavrprogrammer.starter $BuildDir/usr/bin/avrprogrammer
+#cp -r ../../data/* $BuildDir/usr/share/$Program/data
+cp -r ../../help/* $BuildDir/usr/share/$Program/help
+$TmpDir/hexencode --input=../../data --output=$BuildDir/usr/share/$Program/data
+cp ../../languages/*.po $BuildDir/usr/share/$Program/languages
+cp ../../languages/*.txt $BuildDir/usr/share/$Program/languages
+#cp ../../progdata/*.xml $BuildDir/usr/share/$Program/progdata
+echo "building package..."
+dpkg-deb --build $BuildDir
+cp $TmpDir/software_build.deb ../../output/${Program}_${Version}_${Arch}-$Widgetset.deb
+echo "cleaning up..."
+rm -r $BuildDir
diff --git a/Software/setup/x86_64-linux/build_all.sh b/Software/setup/x86_64-linux/build_all.sh
new file mode 100644
index 0000000..f27e15d
--- /dev/null
+++ b/Software/setup/x86_64-linux/build_all.sh
@@ -0,0 +1,66 @@
+#!/bin/bash
+Program=usbavrlabtool
+Widgetset=$1
+if [ "x$Widgetset" = "x" ]; then
+ Widgetset=gtk2
+fi
+Arch=$(fpc -v | grep 'Compiler version' | sed 's/.*for \([^ ]\+\)$/\1/')
+#'
+Year=`date +%y`
+Month=`date +%m`
+Day=`date +%d`
+Date=20$Year$Month$Day
+TmpDir=/tmp
+BuildDir=$TmpDir/software_build
+Version=$(sed 's/\x0D$//' ../../src/version.inc).$(sed 's/\x0D$//' ../../src/revision.inc)
+echo "Build directory is $BuildDir"
+if [ x$BuildDir = x/ ]; then
+ echo "ERROR: invalid build directory"
+ exit
+fi
+rm -rf $BuildDir
+echo "creating control file..."
+mkdir -p $BuildDir/DEBIAN
+cat debian/control.control | \
+ sed -e "s/VERSION/$Version/g" \
+ -e "s/ARCH/$Arch/g" \
+ > $BuildDir/DEBIAN/control
+echo "copyright and changelog files..."
+mkdir -p $BuildDir/usr/share/doc/$Program
+cp debian/changelog.Debian $BuildDir/usr/share/doc/$Programm
+cp ../../src/changes.txt $BuildDir/usr/share/doc/$Program/changelog
+echo "creating installation..."
+mkdir -p $BuildDir/usr/share/pixmaps/
+mkdir -p $BuildDir/usr/share/applications
+mkdir -p $BuildDir/usr/bin/
+mkdir -p $BuildDir/usr/share/$Program
+mkdir -p $BuildDir/usr/share/$Program/languages
+mkdir -p $BuildDir/usr/share/$Program/data
+#mkdir -p $BuildDir/usr/share/$Program/progdata
+mkdir -p $BuildDir/usr/share/$Program/help
+mkdir -p $BuildDir/etc/udev/rules.d
+install -m 644 general/icon.png $BuildDir/usr/share/pixmaps/$Program.png
+#install -m 644 general/progicon.png $BuildDir/usr/share/pixmaps/usbavrlabavrprogrammer.png
+install -m 644 general/$Program.desktop $BuildDir/usr/share/applications/$Program.desktop
+#install -m 644 general/usbavrlabavrprogrammer.desktop $BuildDir/usr/share/applications/usbavrlabavrprogrammer.desktop
+sh copy_to_builddir.sh $Arch $BuildDir/usr/share/$Program
+#strip --strip-all $BuildDir/usr/share/$Program/$Program
+cp general/$Program.starter $BuildDir/usr/share/$Program/
+chmod 755 $BuildDir/usr/share/$Program/$Program.starter
+#cp general/usbavrlabavrprogrammer.starter $BuildDir/usr/share/$Program/
+#chmod 755 $BuildDir/usr/share/$Program/usbavrlabavrprogrammer.starter
+cp general/46-usbavrlab.rules $BuildDir/etc/udev/rules.d
+ln -s /usr/share/$Program/$Program.starter $BuildDir/usr/bin/$Program
+#ln -s /usr/share/$Program/usbavrlabavrprogrammer.starter $BuildDir/usr/bin/usbavrlabavrprogrammer
+ln -s /usr/share/$Program/usbavrlabavrprogrammer.starter $BuildDir/usr/bin/avrprogrammer
+#cp -r ../../data/* $BuildDir/usr/share/$Program/data
+cp -r ../../help/* $BuildDir/usr/share/$Program/help
+$TmpDir/hexencode --input=../../data --output=$BuildDir/usr/share/$Program/data
+cp ../../languages/*.po $BuildDir/usr/share/$Program/languages
+cp ../../languages/*.txt $BuildDir/usr/share/$Program/languages
+#cp ../../progdata/*.xml $BuildDir/usr/share/$Program/progdata
+echo "building package..."
+dpkg-deb --build $BuildDir
+cp $TmpDir/software_build.deb output/${Program}_${Version}_${Arch}-$Widgetset.deb
+echo "cleaning up..."
+rm -r $BuildDir
diff --git a/Software/setup/x86_64-linux/build_all_executables.sh b/Software/setup/x86_64-linux/build_all_executables.sh
new file mode 100644
index 0000000..831b761
Binary files /dev/null and b/Software/setup/x86_64-linux/build_all_executables.sh differ
diff --git a/Software/setup/x86_64-linux/build_deb.sh b/Software/setup/x86_64-linux/build_deb.sh
new file mode 100644
index 0000000..3fe73db
Binary files /dev/null and b/Software/setup/x86_64-linux/build_deb.sh differ
diff --git a/Software/setup/x86_64-linux/build_rpm.sh b/Software/setup/x86_64-linux/build_rpm.sh
new file mode 100644
index 0000000..f94f6d2
--- /dev/null
+++ b/Software/setup/x86_64-linux/build_rpm.sh
@@ -0,0 +1,7 @@
+#!/bin/bash
+mkdir /tmp/build
+cp output/*.deb /tmp/build
+cd /tmp/build
+sudo alien -r /tmp/build/*.deb
+sudo alien -t /tmp/build/*.deb
+#rm -r $BuildDir
diff --git a/Software/setup/x86_64-linux/copy_to_builddir.sh b/Software/setup/x86_64-linux/copy_to_builddir.sh
new file mode 100644
index 0000000..21ee96a
--- /dev/null
+++ b/Software/setup/x86_64-linux/copy_to_builddir.sh
@@ -0,0 +1,8 @@
+#!/bin/bash
+cp ../../output/$1-linux/usbavrlabtool $2
+chmod 777 $2/usbavrlabtool
+#cp ../../output/$1-linux/usbavrlabavrprogrammer $2
+#chmod 777 $2/usbavrlabavrprogrammer
+#strip --strip-all $2/usbavrlabtool
+cp ../../output/$1-linux/hexencode /tmp
+chmod 777 /tmp/hexencode
diff --git a/Software/setup/x86_64-linux/debian/changelog.Debian b/Software/setup/x86_64-linux/debian/changelog.Debian
new file mode 100644
index 0000000..8ca992c
--- /dev/null
+++ b/Software/setup/x86_64-linux/debian/changelog.Debian
@@ -0,0 +1,3 @@
+Debian maintainer and upstream author are identical.
+Therefore see also normal changelog file for Debian changes.
+
diff --git a/Software/setup/x86_64-linux/debian/control.control b/Software/setup/x86_64-linux/debian/control.control
new file mode 100644
index 0000000..496626e
--- /dev/null
+++ b/Software/setup/x86_64-linux/debian/control.control
@@ -0,0 +1,8 @@
+Source: usbavrlab
+Package: usbavrlab
+Version: VERSION
+Section: office
+Priority: optional
+Maintainer: Christian Ulrich
+Architecture: ARCH
+Description: A Tool to manage USB AVR Lab.
diff --git a/Software/setup/x86_64-linux/general/15-usbavrlab-udev.rules b/Software/setup/x86_64-linux/general/15-usbavrlab-udev.rules
new file mode 100644
index 0000000..601dcd8
--- /dev/null
+++ b/Software/setup/x86_64-linux/general/15-usbavrlab-udev.rules
@@ -0,0 +1,12 @@
+# Atmel AVR-Dragon
+ATTRS{idVendor}=="03eb", ATTRS{idProduct}=="2107", GROUP="plugdev", MODE="0660"
+
+# Atmel AVR ISP mkII
+ATTRS{idVendor}=="03eb", ATTRS{idProduct}=="2104", GROUP="plugdev", MODE="0660"
+
+# usbprog bootloader
+ATTRS{idVendor}=="1781", ATTRS{idProduct}=="0c62", GROUP="plugdev", MODE="0660"
+
+# USBasp programmer
+ATTRS{idVendor}=="16c0", ATTRS{idProduct}=="05dc", GROUP="plugdev", MODE="0660"
+
diff --git a/Software/setup/x86_64-linux/general/icon.png b/Software/setup/x86_64-linux/general/icon.png
new file mode 100644
index 0000000..90a09a8
Binary files /dev/null and b/Software/setup/x86_64-linux/general/icon.png differ
diff --git a/Software/setup/x86_64-linux/general/progicon.png b/Software/setup/x86_64-linux/general/progicon.png
new file mode 100644
index 0000000..198232e
Binary files /dev/null and b/Software/setup/x86_64-linux/general/progicon.png differ
diff --git a/Software/setup/x86_64-linux/general/usbavrlabavrprogrammer.desktop b/Software/setup/x86_64-linux/general/usbavrlabavrprogrammer.desktop
new file mode 100644
index 0000000..0a46280
--- /dev/null
+++ b/Software/setup/x86_64-linux/general/usbavrlabavrprogrammer.desktop
@@ -0,0 +1,11 @@
+[Desktop Entry]
+Version=1.0
+Encoding=UTF-8
+Name=USB AVR Lab Programmer
+Type=Application
+Terminal=false
+Icon[de_DE]=usbavrlabavrprogrammer.png
+Name[de_DE]=USB AVR Lab Programmer
+Exec=usbavrlabavrprogrammer
+Icon=usbavrlabavrprogrammer.png
+GenericName[de_DE]=
diff --git a/Software/setup/x86_64-linux/general/usbavrlabavrprogrammer.starter b/Software/setup/x86_64-linux/general/usbavrlabavrprogrammer.starter
new file mode 100644
index 0000000..c5931ba
--- /dev/null
+++ b/Software/setup/x86_64-linux/general/usbavrlabavrprogrammer.starter
@@ -0,0 +1,2 @@
+#!/bin/sh
+/usr/share/usbavrlabtool/usbavrlabavrprogrammer $*
diff --git a/Software/setup/x86_64-linux/general/usbavrlabtool.desktop b/Software/setup/x86_64-linux/general/usbavrlabtool.desktop
new file mode 100644
index 0000000..8a62cee
--- /dev/null
+++ b/Software/setup/x86_64-linux/general/usbavrlabtool.desktop
@@ -0,0 +1,12 @@
+[Desktop Entry]
+Version=1.0
+Encoding=UTF-8
+Name=USB AVR Lab Tool
+Type=Application
+Categories=Application;IDE;Development;
+Terminal=false
+Icon[de_DE]=usbavrlabtool.png
+Name[de_DE]=USB AVR Lab Tool
+Exec=usbavrlabtool
+Icon=usbavrlabtool.png
+GenericName[de_DE]=
diff --git a/Software/setup/x86_64-linux/general/usbavrlabtool.starter b/Software/setup/x86_64-linux/general/usbavrlabtool.starter
new file mode 100644
index 0000000..182ae71
--- /dev/null
+++ b/Software/setup/x86_64-linux/general/usbavrlabtool.starter
@@ -0,0 +1,2 @@
+#!/bin/sh
+/usr/share/usbavrlabtool/usbavrlabtool $*
diff --git a/Software/setup/x86_64-linux/get_help.sh b/Software/setup/x86_64-linux/get_help.sh
new file mode 100644
index 0000000..030dc9f
--- /dev/null
+++ b/Software/setup/x86_64-linux/get_help.sh
@@ -0,0 +1,6 @@
+#!/bin/bash
+echo "Downloading Wiki Pages\n"
+../../../../../Source/wikihelp/output/i386-linux/wikidownload --allpages="http://wiki.ullihome.de/index.php/Spezial:Alle_Seiten" --exportpage="http://wiki.ullihome.de/index.php/Spezial:Exportieren" --pageoffset="USBAVR-ISP-Firmwares" --output="../../help"
+echo "Converting Wiki Pages\n"
+../../../../../Source/wikihelp/output/i386-linux/wiki2html "../../help"
+
diff --git a/Software/src/general/general.lpk b/Software/src/general/general.lpk
new file mode 100644
index 0000000..74d3ffb
--- /dev/null
+++ b/Software/src/general/general.lpk
@@ -0,0 +1,99 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Software/src/general/general.pas b/Software/src/general/general.pas
new file mode 100644
index 0000000..ff7703c
--- /dev/null
+++ b/Software/src/general/general.pas
@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit general;
+
+interface
+
+uses
+ ubenchmark, ucomport, uError, uExtControls, uInfo, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('uExtControls', @uExtControls.Register);
+end;
+
+initialization
+ RegisterPackage('general', @Register);
+end.
diff --git a/Software/src/general/general_nogui.lpk b/Software/src/general/general_nogui.lpk
new file mode 100644
index 0000000..1dc90ca
--- /dev/null
+++ b/Software/src/general/general_nogui.lpk
@@ -0,0 +1,79 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ <_ExternHelp Items="Count"/>
+
+
+
diff --git a/Software/src/general/general_nogui.pas b/Software/src/general/general_nogui.pas
new file mode 100644
index 0000000..5248f61
--- /dev/null
+++ b/Software/src/general/general_nogui.pas
@@ -0,0 +1,21 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit general_nogui;
+
+interface
+
+uses
+ Utils, uGeneralStrConsts, SecureUtils, ProcessUtils, umashineid,
+ uModifiedDS, uColors, uRTFtoTXT, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+end;
+
+initialization
+ RegisterPackage('general_nogui', @Register);
+end.
diff --git a/Software/src/general/src/Mapi.pas b/Software/src/general/src/Mapi.pas
new file mode 100755
index 0000000..3790380
--- /dev/null
+++ b/Software/src/general/src/Mapi.pas
@@ -0,0 +1,596 @@
+{ *********************************************************************** }
+{ }
+{ Delphi Runtime Library }
+{ }
+{ Copyright (c) 1996-2001 Borland Software Corporation }
+{ }
+{ *********************************************************************** }
+
+{*******************************************************}
+{ Simple MAPI Interface Unit }
+{*******************************************************}
+
+unit Mapi;
+
+{NOTE: Do not place the $NOPACKAGEUNIT directive in this file}
+
+interface
+
+uses Windows;
+
+{
+ Messaging Applications Programming Interface.
+
+ Purpose:
+
+ This file defines the structures and constants used by that
+ subset of the Messaging Applications Programming Interface
+ which is supported under Windows by Microsoft Mail for PC
+ Networks version 3.x.
+}
+
+(*$HPPEMIT '#include '*)
+
+type
+ {$EXTERNALSYM FLAGS}
+ FLAGS = Cardinal;
+ {$EXTERNALSYM LHANDLE}
+ LHANDLE = Cardinal;
+ PLHANDLE = ^Cardinal;
+
+const
+ {$EXTERNALSYM lhSessionNull}
+ lhSessionNull = (0);
+
+type
+ PMapiFileDesc = ^TMapiFileDesc;
+ {$EXTERNALSYM MapiFileDesc}
+ MapiFileDesc = packed record
+ ulReserved: Cardinal; { Reserved for future use (must be 0) }
+ flFlags: Cardinal; { Flags }
+ nPosition: Cardinal; { character in text to be replaced by attachment }
+ lpszPathName: LPSTR; { Full path name of attachment file }
+ lpszFileName: LPSTR; { Original file name (optional) }
+ lpFileType: Pointer; { Attachment file type (can be lpMapiFileTagExt) }
+ end;
+ TMapiFileDesc = MapiFileDesc;
+
+const
+ {$EXTERNALSYM MAPI_OLE}
+ MAPI_OLE = $00000001;
+ {$EXTERNALSYM MAPI_OLE_STATIC}
+ MAPI_OLE_STATIC = $00000002;
+
+
+type
+ PMapiFileTagExt = ^TMapiFileTagExt;
+ {$EXTERNALSYM MapiFileTagExt}
+ MapiFileTagExt = packed record
+ ulReserved: Cardinal; { Reserved, must be zero. }
+ cbTag: Cardinal; { Size (in bytes) of }
+ lpTag: PByte; { X.400 OID for this attachment type }
+ cbEncoding: Cardinal; { Size (in bytes) of }
+ lpEncoding: PByte; { X.400 OID for this attachment's encoding }
+ end;
+ TMapiFileTagExt = MapiFileTagExt;
+
+
+ PMapiRecipDesc = ^TMapiRecipDesc;
+ {$EXTERNALSYM MapiRecipDesc}
+ MapiRecipDesc = packed record
+ ulReserved: Cardinal; { Reserved for future use }
+ ulRecipClass: Cardinal; { Recipient class }
+ { MAPI_TO, MAPI_CC, MAPI_BCC, MAPI_ORIG }
+ lpszName: LPSTR; { Recipient name }
+ lpszAddress: LPSTR; { Recipient address (optional) }
+ ulEIDSize: Cardinal; { Count in bytes of size of pEntryID }
+ lpEntryID: Pointer; { System-specific recipient reference }
+ end;
+ TMapiRecipDesc = MapiRecipDesc;
+
+const
+ {$EXTERNALSYM MAPI_ORIG}
+ MAPI_ORIG = 0; { Recipient is message originator }
+ {$EXTERNALSYM MAPI_TO}
+ MAPI_TO = 1; { Recipient is a primary recipient }
+ {$EXTERNALSYM MAPI_CC}
+ MAPI_CC = 2; { Recipient is a copy recipient }
+ {$EXTERNALSYM MAPI_BCC}
+ MAPI_BCC = 3; { Recipient is blind copy recipient }
+
+type
+ PMapiMessage = ^TMapiMessage;
+ {$EXTERNALSYM MapiMessage}
+ MapiMessage = packed record
+ ulReserved: Cardinal; { Reserved for future use (M.B. 0) }
+ lpszSubject: LPSTR; { Message Subject }
+ lpszNoteText: LPSTR; { Message Text }
+ lpszMessageType: LPSTR; { Message Class }
+ lpszDateReceived: LPSTR; { in YYYY/MM/DD HH:MM format }
+ lpszConversationID: LPSTR; { conversation thread ID }
+ flFlags: FLAGS; { unread,return receipt }
+ lpOriginator: PMapiRecipDesc; { Originator descriptor }
+ nRecipCount: Cardinal; { Number of recipients }
+ lpRecips: PMapiRecipDesc; { Recipient descriptors }
+ nFileCount: Cardinal; { # of file attachments }
+ lpFiles: PMapiFileDesc; { Attachment descriptors }
+ end;
+ TMapiMessage = MapiMessage;
+
+const
+ {$EXTERNALSYM MAPI_UNREAD}
+ MAPI_UNREAD = $00000001;
+ {$EXTERNALSYM MAPI_RECEIPT_REQUESTED}
+ MAPI_RECEIPT_REQUESTED = $00000002;
+ {$EXTERNALSYM MAPI_SENT}
+ MAPI_SENT = $00000004;
+
+
+{ Entry points. }
+
+{ flFlags values for Simple MAPI entry points. All documented flags are
+ shown for each call. Duplicates are commented out but remain present
+ for every call. }
+
+{ MAPILogon() flags. }
+
+ {$EXTERNALSYM MAPI_LOGON_UI}
+ MAPI_LOGON_UI = $00000001; { Display logon UI }
+ {$EXTERNALSYM MAPI_PASSWORD_UI}
+ MAPI_PASSWORD_UI = $00020000; { prompt for password only }
+ {$EXTERNALSYM MAPI_NEW_SESSION}
+ MAPI_NEW_SESSION = $00000002; { Don't use shared session }
+ {$EXTERNALSYM MAPI_FORCE_DOWNLOAD}
+ MAPI_FORCE_DOWNLOAD = $00001000; { Get new mail before return }
+ {$EXTERNALSYM MAPI_ALLOW_OTHERS}
+ MAPI_ALLOW_OTHERS = $00000008; { Make this a shared session (removed from 4.0 SDK) }
+ {$EXTERNALSYM MAPI_EXPLICIT_PROFILE}
+ MAPI_EXPLICIT_PROFILE = $00000010; { Don't use default profile (removed from 4.0 SDK) }
+ {$EXTERNALSYM MAPI_EXTENDED}
+ MAPI_EXTENDED = $00000020; { Extended MAPI Logon }
+ {$EXTERNALSYM MAPI_USE_DEFAULT}
+ MAPI_USE_DEFAULT = $00000040; { Use default profile in logon (removed from 4.0 SDK) }
+
+ {$EXTERNALSYM MAPI_SIMPLE_DEFAULT}
+ MAPI_SIMPLE_DEFAULT = MAPI_LOGON_UI or MAPI_FORCE_DOWNLOAD or MAPI_ALLOW_OTHERS; { removed from 4.0 SDK }
+ {$EXTERNALSYM MAPI_SIMPLE_EXPLICIT}
+ MAPI_SIMPLE_EXPLICIT = MAPI_NEW_SESSION or MAPI_FORCE_DOWNLOAD or MAPI_EXPLICIT_PROFILE; { removed from 4.0 SDK }
+
+{ MAPILogoff() flags. }
+
+ {$EXTERNALSYM MAPI_LOGOFF_SHARED}
+ MAPI_LOGOFF_SHARED = $00000001; { Close all shared sessions (removed from 4.0 SDK) }
+ {$EXTERNALSYM MAPI_LOGOFF_UI}
+ MAPI_LOGOFF_UI = $00000002; { It's OK to present UI (removed from 4.0 SDK) }
+
+{ MAPISendMail() flags. }
+
+{ #define MAPI_LOGON_UI 0x00000001 Display logon UI }
+{ #define MAPI_NEW_SESSION 0x00000002 Don't use shared session }
+ {$EXTERNALSYM MAPI_DIALOG}
+ MAPI_DIALOG = $00000008; { Display a send note UI }
+{ # define MAPI_USE_DEFAULT 0x00000040 Use default profile in logon }
+
+{ MAPIFindNext() flags. }
+
+ {$EXTERNALSYM MAPI_UNREAD_ONLY}
+ MAPI_UNREAD_ONLY = $00000020; { Only unread messages }
+ {$EXTERNALSYM MAPI_GUARANTEE_FIFO}
+ MAPI_GUARANTEE_FIFO = $00000100; { use date order }
+ {$EXTERNALSYM MAPI_LONG_MSGID}
+ MAPI_LONG_MSGID = $00004000; { allow 512 char returned ID }
+
+{ MAPIReadMail() flags. }
+
+ {$EXTERNALSYM MAPI_PEEK}
+ MAPI_PEEK = $00000080; { Do not mark as read. }
+ {$EXTERNALSYM MAPI_SUPPRESS_ATTACH}
+ MAPI_SUPPRESS_ATTACH = $00000800; { header + body, no files }
+ {$EXTERNALSYM MAPI_ENVELOPE_ONLY}
+ MAPI_ENVELOPE_ONLY = $00000040; { Only header information }
+ {$EXTERNALSYM MAPI_BODY_AS_FILE}
+ MAPI_BODY_AS_FILE = $00000200;
+
+{ MAPISaveMail() flags. }
+
+{ #define MAPI_LOGON_UI 0x00000001 Display logon UI }
+{ #define MAPI_NEW_SESSION 0x00000002 Don't use shared session }
+{ #define MAPI_LONG_MSGID 0x00004000 /* allow 512 char returned ID }
+
+{ MAPIAddress() flags. }
+
+{ #define MAPI_LOGON_UI 0x00000001 Display logon UI }
+{ #define MAPI_NEW_SESSION 0x00000002 Don't use shared session }
+
+{ MAPIDetails() flags. }
+
+{ #define MAPI_LOGON_UI 0x00000001 Display logon UI }
+{ #define MAPI_NEW_SESSION 0x00000002 Don't use shared session }
+ {$EXTERNALSYM MAPI_AB_NOMODIFY}
+ MAPI_AB_NOMODIFY = $00000400; { Don't allow mods of AB entries }
+
+{ MAPIResolveName() flags. }
+
+{ #define MAPI_LOGON_UI 0x00000001 Display logon UI }
+{ #define MAPI_NEW_SESSION 0x00000002 Don't use shared session }
+{ #define MAPI_DIALOG 0x00000008 Prompt for choices if ambiguous }
+{ #define MAPI_AB_NOMODIFY 0x00000400 Don't allow mods of AB entries }
+
+type
+ PFNMapiLogon = ^TFNMapiLogOn;
+ TFNMapiLogOn = function(ulUIParam: Cardinal; lpszProfileName: LPSTR;
+ lpszPassword: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
+ lplhSession: PLHANDLE): Cardinal stdcall;
+
+ PFNMapiLogOff = ^TFNMapiLogOff;
+ TFNMapiLogOff = function(lhSession: LHANDLE; ulUIParam: Cardinal; flFlags: FLAGS;
+ ulReserved: Cardinal): Cardinal stdcall;
+
+ PFNMapiSendMail = ^TFNMapiSendMail;
+ TFNMapiSendMail = function(lhSession: LHANDLE; ulUIParam: Cardinal;
+ var lpMessage: TMapiMessage; flFlags: FLAGS;
+ ulReserved: Cardinal): Cardinal stdcall;
+
+ PFNMapiSendDocuments = ^TFNMapiSendDocuments;
+ TFNMapiSendDocuments = function(ulUIParam: Cardinal; lpszDelimChar: LPSTR;
+ lpszFilePaths: LPSTR; lpszFileNames: LPSTR;
+ ulReserved: Cardinal): Cardinal stdcall;
+
+ PFNMapiFindNext = ^TFNMapiFindNext;
+ TFNMapiFindNext = function(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszMessageType: LPSTR; lpszSeedMessageID: LPSTR; flFlags: FLAGS;
+ ulReserved: Cardinal; lpszMessageID: LPSTR): Cardinal stdcall;
+
+ PFNMapiReadMail = ^TFNMapiReadMail;
+ TFNMapiReadMail = function(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszMessageID: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
+ var lppMessage: PMapiMessage): Cardinal stdcall;
+
+ PFNMapiSaveMail = ^TFNMapiSaveMail;
+ TFNMapiSaveMail = function(lhSession: LHANDLE; ulUIParam: Cardinal;
+ var lpMessage: TMapiMessage; flFlags: FLAGS; ulReserved: Cardinal;
+ lpszMessageID: LPSTR): Cardinal stdcall;
+
+ PFNMapiDeleteMail = ^TFNMapiDeleteMail;
+ TFNMapiDeleteMail = function(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszMessageID: LPSTR; flFlags: FLAGS;
+ ulReserved: Cardinal): Cardinal stdcall;
+
+ PFNMapiFreeBuffer = ^TFNMapiFreeBuffer;
+ TFNMapiFreeBuffer = function(pv: Pointer): Cardinal stdcall;
+
+ PFNMapiAddress = ^TFNMapiAddress;
+ TFNMapiAddress = function(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszCaption: LPSTR; nEditFields: Cardinal; lpszLabels: LPSTR;
+ nRecips: Cardinal; var lpRecips: TMapiRecipDesc; flFlags: FLAGS;
+ ulReserved: Cardinal; lpnNewRecips: PULONG;
+ var lppNewRecips: PMapiRecipDesc): Cardinal stdcall;
+
+ PFNMapiDetails = ^TFNMapiDetails;
+ TFNMapiDetails = function(lhSession: LHANDLE; ulUIParam: Cardinal;
+ var lpRecip: TMapiRecipDesc; flFlags: FLAGS;
+ ulReserved: Cardinal): Cardinal stdcall;
+
+ PFNMapiResolveName = ^TFNMapiResolveName;
+ TFNMapiResolveName = function(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszName: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
+ var lppRecip: PMapiRecipDesc): Cardinal stdcall;
+
+const
+ {$EXTERNALSYM SUCCESS_SUCCESS}
+ SUCCESS_SUCCESS = 0;
+ {$EXTERNALSYM MAPI_USER_ABORT}
+ MAPI_USER_ABORT = 1;
+ {$EXTERNALSYM MAPI_E_USER_ABORT}
+ MAPI_E_USER_ABORT = MAPI_USER_ABORT;
+ {$EXTERNALSYM MAPI_E_FAILURE}
+ MAPI_E_FAILURE = 2;
+ {$EXTERNALSYM MAPI_E_LOGON_FAILURE}
+ MAPI_E_LOGON_FAILURE = 3;
+ {$EXTERNALSYM MAPI_E_LOGIN_FAILURE}
+ MAPI_E_LOGIN_FAILURE = MAPI_E_LOGON_FAILURE;
+ {$EXTERNALSYM MAPI_E_DISK_FULL}
+ MAPI_E_DISK_FULL = 4;
+ {$EXTERNALSYM MAPI_E_INSUFFICIENT_MEMORY}
+ MAPI_E_INSUFFICIENT_MEMORY = 5;
+ {$EXTERNALSYM MAPI_E_ACCESS_DENIED}
+ MAPI_E_ACCESS_DENIED = 6;
+ {$EXTERNALSYM MAPI_E_TOO_MANY_SESSIONS}
+ MAPI_E_TOO_MANY_SESSIONS = 8;
+ {$EXTERNALSYM MAPI_E_TOO_MANY_FILES}
+ MAPI_E_TOO_MANY_FILES = 9;
+ {$EXTERNALSYM MAPI_E_TOO_MANY_RECIPIENTS}
+ MAPI_E_TOO_MANY_RECIPIENTS = 10;
+ {$EXTERNALSYM MAPI_E_ATTACHMENT_NOT_FOUND}
+ MAPI_E_ATTACHMENT_NOT_FOUND = 11;
+ {$EXTERNALSYM MAPI_E_ATTACHMENT_OPEN_FAILURE}
+ MAPI_E_ATTACHMENT_OPEN_FAILURE = 12;
+ {$EXTERNALSYM MAPI_E_ATTACHMENT_WRITE_FAILURE}
+ MAPI_E_ATTACHMENT_WRITE_FAILURE = 13;
+ {$EXTERNALSYM MAPI_E_UNKNOWN_RECIPIENT}
+ MAPI_E_UNKNOWN_RECIPIENT = 14;
+ {$EXTERNALSYM MAPI_E_BAD_RECIPTYPE}
+ MAPI_E_BAD_RECIPTYPE = 15;
+ {$EXTERNALSYM MAPI_E_NO_MESSAGES}
+ MAPI_E_NO_MESSAGES = 16;
+ {$EXTERNALSYM MAPI_E_INVALID_MESSAGE}
+ MAPI_E_INVALID_MESSAGE = 17;
+ {$EXTERNALSYM MAPI_E_TEXT_TOO_LARGE}
+ MAPI_E_TEXT_TOO_LARGE = 18;
+ {$EXTERNALSYM MAPI_E_INVALID_SESSION}
+ MAPI_E_INVALID_SESSION = 19;
+ {$EXTERNALSYM MAPI_E_TYPE_NOT_SUPPORTED}
+ MAPI_E_TYPE_NOT_SUPPORTED = 20;
+ {$EXTERNALSYM MAPI_E_AMBIGUOUS_RECIPIENT}
+ MAPI_E_AMBIGUOUS_RECIPIENT = 21;
+ {$EXTERNALSYM MAPI_E_AMBIG_RECIP}
+ MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT;
+ {$EXTERNALSYM MAPI_E_MESSAGE_IN_USE}
+ MAPI_E_MESSAGE_IN_USE = 22;
+ {$EXTERNALSYM MAPI_E_NETWORK_FAILURE}
+ MAPI_E_NETWORK_FAILURE = 23;
+ {$EXTERNALSYM MAPI_E_INVALID_EDITFIELDS}
+ MAPI_E_INVALID_EDITFIELDS = 24;
+ {$EXTERNALSYM MAPI_E_INVALID_RECIPS}
+ MAPI_E_INVALID_RECIPS = 25;
+ {$EXTERNALSYM MAPI_E_NOT_SUPPORTED}
+ MAPI_E_NOT_SUPPORTED = 26;
+
+
+{ Delphi wrapper calls around Simple MAPI }
+
+function MapiLogOn(ulUIParam: Cardinal; lpszProfileName: LPSTR;
+ lpszPassword: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
+ lplhSession: PLHANDLE): Cardinal;
+
+function MapiLogOff(lhSession: LHANDLE; ulUIParam: Cardinal; flFlags: FLAGS;
+ ulReserved: Cardinal): Cardinal;
+
+function MapiSendMail(lhSession: LHANDLE; ulUIParam: Cardinal;
+ var lpMessage: TMapiMessage; flFlags: FLAGS; ulReserved: Cardinal): Cardinal;
+
+function MapiSendDocuments(ulUIParam: Cardinal; lpszDelimChar: LPSTR;
+ lpszFilePaths: LPSTR; lpszFileNames: LPSTR; ulReserved: Cardinal): Cardinal;
+
+function MapiFindNext(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszMessageType: LPSTR; lpszSeedMessageID: LPSTR; flFlags: FLAGS;
+ ulReserved: Cardinal; lpszMessageID: LPSTR): Cardinal;
+
+function MapiReadMail(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszMessageID: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
+ var lppMessage: PMapiMessage): Cardinal;
+
+function MapiSaveMail(lhSession: LHANDLE; ulUIParam: Cardinal;
+ var lpMessage: TMapiMessage; flFlags: FLAGS; ulReserved: Cardinal;
+ lpszMessageID: LPSTR): Cardinal;
+
+function MapiDeleteMail(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszMessageID: LPSTR; flFlags: FLAGS;
+ ulReserved: Cardinal): Cardinal;
+
+function MapiFreeBuffer(pv: Pointer): Cardinal;
+
+function MapiAddress(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszCaption: LPSTR; nEditFields: Cardinal; lpszLabels: LPSTR;
+ nRecips: Cardinal; var lpRecips: TMapiRecipDesc; flFlags: FLAGS;
+ ulReserved: Cardinal; lpnNewRecips: PULONG;
+ var lppNewRecips: PMapiRecipDesc): Cardinal;
+
+function MapiDetails(lhSession: LHANDLE; ulUIParam: Cardinal;
+ var lpRecip: TMapiRecipDesc; flFlags: FLAGS;
+ ulReserved: Cardinal): Cardinal;
+
+function MapiResolveName(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszName: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
+ var lppRecip: PMapiRecipDesc): Cardinal;
+
+var
+ MAPIDLL: string = 'MAPI32.DLL';
+
+implementation
+
+var
+ MAPIModule: HModule = 0;
+ LogOn: TFNMapiLogOn = nil;
+ LogOff: TFNMapiLogOff = nil;
+ SendMail: TFNMapiSendMail = nil;
+ SendDocuments: TFNMapiSendDocuments = nil;
+ FindNext: TFNMapiFindNext = nil;
+ ReadMail: TFNMapiReadMail = nil;
+ SaveMail: TFNMapiSaveMail = nil;
+ DeleteMail: TFNMapiDeleteMail = nil;
+ FreeBuffer: TFNMapiFreeBuffer = nil;
+ Address: TFNMapiAddress = nil;
+ Details: TFNMapiDetails = nil;
+ ResolveName: TFNMapiResolveName = nil;
+
+var
+ MAPIChecked: Boolean = False;
+
+procedure InitMapi;
+var
+ OSVersionInfo: TOSVersionInfo;
+ hkWMS: HKEY;
+ MAPIValueSize: Longint;
+ MAPIValueBuf: array[0..8] of char;
+ rType: Longint;
+begin
+ if not MAPIChecked then
+ begin
+ MAPIChecked := True;
+ MAPIModule := 0;
+
+ OSVersionInfo.dwOSVersionInfoSize := SizeOf(OSVersionInfo);
+ GetVersionEx(OSVersionInfo);
+ if (OSVersionInfo.dwMajorVersion > 3) or
+ ((OSVersionInfo.dwMajorVersion = 3) and
+ (OSVersionInfo.dwMinorVersion > 51)) then
+ begin
+ MAPIValueSize := sizeof(MAPIValueBuf);
+ if RegOpenKeyEx(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows Messaging Subsystem',
+ 0, KEY_READ, hkWMS) <> ERROR_SUCCESS then Exit;
+ if RegQueryValueEx(hkWMS, 'MAPI', nil, @rType, @MAPIValueBuf,
+ @MAPIValueSize) <> ERROR_SUCCESS then Exit;
+ RegCloseKey(hkWMS);
+ if not ((MAPIValueBuf[0] = '1') and (MAPIValueBuf[1] = #0)) then Exit;
+ end
+ else if GetProfileInt('Mail', 'MAPI', 0) = 0 then Exit;
+
+ MAPIModule := LoadLibrary(PChar(MAPIDLL));
+ end;
+end;
+
+function MapiLogOn(ulUIParam: Cardinal; lpszProfileName: LPSTR;
+ lpszPassword: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
+ lplhSession: PLHANDLE): Cardinal;
+begin
+ InitMapi;
+ if @LogOn = nil then
+ @LogOn := GetProcAddress(MAPIModule, 'MAPILogon');
+ if @LogOn <> nil then
+ Result := LogOn(ulUIParam, lpszProfileName, lpszPassword, flFlags,
+ ulReserved, lplhSession)
+ else Result := 1;
+end;
+
+function MapiLogOff(lhSession: LHANDLE; ulUIParam: Cardinal; flFlags: FLAGS;
+ ulReserved: Cardinal): Cardinal;
+begin
+ InitMapi;
+ if @LogOff = nil then
+ @LogOff := GetProcAddress(MAPIModule, 'MAPILogoff');
+ if @LogOff <> nil then
+ Result := LogOff(lhSession, ulUIParam, flFlags, ulReserved)
+ else Result := 1;
+end;
+
+function MapiSendMail(lhSession: LHANDLE; ulUIParam: Cardinal;
+ var lpMessage: TMapiMessage; flFlags: FLAGS; ulReserved: Cardinal): Cardinal;
+begin
+ InitMapi;
+ if @SendMail = nil then
+ @SendMail := GetProcAddress(MAPIModule, 'MAPISendMail');
+ if @SendMail <> nil then
+ Result := SendMail(lhSession, ulUIParam, lpMessage, flFlags, ulReserved)
+ else Result := 1;
+end;
+
+function MapiSendDocuments(ulUIParam: Cardinal; lpszDelimChar: LPSTR;
+ lpszFilePaths: LPSTR; lpszFileNames: LPSTR;
+ ulReserved: Cardinal): Cardinal;
+begin
+ InitMapi;
+ if @SendDocuments = nil then
+ @SendDocuments := GetProcAddress(MAPIModule, 'MAPISendDocuments');
+ if @SendDocuments <> nil then
+ Result := SendDocuments(ulUIParam, lpszDelimChar, lpszFilePaths,
+ lpszFileNames, ulReserved)
+ else Result := 1;
+end;
+
+function MapiFindNext(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszMessageType: LPSTR; lpszSeedMessageID: LPSTR; flFlags: FLAGS;
+ ulReserved: Cardinal; lpszMessageID: LPSTR): Cardinal;
+begin
+ InitMapi;
+ if @FindNext = nil then
+ @FindNext := GetProcAddress(MAPIModule, 'MAPIFindNext');
+ if @FindNext <> nil then
+ Result := FindNext(lhSession, ulUIParam, lpszMessageType,
+ lpszSeedMessageID, flFlags, ulReserved, lpszMessageID)
+ else Result := 1;
+end;
+
+function MapiReadMail(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszMessageID: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
+ var lppMessage: PMapiMessage): Cardinal;
+begin
+ InitMapi;
+ if @ReadMail = nil then
+ @ReadMail := GetProcAddress(MAPIModule, 'MAPIReadMail');
+ if @ReadMail <> nil then
+ Result := ReadMail(lhSession, ulUIParam, lpszMessageID, flFlags,
+ ulReserved, lppMessage)
+ else Result := 1;
+end;
+
+function MapiSaveMail(lhSession: LHANDLE; ulUIParam: Cardinal;
+ var lpMessage: TMapiMessage; flFlags: FLAGS; ulReserved: Cardinal;
+ lpszMessageID: LPSTR): Cardinal;
+begin
+ InitMapi;
+ if @SaveMail = nil then
+ @SaveMail := GetProcAddress(MAPIModule, 'MAPISaveMail');
+ if @SaveMail <> nil then
+ Result := SaveMail(lhSession, ulUIParam, lpMessage, flFlags, ulReserved,
+ lpszMessageID)
+ else Result := 1;
+end;
+
+function MapiDeleteMail(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszMessageID: LPSTR; flFlags: FLAGS;
+ ulReserved: Cardinal): Cardinal;
+begin
+ InitMapi;
+ if @DeleteMail = nil then
+ @DeleteMail := GetProcAddress(MAPIModule, 'MAPIDeleteMail');
+ if @DeleteMail <> nil then
+ Result := DeleteMail(lhSession, ulUIParam, lpszMessageID, flFlags,
+ ulReserved)
+ else Result := 1;
+end;
+
+function MapiFreeBuffer(pv: Pointer): Cardinal;
+begin
+ InitMapi;
+ if @FreeBuffer = nil then
+ @FreeBuffer := GetProcAddress(MAPIModule, 'MAPIFreeBuffer');
+ if @FreeBuffer <> nil then
+ Result := FreeBuffer(pv)
+ else Result := 1;
+end;
+
+function MapiAddress(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszCaption: LPSTR; nEditFields: Cardinal; lpszLabels: LPSTR;
+ nRecips: Cardinal; var lpRecips: TMapiRecipDesc; flFlags: FLAGS;
+ ulReserved: Cardinal; lpnNewRecips: PULONG;
+ var lppNewRecips: PMapiRecipDesc): Cardinal;
+begin
+ InitMapi;
+ if @Address = nil then
+ @Address := GetProcAddress(MAPIModule, 'MAPIAddress');
+ if @Address <> nil then
+ Result := Address(lhSession, ulUIParam, lpszCaption, nEditFields,
+ lpszLabels, nRecips, lpRecips, flFlags, ulReserved, lpnNewRecips,
+ lppNewRecips)
+ else Result := 1;
+end;
+
+function MapiDetails(lhSession: LHANDLE; ulUIParam: Cardinal;
+ var lpRecip: TMapiRecipDesc; flFlags: FLAGS; ulReserved: Cardinal): Cardinal;
+begin
+ InitMapi;
+ if @Details = nil then
+ @Details := GetProcAddress(MAPIModule, 'MAPIDetails');
+ if @Details <> nil then
+ Result := Details(lhSession, ulUIParam, lpRecip, flFlags, ulReserved)
+ else Result := 1;
+end;
+
+function MapiResolveName(lhSession: LHANDLE; ulUIParam: Cardinal;
+ lpszName: LPSTR; flFlags: FLAGS; ulReserved: Cardinal;
+ var lppRecip: PMapiRecipDesc): Cardinal;
+begin
+ InitMapi;
+ if @ResolveName = nil then
+ @ResolveName := GetProcAddress(MAPIModule, 'MAPIResolveName');
+ if @ResolveName <> nil then
+ Result := ResolveName(lhSession, ulUIParam, lpszName, flFlags,
+ ulReserved, lppRecip)
+ else Result := 1;
+end;
+
+initialization
+finalization
+ if MAPIModule <> 0 then FreeLibrary(MAPIModule);
+end.
diff --git a/Software/src/general/src/Utils.pas b/Software/src/general/src/Utils.pas
new file mode 100755
index 0000000..9bc90a4
--- /dev/null
+++ b/Software/src/general/src/Utils.pas
@@ -0,0 +1,1028 @@
+UNIT Utils;
+INTERFACE
+{$H+}
+uses Classes,SysUtils
+ {$IFDEF LCL}
+ {$IFNDEF LCLnogui}
+ ,Forms,Dialogs,Clipbrd,Translations,TypInfo,LCLProc,Graphics
+ {$ENDIF}
+ ,FileUtil,UTF8Process
+ {$ENDIF}
+ {$IFDEF MSWINDOWS}
+ ,Registry,Windows
+ {$ELSE}
+ ,unix
+ {$ENDIF}
+;
+{$IFNDEF FPC}
+CONST
+ DirectorySeparator = '\';
+{$ENDIF}
+
+type
+ TRoundToRange = -37..37;
+ TProcessinfoTyp = (piOpen,piPrint);
+ {$ifdef WINDOWS}
+ PFNSHGetFolderPath = Function(Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: PChar): HRESULT; stdcall;
+ {$endif}
+
+function ClearDir (Path: string): boolean;
+function RPos(const Substr: string; const S: string): Integer;
+FUNCTION IsNumeric(s: STRING): boolean;
+FUNCTION StrTimeToValue(val : string) : LongInt;
+{$IFDEF LCL}
+ {$IFNDEF LCLnogui}
+ procedure LoadLanguage(lang : string);
+ function GetProcessforExtension(InfoTyp : TProcessinfoTyp;Extension : string) : string;
+ function TextCut(aCanvas: TCanvas; Len: Integer; Text: String): String;
+ {$ELSE}
+ function TextCut(Len: Integer; Text: String): String;
+ {$ENDIF}
+{$ENDIF}
+function GetMimeTypeforExtension(Extension : string) : string;
+function InstallExt(Extension, ExtDescription, FileDescription,OpenWith, ParamString: string; IconIndex: Integer = 0): Boolean;
+function SystemUserName : string;
+function GetSystemName : string;
+function HTTPEncode(const str : String) : string;
+function ValidateFileName(old : string) : string;
+function ValidateFileDir(old : string) : string;
+function ValidateDate(D : string) : string;
+function GetTempPath : string;
+function GetConfigDir(app : string) : string;
+function GetProgramDir : string;
+function GetGlobalConfigDir(app : string;Global : Boolean = True) : string;
+function SizeToText(size : Longint) : string;
+function GetMainIconHandle(Resourcename : string) : Cardinal;
+function CanWriteToProgramDir : Boolean;
+function HexToBin(h: STRING): dword;
+function RoundTo(const AValue : extended ; const ADigit : TRoundToRange) : extended ;
+function TimeTotext(Seconds : Integer) : string;
+function GetSystemLang : string;
+function DateTimeToHourString(DateTime : TDateTime) : string;
+function DateTimeToIndustrialTime(dateTime : TDateTime) : string;
+function ConvertUnknownStringdate(input : string) : TDateTime;
+function HTMLEncode(s : string) : string;
+function HTMLDecode(s : string) : string;
+IMPLEMENTATION
+function TimeTotext(Seconds : Integer) : string;
+var
+ tmp : Integer;
+begin
+ if Seconds > 60*60 then
+ begin
+ Result := IntToStr(Trunc(Seconds/(60*60))) +' h';
+ tmp := Seconds mod (60*60);
+ Result := Result +' '+IntToStr(Trunc(tmp/(60))) +' m';
+ tmp := Seconds mod 60;
+ Result := Result +' '+IntToStr(tmp) +' s';
+ end
+ else if Seconds > 60 then
+ begin
+ Result := IntToStr(Trunc(Seconds/(60))) +' m';
+ tmp := Seconds mod 60;
+ Result := Result +' '+IntToStr(tmp) +' s';
+ end
+ else
+ begin
+ Result := IntToStr(Seconds)+' s';
+ end
+end;
+function RoundTo(const AValue : extended ; const ADigit : TRoundToRange) : extended ;
+var X : extended ; i : integer ;
+begin
+ X := 1.0 ;
+ for i := 1 to Abs(ADigit) do X := X * 10 ;
+ if ADigit<0 then
+ Result := Round(AValue * X) / X
+ else
+ Result := Round(AValue / X) * X;
+end;
+function HexToBin(h: STRING): dword;
+ FUNCTION HexDigitToInt(c: Char): Integer;
+ BEGIN
+ IF (c >= '0') AND (c <= '9') THEN Result := Ord(c) - Ord('0')
+ ELSE IF (c >= 'A') AND (c <= 'F') THEN Result := Ord(c) - Ord('A') + 10
+ ELSE IF (c >= 'a') AND (c <= 'f') THEN Result := Ord(c) - Ord('a') + 10
+ ELSE Result := -1;
+ END;
+VAR
+ buf: ARRAY[0..16] OF Byte;
+ digit1: Integer;
+ bytes: Integer;
+ index: Integer;
+BEGIN
+ bytes := 0;
+ index := 0;
+ result := 0;
+ IF frac(length(h) / 2) = 0.5 THEN
+ h := '0' + h;
+ WHILE (bytes < 16) DO
+ BEGIN
+ if length(h) > index+1 then
+ digit1 := HexDigitToInt(h[index + 1])
+ else
+ digit1 := -1;
+ IF digit1 < 0 THEN
+ break;
+ buf[bytes] := (digit1 SHL 4) OR HexDigitToInt(h[index + 2]);
+ Inc(index, 2);
+ Inc(bytes);
+ END;
+ dec(bytes);
+ FOR index := bytes DOWNTO 0 DO
+ Result := Result + (buf[index] shl ((bytes-index)*8));
+END;
+{$IFDEF LCL}
+{$IFNDEF LCLnogui}
+{$ifndef ver2_0}
+function Translate (Name,Value : AnsiString; Hash : Longint; arg:pointer) : AnsiString;
+var
+ po: TPOFile;
+begin
+ po:=TPOFile(arg);
+ // get UTF8 string
+ result := po.Translate(Name,Value);
+ // convert UTF8 to current local
+ if result<>'' then
+ result:=UTF8ToSystemCharSet(result);
+end;
+{$endif ver2_0}
+function TextCut(aCanvas: TCanvas; Len: Integer; Text: String): String;
+var
+ k: Integer;
+begin
+ Result := '';
+ if Len < 0 then exit;
+ if Len <= aCanvas.TextWidth(Copy(Text, 1, 1) + '...') then exit;
+ Result := Text;
+ with aCanvas do
+ begin
+ if TextWidth(Text) > Len then
+ begin
+ for k := Length(Text) downto 1 do
+ if TextWidth(Copy(Text, 1, k) + '...') > Len then Continue
+ else
+ begin
+ Result := Copy(Text, 1, k) + '...';
+ Exit;
+ end;
+ end;
+ end;
+end;
+procedure LoadLanguage(lang: string);
+var
+ Info : TSearchRec;
+ po: TPOFile;
+ units: TStringList;
+ id: String;
+ i: Integer;
+ a: Integer;
+ Comp: TComponent;
+Begin
+ If FindFirstUTF8(ProgramDirectory+'languages'+Directoryseparator+'*.'+lowercase(copy(lang,0,2))+'.po',faAnyFile,Info)=0 then
+ repeat
+ po := TPOFile.Create(ProgramDirectory+'languages'+Directoryseparator+Info.Name);
+ units := TStringList.Create;
+ for i := 0 to po.Items.Count-1 do
+ begin
+ id := copy(TPoFileItem(po.Items[i]).IdentifierLow,0,pos('.',TPoFileItem(po.Items[i]).IdentifierLow)-1);
+ if units.IndexOf(id) = -1 then
+ units.Add(id);
+ end;
+ for i := 0 to units.Count-1 do
+ Translations.TranslateUnitResourceStrings(units[i],ProgramDirectory+'languages'+Directoryseparator+Info.Name);
+ units.Free;
+ for i := 0 to po.Items.Count-1 do
+ begin
+ id := copy(TPoFileItem(po.Items[i]).IdentifierLow,0,pos('.',TPoFileItem(po.Items[i]).IdentifierLow)-1);
+ for a := 0 to Screen.FormCount-1 do
+ if UTF8UpperCase(Screen.Forms[a].ClassName) = UTF8UpperCase(id) then
+ begin
+ id := copy(TPoFileItem(po.Items[i]).IdentifierLow,pos('.',TPoFileItem(po.Items[i]).IdentifierLow)+1,length(TPoFileItem(po.Items[i]).IdentifierLow));
+ if Assigned(Screen.Forms[a].FindComponent(copy(id,0,pos('.',id)-1))) then
+ begin
+ Comp := Screen.Forms[a].FindComponent(copy(id,0,pos('.',id)-1));
+ id := copy(id,pos('.',id)+1,length(id));
+ SetStrProp(Comp,id,TPoFileItem(po.Items[i]).Translation);
+ end;
+ end;
+ end;
+ po.Free;
+ until FindNextUTF8(info)<>0;
+ FindCloseUTF8(Info);
+end;
+function GetProcessforExtension(InfoTyp : TProcessinfoTyp;Extension : string) : string;
+var
+{$ifdef MSWINDOWS}
+ reg : TRegistry;
+ ot : string;
+ FileClass: string;
+ chrResult: array[0..1023] of Char;
+ wrdReturn: DWORD;
+{$else}
+ SRec : TSearchRec;
+ res : Integer;
+ f : TextFile;
+ tmp : string;
+ mime : string;
+ apps : string;
+{$endif}
+begin
+{$ifdef WINDOWS}
+ case InfoTyp of
+ piOpen:ot := 'open';
+ piPrint:ot := 'print';
+ end;
+ Result := '';
+ Reg := TRegistry.Create(KEY_READ);
+ Reg.RootKey := HKEY_CLASSES_ROOT;
+ FileClass := '';
+ if Reg.OpenKeyReadOnly(ExtractFileExt('.'+Extension)) then
+ begin
+ FileClass := Reg.ReadString('');
+ Reg.CloseKey;
+ end;
+ if FileClass <> '' then begin
+ if Reg.OpenKeyReadOnly(FileClass + '\Shell\'+ot+'\Command') then
+ begin
+ wrdReturn := ExpandEnvironmentStrings(PChar(StringReplace(Reg.ReadString(''),'%1','%s',[rfReplaceAll])), chrResult, 1024);
+ if wrdReturn = 0 then
+ Result := StringReplace(Reg.ReadString(''),'%1','%s',[rfReplaceAll])
+ else
+ Result := Trim(chrResult);
+ Reg.CloseKey;
+ end;
+ end;
+ Reg.Free;
+{$ELSE}
+ apps := '';
+ mime := GetMimeTypeforExtension(Extension);
+// /usr/share/mime-info *.keys
+ Res := FindFirst ('/usr/share/mime-info/*.keys', faAnyFile, SRec);
+ while Res = 0 do
+ begin
+ AssignFile(f,'/usr/share/mime-info/'+SRec.Name);
+ Reset(f);
+ while not eof(f) do
+ begin
+ readln(f,tmp);
+// nicht eingerueckt ist der mime typ
+ if not ((copy(tmp,0,1) = ' ') or (copy(tmp,0,1) = #9)) then
+//eingerÃckt die eigenschaften
+ if ((copy(tmp,length(tmp)-2,1) = '*')
+ and (copy(tmp,0,length(tmp)-2) = copy(mime,0,length(tmp)-2)))
+ or (trim(tmp) = trim(mime)) then
+ begin
+ readln(f,tmp);
+ while (not eof(f)) and ((copy(tmp,0,1) = ' ') or (copy(tmp,0,1) = #9)) do
+ begin
+ tmp := StringReplace(trim(tmp),#9,'',[rfReplaceAll]);
+//open referenziert gleich das program
+ if lowercase(copy(tmp,0,5)) = 'open=' then
+ begin
+ Result := copy(tmp,6,length(tmp));
+ if pos('%f',Result) = 0 then
+ Result := Result+' "%s"'
+ else
+ Stringreplace(Result,'%f','%s',[rfReplaceAll]);
+ SysUtils.FindClose(SRec);
+ exit;
+ end
+//das referenziert ein kÃrzel das isn der application registry steht
+ else if lowercase(copy(tmp,0,49)) = 'short_list_application_ids_for_novice_user_level=' then
+ begin
+ apps := copy(tmp,50,length(tmp));
+ break;
+ end;
+ readln(f,tmp);
+ end;
+ end;
+ if apps <> '' then break;
+ end;
+ CloseFile(f);
+ Res := FindNext(SRec);
+ if apps <> '' then break;
+ end;
+ SysUtils.FindClose(SRec);
+ Result := apps;
+ if apps <> '' then
+ begin
+ while pos(',',apps) > 0 do
+ begin
+ Res := FindFirst ('/usr/share/application-registry/*.applications', faAnyFile, SRec);
+ while Res = 0 do
+ begin
+ AssignFile(f,'/usr/share/application-registry/'+SRec.Name);
+ Reset(f);
+ while not eof(f) do
+ begin
+ readln(f,tmp);
+ if not ((copy(tmp,0,1) = ' ') or (copy(tmp,0,1) = #9)) then
+ //eingerÃckt die eigenschaften
+ if trim(tmp) = copy(apps,0,pos(',',apps)-1) then
+ begin
+ readln(f,tmp);
+ while (not eof(f)) and ((copy(tmp,0,1) = ' ') or (copy(tmp,0,1) = #9)) do
+ begin
+ tmp := StringReplace(trim(tmp),#9,'',[rfReplaceAll]);
+ if lowercase(copy(tmp,0,8)) = 'command=' then
+ begin
+ Result := copy(tmp,9,length(tmp));
+ if FindFilenameOfCmd(Result) <> '' then
+ begin
+ if pos('%f',Result) = 0 then
+ Result := Result+' "%s"'
+ else
+ Stringreplace(Result,'%f','%s',[rfReplaceAll]);
+
+ CloseFile(f);
+ exit;
+ end;
+ end;
+ readln(f,tmp);
+ end;
+ end;
+ end;
+ CloseFile(f);
+ Res := FindNext(SRec);
+ end;
+ apps := copy(apps,pos(',',apps)+1,length(apps));
+ end;
+ end;
+ if Result='' then
+ Result:=FindFilenameOfCmd('xdg-open')+' "%s"'; // Portland OSDL/FreeDesktop standard on Linux
+ if Result='' then
+ Result:=FindFilenameOfCmd('kfmclient')+' "%s"'; // KDE command
+ if Result='' then
+ Result:=FindFilenameOfCmd('gnome-open')+' "%s"'; // GNOME command
+{$endif}
+end;
+{$ELSE}
+function TextCut(Len: Integer; Text: String): String;
+begin
+ if Len < length(Text) then
+ Result := copy(Text,0,len-3)+'...'
+ else
+ Result := Text;
+end;
+{$ENDIF}
+{$ENDIF}
+function GetMimeTypeforExtension(Extension : string) : string;
+var
+{$ifdef MSWINDOWS}
+ reg : TRegistry;
+{$else}
+ f : TextFile;
+ tmp : string;
+{$endif}
+begin
+{$ifdef WINDOWS}
+ Result := '';
+ Reg := TRegistry.Create(KEY_READ);
+ Reg.RootKey := HKEY_CLASSES_ROOT;
+ if Reg.OpenKeyReadOnly(ExtractFileExt('.'+Extension)) then
+ begin
+ Result := Reg.ReadString('Content Type');
+ Reg.CloseKey;
+ end;
+ Reg.Free;
+{$ELSE}
+ if FileExists('~/.local/share/mime/globs') then
+ AssignFile(f,'~/.local/share/mime/globs')
+ else if FileExists('/usr/local/share/mime/globs') then
+ AssignFile(f,'/usr/local/share/mime/globs')
+ else if FileExists('/usr/share/mime/globs') then
+ AssignFile(f,'/usr/share/mime/globs')
+ else
+ exit;
+ Reset(f);
+ while not eof(f) do
+ begin
+ readln(f,tmp);
+ if copy(tmp,pos(':*.',tmp)+3,length(tmp)) = Extension then
+ result := copy(tmp,0,pos(':*.',tmp)-1);
+ end;
+ CloseFile(f);
+{$endif}
+end;
+function GetSystemLang: string;
+{$IFDEF WINDOWS}
+var
+ Ident: Integer;
+ MyLang: PChar;
+const
+ Size: Integer = 250;
+{$ENDIF}
+begin
+{$IFDEF WINDOWS}
+ GetMem(MyLang, Size);
+ Ident:=GetSystemDefaultLangID;
+ VerLanguageName(Ident, MyLang, Size);
+ Result:=StrPas(MyLang);
+ FreeMem(MyLang);
+{$ELSE}
+ Result := GetEnvironmentVariable('LANG');
+{$ENDIF}
+end;
+function DateTimeToHourString(DateTime: TDateTime): string;
+var
+ Hour,Minute,Second,Millisecond: word;
+begin
+ DecodeTime(DateTime,Hour,Minute,Second,Millisecond);
+ Result := Format('%.2d:%.2d',[Trunc(DateTime)*HoursPerDay+Hour,Minute]);
+end;
+function DateTimeToIndustrialTime(DateTime: TDateTime): string;
+var
+ Hour,Minute,Second,Millisecond: word;
+begin
+ DecodeTime(DateTime,Hour,Minute,Second,Millisecond);
+ Result := IntToStr(round((((Trunc(DateTime)*HoursperDay)+Hour)*100)+((Minute/60)*100)));
+end;
+function ConvertUnknownStringdate(input: string): TDateTime;
+begin
+ if (input <> '') and (pos('.',input) = 0) and (pos('-',input) = 0) and (pos('/',input) = 0) and (length(input) = 8) then
+ Result := EncodeDate(StrToInt(copy(input,0,4)),StrToInt(copy(input,5,2)),StrToInt(copy(input,7,2)))
+ else
+ begin //decode date
+ try
+ if length(input) = 4 then //YYYY
+ Result := EncodeDate(StrToInt(input),1,1)
+ else if length(input) = 7 then
+ begin
+ if pos('-',input) = 5 then //YYYY-MM
+ Result := EncodeDate(StrToInt(copy(input,0,4)),StrToInt(copy(input,6,2)),1)
+ end
+ else if length(input) = 10 then
+ begin
+ if pos('.',input) > 0 then
+ begin
+ if rpos('.',input) = 6 then //DD.MM.YYYY
+ Result := EncodeDate(StrToInt(copy(input,6,4)),StrToInt(copy(input,3,2)),StrToInt(copy(input,0,2)))
+ else if pos('-',input) = 3 then //DD.MM.YY
+ Result := EncodeDate(1900+StrToInt(copy(input,6,2)),StrToInt(copy(input,3,2)),StrToInt(copy(input,0,2)))
+ end
+ else if pos('-',input) > 0 then
+ begin
+ if pos('-',input) = 5 then //YYYY-MM-DD
+ Result := EncodeDate(StrToInt(copy(input,0,4)),StrToInt(copy(input,6,2)),StrToInt(copy(input,9,2)))
+ else if pos('-',input) = 3 then //YY-MM-DD
+ Result := EncodeDate(1900+StrToInt(copy(input,0,2)),StrToInt(copy(input,4,2)),StrToInt(copy(input,7,2)))
+ end
+ else if pos('/',input) > 0 then
+ begin
+ if pos('/',input) = 5 then //YYYY/MM/DD
+ Result := EncodeDate(StrToInt(copy(input,0,4)),StrToInt(copy(input,6,2)),StrToInt(copy(input,9,2)))
+ else if pos('/',input) = 3 then //YY/MM/DD
+ Result := EncodeDate(1900+StrToInt(copy(input,0,2)),StrToInt(copy(input,4,2)),StrToInt(copy(input,7,2)))
+ end;
+ end;
+ except
+ end;
+ end;
+end;
+function HTMLEncode(s: string): string;
+begin
+ Result := StringReplace(s, '&', '&', [rfreplaceall]);
+ Result := StringReplace(Result, '"', '"', [rfreplaceall]);
+ Result := StringReplace(result, '<', '<', [rfreplaceall]);
+ Result := StringReplace(result, '>', '>', [rfreplaceall]);
+ Result := StringReplace(result, '''', 'ä', [rfreplaceall]);
+ Result := StringReplace(result, 'ä', 'ä', [rfreplaceall]);
+ Result := StringReplace(result, 'ö', 'ö', [rfreplaceall]);
+ Result := StringReplace(result, 'ü', 'ü', [rfreplaceall]);
+ Result := StringReplace(result, 'Ä', 'Ä', [rfreplaceall]);
+ Result := StringReplace(result, 'Ö', 'Ö', [rfreplaceall]);
+ Result := StringReplace(result, 'Ãœ', 'Ü', [rfreplaceall]);
+ Result := StringReplace(result, 'ß', 'ß', [rfreplaceall]);
+end;
+function HTMLDecode(s: string): string;
+begin
+ Result := s;
+ Result := StringReplace(Result, '&' ,'&', [rfreplaceall]);
+ Result := StringReplace(Result, '"' ,'"', [rfreplaceall]);
+ Result := StringReplace(Result, '<' ,'<', [rfreplaceall]);
+ Result := StringReplace(Result, '>' ,'>', [rfreplaceall]);
+ Result := StringReplace(Result, ' ' ,' ', [rfreplaceall]);
+ Result := StringReplace(Result, 'ä' ,'ä', [rfreplaceall]);
+ Result := StringReplace(Result, 'ö' ,'ö', [rfreplaceall]);
+ Result := StringReplace(Result, 'ü' ,'ü', [rfreplaceall]);
+ Result := StringReplace(Result, 'Ä' ,'Ä', [rfreplaceall]);
+ Result := StringReplace(Result, 'Ö' ,'Ö', [rfreplaceall]);
+ Result := StringReplace(Result, 'Ü' ,'Ãœ', [rfreplaceall]);
+ Result := StringReplace(Result, 'ß','ß', [rfreplaceall]);
+end;
+function CanWriteToProgramDir : Boolean;
+var
+ f : TextFile;
+begin
+ AssignFile(f,ExtractFilePath(Paramstr(0))+'writetest.tmp');
+ try
+ Rewrite(f);
+ except
+ Result := False;
+ exit;
+ end;
+ CloseFile(f);
+ SysUtils.DeleteFile(ExtractFilePath(Paramstr(0))+'writetest.tmp');
+ Result := True;
+end;
+function SizeToText(size : Longint) : string;
+begin
+ if size > 1024*1024*1024 then
+ Result := FormatFloat('0.00',size/(1024*1024*1024))+' Gb'
+ else if size > 1024*1024 then
+ Result := FormatFloat('0.00',size/(1024*1024))+' Mb'
+ else if size > 1024 then
+ Result := FormatFloat('0.00',size/(1024))+' Kb'
+ else
+ Result := IntToStr(size)+' byte'
+end;
+function GetMainIconHandle(Resourcename : string) : Cardinal;
+begin
+{$ifdef MSWINDOWS}
+ Result := LoadIcon(hInstance,PChar(Resourcename));
+{$else}
+ Result := 0;
+{$endif}
+end;
+function GetGlobalConfigDir(app : string;Global : Boolean = True) : string;
+{$IFDEF MSWINDOWS}
+const
+ CSIDL_COMMON_APPDATA = $0023; // All Users\Application Data
+ CSIDL_LOCAL_APPDATA = $001c;
+ CSIDL_FLAG_CREATE = $8000; { (force creation of requested folder if it doesn't exist yet) }
+var
+ Path: array [0..1024] of char;
+ P : Pointer;
+ SHGetFolderPath : PFNSHGetFolderPath = Nil;
+ CFGDLLHandle : THandle = 0;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ CFGDLLHandle:=LoadLibrary('shell32.dll');
+ if (CFGDLLHandle<>0) then
+ begin
+ P:=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA');
+ If (P=Nil) then
+ begin
+ FreeLibrary(CFGDLLHandle);
+ CFGDllHandle:=0;
+ end
+ else
+ SHGetFolderPath:=PFNSHGetFolderPath(P);
+ end;
+ If (P=Nil) then
+ begin
+ CFGDLLHandle:=LoadLibrary('shfolder.dll');
+ if (CFGDLLHandle<>0) then
+ begin
+ P:=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA');
+ If (P=Nil) then
+ begin
+ FreeLibrary(CFGDLLHandle);
+ CFGDllHandle:=0;
+ end
+ else
+ ShGetFolderPath:=PFNSHGetFolderPath(P);
+ end;
+ end;
+ Result := ExtractFilePath(Paramstr(0));
+ If (@ShGetFolderPath<>Nil) then
+ begin
+ if Global then
+ begin
+ if SHGetFolderPath(0,CSIDL_COMMON_APPDATA or CSIDL_FLAG_CREATE,0,0,@PATH[0])=S_OK then
+ Result:=IncludeTrailingPathDelimiter(StrPas(@Path[0]))+app;
+ end
+ else
+ begin
+ if SHGetFolderPath(0,CSIDL_LOCAL_APPDATA or CSIDL_FLAG_CREATE,0,0,@PATH[0])=S_OK then
+ Result:=IncludeTrailingPathDelimiter(StrPas(@Path[0]))+app;
+ end;
+ end;
+{$ELSE}
+ Result:=GetEnvironmentVariable('HOME');
+ If (Result<>'') then
+ Result:=IncludeTrailingPathDelimiter(Result)+'.'+app;
+{$ENDIF}
+ Result := IncludeTrailingPathDelimiter(result);
+end;
+function GetConfigDir(app : string) : string;
+begin
+ Result := GetGlobalConfigDir(app,False);
+ if Result = DirectorySeparator then
+ Result := '';
+end;
+function GetProgramDir : string;
+{$IFDEF MSWINDOWS}
+const
+ CSIDL_PROGRAM_FILES = $0026; // C:\Program Files
+var
+ Path: array [0..1024] of char;
+ P : Pointer;
+ SHGetFolderPath : PFNSHGetFolderPath = Nil;
+ CFGDLLHandle : THandle = 0;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ CFGDLLHandle:=LoadLibrary('shell32.dll');
+ if (CFGDLLHandle<>0) then
+ begin
+ P:=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA');
+ If (P=Nil) then
+ begin
+ FreeLibrary(CFGDLLHandle);
+ CFGDllHandle:=0;
+ end
+ else
+ SHGetFolderPath:=PFNSHGetFolderPath(P);
+ end;
+ If (P=Nil) then
+ begin
+ CFGDLLHandle:=LoadLibrary('shfolder.dll');
+ if (CFGDLLHandle<>0) then
+ begin
+ P:=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA');
+ If (P=Nil) then
+ begin
+ FreeLibrary(CFGDLLHandle);
+ CFGDllHandle:=0;
+ end
+ else
+ ShGetFolderPath:=PFNSHGetFolderPath(P);
+ end;
+ end;
+ Result := ExtractFilePath(Paramstr(0));
+ If (@ShGetFolderPath<>Nil) then
+ if SHGetFolderPath(0,CSIDL_PROGRAM_FILES,0,0,@PATH[0])=S_OK then
+ Result:=StrPas(@Path[0]);
+{$ELSE}
+{$ENDIF}
+ Result := IncludeTrailingPathDelimiter(result);
+end;
+function GetTempPath : string;
+{$IFDEF MSWINDOWS}
+var
+ TD : PChar;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ GetMem(TD, 256);
+ try
+ FillChar(TD^, 256, 0);
+ Windows.GetTempPath(256, TD);
+ Result := TD;
+ finally
+ FreeMem(TD, 256);
+ end;
+{$ELSE}
+ Result := '/tmp';
+{$ENDIF}
+end;
+function ValidateFileDir(old: string): string;
+begin
+ Result := old;
+ if DirectorySeparator <> '/' then
+ Result := StringReplace(Result,'/','',[rfReplaceAll]);
+ Result := StringReplace(Result,'@','',[rfReplaceAll]);
+ Result := StringReplace(Result,';','',[rfReplaceAll]);
+end;
+function ValidateDate(D : string) : string;
+begin
+ if pos('.',D) > 0 then
+ Result := StringReplace(D,'-','.',[rfReplaceAll]);
+ if length(D) = 4 then
+ Result := '01.01.'+D;
+end;
+function ValidateFileName(old : string) : string;
+begin
+ Result := StringReplace(old,'\','',[rfReplaceAll]);
+ Result := StringReplace(Result,'/','',[rfReplaceAll]);
+ Result := StringReplace(Result,'@','',[rfReplaceAll]);
+ Result := StringReplace(Result,';','',[rfReplaceAll]);
+ Result := StringReplace(Result,'#','_',[rfReplaceAll]);
+ Result := StringReplace(Result,'>','_',[rfReplaceAll]);
+ Result := StringReplace(Result,'<','_',[rfReplaceAll]);
+ Result := StringReplace(Result,'|','_',[rfReplaceAll]);
+ Result := StringReplace(Result,'"','_',[rfReplaceAll]);
+ Result := StringReplace(Result,':','_',[rfReplaceAll]);
+ Result := StringReplace(Result,'*','_',[rfReplaceAll]);
+ Result := StringReplace(Result,'?','_',[rfReplaceAll]);
+ Result := StringReplace(Result,'&','',[rfReplaceAll]);
+ Result := StringReplace(Result,'(','_',[rfReplaceAll]);
+ Result := StringReplace(Result,')','_',[rfReplaceAll]);
+end;
+function StripHTML(S: string): string;
+var
+ TagBegin, TagEnd, TagLength: integer;
+begin
+ S := Stringreplace(S,'
',#13,[rfReplaceAll]);
+ TagBegin := Pos( '<', S); // search position of first <
+
+ while (TagBegin > 0) do begin // while there is a < in S
+ TagEnd := Pos('>', S); // find the matching >
+ TagLength := TagEnd - TagBegin + 1;
+ if Taglength <= 0 then break;
+ Delete(S, TagBegin, TagLength); // delete the tag
+ TagBegin:= Pos( '<', S); // search for next <
+ end;
+
+ S := Stringreplace(S,' ',' ',[rfReplaceAll]);
+ S := Stringreplace(S,'&','&',[rfReplaceAll]);
+ S := Stringreplace(S,'<','<',[rfReplaceAll]);
+ S := Stringreplace(S,'>','>',[rfReplaceAll]);
+ S := Stringreplace(S,'"','"',[rfReplaceAll]);
+ Result := HTMLDecode(S); // give the result
+end;
+function GetSystemName: string;
+{$IFDEF MSWINDOWS}
+var
+ ComputerNameBuffer: array[0..255] of char;
+ sizeBuffer: DWord;
+{$ENDIF}
+begin
+ {$IFDEF MSWINDOWS}
+ SizeBuffer := 256;
+ GetComputerName(ComputerNameBuffer, sizeBuffer);
+ Result := string(ComputerNameBuffer);
+ {$ELSE}
+ Result := GetHostName;
+ {$ENDIF}
+end;
+function HTTPEncode(const str : String) : string;
+const
+ noconvert = ['A'..'Z','a'..'z','*','@','.','_','-','0'..'9','$','!','''','(',')'];
+ hex2str : array[0..15] of char = '0123456789ABCDEF';
+var
+ i : integer;
+ c : char;
+begin
+ Result := '';
+ for i:=1 to length(str) do
+ begin
+ c:=str[i];
+ if c in noconvert then
+ Result:=Result+c
+ else
+ Result:=Result+'%'+hex2str[ord(c) shr 4]+hex2str[ord(c) and $f];
+ end;
+end;
+{$IFDEF MSWINDOWS}
+function SystemUserName : string;
+var
+ buffer : array[0..MAX_PATH] of Char;
+ Size: DWORD;
+ FUserName: WideString;
+begin
+ Size := sizeof(buffer);
+ GetUserName(buffer, Size);
+ SetString(FUserName, buffer, lstrlen(buffer));
+ Result := FUserName;
+end;
+{$ENDIF}
+{$IFNDEF WINDOWS}
+function SystemUserName : string;
+begin
+ Result := GetEnvironmentVariable('USERNAME');
+ if Result = '' then
+ Result := GetEnvironmentVariable('USER');
+end;
+{$ENDIF}
+{$IFDEF MSWINDOWS}
+function GetAdminSid: PSID;
+const
+ // bekannte SIDs ... (WinNT.h)
+ SECURITYNTAUTHORITY: TSIDIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 5));
+ // bekannte RIDs ... (WinNT.h)
+ SECURITYBUILTINDOMAINRID: DWORD = $00000020;
+ DOMAINALIASRIDADMINS: DWORD = $00000220;
+begin
+ Result := nil;
+ AllocateAndInitializeSid(SECURITYNTAUTHORITY,
+ 2,
+ SECURITYBUILTINDOMAINRID,
+ DOMAINALIASRIDADMINS,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ 0,
+ Result);
+end;
+//----von Mathias Simmacks "IsAdmin.inc" (TFileTypeRegistration.zip) geklaut:
+function IsAdmin: LongBool;
+var
+ TokenHandle: THandle;
+ ReturnLength: DWORD;
+ TokenInformation: PTokenGroups;
+ AdminSid: PSID;
+ Loop: Integer;
+ wv: TOSVersionInfo;
+begin
+ wv.dwOSVersionInfoSize := sizeof(TOSversionInfo);
+ GetVersionEx(wv);
+
+ Result := (wv.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS);
+
+ if (wv.dwPlatformId = VER_PLATFORM_WIN32_NT) then
+ begin
+ TokenHandle := 0;
+ if OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, TokenHandle) then
+ try
+ ReturnLength := 0;
+ GetTokenInformation(TokenHandle, TokenGroups, nil, 0, ReturnLength);
+ TokenInformation := GetMemory(ReturnLength);
+ if Assigned(TokenInformation) then
+ try
+ if GetTokenInformation(TokenHandle, TokenGroups,
+ TokenInformation, ReturnLength, ReturnLength) then
+ begin
+ AdminSid := GetAdminSid;
+ for Loop := 0 to TokenInformation^.GroupCount - 1 do
+ begin
+ if EqualSid(TokenInformation^.Groups[Loop].Sid, AdminSid) then
+ begin
+ Result := True; break;
+ end;
+ end;
+ FreeSid(AdminSid);
+ end;
+ finally
+ FreeMemory(TokenInformation);
+ end;
+ finally
+ CloseHandle(TokenHandle);
+ end;
+ end;
+end;
+{$ENDIF}
+function InstallExt(Extension, ExtDescription, FileDescription,OpenWith, ParamString: string; IconIndex: Integer = 0): Boolean;
+{$IFDEF MSWINDOWS}
+const
+ SHCNE_ASSOCCHANGED = $8000000;
+ SHCNF_IDLIST = $0000;
+var
+ Reg: TRegistry;
+{$ENDIF}
+begin
+ Result := False;
+ if Extension <> '' then
+ begin
+{$IFDEF MSWINDOWS}
+ if Extension[1] <> '.' then
+ Extension := '.' + Extension;
+ Reg := TRegistry.Create;
+ try
+ Reg.RootKey := HKEY_CLASSES_ROOT;
+ if Reg.OpenKey(Extension, True) then
+ begin
+ Reg.WriteString('', ExtDescription);
+ if Reg.OpenKey('\' + ExtDescription, True) then
+ begin
+ Reg.WriteString('', FileDescription);
+ if Reg.OpenKey('DefaultIcon', True) then
+ begin
+ Reg.WriteString('', Format('%s,%d', [OpenWith, IconIndex]));
+ if Reg.OpenKey('\' + ExtDescription + '\Shell\Open\Command', True) then
+ begin
+ Reg.WriteString('', Format('"%s" "%s"', [OpenWith, ParamString]));
+ Result:=True;
+ end;
+ end;
+ end
+ else
+ begin
+ Reg.RootKey:=HKEY_CURRENT_USER;
+ if Reg.OpenKey('Software\Classes\', True) then
+ begin
+ if Reg.OpenKey(Extension, True) then
+ begin
+ Reg.WriteString('', ExtDescription);
+ if Reg.OpenKey('\' + ExtDescription, True) then
+ begin
+ Reg.WriteString('', FileDescription);
+ if Reg.OpenKey('DefaultIcon', True) then
+ begin
+ Reg.WriteString('', Format('%s,%d', [OpenWith, IconIndex]));
+ if Reg.OpenKey('\' + ExtDescription + '\Shell\Open\Command', True) then
+ begin
+ Reg.WriteString('', Format('"%s" "%s"', [OpenWith, ParamString]));
+ Result:=True;
+ end;
+ end;
+ end;
+ end
+ end;
+ end;
+ end;
+ finally
+ Reg.Free;
+ end;
+ SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
+{$ENDIF}
+ end;
+end;
+FUNCTION StrTimeToValue(val : string) : LongInt;
+var
+ i : Integer;
+ un : string;
+begin
+ //TODO:replace ',' with system delemiter
+ un := '';
+ FOR i := 1 TO length(val) DO
+ IF NOT ((Char(Val[i]) IN ['0'..'9']) or (Char(Val[i]) = DecimalSeparator)) THEN
+ begin
+ un := trim(copy(Val,i,length(Val)));
+ break;
+ end;
+ if copy(Val,0,i-1) = '' then
+ begin
+ Result := -1;
+ exit;
+ end;
+ if (UpperCase(un) = 'MS') or (un = '') then
+ Result := Round(StrToFloat(copy(Val,0,i-1)))
+ else if UpperCase(un) = 'S' then
+ Result := Round(1000*StrToFloat(copy(Val,0,i-1)))
+ else if UpperCase(un) = 'M' then
+ Result := Round(60*1000*StrToFloat(copy(Val,0,i-1)))
+ else
+ Result := -1;
+end;
+FUNCTION IsNumeric(s: STRING): boolean;
+var
+ i : integer;
+begin
+ if copy(s,0,1) = '-' then
+ s := copy(s,2,length(s));
+ Result := length(s) > 0;
+ for i:= 0 to 47 do
+ begin
+ if (pos(chr(i),s) > 0) then
+ begin
+ result := false;
+ end;
+ end;
+ for i := 58 to 255 do
+ begin
+ if (pos(chr(i),s)>0) then
+ begin
+ result := false;
+ end
+ end;
+end;
+function RPos(const Substr: string; const S: string): Integer;
+var
+ SL, i : Integer;
+begin
+ SL := Length(Substr);
+ i := Length(S);
+ if (Substr = '') or (S = '') or (SL > i) then begin
+ Result := 0;
+ Exit;
+ end;
+
+ while i >= SL do begin
+ if S[i] = Substr[SL] then begin
+ if Copy(S, i - SL + 1, SL) = Substr then begin
+ Result := i - SL + 1;
+ Exit;
+ end;
+ end;
+ Dec(i);
+ end;
+ Result := i;
+end;
+ { Make sure given file path is ended with backslash ("\") }
+ { Clears Directory: Removes all files and directories contained }
+function ClearDir (Path: string): boolean;
+var
+ Res: integer;
+ SRec: SysUtils.TSearchRec;
+begin
+ Result := false;
+ try
+ if copy(path,length(path)-1,1) <> DirectorySeparator then
+ Path := Path+DirectorySeparator;
+ Res := FindFirst (Path + '*.*', faAnyFile, SRec);
+ while Res = 0 do
+ begin
+ if (SRec.Attr = faDirectory) and (SRec.Name[1] <> '.') then
+ begin
+ ClearDir (Path + SRec.Name); { Clear before removing }
+ if not RemoveDir (pchar(Path + SRec.Name)) then
+ exit;
+ end
+ else
+ SysUtils.DeleteFile(Path + SRec.Name);
+ Res := FindNext(SRec);
+ end;
+ SysUtils.FindClose(SRec);
+ Result := true;
+ except
+ end;
+end;
+END.
+
+
\ No newline at end of file
diff --git a/Software/src/general/src/aspell.pas b/Software/src/general/src/aspell.pas
new file mode 100755
index 0000000..4375cac
--- /dev/null
+++ b/Software/src/general/src/aspell.pas
@@ -0,0 +1,175 @@
+unit Aspell;
+
+interface
+
+uses SysUtils, Classes, ProcessLineTalk, Contnrs;
+
+type
+ TMessageType = (mtPlainText, mtInformation, mtWarning, mtError);
+ TPasDocMessageEvent = procedure(const MessageType: TMessageType; const
+ AMessage: string; const AVerbosity: Cardinal) of object;
+
+ TSpellingError = class
+ public
+ { the mis-spelled word }
+ Word: string;
+ { offset inside the checked string }
+ Offset: Integer;
+ { comma-separated list of suggestions }
+ Suggestions: string;
+ end;
+
+ { This is a class to interface with aspell through pipe.
+ It uses underlying @link(TProcessLineTalk) to execute and
+ "talk" with aspell. }
+ TAspellProcess = class
+ private
+ FProcess: TProcessLineTalk;
+ FAspellMode: string;
+ FAspellLanguage: string;
+ FOnMessage: TPasDocMessageEvent;
+
+ procedure DoMessage(const AVerbosity: Cardinal;
+ const MessageType: TMessageType; const AMessage: string);
+ public
+ { Values for AspellMode and AspellLanguage are the same as for
+ aspell @--mode and @--lang command-line options.
+ You can pass here '', then we will not pass appropriate
+ command-line option to aspell. }
+ constructor Create(const AAspellMode, AAspellLanguage: string);
+ destructor Destroy; override;
+
+ property AspellMode: string read FAspellMode;
+
+ property AspellLanguage: string read FAspellLanguage;
+
+ procedure SetIgnoreWords(Value: TStringList);
+
+ { Spellchecks AString and returns result.
+ Will create an array of TSpellingError objects,
+ one entry for each misspelled word.
+ Offsets of TSpellingErrors will be relative to AString. }
+ procedure CheckString(const AString: string; const AErrors: TObjectList);
+
+ property OnMessage: TPasDocMessageEvent read FOnMessage write FOnMessage;
+ end;
+
+implementation
+
+//uses PasDoc_Utils;
+
+constructor TAspellProcess.Create(const AAspellMode, AAspellLanguage: string);
+var FirstAspellLine: string;
+begin
+ inherited Create;
+
+ FAspellMode := AAspellMode;
+ FAspellLanguage := AAspellLanguage;
+
+ FProcess := TProcessLineTalk.Create(nil);
+
+ { calculate FProcess.CommandLine }
+// FProcess.CurrentDirectory := 'D:\Programme\Aspell\bin';
+ FProcess.CommandLine := 'D:\Programme\Aspell\bin\aspell -a';
+ if AspellMode <> '' then
+ FProcess.CommandLine := FProcess.CommandLine + ' --mode=' + AspellMode;
+ if AspellLanguage <> '' then
+ FProcess.CommandLine := FProcess.CommandLine + ' --lang=' + AspellLanguage;
+
+ { execute }
+ FProcess.Execute;
+
+ { read and check 1st aspell output line }
+ FirstAspellLine := FProcess.ReadLine;
+ if Copy(FirstAspellLine, 1, 4) <> '@(#)' then
+ raise Exception.CreateFmt('Wrong introduction from aspell: "%s"',
+ [FirstAspellLine]);
+
+ { switch to aspell terse mode (do not report about correct words;
+ report only mispellings) }
+ FProcess.WriteLine('!');
+end;
+
+destructor TAspellProcess.Destroy;
+begin
+ FProcess.Free;
+ inherited;
+end;
+
+procedure TAspellProcess.SetIgnoreWords(Value: TStringList);
+var
+ i: Integer;
+begin
+ for i := 0 to Value.Count - 1 do
+ FProcess.WriteLine('@' + Value[i]);
+end;
+
+procedure TAspellProcess.CheckString(const AString: string;
+ const AErrors: TObjectList);
+var
+ s: string;
+ p, p2: Integer;
+ LError: TSpellingError;
+begin
+ AErrors.Clear;
+
+ { make sure that FAspellMode is set -- should be removed, since it's
+ passed to aspell command-line ? TODO. }
+ if AspellMode <> '' then
+ begin
+ FProcess.WriteLine('-');
+ FProcess.WriteLine('+' + AspellMode);
+ end;
+
+ { request spell-checking AString }
+ FProcess.WriteLine('^' + StringReplace(AString,StringReplace(AString,#13, ' ',[rfReplaceAll]),#10,[rfReplaceAll]));
+
+ repeat
+ s := FProcess.ReadLine;
+ { aspell returns empty line when it finished spell-checking AString }
+ if s = '' then break;
+
+ case s[1] of
+ '*': Continue; // no error
+ '#': begin
+ LError := TSpellingError.Create;
+ s := copy(s, 3, MaxInt); // get rid of '# '
+ p := Pos(' ', s);
+ LError.Word := copy(s, 1, p-1); // get word
+ LError.Suggestions := '';
+ s := copy(s, p+1, MaxInt);
+ LError.Offset := StrToIntDef(s, 0)-1;
+ AErrors.Add(LError);
+ end;
+ '&': begin
+ LError := TSpellingError.Create;
+ s := copy(s, 3, MaxInt); // get rid of '& '
+ p := Pos(' ', s);
+ LError.Word := copy(s, 1, p-1); // get word
+ s := copy(s, p+1, MaxInt);
+ p := Pos(' ', s);
+ s := copy(s, p+1, MaxInt);
+ p2 := Pos(':', s);
+ LError.Suggestions := Copy(s, Pos(':', s)+2, MaxInt);
+ SetLength(s, p2-1);
+ LError.Offset := StrToIntDef(s, 0)-1;
+ AErrors.Add(LError);
+ end;
+ else
+ { Actually, it's nowhere formally specified that aspell error
+ messages start with "Error:". So we can possibly accidentaly
+ skip some error messages from aspell. }
+ if copy(s,0,6) = 'Error:' then
+ DoMessage(2, mtWarning, 'Aspell error: ' + S);
+ end;
+ until false;
+end;
+
+procedure TAspellProcess.DoMessage(const AVerbosity: Cardinal;
+ const MessageType: TMessageType; const AMessage: string);
+begin
+ if Assigned(FOnMessage) then
+ FOnMessage(MessageType, AMessage, AVerbosity);
+end;
+
+end.
diff --git a/Software/src/general/src/eparser.pas b/Software/src/general/src/eparser.pas
new file mode 100755
index 0000000..7d6ebf1
--- /dev/null
+++ b/Software/src/general/src/eparser.pas
@@ -0,0 +1,394 @@
+unit EParser;
+
+interface
+
+uses
+ Classes, SysUtils;
+
+type
+ //Parser error messages
+ TParserEMessage=(pBadQuotes, pBadBrackets, pBadSyntax);
+
+ //Parser error messages handler
+ TParserException=class(Exception)
+ public
+ constructor CreatePE(VPEMessage : TParserEMessage);
+ end;
+
+ //Type of the result returned
+ TRes = (trInt, trStr, trBool);
+
+ //Result structure
+ PPRes = ^TPRes;
+ TPRes=record
+ Res : TRes;
+ Value : String;
+ end;
+
+ //Type of the token
+ TTokenType=(ttDelimiter, ttNumber, ttQuote, ttString, ttFinished);
+
+ //Main parser class
+ TFEParser = class
+ private
+ FExpr : String;
+ FLExpr : Integer;
+ FExprID : Integer;
+ FToken : String;
+ FTokenType : TTokenType;
+ function IsDelim(C : Char) : Boolean;
+ function IsDigit(C : Char) : Boolean;
+ function IsAlpha(C : Char) : Boolean;
+ function GetExpr : String;
+ procedure SetExpr(const VExpr : String);
+ procedure Get_Token;
+
+ procedure Level1(Res : PPRes);
+ procedure Level2(Res : PPRes);
+ procedure Level3(Res : PPRes);
+ procedure Level4(Res : PPRes);
+ procedure Level5(Res : PPRes);
+ procedure Level6(Res : PPRes);
+ procedure Primitive(Res : PPRes);
+ procedure LogOp(Op : String; Res, Res2 : PPRes);
+ procedure LogConOp(Op : String; Res, Res2 : PPRes);
+ procedure ArithOp(Op : Char; Res, Res2 : PPRes);
+ procedure UnaryOp(Op : Char; Res : PPRes);
+ protected
+ //Method to be overridden by descendents to translate
+ //a variable name (VName) into a value
+ function ValueByName(VName : String) : String;virtual;
+ public
+ //The Expression to parse
+ property Expr : String read GetExpr write SetExpr;
+ //Interface to enumerate expression tokens
+ procedure ListTokens(Str : TStrings);
+ //Entry point
+ function Get_Result : Boolean;
+ end;
+
+implementation
+
+{ TFEParser }
+
+const
+ EndSymbol='~';
+ STrue='1'; SFalse='0';
+ PEMessageStr : array[TParserEMessage] of String=(
+ 'Bad quotes',
+ 'Bad brackets',
+ 'Bad Syntax'
+ );
+
+
+procedure TFEParser.ArithOp(Op: Char; Res, Res2: PPRes);
+begin
+ case Op of
+ '+':try
+ Res^.Value := FloatToStr(StrToFloat(Res^.Value)+StrToFloat(Res2^.Value))
+ except
+ Res^.Value := Res^.Value+Res2^.Value;
+ end;
+ '-':Res^.Value := FloatToStr(StrToFloat(Res^.Value)-StrToFloat(Res2^.Value));
+ '*':Res^.Value := FloatToStr(StrToFloat(Res^.Value)*StrToFloat(Res2^.Value));
+ '/':Res^.Value := FloatToStr(StrToFloat(Res^.Value)/StrToFloat(Res2^.Value));
+ end;
+end;
+
+function TFEParser.GetExpr: String;
+begin
+ Result := FExpr;
+ System.Delete(Result, Length(Result)-1, 1);
+end;
+
+function TFEParser.Get_Result: Boolean;
+var
+ PRes : TPRes;
+begin
+ Get_Token;
+ if FTokenType=ttFinished then
+ begin
+ Result := True;
+ exit;
+ end;
+ Level1(@PRes);
+ if PRes.Res<>trBool then
+ raise TParserException.CreatePE(pBadSyntax);
+ Result := (PRes.Value=STrue);
+end;
+
+//Get next token
+procedure TFEParser.Get_Token;
+begin
+ //Spaces
+ while (FExpr[FExprID]=' ') and (FExprID<=FLExpr) do Inc(FExprID);
+ //Check if End of Expression
+ if FExpr[FExprID]=EndSymbol then
+ begin
+ FToken := '';
+ FTokenType := ttFinished;
+ exit;
+ end;
+ //Delimiters
+ if Pos(FExpr[FExprID], '+-/*=()<>')<>0 then
+ begin
+ FToken := FExpr[FExprID];
+ Inc(FExprID);
+ if (FExpr[FExprID]<>EndSymbol) and (Pos(FExpr[FExprID-1], '<>')<>0) and
+ (Pos(FExpr[FExprID], '=>')<>0) then
+ begin
+ FToken := FToken+FExpr[FExprID];
+ Inc(FExprID);
+ end;
+ FTokenType := ttDelimiter;
+ exit;
+ end;
+ //Quotes
+ if FExpr[FExprID]='''' then
+ begin
+ Inc(FExprID);
+ FToken := '';
+ while (FExpr[FExprID]<>'''') and (FExpr[FExprID]<>EndSymbol) do
+ begin
+ FToken := FToken+FExpr[FExprID];
+ Inc(FExprID);
+ end;
+ if FExpr[FExprID]=EndSymbol then
+ raise TParserException.CreatePE(pBadQuotes);
+ Inc(FExprID);
+ FTokenType := ttQuote;
+ exit;
+ end;
+ //Number
+ if IsDigit(FExpr[FExprID]) then
+ begin
+ FToken := '';
+ while (not IsDelim(FExpr[FExprID])) and (FExpr[FExprID]<>EndSymbol) do
+ begin
+ FToken := FToken+FExpr[FExprID];
+ Inc(FExprID);
+ end;
+ FTokenType := ttNumber;
+ exit;
+ end;
+ //Variable
+ if IsAlpha(FExpr[FExprID]) then
+ begin
+ FToken := '';
+ while (not IsDelim(FExpr[FExprID])) and (FExpr[FExprID]<>EndSymbol) do
+ begin
+ FToken := FToken+FExpr[FExprID];
+ Inc(FExprID);
+ end;
+ FTokenType := ttString;
+ exit;
+ end;
+end;
+
+
+function TFEParser.IsAlpha(C: Char): Boolean;
+begin
+ Result := C in ['A'..'Z', 'a'..'z'];
+end;
+
+function TFEParser.IsDelim(C: Char): Boolean;
+begin
+ Result := Pos(C, ' ,+-<>=/*%^()')<>0;
+end;
+
+function TFEParser.IsDigit(C: Char): Boolean;
+begin
+ Result := C in ['0'..'9','.']
+end;
+
+procedure TFEParser.Level1(Res: PPRes);
+var
+ Res2 : TPRes;
+ Op : String;
+begin
+ Level2(Res);
+ while (FToken='and') or (FToken='or') do
+ begin
+ Op := FToken;
+ Get_Token;
+ Level2(@Res2);
+ LogConOp(Op, Res, @Res2);
+ end;
+end;
+
+procedure TFEParser.Level2(Res: PPRes);
+var
+ Res2 : TPRes;
+ Op : String;
+begin
+ Level3(Res);
+ if (FToken='>') or (FToken='<') or
+ (FToken='<=') or (FToken='>=') or (FToken='=') then
+ begin
+ Op := FToken;
+ Get_Token;
+ Level3(@Res2);
+ LogOp(Op, Res, @Res2);
+ end;
+end;
+
+procedure TFEParser.Level3(Res: PPRes);
+var
+ Res2 : TPRes;
+ Op : Char;
+begin
+ Level4(Res);
+ while (FToken='+') or (FToken='-') do
+ begin
+ Op := FToken[1];
+ Get_Token;
+ Level4(@Res2);
+ ArithOp(Op, Res, @Res2);
+ end;
+end;
+
+procedure TFEParser.Level4(Res: PPRes);
+var
+ Res2 : TPRes;
+ Op : Char;
+begin
+ Level5(Res);
+ while (FToken='*') or (FToken='/') do
+ begin
+ Op := FToken[1];
+ Get_Token;
+ Level5(@Res2);
+ ArithOp(Op, Res, @Res2);
+ end;
+end;
+procedure TFEParser.Level5(Res: PPRes);
+var
+ Op : Char;
+begin
+ Op := #0;
+ if (FTokenType=ttDelimiter) and ((FToken='+') or (FToken='-')) then
+ begin
+ Op := FToken[1];
+ Get_Token;
+ end;
+ Level6(Res);
+ if Op<>#0 then
+ UnaryOp(Op, Res);
+end;
+
+procedure TFEParser.Level6(Res: PPRes);
+begin
+ if (FToken='(') and (FTokenType=ttDelimiter) then
+ begin
+ Get_Token;
+ Level1(Res);
+ if FToken<>')' then
+ raise TParserException.CreatePE(pBadBrackets);
+ Get_Token;
+ end else
+ Primitive(Res);
+end;
+
+procedure TFEParser.ListTokens(Str: TStrings);
+begin
+ while (FExprID<>-1) and (FExprID<=FLExpr) do
+ begin
+ Get_Token;
+ if FTokenType=ttFinished then break;
+ Str.Add(FToken);
+ end;
+end;
+
+procedure TFEParser.LogConOp(Op: String; Res, Res2: PPRes);
+begin
+ if (Res^.Res<>trBool) or (Res2^.Res<>trBool) then
+ raise TParserException.CreatePE(pBadSyntax);
+ if Op='and' then
+ begin
+ if (Res^.Value=STrue) and (Res2^.Value=STrue) then
+ Res^.Value := STrue
+ else
+ Res^.Value := SFalse;
+ end else if Op='or' then
+ begin
+ if (Res^.Value=STrue) or (Res2^.Value=STrue) then
+ Res^.Value := STrue
+ else
+ Res^.Value := SFalse;
+ end;
+end;
+
+procedure TFEParser.LogOp(Op: String; Res, Res2: PPRes);
+begin
+ Res^.Res := trBool;
+ if Op='=' then
+ begin
+ if Res^.Value=Res2^.Value then
+ Res^.Value := STrue
+ else Res^.Value := SFalse;
+ end else if Op='>' then
+ begin
+ if StrToFloat(Res^.Value)>StrToFloat(Res2^.Value) then
+ Res^.Value := STrue
+ else Res^.Value := SFalse;
+ end else if Op='>=' then
+ begin
+ if StrToFloat(Res^.Value)>=StrToFloat(Res2^.Value) then
+ Res^.Value := STrue
+ else Res^.Value := SFalse;
+ end else if Op='<' then
+ begin
+ if StrToFloat(Res^.Value) greater-than sign }
+ 63, { 63 ? question mark }
+ 0, { 64 @ commercial at sign }
+ 65, { 65 A uppercase A }
+ 66, { 66 B uppercase B }
+ 67, { 67 C uppercase C }
+ 68, { 68 D uppercase D }
+ 69, { 69 E uppercase E }
+ 70, { 70 F uppercase F }
+ 71, { 71 G uppercase G }
+ 72, { 72 H uppercase H }
+ 73, { 73 I uppercase I }
+ 74, { 74 J uppercase J }
+ 75, { 75 K uppercase K }
+ 76, { 76 L uppercase L }
+ 77, { 77 M uppercase M }
+ 78, { 78 N uppercase N }
+ 79, { 79 O uppercase O }
+ 80, { 80 P uppercase P }
+ 81, { 81 Q uppercase Q }
+ 82, { 82 R uppercase R }
+ 83, { 83 S uppercase S }
+ 84, { 84 T uppercase T }
+ 85, { 85 U uppercase U }
+ 86, { 86 V uppercase V }
+ 87, { 87 W uppercase W }
+ 88, { 88 X uppercase X }
+ 89, { 89 Y uppercase Y }
+ 90, { 90 Z uppercase Z }
+ 60+256, { 91 [ left square bracket }
+ 47+256, { 92 \ backslash }
+ 62+256, { 93 ] right square bracket }
+ 20+256, { 94 ^ circumflex accent }
+ 17, { 95 _ underscore }
+ -39, { 96 ` back apostrophe }
+ 97, { 97 a lowercase a }
+ 98, { 98 b lowercase b }
+ 99, { 99 c lowercase c }
+ 100, { 100 d lowercase d }
+ 101, { 101 e lowercase e }
+ 102, { 102 f lowercase f }
+ 103, { 103 g lowercase g }
+ 104, { 104 h lowercase h }
+ 105, { 105 i lowercase i }
+ 106, { 106 j lowercase j }
+ 107, { 107 k lowercase k }
+ 108, { 108 l lowercase l }
+ 109, { 109 m lowercase m }
+ 110, { 110 n lowercase n }
+ 111, { 111 o lowercase o }
+ 112, { 112 p lowercase p }
+ 113, { 113 q lowercase q }
+ 114, { 114 r lowercase r }
+ 115, { 115 s lowercase s }
+ 116, { 116 t lowercase t }
+ 117, { 117 u lowercase u }
+ 118, { 118 v lowercase v }
+ 119, { 119 w lowercase w }
+ 120, { 120 x lowercase x }
+ 121, { 121 y lowercase y }
+ 122, { 122 z lowercase z }
+ 40+256, (* 123 { left brace *)
+ 64+256, { 124 | vertical bar }
+ 41+256, (* 125 } right brace *)
+ 61+256, { 126 ~ tilde accent }
+ NPC7, { 127 delete [DEL] }
+ NPC7, { 128 }
+ NPC7, { 129 }
+ -39, { 130 low left rising single quote }
+ -102, { 131 lowercase italic f }
+ -34, { 132 low left rising double quote }
+ NPC7, { 133 low horizontal ellipsis }
+ NPC7, { 134 dagger mark }
+ NPC7, { 135 double dagger mark }
+ NPC7, { 136 letter modifying circumflex }
+ NPC7, { 137 per thousand (mille) sign }
+ -83, { 138 uppercase S caron or hacek }
+ -39, { 139 left single angle quote mark }
+ -214, { 140 uppercase OE ligature }
+ NPC7, { 141 }
+ NPC7, { 142 }
+ NPC7, { 143 }
+ NPC7, { 144 }
+ -39, { 145 left single quotation mark }
+ -39, { 146 right single quote mark }
+ -34, { 147 left double quotation mark }
+ -34, { 148 right double quote mark }
+ -42, { 149 round filled bullet }
+ -45, { 150 en dash }
+ -45, { 151 em dash }
+ -39, { 152 small spacing tilde accent }
+ NPC7, { 153 trademark sign }
+ -115, { 154 lowercase s caron or hacek }
+ -39, { 155 right single angle quote mark }
+ -111, { 156 lowercase oe ligature }
+ NPC7, { 157 }
+ NPC7, { 158 }
+ -89, { 159 uppercase Y dieresis or umlaut }
+ -32, { 160 non-breaking space }
+ 64, { 161 ¡ inverted exclamation mark }
+ -99, { 162 ¢ cent sign }
+ 1, { 163 £ pound sterling sign }
+ 36, { 164 ¤ general currency sign }
+ 3, { 165 ¥ yen sign }
+ -33, { 166 ¦ broken vertical bar }
+ 95, { 167 § section sign }
+ -34, { 168 ¨ spacing dieresis or umlaut }
+ NPC7, { 169 © copyright sign }
+ NPC7, { 170 ª feminine ordinal indicator }
+ -60, { 171 « left (double) angle quote }
+ NPC7, { 172 ¬ logical not sign }
+ -45, { 173 soft hyphen }
+ NPC7, { 174 ® registered trademark sign }
+ NPC7, { 175 ¯ spacing macron (long) accent }
+ NPC7, { 176 ° degree sign }
+ NPC7, { 177 ± plus-or-minus sign }
+ -50, { 178 ² superscript 2 }
+ -51, { 179 ³ superscript 3 }
+ -39, { 180 ´ spacing acute accent }
+ -117, { 181 µ micro sign }
+ NPC7, { 182 ¶ paragraph sign, pilcrow sign }
+ NPC7, { 183 · middle dot, centered dot }
+ NPC7, { 184 ¸ spacing cedilla }
+ -49, { 185 ¹ superscript 1 }
+ NPC7, { 186 º masculine ordinal indicator }
+ -62, { 187 » right (double) angle quote (guillemet) }
+ NPC7, { 188 ¼ fraction 1/4 }
+ NPC7, { 189 ½ fraction 1/2 }
+ NPC7, { 190 ¾ fraction 3/4 }
+ 96, { 191 ¿ inverted question mark }
+ -65, { 192 À uppercase A grave }
+ -65, { 193 Á uppercase A acute }
+ -65, { 194 Â uppercase A circumflex }
+ -65, { 195 Ã uppercase A tilde }
+ 91, { 196 Ä uppercase A dieresis or umlaut }
+ 14, { 197 Å uppercase A ring }
+ 28, { 198 Æ uppercase AE ligature }
+ 9, { 199 Ç uppercase C cedilla }
+ -31, { 200 È uppercase E grave }
+ 31, { 201 É uppercase E acute }
+ -31, { 202 Ê uppercase E circumflex }
+ -31, { 203 Ë uppercase E dieresis or umlaut }
+ -73, { 204 Ì uppercase I grave }
+ -73, { 205 Í uppercase I acute }
+ -73, { 206 Î uppercase I circumflex }
+ -73, { 207 Ï uppercase I dieresis or umlaut }
+ -68, { 208 Ð uppercase ETH }
+ 93, { 209 Ñ uppercase N tilde }
+ -79, { 210 Ò uppercase O grave }
+ -79, { 211 Ó uppercase O acute }
+ -79, { 212 Ô uppercase O circumflex }
+ -79, { 213 Õ uppercase O tilde }
+ 92, { 214 Ö uppercase O dieresis or umlaut }
+ -42, { 215 × multiplication sign }
+ 11, { 216 Ø uppercase O slash }
+ -85, { 217 Ù uppercase U grave }
+ -85, { 218 Ú uppercase U acute }
+ -85, { 219 Û uppercase U circumflex }
+ 94, { 220 Ü uppercase U dieresis or umlaut }
+ -89, { 221 Ý uppercase Y acute }
+ NPC7, { 222 Þ uppercase THORN }
+ 30, { 223 ß lowercase sharp s, sz ligature }
+ 127, { 224 à lowercase a grave }
+ -97, { 225 á lowercase a acute }
+ -97, { 226 â lowercase a circumflex }
+ -97, { 227 ã lowercase a tilde }
+ 123, { 228 ä lowercase a dieresis or umlaut }
+ 15, { 229 å lowercase a ring }
+ 29, { 230 æ lowercase ae ligature }
+ -9, { 231 ç lowercase c cedilla }
+ 4, { 232 è lowercase e grave }
+ 5, { 233 é lowercase e acute }
+ -101, { 234 ê lowercase e circumflex }
+ -101, { 235 ë lowercase e dieresis or umlaut }
+ 7, { 236 ì lowercase i grave }
+ 7, { 237 í lowercase i acute }
+ -105, { 238 î lowercase i circumflex }
+ -105, { 239 ï lowercase i dieresis or umlaut }
+ NPC7, { 240 ð lowercase eth }
+ 125, { 241 ñ lowercase n tilde }
+ 8, { 242 ò lowercase o grave }
+ -111, { 243 ó lowercase o acute }
+ -111, { 244 ô lowercase o circumflex }
+ -111, { 245 õ lowercase o tilde }
+ 124, { 246 ö lowercase o dieresis or umlaut }
+ -47, { 247 ÷ division sign }
+ 12, { 248 ø lowercase o slash }
+ 6, { 249 ù lowercase u grave }
+ -117, { 250 ú lowercase u acute }
+ -117, { 251 û lowercase u circumflex }
+ 126, { 252 ü lowercase u dieresis or umlaut }
+ -121, { 253 ý lowercase y acute }
+ NPC7, { 254 þ lowercase thorn }
+ -121 { 255 ÿ lowercase y dieresis or umlaut }
+);
+
+{***************************************************************************
+ This lookup table converts from the 7 bit "default alphabet" as
+ defined in ETSI GSM 03.38 to a standard ISO-8859-1 8-bit ASCII.
+
+ Some characters in the 7-bit alphabet does not exist in the ISO
+ character set, they are replaced by the NPC8-character.
+
+ If the character is decimal 27 (ESC) the following character have
+ a special meaning and must be handled separately.
+***************************************************************************}
+
+lookup_ascii7to8: array[0..127] of Byte = (
+ 64, { 0 @ COMMERCIAL AT }
+ 163, { 1 £ POUND SIGN }
+ 36, { 2 $ DOLLAR SIGN }
+ 165, { 3 ¥ YEN SIGN }
+ 232, { 4 è LATIN SMALL LETTER E WITH GRAVE }
+ 233, { 5 é LATIN SMALL LETTER E WITH ACUTE }
+ 249, { 6 ù LATIN SMALL LETTER U WITH GRAVE }
+ 236, { 7 ì LATIN SMALL LETTER I WITH GRAVE }
+ 242, { 8 ò LATIN SMALL LETTER O WITH GRAVE }
+ 199, { 9 Ç LATIN CAPITAL LETTER C WITH CEDILLA }
+ 10, { 10 LINE FEED }
+ 216, { 11 Ø LATIN CAPITAL LETTER O WITH STROKE }
+ 248, { 12 ø LATIN SMALL LETTER O WITH STROKE }
+ 13, { 13 CARRIAGE RETURN }
+ 197, { 14 Å LATIN CAPITAL LETTER A WITH RING ABOVE }
+ 229, { 15 å LATIN SMALL LETTER A WITH RING ABOVE }
+ NPC8, { 16 GREEK CAPITAL LETTER DELTA }
+ 95, { 17 _ LOW LINE }
+ NPC8, { 18 GREEK CAPITAL LETTER PHI }
+ NPC8, { 19 GREEK CAPITAL LETTER GAMMA }
+ NPC8, { 20 GREEK CAPITAL LETTER LAMBDA }
+ NPC8, { 21 GREEK CAPITAL LETTER OMEGA }
+ NPC8, { 22 GREEK CAPITAL LETTER PI }
+ NPC8, { 23 GREEK CAPITAL LETTER PSI }
+ NPC8, { 24 GREEK CAPITAL LETTER SIGMA }
+ NPC8, { 25 GREEK CAPITAL LETTER THETA }
+ NPC8, { 26 GREEK CAPITAL LETTER XI }
+ 27, { 27 ESCAPE TO EXTENSION TABLE }
+ 198, { 28 Æ LATIN CAPITAL LETTER AE }
+ 230, { 29 æ LATIN SMALL LETTER AE }
+ 223, { 30 ß LATIN SMALL LETTER SHARP S (German) }
+ 201, { 31 É LATIN CAPITAL LETTER E WITH ACUTE }
+ 32, { 32 SPACE }
+ 33, { 33 ! EXCLAMATION MARK }
+ 34, { 34 " QUOTATION MARK }
+ 35, { 35 # NUMBER SIGN }
+ 164, { 36 ¤ CURRENCY SIGN }
+ 37, { 37 % PERCENT SIGN }
+ 38, { 38 & AMPERSAND }
+ 39, { 39 ' APOSTROPHE }
+ 40, { 40 ( LEFT PARENTHESIS }
+ 41, { 41 ) RIGHT PARENTHESIS }
+ 42, { 42 * ASTERISK }
+ 43, { 43 + PLUS SIGN }
+ 44, { 44 , COMMA }
+ 45, { 45 - HYPHEN-MINUS }
+ 46, { 46 . FULL STOP }
+ 47, { 47 / SOLIDUS (SLASH) }
+ 48, { 48 0 DIGIT ZERO }
+ 49, { 49 1 DIGIT ONE }
+ 50, { 50 2 DIGIT TWO }
+ 51, { 51 3 DIGIT THREE }
+ 52, { 52 4 DIGIT FOUR }
+ 53, { 53 5 DIGIT FIVE }
+ 54, { 54 6 DIGIT SIX }
+ 55, { 55 7 DIGIT SEVEN }
+ 56, { 56 8 DIGIT EIGHT }
+ 57, { 57 9 DIGIT NINE }
+ 58, { 58 : COLON }
+ 59, { 59 ; SEMICOLON }
+ 60, { 60 < LESS-THAN SIGN }
+ 61, { 61 = EQUALS SIGN }
+ 62, { 62 > GREATER-THAN SIGN }
+ 63, { 63 ? QUESTION MARK }
+ 161, { 64 ¡ INVERTED EXCLAMATION MARK }
+ 65, { 65 A LATIN CAPITAL LETTER A }
+ 66, { 66 B LATIN CAPITAL LETTER B }
+ 67, { 67 C LATIN CAPITAL LETTER C }
+ 68, { 68 D LATIN CAPITAL LETTER D }
+ 69, { 69 E LATIN CAPITAL LETTER E }
+ 70, { 70 F LATIN CAPITAL LETTER F }
+ 71, { 71 G LATIN CAPITAL LETTER G }
+ 72, { 72 H LATIN CAPITAL LETTER H }
+ 73, { 73 I LATIN CAPITAL LETTER I }
+ 74, { 74 J LATIN CAPITAL LETTER J }
+ 75, { 75 K LATIN CAPITAL LETTER K }
+ 76, { 76 L LATIN CAPITAL LETTER L }
+ 77, { 77 M LATIN CAPITAL LETTER M }
+ 78, { 78 N LATIN CAPITAL LETTER N }
+ 79, { 79 O LATIN CAPITAL LETTER O }
+ 80, { 80 P LATIN CAPITAL LETTER P }
+ 81, { 81 Q LATIN CAPITAL LETTER Q }
+ 82, { 82 R LATIN CAPITAL LETTER R }
+ 83, { 83 S LATIN CAPITAL LETTER S }
+ 84, { 84 T LATIN CAPITAL LETTER T }
+ 85, { 85 U LATIN CAPITAL LETTER U }
+ 86, { 86 V LATIN CAPITAL LETTER V }
+ 87, { 87 W LATIN CAPITAL LETTER W }
+ 88, { 88 X LATIN CAPITAL LETTER X }
+ 89, { 89 Y LATIN CAPITAL LETTER Y }
+ 90, { 90 Z LATIN CAPITAL LETTER Z }
+ 196, { 91 Ä LATIN CAPITAL LETTER A WITH DIAERESIS }
+ 214, { 92 Ö LATIN CAPITAL LETTER O WITH DIAERESIS }
+ 209, { 93 Ñ LATIN CAPITAL LETTER N WITH TILDE }
+ 220, { 94 Ü LATIN CAPITAL LETTER U WITH DIAERESIS }
+ 167, { 95 § SECTION SIGN }
+ 191, { 96 ¿ INVERTED QUESTION MARK }
+ 97, { 97 a LATIN SMALL LETTER A }
+ 98, { 98 b LATIN SMALL LETTER B }
+ 99, { 99 c LATIN SMALL LETTER C }
+ 100, { 100 d LATIN SMALL LETTER D }
+ 101, { 101 e LATIN SMALL LETTER E }
+ 102, { 102 f LATIN SMALL LETTER F }
+ 103, { 103 g LATIN SMALL LETTER G }
+ 104, { 104 h LATIN SMALL LETTER H }
+ 105, { 105 i LATIN SMALL LETTER I }
+ 106, { 106 j LATIN SMALL LETTER J }
+ 107, { 107 k LATIN SMALL LETTER K }
+ 108, { 108 l LATIN SMALL LETTER L }
+ 109, { 109 m LATIN SMALL LETTER M }
+ 110, { 110 n LATIN SMALL LETTER N }
+ 111, { 111 o LATIN SMALL LETTER O }
+ 112, { 112 p LATIN SMALL LETTER P }
+ 113, { 113 q LATIN SMALL LETTER Q }
+ 114, { 114 r LATIN SMALL LETTER R }
+ 115, { 115 s LATIN SMALL LETTER S }
+ 116, { 116 t LATIN SMALL LETTER T }
+ 117, { 117 u LATIN SMALL LETTER U }
+ 118, { 118 v LATIN SMALL LETTER V }
+ 119, { 119 w LATIN SMALL LETTER W }
+ 120, { 120 x LATIN SMALL LETTER X }
+ 121, { 121 y LATIN SMALL LETTER Y }
+ 122, { 122 z LATIN SMALL LETTER Z }
+ 228, { 123 ä LATIN SMALL LETTER A WITH DIAERESIS }
+ 246, { 124 ö LATIN SMALL LETTER O WITH DIAERESIS }
+ 241, { 125 ñ LATIN SMALL LETTER N WITH TILDE }
+ 252, { 126 ü LATIN SMALL LETTER U WITH DIAERESIS }
+ 224 { 127 à LATIN SMALL LETTER A WITH GRAVE }
+);
+
+(* The double bytes below must be handled separately after the
+ table lookup.
+ 12 27 10 FORM FEED
+ 94 27 20 ^ CIRCUMFLEX ACCENT
+ 123 27 40 { LEFT CURLY BRACKET
+ 125 27 41 } RIGHT CURLY BRACKET
+ 92 27 47 \ REVERSE SOLIDUS (BACKSLASH)
+ 91 27 60 [ LEFT SQUARE BRACKET
+ 126 27 61 ~ TILDE
+ 93 27 62 ] RIGHT SQUARE BRACKET
+ 124 27 64 | VERTICAL BAR
+*)
+
+function HexToInt(W: PWord): Byte;
+var
+ B, C: Byte;
+begin
+ B := Lo(W^) - Ord('0');
+ if B > 9 then Dec(B, 7);
+ C := Hi(W^) - Ord('0');
+ if C > 9 then Dec(C, 7);
+ Result := B shl 4 + C;
+end;
+
+function IntToHex(B: Byte): Word;
+var
+ C: Byte;
+begin
+ C := (B and $F);
+ B := B shr 4;
+ if C > 9 then Inc(C, 7);
+ if B > 9 then Inc(B, 7);
+ Result := (C + Ord('0')) shl 8 or (B + Ord('0'));
+end;
+
+function PduToDec(P: PWord; Len: Cardinal): string;
+var
+ W: PWord;
+begin
+ SetLength(Result, Len);
+ W := @Result[1];
+ while Len > 0 do
+ begin
+ W^ := Swap(P^);
+ Inc(P);
+ Inc(W);
+ Dec(Len, 2);
+ end;
+ if (PChar(W)-1)^ = 'F' then
+ SetLength(Result, Length(Result)-1);
+end;
+
+function DecToPdu(P: PWord; Len: Cardinal): string;
+var
+ W: PByte;
+begin
+ // decimal semi octet --
+ if Odd(Len) then
+ Inc(Len);
+ SetLength(Result, Len div 2);
+ W := @Result[1];
+ while Len > 0 do
+ begin
+ W^ := (Hi(P^) shr 4 + Ord('0')) or (Lo(P^) + Ord('0'));
+ Inc(P);
+ Inc(W);
+ Dec(Len, 2);
+ end;
+end;
+
+function PduToBin(P: PWord; Len: Cardinal): string;
+var
+ W: PByte;
+ I: Integer;
+begin
+ // make hex_pdu to bin_pdu --
+ SetLength(Result, Len div 2);
+ W := @Result[1];
+ for I := 1 to Len div 2 do
+ begin
+ W^ := HexToInt(P);
+ Inc(P); Inc(W);
+ end;
+end;
+
+{
+ * Use a lookup table to convert from the 7-bit default alphabet
+ * used by SMS to an ISO-8859-1 ASCII string.
+ * a7bit An array of the 7-bit 'string' to convert
+ }
+function Convert_7bit_To_Ascii(const a7bit: string): string;
+var
+ R: Integer;
+ W: PChar;
+ C: Char;
+begin
+ SetLength(Result, Length(a7bit) * 2);
+ R := 0; W := @Result[1];
+ while R < Length(a7bit) do
+ begin
+ Inc(R);
+ C := Chr(lookup_ascii7to8[Ord(a7bit[R])]);
+ if C = #27 then
+ begin
+ Inc(R);
+ case Ord(a7bit[R]) of
+ 10: C := #12;
+ 20: C := '^';
+ 40: C := '{';
+ 41: C := '}';
+ 47: C := '\';
+ 60: C := '[';
+ 61: C := '~';
+ 62: C := ']';
+ 64: C := '|';
+ else C := Chr(NPC8);
+ end;
+ end;
+ W^ := C;
+ Inc(W);
+ end;
+ SetLength(Result, W - @Result[1]);
+end;
+
+{
+ * Use a lookup table to convert from an ISO-8859-1 string to
+ * the 7-bit default alphabet used by SMS.
+ * ascii The string to convert
+ }
+function convert_ascii_to_7bit(const Ascii: string): string;
+var
+ I: Integer;
+ W: PChar;
+ M: SmallInt;
+begin
+ SetLength(Result, Length(Ascii) * 2);
+ W := @Result[1];
+ for I := 1 to Length(Ascii) do
+ begin
+ M := Abs(lookup_ascii8to7[Ord(ascii[I])]);
+ if M > 256 then
+ begin
+ W^ := #27;
+ Inc(W);
+ Dec(M, 256);
+ end;
+ W^ := Chr(M);
+ Inc(W);
+ end;
+ SetLength(Result, W - @Result[1]);
+end;
+
+{
+ * Convert a PDU-coded string to ISO-8859-1 ASCII
+ * *pdu The pdu-array to convert to cleartext
+ }
+function PduToAscii(W: PWord; Len: Cardinal): string;
+var
+ R: Integer;
+ C: PChar;
+ S: string;
+begin
+ SetLength(Result, Len);
+ S := PduToBin(W, Len);
+ C := @Result[1];
+ for R := 0 to Length(S)-1 do
+ begin
+ if R mod 7 = 0 then
+ C^ := Chr(Ord(S[R+1]) and $7F)
+ else if R mod 7 = 6 then
+ begin
+ C^ := Chr(((Ord(S[R+1]) shl 6) or (Ord(S[R]) shr 2)) and $7F);
+ Inc(C);
+ C^ := Chr(Ord(S[R+1]) shr 1 and $7F);
+ end
+ else
+ C^ := Chr(((Ord(S[R+1]) shl (R mod 7)) or (Ord(S[R]) shr (7+1 - (R mod 7)))) and $7F);
+ Inc(C);
+ end;
+ SetLength(Result, C - @Result[1]);
+ Result := Convert_7bit_To_Ascii(Result);
+end;
+
+{
+ * Convert an ISO-8859-1 ASCII string to an array of PDU-coded bytes
+ * *ascii The ISO-cleartext to convert
+ }
+function AsciiToPdu(const Ascii: string; P: PWord): Integer;
+var
+ I: Cardinal;
+ R: PChar;
+ S: string;
+begin
+ S := Convert_Ascii_To_7bit(Ascii);
+ R := @S[1];
+ Result := Length(S);
+ for I := 0 to Result-1 do
+ begin
+ P^ := IntToHex((Ord(R^) shr (I mod 7) and $7F) or (Ord((R+1)^) shl (7-(I mod 7)) and $FF));
+ if (I mod 7) = 6 then
+ Inc(R);
+ Inc(R);
+ Inc(P);
+ end;
+ Result := (Result - Result div 8) * 2;
+end;
+
+function PduToDateTime(W: PWord): TDateTime;
+type
+ TScts = packed record
+ Y,
+ M,
+ D,
+ H,
+ N,
+ S: Byte;
+ T: ShortInt;
+ end;
+ PScts = ^TScts;
+var
+ S: string;
+ Cen: Word;
+ I: Integer;
+ B: PByte;
+begin
+ S := PduToBin(W, 14);
+ B := @S[1];
+ for I := 1 to 7 do
+ begin
+ B^ := (B^ and $0F) * 10 + B^ shr 4;
+ Inc(B);
+ end;
+ with PScts(@S[1])^ do
+ begin
+ if Y > 95 then Cen := 1900 else Cen := 2000;
+ Result := EncodeDate(Cen + Y, M, D) + EncodeTime(H, N, S, 0) - (T / 96) + (7 / 24); // GMT+7
+ end;
+end;
+
+{ Decode PDU text to TSmsPdu structure
+ ScToMs: True if PDU from SMS Center, False if from Mobile Station
+ Txt: PDU text
+ Result: TSMSPdu record
+}
+function DecodePdu(ScToMs: Boolean; const Txt: string): TSMS;
+type
+ TPDUAddr = packed record
+ Len,
+ Toa,
+ Str: Word;
+ end;
+ PPDUAddr = ^TPDUAddr;
+var
+ I,
+ J: Integer;
+begin
+ I := 1;
+ with PPDUAddr(@Txt[I])^ do
+ begin
+ J := HexToInt(@Len)* 2;
+{ if J > 0 then
+ Result.Center := PduToDec(@Str, J-2);}
+ Inc(I, J + 2);
+ end;
+ // type of PDU (from first octet) --
+// Result.Fio := TSmsFios(HexToInt(@Txt[I]));
+ Inc(I, 2);
+ case Byte(HexToInt(@Txt[I])) and 3 of
+ 0:if ScToMs then Result.MessageTyp := mtiDeliver
+ else
+ begin
+ Result.MessageTyp := mtiDeliverRep;
+ Result.Reference := HexToInt(@Txt[I]);
+ Exit;
+ end;
+ 1:if ScToMs then
+ begin
+ Result.MessageTyp := mtiSubmitRep;
+ Result.Reference := HexToInt(@Txt[I]);
+ Exit;
+ end
+ else
+ begin
+ Result.MessageTyp := mtiSubmit;
+ Exit;
+ end;
+ 2:if ScToMs then
+ begin
+ Result.MessageTyp := mtiStatusRep;
+ Result.Reference := HexToInt(@Txt[I]);
+ Inc(I, 2);
+ end
+ else
+ begin
+ Result.MessageTyp := mtiCommand;
+ Exit;
+ end;
+ end;
+ // only sms_deliver & status_report is processed --
+ with PPDUAddr(@Txt[I])^ do
+ begin
+ J := HexToInt(@Len);
+ if Odd(J) then Inc(J);
+ Result.Reciver := TPhoneNumber.Create(PduToDec(@Str, J));
+ Inc(I, J + 4);
+ end;
+ if Result.MessageTyp = mtiDeliver then
+ begin
+ Result.ProtocolID := HexToInt(@Txt[I]);
+ Result.DataCodingSheme := HexToInt(@Txt[I+2]);
+ Inc(I, 4);
+ end;
+ Result.TimeStamp := PduToDateTime(@Txt[I]);
+ Inc(I, 14);
+ if Result.MessageTyp = mtiDeliver then
+ begin
+ J := HexToInt(@Txt[I]);
+ Result.Text := PduToAscii(@Txt[I+2], Length(Txt) - I);
+ if Length(Result.Text) > J then
+ SetLength(Result.Text, J);
+ end
+ else
+ begin
+ Result.Text := '';
+// Result.Stat := HexToInt(@Txt[I+14]); // 0..2 = success
+ end;
+end;
+
+{ Encode ascii text to PDU text (to submit via mobile station)
+ Str: Plain text to encode
+ Phone: Mobile station number
+ Result: PDU text
+}
+function EncodePdu(SMS : TSMS): string;
+type
+ TPduSubmit = packed record
+ Smsc_Len,
+ Fo,
+ Ref,
+ Rcv_Len,
+ Rcv_Toa: Word;
+ end;
+ PPduSubmit = ^TPduSubmit;
+var
+ W: PWord;
+ Phone : string;
+// B: TSmsFios;
+ I: Integer;
+begin
+ SetLength(Result, Length(SMS.Text)*2 + Length(SMS.Reciver.BuildModemCompatibleNumber)*2 + 9*2);
+ Phone := SMS.Reciver.BuildModemCompatibleNumber;
+// B := [fioSR, fioVP1, fioMM_RD, fioMT2];
+ with PPduSubmit(@Result[1])^ do
+ begin
+ Smsc_Len := $3030; // 00: without service center
+// Fo := IntToHex(Byte(B));
+ Ref := $3030; // 00: ref from phone
+ Rcv_Len := IntToHex(Length(Phone));
+ Rcv_Toa := $3139; // 91: internat. format
+ end;
+ W := @Result[SizeOf(TPduSubmit)+1];
+ for I := 1 to Length(Phone) shr 1 do
+ begin
+ W^ := Swap(PWord(@Phone[(I-1)*2+1])^);
+ Inc(W);
+ end;
+ if Odd(Length(Phone)) then
+ begin
+ W^ := Swap($4600 + Ord(Phone[Length(Phone)]));
+ Inc(W);
+ end;
+ W^ := $3030; // PID: 00
+ Inc(W);
+ W^ := $3030; // DCS: 00
+ Inc(W);
+ W^ := $4141; // VP: AA (4 days)
+ Inc(W);
+ W^ := IntToHex(Length(SMS.Text));
+ Inc(W);
+ SetLength(Result, PChar(W) - @Result[1] + AsciiToPdu(SMS.Text, W));
+end;
+
+end.
diff --git a/Software/src/general/src/processutils.pas b/Software/src/general/src/processutils.pas
new file mode 100755
index 0000000..7b96839
--- /dev/null
+++ b/Software/src/general/src/processutils.pas
@@ -0,0 +1,206 @@
+unit ProcessUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, Process, AsyncProcess,UTF8Process, FileUtil
+ {$IFDEF MSWINDOWS}
+ ,Windows
+ {$ENDIF}
+ ;
+
+type
+ TLineWriteEvent = procedure(Line : string) of object;
+ TCharWriteEvent = procedure(c : char) of object;
+
+ { TExtendedProcess }
+
+ TExtendedProcess = class(TAsyncProcess)
+ procedure ExtendedProcessReadData(Sender: TObject);
+ procedure ExtendedProcessTerminate(Sender: TObject);
+ private
+ FActive: Boolean;
+ FOnCharWritten: TCharWriteEvent;
+ FOnDone: TNotifyEvent;
+ FOnLineWritten: TLineWriteEvent;
+ FDataLine : string;
+ public
+ constructor Create(Cmdln : string;Autorun : Boolean = True;Dir : string = '');
+ property OnLineWritten : TLineWriteEvent read FOnLineWritten write FOnLineWritten;
+ property OnCharWritten : TCharWriteEvent read FOnCharWritten write FOnCharWritten;
+ procedure Writeln(str : string);
+ property OnDone : TNotifyEvent read FOnDone write FOnDone;
+ procedure Start;
+ end;
+
+procedure ExecProcess(CommandLine : string;CurDir : string = '';Waitfor : Boolean = True);
+procedure ExecVisualProcess(CommandLine : string;CurDir : string = '';Waitfor : Boolean = True);
+function ExecProcessEx(CommandLine : string;CurDir : string = '') : string;
+
+implementation
+uses ClipBrd;
+
+{ TExtendedProcess }
+
+procedure TExtendedProcess.ExtendedProcessReadData(Sender: TObject);
+var
+ tmp : string;
+ len: LongWord;
+ i: Integer;
+begin
+ len := NumBytesAvailable;
+ if len > 0 then
+ begin
+ setlength(tmp,len);
+ setlength(tmp,Output.Read(tmp[1],len));
+ if Assigned(FOnCharWritten) then
+ for i := 1 to length(tmp) do
+ FOnCharWritten(tmp[i]);
+ FDataLine := FdataLine+tmp;
+ while pos(lineending,FDataLine) > 0 do
+ begin
+ if Assigned(FOnLineWritten) then
+ FOnLineWritten(copy(FDataLine,0,pos(LineEnding,FDataLine)-1));
+ FDataLine := copy(FDataLine,pos(LineEnding,FDataLine)+length(LineEnding),length(FDataLine));
+ end;
+ end;
+end;
+
+procedure TExtendedProcess.ExtendedProcessTerminate(Sender: TObject);
+begin
+ if Assigned(FOnDone) then
+ FOnDone(Self);
+end;
+
+constructor TExtendedProcess.Create(Cmdln: string;Autorun : Boolean;Dir: string);
+begin
+ inherited Create(nil);
+ FActive := False;
+ FDataLine := '';
+ Options:= [poUsePipes, poNoConsole, poStdErrToOutPut];
+ ShowWindow := swoNone;
+ CommandLine := Cmdln;
+ OnTerminate :=@ExtendedProcessTerminate;
+ OnreadData :=@ExtendedProcessReadData;
+
+ if Dir <> '' then
+ CurrentDirectory := Dir;
+ if Autorun then
+ begin
+ try
+ Execute;
+ except
+ ExtendedProcessTerminate(self);
+ exit;
+ end;
+ end
+end;
+
+procedure TExtendedProcess.Writeln(str: string);
+var
+ tmp : string;
+begin
+ Input.Write(str[1],length(str));
+ tmp := #10;
+ Input.Write(tmp[1],1);
+end;
+
+procedure TExtendedProcess.Start;
+begin
+ if Active then exit;
+ Execute;
+end;
+
+function ExecProcessEx(CommandLine : string;CurDir : string = '') : string;
+var
+ process : TProcessUTF8;
+ tmps: tstringlist;
+ err : string = '';
+begin
+ Process := TProcessUTF8.Create(nil);
+ Process.Options:= [poUsePipes, poWaitOnExit, poNoConsole, poStdErrToOutPut, poNewProcessGroup];
+// Process.ShowWindow := swoHide;
+ Process.CommandLine := CommandLine;
+ if CurDir <> '' then
+ Process.CurrentDirectory := CurDir;
+ try
+ Process.Execute;
+ except
+ on e : exception do
+ err := err+#13+e.Message;
+ end;
+ tmps := TStringList.Create;
+ tmps.LoadFromStream(Process.Output);
+ Process.Free;
+ Result := tmps.Text;
+ tmps.Free;
+ if err <> '' then
+ Result := 'errors:'+err+#13+Result;
+end;
+procedure ExecProcess(CommandLine : string;CurDir : string = '';Waitfor : Boolean = True);
+var
+{$IFDEF MSWINDOWS}
+ SUInfo: TStartupInfo;
+ ProcInfo: TProcessInformation;
+ Res: Boolean;
+{$ELSE}
+ process : TProcessUTF8;
+{$ENDIF}
+ aDir: String;
+begin
+ aDir := GetCurrentDirUTF8;
+ if CurDir <> '' then
+ ChDir(CurDir);
+{$IFDEF MSWINDOWS}
+ FillChar(SUInfo, SizeOf(SUInfo), #0);
+ with SUInfo do begin
+ cb := SizeOf(SUInfo);
+ dwFlags := STARTF_USESHOWWINDOW;
+ wShowWindow := SW_HIDE
+ end;
+ Res := CreateProcess(NIL, PChar(UTF8ToSys(CommandLine)), NIL, NIL, FALSE,
+ CREATE_NEW_CONSOLE or
+ NORMAL_PRIORITY_CLASS, NIL,
+ PChar(UTF8ToSys(CurDir)),
+ SUInfo, ProcInfo);
+ { Wait for it to finish. }
+// Clipboard.AsText:=CommandLine;
+ if Res and Waitfor then
+ WaitForSingleObject(ProcInfo.hProcess, INFINITE);
+{$ELSE}
+ Process := TProcessUTF8.Create(nil);
+ if CurDir <> '' then
+ Process.CurrentDirectory := CurDir;
+ Process.CommandLine := CommandLine;
+ if Waitfor then
+ Process.Options := [poNoConsole,poWaitOnExit]
+ else
+ Process.Options := [poNoConsole];
+// Process.ShowWindow := swoHide;
+ Process.Execute;
+ if Waitfor then Process.Free;
+{$ENDIF}
+ ChDir(aDir);
+end;
+
+procedure ExecVisualProcess(CommandLine : string;CurDir : string = '';Waitfor : Boolean = True);
+var
+ process : TProcessUTF8;
+begin
+ Process := TProcessUTF8.Create(nil);
+ if CurDir <> '' then
+ Process.CurrentDirectory := CurDir;
+ Process.CommandLine := CommandLine;
+ if Waitfor then
+ Process.Options := [poWaitOnExit]
+ else
+ Process.Options := [];
+ Process.Execute;
+ if Waitfor then Process.Free;
+end;
+
+
+end.
+
\ No newline at end of file
diff --git a/Software/src/general/src/resources/docked.xpm b/Software/src/general/src/resources/docked.xpm
new file mode 100755
index 0000000..878f12c
--- /dev/null
+++ b/Software/src/general/src/resources/docked.xpm
@@ -0,0 +1,24 @@
+/* XPM */
+static char * docked_xpm[] = {
+"16 16 5 1",
+" c None",
+". c #000000",
+"+ c #333333",
+"@ c #000080",
+"# c #FFFFFF",
+" ",
+" . ",
+" . ",
+" . . ",
+"+@@@@@@@@@.. ",
+"+ ... ",
+"+ ++++++++ . ",
+"+ +@@@@@@@ . ",
+"+ +++++++. . ",
+"+ +######. . ",
+"+ +######. . ",
+"+ +######. . ",
+"+ +######. . ",
+"+ +....... . ",
+"+ . ",
+"+........... "};
diff --git a/Software/src/general/src/resources/formcontrol.lrs b/Software/src/general/src/resources/formcontrol.lrs
new file mode 100755
index 0000000..739a093
--- /dev/null
+++ b/Software/src/general/src/resources/formcontrol.lrs
@@ -0,0 +1,81 @@
+LazarusResources.Add('minimized','XPM',[
+ '/* XPM */'#10'static char * minimized_xpm[] = {'#10'"16 16 4 1",'#10'" '#9'c'
+ +' None",'#10'".'#9'c #333333",'#10'"+'#9'c #000080",'#10'"@'#9'c #000000",'
+ +#10'"................",'#10'".++++++++++++++@",'#10'"...............@",'#10
+ +'". @ @",'#10'". @ @",'#10'". @ @",'#10'". '
+ +' @ @ @",'#10'". @@ @",'#10'". @@@ @",'#10'". '
+ +' @",'#10'". @",'#10'". ............ @",'#10'". .+++++'
+ +'++++++ @",'#10'". ............ @",'#10'". @",'#10'".@@@@@@@@@@'
+ +'@@@@@"};'#10
+]);
+LazarusResources.Add('maximized','XPM',[
+ '/* XPM */'#10'static char * maximized_xpm[] = {'#10'"16 16 5 1",'#10'" '#9'c'
+ +' None",'#10'".'#9'c #333333",'#10'"+'#9'c #000080",'#10'"@'#9'c #000000",'
+ +#10'"#'#9'c #FFFFFF",'#10'" ",'#10'".++++++++++++++@",'#10'".'
+ +' @",'#10'". ............ @",'#10'". .+++++++++++ @",'#10'". ..'
+ +'.........@ @",'#10'". .##########@ @",'#10'". .###@@@####@ @",'#10'". .####'
+ +'@@####@ @",'#10'". .###@#@####@ @",'#10'". .##@#######@ @",'#10'". .#@#####'
+ +'###@ @",'#10'". .##########@ @",'#10'". .@@@@@@@@@@@ @",'#10'". '
+ +' @",'#10'".@@@@@@@@@@@@@@@"};'#10
+]);
+LazarusResources.Add('normal','XPM',[
+ '/* XPM */'#10'static char * normal_xpm[] = {'#10'"16 16 5 1",'#10'" '#9'c No'
+ +'ne",'#10'".'#9'c #333333",'#10'"+'#9'c #000080",'#10'"@'#9'c #000000",'#10
+ +'"#'#9'c #FFFFFF",'#10'" ",'#10'".++++++++++++++@",'#10'". '
+ +' @",'#10'". ............ @",'#10'". .+++++++++++ @",'#10'". .....'
+ +'......@ @",'#10'". .##########@ @",'#10'". .@@@@@@@@@@@ @",'#10'". '
+ +' @",'#10'". ............ @",'#10'". .+++++++++++ @",'#10'". ...........'
+ +'@ @",'#10'". .##########@ @",'#10'". .@@@@@@@@@@@ @",'#10'". @'
+ +'",'#10'".@@@@@@@@@@@@@@@"};'#10
+]);
+LazarusResources.Add('docked','XPM',[
+ '/* XPM */'#10'static char * docked_xpm[] = {'#10'"16 16 5 1",'#10'" '#9'c No'
+ +'ne",'#10'".'#9'c #000000",'#10'"+'#9'c #333333",'#10'"@'#9'c #000080",'#10
+ +'"#'#9'c #FFFFFF",'#10'" ",'#10'" . ",'#10'" '
+ +' . ",'#10'" . . ",'#10'"+@@@@@@@@@.. ",'#10'"+ '
+ +' ... ",'#10'"+ ++++++++ . ",'#10'"+ +@@@@@@@ . ",'#10'"+ +++++++.'
+ +' . ",'#10'"+ +######. . ",'#10'"+ +######. . ",'#10'"+ +######. . '
+ +' ",'#10'"+ +######. . ",'#10'"+ +....... . ",'#10'"+ . '
+ +'",'#10'"+........... "};'#10
+]);
+LazarusResources.Add('undocked','XPM',[
+ '/* XPM */'#10'static char * undocked_xpm[] = {'#10'"16 16 5 1",'#10'" '#9'c '
+ +'None",'#10'".'#9'c #333333",'#10'"+'#9'c #000080",'#10'"@'#9'c #000000",'#10
+ +'"#'#9'c #FFFFFF",'#10'" ............",'#10'" .+++++++++++",'#10'" '
+ +'...........@",'#10'".....##########@",'#10'".+++.##########@",'#10'".....##'
+ +'########@",'#10'". .##########@",'#10'". .##########@",'#10'". .#####'
+ +'#####@",'#10'". @@@########@",'#10'". .@@@@@@@@@@@",'#10'". @ @ @ '
+ +' ",'#10'". @ @ ",'#10'". @ @ ",'#10'". @ '
+ +'",'#10'".@@@@@@@@@@@ "};'#10
+]);
+LazarusResources.Add('title','XPM',[
+ '/* XPM */'#13#10'static char * title_xpm[] = {'#13#10'"84 19 10 1",'#13#10'"'
+ +' '#9'c None",'#13#10'".'#9'c #FCFCFC",'#13#10'"+'#9'c #FBFBFB",'#13#10'"@'#9
+ +'c #FAFAFA",'#13#10'"#'#9'c #F4F4F4",'#13#10'"$'#9'c #F8F8F8",'#13#10'"%'#9
+ +'c #F5F5F5",'#13#10'"&'#9'c #F6F6F6",'#13#10'"*'#9'c #F7F7F7",'#13#10'"='#9
+ +'c #F9F9F9",'#13#10'".......................................................'
+ +'+..+@@@+@@@+@++...@+.........",'#13#10'".####$.####$.####$.####$.%###%.%###'
+ +'#.$####.$####.$####$$##&&**#&$*$@$$@=$=+@@$......",'#13#10'".####$.####$.##'
+ +'##%.####%.#####.%####.%####.$####.$####$&####*&#%&&*$&&@=*$+@@=......",'#13
+ +#10'".####$.####$.####%.####%.####%.%####.%####.$####.$####$&####*&#%%%*$&&@'
+ +'$&$+@@=......",'#13#10'"$####$.####$.####%.####%.#####.#####.%####.$####.$#'
+ +'###$&####*&#&&%&$&&@=*$+@@$......",'#13#10'".%%%%$.%%%%$.$%%%$.$%%%$.$%%%$.'
+ +'$%%%$.$%%%$.$%%%%.$%%%%$&%###$*%&*&*@&&@=$$+++$......",'#13#10'"...........'
+ +'............................................+..@+.@.+@@+++....+..........",'
+ +#13#10'".####$.####$.%###$.%###$.%###$.$###%.$###%.$####.$####$$##&&$$*=@=@+'
+ +'+@..++...+......",'#13#10'".####$.####$.####%.####%.#####.%####.%####.$####'
+ +'.$####$*%%&*$$=@@@+.++..............",'#13#10'".####$.####$.####%.####%.###'
+ +'#%.%####.%####.$####.$####$$%%&&$$$@==@+@@...+..........",'#13#10'"$####$.#'
+ +'###$.####%.####%.#####.#####.%####.$####$$####$$&%%&$$&@=$@++@+..@...+.....'
+ +'.",'#13#10'".####$.####$.%###$.%###$.$###$.$###%.$###%.$####.$#%&%$$$$$@+@@'
+ +'..@+..@+..@...@......",'#13#10'"...........................................'
+ +'.......$.+@+++@+++@@+.@@..@+..@..........",'#13#10'".####$.####$.%###$.%###'
+ +'$.%###$.$###%.$###%.$####.$#*$&=$$&&$=$&==$$@@$@@+$@+.$+.....",'#13#10'"$##'
+ +'##$.####$.####%.####%.#####.#####.%####.$####$$#&%#$*&##&$*&$$&&$@*$=+$@+.$'
+ +'+.....",'#13#10'".####$.####$.####%.####%.####%.%####.%####.$####$$#&%#$*&#'
+ +'#&$*%$$*&$=$$=+$@+.@+.....",'#13#10'".####$.####$.####%.####%.#####.%####.%'
+ +'####.$####$$#&%#$$&##*$*%$$$&=@==@+=@..@@.....",'#13#10'".####$.####$.%###$'
+ +'.%###$.%###%.$###%.$###%.$####.$#&%#$$*##$$$&@==$+@@@.............",'#13#10
+ +'"...................................................++.......+@...+........'
+ +'.........."};'#13#10
+]);
diff --git a/Software/src/general/src/resources/makeres.bat b/Software/src/general/src/resources/makeres.bat
new file mode 100755
index 0000000..ffa4dde
--- /dev/null
+++ b/Software/src/general/src/resources/makeres.bat
@@ -0,0 +1,3 @@
+del *.lrs
+lazres formcontrol.lrs minimized.xpm maximized.xpm normal.xpm docked.xpm undocked.xpm title.xpm
+del ..\..\lib\i386-win32\uformcontrol.ppu
diff --git a/Software/src/general/src/resources/makeres.sh b/Software/src/general/src/resources/makeres.sh
new file mode 100755
index 0000000..874cec2
--- /dev/null
+++ b/Software/src/general/src/resources/makeres.sh
@@ -0,0 +1 @@
+lazres formcontrol.lrs minimized.xpm maximized.xpm normal.xpm docked.xpm undocked.xpm title.xpm
diff --git a/Software/src/general/src/resources/maximized.xpm b/Software/src/general/src/resources/maximized.xpm
new file mode 100755
index 0000000..0e9d992
--- /dev/null
+++ b/Software/src/general/src/resources/maximized.xpm
@@ -0,0 +1,24 @@
+/* XPM */
+static char * maximized_xpm[] = {
+"16 16 5 1",
+" c None",
+". c #333333",
+"+ c #000080",
+"@ c #000000",
+"# c #FFFFFF",
+" ",
+".++++++++++++++@",
+". @",
+". ............ @",
+". .+++++++++++ @",
+". ...........@ @",
+". .##########@ @",
+". .###@@@####@ @",
+". .####@@####@ @",
+". .###@#@####@ @",
+". .##@#######@ @",
+". .#@########@ @",
+". .##########@ @",
+". .@@@@@@@@@@@ @",
+". @",
+".@@@@@@@@@@@@@@@"};
diff --git a/Software/src/general/src/resources/minimized.xpm b/Software/src/general/src/resources/minimized.xpm
new file mode 100755
index 0000000..7df8fbf
--- /dev/null
+++ b/Software/src/general/src/resources/minimized.xpm
@@ -0,0 +1,23 @@
+/* XPM */
+static char * minimized_xpm[] = {
+"16 16 4 1",
+" c None",
+". c #333333",
+"+ c #000080",
+"@ c #000000",
+"................",
+".++++++++++++++@",
+"...............@",
+". @ @",
+". @ @",
+". @ @",
+". @ @ @",
+". @@ @",
+". @@@ @",
+". @",
+". @",
+". ............ @",
+". .+++++++++++ @",
+". ............ @",
+". @",
+".@@@@@@@@@@@@@@@"};
diff --git a/Software/src/general/src/resources/normal.xpm b/Software/src/general/src/resources/normal.xpm
new file mode 100755
index 0000000..9754391
--- /dev/null
+++ b/Software/src/general/src/resources/normal.xpm
@@ -0,0 +1,24 @@
+/* XPM */
+static char * normal_xpm[] = {
+"16 16 5 1",
+" c None",
+". c #333333",
+"+ c #000080",
+"@ c #000000",
+"# c #FFFFFF",
+" ",
+".++++++++++++++@",
+". @",
+". ............ @",
+". .+++++++++++ @",
+". ...........@ @",
+". .##########@ @",
+". .@@@@@@@@@@@ @",
+". @",
+". ............ @",
+". .+++++++++++ @",
+". ...........@ @",
+". .##########@ @",
+". .@@@@@@@@@@@ @",
+". @",
+".@@@@@@@@@@@@@@@"};
diff --git a/Software/src/general/src/resources/pspbrwse.jbf b/Software/src/general/src/resources/pspbrwse.jbf
new file mode 100755
index 0000000..ef81fb2
Binary files /dev/null and b/Software/src/general/src/resources/pspbrwse.jbf differ
diff --git a/Software/src/general/src/resources/title.xpm b/Software/src/general/src/resources/title.xpm
new file mode 100755
index 0000000..3da39fd
--- /dev/null
+++ b/Software/src/general/src/resources/title.xpm
@@ -0,0 +1,32 @@
+/* XPM */
+static char * title_xpm[] = {
+"84 19 10 1",
+" c None",
+". c #FCFCFC",
+"+ c #FBFBFB",
+"@ c #FAFAFA",
+"# c #F4F4F4",
+"$ c #F8F8F8",
+"% c #F5F5F5",
+"& c #F6F6F6",
+"* c #F7F7F7",
+"= c #F9F9F9",
+".......................................................+..+@@@+@@@+@++...@+.........",
+".####$.####$.####$.####$.%###%.%####.$####.$####.$####$$##&&**#&$*$@$$@=$=+@@$......",
+".####$.####$.####%.####%.#####.%####.%####.$####.$####$&####*&#%&&*$&&@=*$+@@=......",
+".####$.####$.####%.####%.####%.%####.%####.$####.$####$&####*&#%%%*$&&@$&$+@@=......",
+"$####$.####$.####%.####%.#####.#####.%####.$####.$####$&####*&#&&%&$&&@=*$+@@$......",
+".%%%%$.%%%%$.$%%%$.$%%%$.$%%%$.$%%%$.$%%%$.$%%%%.$%%%%$&%###$*%&*&*@&&@=$$+++$......",
+".......................................................+..@+.@.+@@+++....+..........",
+".####$.####$.%###$.%###$.%###$.$###%.$###%.$####.$####$$##&&$$*=@=@++@..++...+......",
+".####$.####$.####%.####%.#####.%####.%####.$####.$####$*%%&*$$=@@@+.++..............",
+".####$.####$.####%.####%.####%.%####.%####.$####.$####$$%%&&$$$@==@+@@...+..........",
+"$####$.####$.####%.####%.#####.#####.%####.$####$$####$$&%%&$$&@=$@++@+..@...+......",
+".####$.####$.%###$.%###$.$###$.$###%.$###%.$####.$#%&%$$$$$@+@@..@+..@+..@...@......",
+"..................................................$.+@+++@+++@@+.@@..@+..@..........",
+".####$.####$.%###$.%###$.%###$.$###%.$###%.$####.$#*$&=$$&&$=$&==$$@@$@@+$@+.$+.....",
+"$####$.####$.####%.####%.#####.#####.%####.$####$$#&%#$*&##&$*&$$&&$@*$=+$@+.$+.....",
+".####$.####$.####%.####%.####%.%####.%####.$####$$#&%#$*&##&$*%$$*&$=$$=+$@+.@+.....",
+".####$.####$.####%.####%.#####.%####.%####.$####$$#&%#$$&##*$*%$$$&=@==@+=@..@@.....",
+".####$.####$.%###$.%###$.%###%.$###%.$###%.$####.$#&%#$$*##$$$&@==$+@@@.............",
+"...................................................++.......+@...+.................."};
diff --git a/Software/src/general/src/resources/title_old.xpm b/Software/src/general/src/resources/title_old.xpm
new file mode 100755
index 0000000..062a4fd
--- /dev/null
+++ b/Software/src/general/src/resources/title_old.xpm
@@ -0,0 +1,35 @@
+/* XPM */
+static char * title_xpm[] = {
+"84 19 13 1",
+" c #8C9FD9",
+". c #8B9FD8",
+"+ c #8CA0D9",
+"@ c #8DA0D9",
+"# c #8A9ED8",
+"$ c #899DD8",
+"% c #889DD7",
+"& c #889CD7",
+"* c #879CD7",
+"= c #879BD7",
+"- c #869BD7",
+"; c #859AD6",
+"> c #8499D6",
+" .... +.... +.... +.....+.....@.....+.....+ ..## .###$##$$%%$%&**=**------;;;;;>>>>>",
+"#>>>>%#>>>>&.;>>>=.;>>>=.->>>-.->>>;.=>>>;.*>>>>#*>>>>$*>>>>*=>>>>-->>>>;;>>>>>>>>>>",
+"#>>>>%#>>>>*.>>>>-.;>>>-.;>>>;.->>>;.->>>>.=>>>>#*>>>>%&>>>>*=>>>>-->>>>;;>>>>>>>>>>",
+"#>>>>%#>>>>*.>>>>-.;>>>-.;>>>-.->>>;.->>>;.=>>>>#*>>>>%&>>>>*=>>>>-->>>>;;>>>>>>>>>>",
+"$>>>>&#>>>>*.>>>>-.>>>>-.;>>>;.;>>>>.->>>>.=>>>>#=>>>>%*>>>>==>>>>;->>>>;;>>>>>>>>>>",
+"#----$.----$.=---&.=---&.=---*.&---=.&---=.%----#%----$%-;;;&*;;;;--;;;>;;>>>>>>>>>>",
+"+.... +.... +.... +.... +.....+.....+ ....@ .... .######$$%%$%&&*===------;;;;;>>>>>",
+"#;;;;%.;;;;%.-;;;*.-;;;*.-;;;=.=;;;-.*;;;-.&;;;;#&;;;;$*;>>>*=>;>>-->>>>;;>>>>>>>>>>",
+"#>>>>%#>>>>*.>>>>-.>>>>-.;>>>;.->>>;.->>>>.=>>>>#*>>>>%*>>>>==>>>>-->>>>;;>>>>>>>>>>",
+"#>>>>%#>>>>*.>>>>-.;>>>-.;>>>-.->>>;.->>>;.=>>>>#*>>>>%&>>>>==>>>>-->>>>;;>>>>>>>>>>",
+"$>>>>&#>>>>*#>>>>-.>>>>-.;>>>;.;>>>>.->>>>#=>>>>$=>>>>%*>>>>==>>>>;->>>>;;>>>>>>>>>>",
+"#;;;;$.;;;;%.-;;;*.-;;;*.=;;;=.*;;;- &;;;-.&;;;;#&;;;;%&;;;;*=>;>>-->>>>;;>>>>>>>>>>",
+"+....+@.... +.... +.... @ ... @ ....@ ....+ .... .$##$#$$$%%$%***=*=-----;;;;;;>>>>>",
+"#;;;;$.;;;;%.-;;;*.-;;;*.-;;;=.=;;;- *;;;-.&;;;;#&;;;;$*;;;;*=;;>>-->>>>;;>>>>>>>>>>",
+"$>>>>&#>>>>*#>>>>-.>>>>-.;>>>;.;>>>>.->>>>#=>>>>$=>>>>%*>>>>==>>>>;->>>>;;>>>>>>>>>>",
+"#>>>>%#>>>>*.>>>>-.;>>>-.;>>>-.->>>;.->>>;#=>>>>$=>>>>%*>>>>==>>>>-->>>>;;>>>>>>>>>>",
+"#>>>>%#>>>>*.>>>>-.>>>>-.;>>>;.->>>>.->>>>#=>>>>$=>>>>%*>>>>==>>>>-->>>>;;>>>>>>>>>>",
+"#;;;;$.;;;;%.-;;;*.-;;;=.-;;;-.=;;;-.=;;;-.&;;;;#*;;;;%*;;;>*=>>>>-->>>>;;>>>>>>>>>>",
+"+....++.... +.... +.... @.....+.....+..... ...##.####$##$$%&$%**====-----;;;;;>>>>>>"};
diff --git a/Software/src/general/src/resources/undocked.xpm b/Software/src/general/src/resources/undocked.xpm
new file mode 100755
index 0000000..6ed54f5
--- /dev/null
+++ b/Software/src/general/src/resources/undocked.xpm
@@ -0,0 +1,24 @@
+/* XPM */
+static char * undocked_xpm[] = {
+"16 16 5 1",
+" c None",
+". c #333333",
+"+ c #000080",
+"@ c #000000",
+"# c #FFFFFF",
+" ............",
+" .+++++++++++",
+" ...........@",
+".....##########@",
+".+++.##########@",
+".....##########@",
+". .##########@",
+". .##########@",
+". .##########@",
+". @@@########@",
+". .@@@@@@@@@@@",
+". @ @ @ ",
+". @ @ ",
+". @ @ ",
+". @ ",
+".@@@@@@@@@@@ "};
diff --git a/Software/src/general/src/secureutils.pas b/Software/src/general/src/secureutils.pas
new file mode 100755
index 0000000..7ce5983
--- /dev/null
+++ b/Software/src/general/src/secureutils.pas
@@ -0,0 +1,208 @@
+unit SecureUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Utils
+ {$IFDEF WINDOWS}
+ , Windows,RtlConsts
+ {$ENDIF}
+ ;
+
+type
+ TSecureDeleteMethod = (dmDoD522022,dmOverride,dmSecure);
+
+{$IFDEF WINDOWS}
+{ TFlagFileStream }
+
+TFlagFileStream = Class(THandleStream)
+ Public
+ constructor Create(const FileName: string; const AMode: word; Flags: DWord);
+ Destructor Destroy; Override;
+ End;
+{$ENDIF}
+
+function DeleteSecure(Filename : string;Method : TSecureDeleteMethod = dmSecure) : Boolean;
+function DeleteDirectorySecure(const DirectoryName: string;OnlyChilds: boolean;Method : TSecureDeleteMethod = dmSecure): boolean;
+
+implementation
+
+
+function DeleteDirectorySecure(const DirectoryName: string;OnlyChilds: boolean;Method : TSecureDeleteMethod): boolean;
+var
+ FileInfo: TSearchRec;
+ CurSrcDir: String;
+ CurFilename: String;
+begin
+ Result:=false;
+ CurSrcDir:=CleanAndExpandDirectory(DirectoryName);
+ if FindFirstUTF8(CurSrcDir+GetAllFilesMask,faAnyFile,FileInfo)=0 then
+ begin
+ repeat
+ // check if special file
+ if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
+ continue;
+ CurFilename:=CurSrcDir+FileInfo.Name;
+ if (FileInfo.Attr and faDirectory)>0 then begin
+ if not DeleteDirectorySecure(CurFilename,false,Method) then exit;
+ end else begin
+ if not DeleteSecure(CurFilename,Method) then exit;
+ end;
+ until FindNextUTF8(FileInfo)<>0;
+ end;
+ SysUtils.FindClose(FileInfo);
+ if (not OnlyChilds) and (not RemoveDirUTF8(DirectoryName)) then exit;
+ Result:=true;
+end;
+
+function WriteData(Filename : string;Data : byte) : Boolean;
+const buffersize = 1024;
+var
+ fs : THandleStream;
+ i : Integer;
+ buffer : array[0..buffersize-1] of byte;
+begin
+ for i := 0 to buffersize-1 do
+ buffer[i] := Data;
+ Result := True;
+ try
+{$IFDEF WINDOWS}
+ fs:=TFlagFileStream.Create(Filename,fmOpenWrite,{FILE_FLAG_NO_BUFFERING}FILE_FLAG_WRITE_THROUGH);
+{$ELSE}
+ fs:=TFileStream.Create(Filename,fmOpenWrite);
+{$ENDIF}
+ repeat
+ fs.Write(buffer, buffersize);
+ until fs.Position + 1 >= fs.Size;
+{$IFDEF WINDOWS}
+ FlushFileBuffers(fs.Handle);
+{$ENDIF}
+ fs.Free;
+ except
+ Result := False;
+ end;
+end;
+
+
+
+procedure ZeroFillDelete(FileName: string);
+var
+ fs: THandleStream;
+ i: integer;
+ procedure RandomWrite;
+ var
+ b : array[0..1024] of byte;
+ i : Integer;
+ begin
+ repeat
+ for i := 0 to 1024 do
+ b[i] := Random(256);
+ fs.Write(b, 1024);
+ until fs.Position + 1 >= fs.Size;
+ end;
+ procedure WritePattern(pattern: byte);
+ var
+ i : Integer;
+ const patt: array[5..31] of dword = ($555555, $AAAAAA, $924924, $492492,
+ $249249, 0, $111111, $222222, $333333, $444444, $555555, $666666,
+ $777777, $888888, $999999, $AAAAAA, $BBBBBB, $CCCCCC, $DDDDDD,
+ $EEEEEE, $FFFFFF, $924924, $492492, $249249, $6DB6DB, $B6DB6D, $DB6DB6);
+ var d : array[0..512] of dword;
+ begin
+ for i := 0 to 512 do
+ d[i] := patt[pattern] shl 8;
+ repeat fs.Write(d, 512*sizeof(dword)); until fs.Position + 3 >= fs.Size;
+ end;
+begin
+ if not FileExists(FileName) then Exit;
+ for i := 1 to 35 do
+ try
+{$IFDEF WINDOWS}
+ fs:=TFlagFileStream.Create(Filename,fmOpenWrite,{FILE_FLAG_NO_BUFFERING}FILE_FLAG_WRITE_THROUGH);
+{$ELSE}
+ fs:=TFileStream.Create(Filename,fmOpenWrite);
+{$ENDIF}
+ try
+ if (i < 5) or (i > 31) then RandomWrite
+ else WritePattern(i);
+ finally
+{$IFDEF WINDOWS}
+ FlushFileBuffers(fs.Handle);
+{$ENDIF}
+ fs.Free;
+ end;
+ except Exit; end;
+end;
+
+
+function DeleteSecure(Filename: string; Method: TSecureDeleteMethod): Boolean;
+var
+ i,a: Integer;
+ aFilename: String;
+ newFilename: String;
+begin
+ Result:=False;
+ case Method of
+ dmDoD522022:
+ begin
+ Result := WriteData(UTF8ToSys(Filename),0);
+ Result := Result and WriteData(UTF8ToSys(Filename),$FF);
+ Randomize;
+ Result := Result and WriteData(UTF8ToSys(Filename),Random($FF));
+ end;
+ dmOverride:
+ begin
+ Result := WriteData(UTF8ToSys(Filename),0);
+ end;
+ dmSecure:
+ begin
+ ZeroFillDelete(UTF8ToSys(Filename));
+ Result := True;
+ end;
+ end;
+ aFilename := Filename;
+ for i := 0 to 35 do
+ begin
+ newFilename := '';
+ for a := 0 to 15 do
+ newFilename := newFilename+chr($30+Random(26));
+ newFilename := ValidateFilename(newFilename);
+ if RenameFileUTF8(aFilename,newFilename) then
+ aFilename := newFilename;
+ end;
+ DeleteFileUTF8(aFilename);
+end;
+
+{$IFDEF WINDOWS}
+{ TFlagFileStream }
+
+constructor TFlagFileStream.Create(const FileName: string; const AMode: word; Flags: DWord);
+var
+ lHandle: THandle;
+begin
+ if AMode = fmCreate then
+ begin
+ lHandle := CreateFile(PChar(FileName), GENERIC_READ Or GENERIC_WRITE, 0, Nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL or Flags, 0);
+ if lHandle = INVALID_HANDLE_VALUE then
+ raise EFCreateError.CreateResFmt(PResStringRec(@SFCreateError), [FileName]);
+ end
+ else
+ begin
+ lHandle := CreateFile(PChar(FileName), GENERIC_READ Or GENERIC_WRITE,0, Nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or Flags, 0);
+ if lHandle = INVALID_HANDLE_VALUE then
+ raise EFOpenError.CreateResFmt(PResStringRec(@SFOpenError), [FileName]);
+ end;
+ inherited Create(lHandle);
+end;
+
+destructor TFlagFileStream.Destroy;
+begin
+ FileClose(Handle);
+ inherited Destroy;
+end;
+{$ENDIF}
+
+end.
+
\ No newline at end of file
diff --git a/Software/src/general/src/serial_osx.pp b/Software/src/general/src/serial_osx.pp
new file mode 100755
index 0000000..bff1fa9
--- /dev/null
+++ b/Software/src/general/src/serial_osx.pp
@@ -0,0 +1,214 @@
+{ Unit for handling the serial interfaces for Linux and similar Unices.
+ (c) 2000 Sebastian Guenther, sg@freepascal.org
+}
+
+unit serial_osx;
+
+{$MODE objfpc}
+{$H+}
+{$PACKRECORDS C}
+
+interface
+
+uses BaseUnix,termio,unix;
+
+type
+
+ TSerialHandle = LongInt;
+
+ TParityType = (NoneParity, OddParity, EvenParity);
+
+ TSerialFlags = set of (RtsCtsFlowControl);
+
+ TSerialState = record
+ LineState: LongWord;
+ tios: termios;
+ end;
+
+
+{ Open the serial device with the given device name, for example:
+ /dev/ttyS0, /dev/ttyS1... for normal serial ports
+ /dev/ttyI0, /dev/ttyI1... for ISDN emulated serial ports
+ other device names are possible; refer to your OS documentation.
+ Returns "0" if device could not be found }
+function SerOpen(const DeviceName: String): TSerialHandle;
+
+{ Closes a serial device previously opened with SerOpen. }
+procedure SerClose(Handle: TSerialHandle);
+
+{ Flushes the data queues of the given serial device. }
+procedure SerFlush(Handle: TSerialHandle);
+
+{ Reads a maximum of "Count" bytes of data into the specified buffer.
+ Result: Number of bytes read. }
+function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+
+{ Tries to write "Count" bytes from "Buffer".
+ Result: Number of bytes written. }
+function SerWrite(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+
+procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
+ ByteSize: Integer; Parity: TParityType; StopBits: Integer;
+ Flags: TSerialFlags);
+
+{ Saves and restores the state of the serial device. }
+function SerSaveState(Handle: TSerialHandle): TSerialState;
+procedure SerRestoreState(Handle: TSerialHandle; State: TSerialState);
+
+{ Getting and setting the line states directly. }
+procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
+procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
+function SerGetCTS(Handle: TSerialHandle): Boolean;
+function SerGetDSR(Handle: TSerialHandle): Boolean;
+function SerGetRI(Handle: TSerialHandle): Boolean;
+
+
+{ ************************************************************************** }
+
+implementation
+
+
+function SerOpen(const DeviceName: String): TSerialHandle;
+begin
+ Result := fpopen(DeviceName, O_RDWR or O_NOCTTY);
+end;
+
+procedure SerClose(Handle: TSerialHandle);
+begin
+ fpClose(Handle);
+end;
+
+procedure SerFlush(Handle: TSerialHandle);
+begin
+ fpfsync(Handle);
+end;
+
+function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+begin
+ Result := fpRead(Handle, Buffer, Count);
+end;
+
+function SerWrite(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+begin
+ Result := fpWrite(Handle, Buffer, Count);
+end;
+
+procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
+ ByteSize: Integer; Parity: TParityType; StopBits: Integer;
+ Flags: TSerialFlags);
+var
+ tios: termios;
+begin
+ FillChar(tios, SizeOf(tios), #0);
+
+ case BitsPerSec of
+ 50: tios.c_cflag := B50;
+ 75: tios.c_cflag := B75;
+ 110: tios.c_cflag := B110;
+ 134: tios.c_cflag := B134;
+ 150: tios.c_cflag := B150;
+ 200: tios.c_cflag := B200;
+ 300: tios.c_cflag := B300;
+ 600: tios.c_cflag := B600;
+ 1200: tios.c_cflag := B1200;
+ 1800: tios.c_cflag := B1800;
+ 2400: tios.c_cflag := B2400;
+ 4800: tios.c_cflag := B4800;
+ 19200: tios.c_cflag := B19200;
+ 38400: tios.c_cflag := B38400;
+ 57600: tios.c_cflag := B57600;
+ 115200: tios.c_cflag := B115200;
+ 230400: tios.c_cflag := B230400;
+{$ifndef BSD}
+ 460800: tios.c_cflag := B460800;
+{$endif}
+ else tios.c_cflag := B9600;
+ end;
+ tios.c_ispeed := tios.c_cflag;
+ tios.c_ospeed := tios.c_ispeed;
+
+ tios.c_cflag := tios.c_cflag or CREAD or CLOCAL;
+
+ case ByteSize of
+ 5: tios.c_cflag := tios.c_cflag or CS5;
+ 6: tios.c_cflag := tios.c_cflag or CS6;
+ 7: tios.c_cflag := tios.c_cflag or CS7;
+ else tios.c_cflag := tios.c_cflag or CS8;
+ end;
+
+ case Parity of
+ OddParity: tios.c_cflag := tios.c_cflag or PARENB or PARODD;
+ EvenParity: tios.c_cflag := tios.c_cflag or PARENB;
+ end;
+
+ if StopBits = 2 then
+ tios.c_cflag := tios.c_cflag or CSTOPB;
+
+ if RtsCtsFlowControl in Flags then
+ tios.c_cflag := tios.c_cflag or CRTSCTS;
+
+ tcflush(Handle, TCIOFLUSH);
+ tcsetattr(Handle, TCSANOW, tios)
+end;
+
+function SerSaveState(Handle: TSerialHandle): TSerialState;
+begin
+ fpioctl(Handle, TIOCMGET, @Result.LineState);
+// fpioctl(Handle, TCGETS, @Result.tios);
+ TcGetAttr(handle,result.tios);
+
+end;
+
+procedure SerRestoreState(Handle: TSerialHandle; State: TSerialState);
+begin
+// fpioctl(Handle, TCSETS, @State.tios);
+ TCSetAttr(handle,TCSANOW,State.tios);
+ fpioctl(Handle, TIOCMSET, @State.LineState);
+end;
+
+procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
+const
+ DTR: Cardinal = TIOCM_DTR;
+begin
+ if State then
+ fpioctl(Handle, TIOCMBIS, @DTR)
+ else
+ fpioctl(Handle, TIOCMBIC, @DTR);
+end;
+
+procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
+const
+ RTS: Cardinal = TIOCM_RTS;
+begin
+ if State then
+ fpioctl(Handle, TIOCMBIS, @RTS)
+ else
+ fpioctl(Handle, TIOCMBIC, @RTS);
+end;
+
+function SerGetCTS(Handle: TSerialHandle): Boolean;
+var
+ Flags: Cardinal;
+begin
+ fpioctl(Handle, TIOCMGET, @Flags);
+ Result := (Flags and TIOCM_CTS) <> 0;
+end;
+
+function SerGetDSR(Handle: TSerialHandle): Boolean;
+var
+ Flags: Cardinal;
+begin
+ fpioctl(Handle, TIOCMGET, @Flags);
+ Result := (Flags and TIOCM_DSR) <> 0;
+end;
+
+function SerGetRI(Handle: TSerialHandle): Boolean;
+var
+ Flags: Cardinal;
+begin
+ fpioctl(Handle, TIOCMGET, @Flags);
+ Result := (Flags and TIOCM_RI) <> 0;
+end;
+
+
+end.
diff --git a/Software/src/general/src/serial_win.pp b/Software/src/general/src/serial_win.pp
new file mode 100755
index 0000000..20188af
--- /dev/null
+++ b/Software/src/general/src/serial_win.pp
@@ -0,0 +1,203 @@
+{ Unit for handling the serial interfaces for Win32.
+ (c) 2007 Luis R. Hilario B., luisdigital@gmail.com
+}
+
+unit serial_win;
+
+{$MODE objfpc}
+{$H+}
+{$PACKRECORDS C}
+
+interface
+
+uses Windows, SysUtils;
+
+type
+
+ TSerialHandle = THandle;
+
+ TParityType = (NoneParity, OddParity, EvenParity);
+
+ TSerialFlags = set of (RtsCtsFlowControl);
+
+ TSerialState = record
+ LineState: LongWord;
+ DCB: TDCB;
+ end;
+
+
+{ Open the serial device with the given device name, for example:
+ COM1, COM2... for normal serial ports
+ other device names are possible; refer to your OS documentation.
+ Returns "INVALID_HANDLE_VALUE" if device could not be found }
+function SerOpen(const DeviceName: String): TSerialHandle;
+
+{ Closes a serial device previously opened with SerOpen. }
+procedure SerClose(Handle: TSerialHandle);
+
+{ Flushes the data queues of the given serial device. }
+procedure SerFlush(Handle: TSerialHandle);
+
+{ Reads a maximum of "Count" bytes of data into the specified buffer.
+ Result: Number of bytes read. }
+function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+
+{ Tries to write "Count" bytes from "Buffer".
+ Result: Number of bytes written. }
+function SerWrite(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+
+procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
+ ByteSize: Integer; Parity: TParityType; StopBits: Integer;
+ Flags: TSerialFlags);
+
+{ Saves and restores the state of the serial device. }
+function SerSaveState(Handle: TSerialHandle): TSerialState;
+procedure SerRestoreState(Handle: TSerialHandle; State: TSerialState);
+
+{ Getting and setting the line states directly. }
+procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
+procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
+function SerGetCTS(Handle: TSerialHandle): Boolean;
+function SerGetDSR(Handle: TSerialHandle): Boolean;
+function SerGetRI(Handle: TSerialHandle): Boolean;
+
+
+{ ************************************************************************** }
+
+implementation
+
+
+function SerOpen(const DeviceName: String): TSerialHandle;
+begin
+ Result := CreateFile(PChar('\\.\' + DeviceName),
+ GENERIC_READ or GENERIC_WRITE,
+ 0,
+ Nil,
+ OPEN_EXISTING,
+ FILE_ATTRIBUTE_NORMAL,
+ 0);
+end;
+
+procedure SerClose(Handle: TSerialHandle);
+begin
+ CloseHandle(Handle);
+end;
+
+procedure SerFlush(Handle: TSerialHandle);
+begin
+ FlushFileBuffers(Handle);
+end;
+
+function SerRead(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+begin
+ if not ReadFile(Handle, Buffer, Count, DWord(Result), Nil) then Result := -1
+end;
+
+function SerWrite(Handle: TSerialHandle; var Buffer; Count: LongInt): LongInt;
+begin
+ if not WriteFile(Handle, Buffer, Count, DWord(Result), Nil) then Result := -1
+end;
+
+procedure SerSetParams(Handle: TSerialHandle; BitsPerSec: LongInt;
+ ByteSize: Integer; Parity: TParityType; StopBits: Integer;
+ Flags: TSerialFlags);
+var
+ DCB: TDCB;
+ COMMTIMEOUTS: TCOMMTIMEOUTS;
+
+begin
+ FillChar(COMMTIMEOUTS, SizeOf(COMMTIMEOUTS), #0);
+ COMMTIMEOUTS.ReadIntervalTimeout := MAXDWORD;
+
+ FillChar(DCB, SizeOf(DCB), #0);
+ DCB.DCBLength := SizeOf(DCB);
+
+ DCB.Flags := bm_DCB_fBinary;
+
+ case BitsPerSec of
+ 110: DCB.BaudRate := CBR_110;
+ 300: DCB.BaudRate := CBR_300;
+ 600: DCB.BaudRate := CBR_600;
+ 1200: DCB.BaudRate := CBR_1200;
+ 2400: DCB.BaudRate := CBR_2400;
+ 4800: DCB.BaudRate := CBR_4800;
+ 14400: DCB.BaudRate := CBR_14400;
+ 19200: DCB.BaudRate := CBR_19200;
+ 38400: DCB.BaudRate := CBR_38400;
+ 56000: DCB.BaudRate := CBR_56000;
+ 57600: DCB.BaudRate := CBR_57600;
+ 115200: DCB.BaudRate := CBR_115200;
+ 128000: DCB.BaudRate := CBR_128000;
+ 256000: DCB.BaudRate := CBR_256000;
+ else DCB.BaudRate := CBR_9600;
+ end;
+
+ if ByteSize in[4..7] then DCB.ByteSize := ByteSize
+ else
+ DCB.ByteSize := 8;
+
+ DCB.Parity := Ord(Parity);
+
+ if StopBits = 2 then DCB.StopBits := TWOSTOPBITS;
+
+ if RtsCtsFlowControl in Flags then
+ DCB.Flags := DCB.Flags or bm_DCB_fOutxCtsFlow or (bm_DCB_fRtsControl -$1000);
+
+ PurgeComm(Handle, PURGE_TXCLEAR or PURGE_RXCLEAR);
+ if not SetCommState(Handle, DCB) then raise Exception.Create('SetCommState Failed!');
+ if not SetCommTimeouts(Handle, COMMTIMEOUTS) then raise Exception.Create('SetCommTimeouts Failed!');
+end;
+
+function SerSaveState(Handle: TSerialHandle): TSerialState;
+begin
+ GetCommModemStatus(Handle, Result.LineState);
+ GetCommState(Handle, Result.DCB);
+end;
+
+procedure SerRestoreState(Handle: TSerialHandle; State: TSerialState);
+begin
+ SetCommState(Handle, State.DCB);
+end;
+
+procedure SerSetDTR(Handle: TSerialHandle; State: Boolean);
+begin
+ if State then
+ EscapeCommFunction(Handle, SETDTR)
+ else
+ EscapeCommFunction(Handle, CLRDTR);
+end;
+
+procedure SerSetRTS(Handle: TSerialHandle; State: Boolean);
+begin
+ if State then
+ EscapeCommFunction(Handle, SETRTS)
+ else
+ EscapeCommFunction(Handle, CLRRTS);
+end;
+
+function SerGetCTS(Handle: TSerialHandle): Boolean;
+var
+ Flags: Cardinal;
+begin
+ GetCommModemStatus(Handle, Flags);
+ Result := (Flags and MS_CTS_ON) <> 0;
+end;
+
+function SerGetDSR(Handle: TSerialHandle): Boolean;
+var
+ Flags: Cardinal;
+begin
+ GetCommModemStatus(Handle, Flags);
+ Result := (Flags and MS_DSR_ON) <> 0;
+end;
+
+function SerGetRI(Handle: TSerialHandle): Boolean;
+var
+ Flags: Cardinal;
+begin
+ GetCommModemStatus(Handle, Flags);
+ Result := (Flags and MS_RING_ON) <> 0;
+end;
+
+
+end.
diff --git a/Software/src/general/src/skype.pas b/Software/src/general/src/skype.pas
new file mode 100755
index 0000000..340b8c7
--- /dev/null
+++ b/Software/src/general/src/skype.pas
@@ -0,0 +1,13 @@
+unit skype;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, dbus;
+
+implementation
+
+end.
+
diff --git a/Software/src/general/src/ucolors.pas b/Software/src/general/src/ucolors.pas
new file mode 100644
index 0000000..27d8d61
--- /dev/null
+++ b/Software/src/general/src/ucolors.pas
@@ -0,0 +1,45 @@
+unit uColors;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils,Graphics,LCLIntf;
+
+function Ligthen(InputColor: TColor; n: Extended): TColor;
+
+implementation
+
+function Ligthen(InputColor: TColor; n: Extended): TColor;
+var
+ r,g,b,y,u,v: integer;
+ temp: Integer;
+begin
+ // RGB To YUV
+ r := GetRValue(InputColor);
+ g := GetGValue(InputColor);
+ b := GetBValue(InputColor);
+ y := g*150 + b*29 + r*77; // 0.587 x 256, 0.114 x 256, 0.299 x 256
+ u := (round(b) shl 8 - y) * 144; // 0.564 x 256
+ v := (round(r) shl 8 - y) * 183; // 0,713 x 256
+ y :=round(y) shr 8;
+ u :=round(u) shr 16 + $80;
+ v :=round(v) shr 16 + $80;
+ //Modify
+ y := y+round(y*n);
+ //YUV To RGB
+ temp := y + (u - $80) * 256 div 144;
+ if temp > 0 then b:=temp else b:=0;
+ if temp > 255 then b:=255;
+ temp := y + (v - $80) * 256 div 183 ;
+ if temp > 0 then r:=temp else r:=0;
+ if temp > 255 then r:=255;
+ temp := (y shl 8 - u*29 - v*77) div 150;
+ if temp > 0 then g:=temp else g:=0;
+ if temp > 255 then g:=255;
+ Result := RGB(byte(Round(r)),byte(Round(g)),byte(Round(b)));
+end;
+
+end.
+
diff --git a/Software/src/general/src/uerror.pas b/Software/src/general/src/uerror.pas
new file mode 100644
index 0000000..461d519
--- /dev/null
+++ b/Software/src/general/src/uerror.pas
@@ -0,0 +1,221 @@
+unit uError;
+
+
+{$mode objfpc}{$H+}
+
+
+interface
+
+
+uses
+
+ Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
+ Buttons,uGeneralStrConsts,LCLProc, LCLType,FileUtil,LConvEncoding;
+
+type
+ { TfError }
+ TfError = class(TForm)
+ bBacktrace: TBitBtn;
+ bSendToAdmin: TBitBtn;
+ bOK: TBitBtn;
+ mError: TMemo;
+ procedure bBacktraceClick(Sender: TObject);
+ procedure bOKClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ private
+ { private declarations }
+ function GetMessage(aFile : string;aMessage : string) : string;
+ public
+ { public declarations }
+ procedure ShowError(Msg : string = '');
+ procedure ShowWarning(Msg : string = '');
+ procedure SetLanguage;
+ end;
+
+var
+ fError: TfError;
+
+implementation
+
+{ TfError }
+procedure TfError.bOKClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TfError.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
+ );
+begin
+ if Key = VK_ESCAPE then
+ begin
+ Key := 0;
+ Close;
+ end;
+end;
+
+function TfError.GetMessage(aFile: string; aMessage: string): string;
+var
+ sl: TStringList;
+ tmp: String;
+ varname: String;
+ tmp1: String;
+ aRes: String;
+ i: Integer;
+ varvalue: String;
+begin
+ try
+ aRes := ConvertEncoding(aMessage,GuessEncoding(aMessage),EncodingUTF8);
+ Result := aRes;
+ if FileExistsUTF8(AppendPathDelim(Application.Location)+aFile) then
+ begin
+ sl := TStringList.Create;
+ sl.LoadFromFile(UTF8ToSys(AppendPathDelim(Application.Location)+aFile));
+ for i := 0 to sl.Count-1 do
+ begin
+ aMessage:=ConvertEncoding(aMessage,GuessEncoding(aMessage),EncodingUTF8);
+ aMessage := StringReplace(aMessage,#10,'',[rfReplaceAll]);
+ aMessage := StringReplace(aMessage,#13,'',[rfReplaceAll]);
+ tmp := sl.Names[i];
+ Result := sl.ValueFromIndex[i];
+ while pos('@',tmp)>0 do
+ begin
+ if pos('@',copy(tmp,pos('@',tmp)+1,length(tmp)))>0 then
+ begin
+ if copy(tmp,0,pos('@',tmp)-1) = copy(aMessage,0,pos('@',tmp)-1) then
+ begin
+ aMessage := copy(aMessage,pos('@',tmp),length(aMessage));
+ tmp := copy(tmp,pos('@',tmp)+1,length(tmp));
+ varname := copy(tmp,0,pos('@',tmp)-1);
+ tmp := copy(tmp,pos('@',tmp)+1,length(tmp));
+ if pos('@',tmp)>0 then
+ tmp1 := copy(tmp,0,pos('@',tmp)-1)
+ else
+ tmp1 := tmp;
+ varvalue := copy(aMessage,0,pos(tmp1,aMessage)-1);
+ aMessage:=copy(aMessage,length(varvalue)+1,length(aMessage));
+ Result := StringReplace(Result,'@'+varname+'@',varvalue,[rfReplaceAll])
+ end
+ else
+ begin
+ Result := aRes;
+ break;
+ end;
+ end
+ else
+ begin
+ Result := aRes;
+ break;
+ end;
+ end;
+ if (aMessage='') or (aMessage=tmp) then break
+ else
+ begin
+ aMessage:=aRes;
+ Result := aRes;
+ end;
+ end;
+ sl.Free;
+ end;
+ except
+ Result := aRes;
+ end;
+end;
+
+procedure TfError.ShowError(Msg: string = '');
+var
+ aMsg : string;
+begin
+ if not Assigned(Self) then
+ begin
+ Application.CreateForm(TfError,fError);
+ Self := fError;
+ end;
+ try
+ bBacktrace.Visible:=ExceptObject <> nil;
+ except
+ end;
+ SetLanguage;
+ mError.Lines.Clear;
+ mError.Font.Color:=clred;
+ bSendToAdmin.Visible:=True;
+ if Msg <> '' then
+ aMsg := GetMessage('errors.txt',Msg)+lineending;
+ if ExceptObject <> nil then
+ begin
+ aMsg := aMsg+lineending+strOriginalException+Exception(ExceptObject).Message;
+ aMsg := aMsg+lineending+strExceptObjectclass+ExceptObject.ClassName;
+ aMsg := aMsg+lineending+strDescription;
+ end;
+ Debugln(aMsg);
+ mError.Lines.Text := trim(aMsg);
+ Showmodal;
+end;
+
+procedure TfError.ShowWarning(Msg: string);
+var
+ aMsg: String;
+begin
+ if not Assigned(Self) then
+ begin
+ Application.CreateForm(TfError,fError);
+ Self := fError;
+ end;
+ SetLanguage;
+ mError.Lines.Clear;
+ mError.Font.Color:=clWindowText;
+ bBacktrace.Visible:=False;
+ bSendToAdmin.Visible:=False;
+ if Msg <> '' then
+ aMsg := GetMessage('warnings.txt',Msg)+lineending;
+ Debugln(aMsg);
+ mError.Lines.Text := trim(aMsg);
+ Showmodal;
+end;
+
+procedure TfError.SetLanguage;
+begin
+ if not Assigned(Self) then
+ begin
+ Application.CreateForm(TfError,fError);
+ Self := fError;
+ end;
+ try
+ bOK.Caption := strOK;
+ bBacktrace.Caption := strBacktrace;
+
+ Caption := strError;
+ except
+ end;
+end;
+
+procedure TfError.bBacktraceClick(Sender: TObject);
+var
+ aMsg : string = '';
+ FrameCount: LongInt;
+ Frames: PPointer;
+ FrameNumber: Integer;
+begin
+ try
+ if ExceptAddr <> nil then
+ begin
+ aMsg := aMsg+lineending+strStackTrace;
+ aMsg := aMsg+lineending+BackTraceStrFunc(ExceptAddr);
+ FrameCount:=ExceptFrameCount;
+ Frames:=ExceptFrames;
+ for FrameNumber := 0 to FrameCount-1 do
+ aMsg := aMsg+lineending+BackTraceStrFunc(Frames[FrameNumber]);
+ end;
+ except
+ end;
+ mError.Lines.Text:=mError.Lines.Text+lineending+aMsg;
+end;
+
+initialization
+ {$I uerror.lrs}
+
+end.
+
+
+
+
+
\ No newline at end of file
diff --git a/Software/src/general/src/ufilesystem.pas b/Software/src/general/src/ufilesystem.pas
new file mode 100755
index 0000000..a65ea72
--- /dev/null
+++ b/Software/src/general/src/ufilesystem.pas
@@ -0,0 +1,424 @@
+unit uFileSystem;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, Graphics, Utils
+ {$IFDEF WINDOWS}
+ ,Windows
+ {$ENDIF}
+ ;
+
+
+const
+ cDefaultListGrowthDelta = 16;
+
+resourcestring
+ strNamecannotbeclear = 'The name of an object cannot be clear';
+ strComputer = 'Computer';
+
+type
+ TBaseInterface = class;
+
+ TUser = class
+ end;
+
+ TUserGroup = class
+ end;
+
+ { TBaseAttribute }
+
+ TBaseAttribute = class
+ private
+ FCanExecute: Boolean;
+ FCanRead: Boolean;
+ FCanWrite: Boolean;
+ procedure SetCanExecute(const AValue: Boolean);
+ procedure SetCanRead(const AValue: Boolean);
+ procedure SetCanWrite(const AValue: Boolean);
+ public
+ property canread : Boolean read FCanRead write SetCanRead;
+ property canwrite : Boolean read FCanWrite write SetCanWrite;
+ property canexecute : Boolean read FCanExecute write SetCanExecute;
+ end;
+
+ { TBaseAttributes }
+
+ TBaseAttributes = class
+ private
+ FGroup: TUserGroup;
+ FGroupRights: TBaseAttribute;
+ FOtherRights: TBaseAttribute;
+ FUser: TUser;
+ FUserRights: TBaseAttribute;
+ procedure SetGroup(const AValue: TUserGroup);
+ procedure SetGroupRights(const AValue: TBaseAttribute);
+ procedure SetOtherRights(const AValue: TBaseAttribute);
+ procedure SetUser(const AValue: TUser);
+ procedure SetUserRights(const AValue: TBaseAttribute);
+ public
+ property User : TUser read FUser write SetUser;
+ property Group : TUserGroup read FGroup write SetGroup;
+ property UserRights : TBaseAttribute read FUserRights write SetUserRights;
+ property GroupRights : TBaseAttribute read FGroupRights write SetGroupRights;
+ property OtherRights : TBaseAttribute read FOtherRights write SetOtherRights;
+ end;
+
+ { TBaseEntry }
+
+ PbaseEntry = ^TBaseEntry;
+ TBaseEntry = class
+ private
+ FAttributes: TBaseAttributes;
+ FChanged: TDateTime;
+ FCreation: TDateTime;
+ FName: string;
+ FFullPath : string;
+ FParent : TBaseEntry;
+ function GetSize: LongInt;virtual;
+ procedure SetAttributes(const AValue: TBaseAttributes);virtual;
+ procedure SetName(const AValue: string);virtual;
+ protected
+ FInterface : TBaseInterface;
+ procedure Select(Sender : TObject);
+ procedure Deselect(Sender : TObject);
+ public
+ constructor Create(Creator : TBaseEntry;Path : string);
+ procedure Open; virtual;
+ procedure Close; virtual;
+ property Parent : TBaseEntry read FParent;
+ property Name : string read FName write SetName;
+ property Size : LongInt read GetSize;
+ property Created : TDateTime read FCreation;
+ property Changed : TDateTime read FChanged;
+ property Attributes : TBaseAttributes read FAttributes write SetAttributes;
+ property FullPath : string read FFullPath;
+ end;
+
+ TBaseFile = class(TBaseEntry)
+ public
+ end;
+
+ TDirectoryWatcher = class
+ end;
+
+ TPointerEntryList = array [0..MaxInt shr 3] of TbaseEntry;
+ PPointerEntryList = ^TPointerEntryList;
+
+ { TBaseDirectory }
+
+ TBaseDirectory = class(TBaseEntry)
+ private
+ FList: TList;
+ function Get(Index : Integer): TBaseEntry;
+ function GetCount: Integer;
+ procedure Put(Index : Integer; const AValue: TBaseEntry);
+ function Add(const item : TBaseEntry) : Integer;virtual;
+ function Remove(Item: TBaseEntry): Integer;
+ public
+ constructor Create(Creator : TBaseEntry;Path : string;Intf : TBaseInterface = nil);
+ destructor Destroy;override;
+ procedure Close;override;
+ property Count: Integer read GetCount;
+ function IndexOf(Item: TBaseEntry): Integer;
+ property Items[Index : Integer] : TBaseEntry read Get write Put;
+ end;
+
+ { TDirectory }
+
+ TDirectory = class(TBaseDirectory)
+ private
+ protected
+ public
+ procedure Open;override;
+ end;
+
+ { TComputerDirectory }
+
+ TComputerDirectory = class(TBaseDirectory)
+ public
+ procedure Open;override;
+ constructor Create;
+ end;
+
+ { TDrive }
+
+ TDrive = class(TDirectory)
+ public
+ constructor Create(Creator : TBaseEntry;Path : string);
+ end;
+
+ TFile = class(TBaseFile)
+ end;
+
+ { TBaseInterface }
+
+ TBaseInterface = CLASS
+ private
+ FFont : TFont;
+ FFontSize : Integer;
+ protected
+ FLanguage : string;
+ public
+ Tag : LongInt;
+ function GetLanguage : string;
+ procedure SetLanguage(Lang : string);dynamic;abstract;
+ procedure ShowInfo(Msg : String);dynamic;abstract;
+ procedure ShowError(Msg : String);dynamic;abstract;
+ procedure ShowDebug(Msg : String);dynamic;abstract;
+ procedure GetMyInterfaces(Obj : TBaseEntry);dynamic;abstract;
+ destructor Destroy;
+ published
+ property Font : TFont read FFont write FFont;
+ property FontSize : Integer read FFontSize write FFontSize;
+ property Language : string read FLanguage write SetLanguage;
+ end;
+
+
+implementation
+
+{ TBaseEntry }
+
+function TBaseEntry.GetSize: LongInt;
+begin
+ Result := 0;
+end;
+
+procedure TBaseEntry.SetAttributes(const AValue: TBaseAttributes);
+begin
+ if FAttributes=AValue then exit;
+ FAttributes:=AValue;
+end;
+
+procedure TBaseEntry.SetName(const AValue: string);
+begin
+ if FName=AValue then exit;
+ FName:=AValue;
+end;
+
+procedure TBaseEntry.Select(Sender : TObject);
+begin
+end;
+
+procedure TBaseEntry.Deselect(Sender : TObject);
+begin
+end;
+
+constructor TBaseEntry.Create(Creator: TBaseEntry; Path: string);
+begin
+ if Creator = nil then
+ FFullPath := Path
+ else
+ FFullPath := Creator.FFullPath+DirectorySeparator+Path;
+ if Rpos('\',FFullPath)>0 then
+ FName := copy(FFullPath,RPos('\',FFullPath)+1,length(FFullPath))
+ else if Rpos('/',FFullPath)>0 then
+ FName := copy(FFullPath,RPos('/',FFullPath)+1,length(FFullPath))
+ else
+ Fname := FFullPath;
+ FName := AnsiToUTF8(FName);
+ FParent := Creator;
+end;
+
+procedure TBaseEntry.Open;
+begin
+end;
+
+procedure TBaseEntry.Close;
+begin
+end;
+
+{ TBaseAttribute }
+
+procedure TBaseAttribute.SetCanExecute(const AValue: Boolean);
+begin
+ if FCanExecute=AValue then exit;
+ FCanExecute:=AValue;
+end;
+
+procedure TBaseAttribute.SetCanRead(const AValue: Boolean);
+begin
+ if FCanRead=AValue then exit;
+ FCanRead:=AValue;
+end;
+
+procedure TBaseAttribute.SetCanWrite(const AValue: Boolean);
+begin
+ if FCanWrite=AValue then exit;
+ FCanWrite:=AValue;
+end;
+
+{ TBaseAttributes }
+
+procedure TBaseAttributes.SetGroup(const AValue: TUserGroup);
+begin
+ if FGroup=AValue then exit;
+ FGroup:=AValue;
+end;
+
+procedure TBaseAttributes.SetGroupRights(const AValue: TBaseAttribute);
+begin
+ if FGroupRights=AValue then exit;
+ FGroupRights:=AValue;
+end;
+
+procedure TBaseAttributes.SetOtherRights(const AValue: TBaseAttribute);
+begin
+ if FOtherRights=AValue then exit;
+ FOtherRights:=AValue;
+end;
+
+procedure TBaseAttributes.SetUser(const AValue: TUser);
+begin
+ if FUser=AValue then exit;
+ FUser:=AValue;
+end;
+
+procedure TBaseAttributes.SetUserRights(const AValue: TBaseAttribute);
+begin
+ if FUserRights=AValue then exit;
+ FUserRights:=AValue;
+end;
+
+{ TBaseDirectory }
+
+function TBaseDirectory.Get(Index : Integer): TBaseEntry;
+begin
+ if Flist.Count > Index then
+ Result := TBaseEntry(FList[Index]);
+end;
+
+function TBaseDirectory.GetCount: Integer;
+begin
+ Result := FList.Count;
+end;
+
+procedure TBaseDirectory.Put(Index : Integer; const AValue: TBaseEntry);
+begin
+ FList[Index] := AValue;
+end;
+
+constructor TBaseDirectory.Create(Creator: TBaseEntry; Path: string;
+ Intf: TBaseInterface);
+begin
+ FList := TList.Create;
+ inherited Create(Creator, Path);
+end;
+
+destructor TBaseDirectory.Destroy;
+begin
+ inherited Destroy;
+ Close;
+end;
+
+procedure TBaseDirectory.Close;
+var
+ aItem: TBaseEntry;
+begin
+ inherited Close;
+ while Count > 0 do
+ begin
+ aItem := Items[0];
+ Remove(Items[0]);
+ aItem.Free;
+ end;
+end;
+
+function TBaseDirectory.Add(const item: TBaseEntry): Integer;
+begin
+ FList.Add(item);
+end;
+
+function TBaseDirectory.Remove(Item: TBaseEntry): Integer;
+begin
+ fList.Remove(Item);
+end;
+
+function TBaseDirectory.IndexOf(Item: TbaseEntry): Integer;
+begin
+ Result := FList.IndexOf(Item);
+end;
+
+{ TBaseInterface }
+
+destructor TBaseInterface.Destroy;
+begin
+end;
+
+function TBaseInterface.GetLanguage: string;
+begin
+ Result := FLanguage;
+end;
+
+{ TDirectory }
+
+procedure TDirectory.Open;
+var
+ SR : TSearchRec;
+begin
+ if FindFirst(FFullPath+DirectorySeparator+'*',faAnyFile,sr)=0 then
+ begin
+ repeat
+ If (sr.Attr and faDirectory) = faDirectory then
+ begin
+ if copy(sr.name,0,1) <> '.' then
+ Add(TDirectory.Create(Self,sr.Name))
+ end
+ else
+ Add(TFile.Create(Self,sr.Name));
+ until FindNext(sr)<>0;
+ end;
+ SysUtils.FindClose(sr);
+end;
+
+{ TComputerDirectory }
+
+procedure TComputerDirectory.Open;
+var
+{$IFDEF MSWINDOWS}
+ DriveNum: Integer;
+ DriveBits: set of 0..25;
+{$ELSE}
+ sr : TSearchRec;
+{$ENDIF}
+begin
+{$IFDEF MSWINDOWS}
+ Integer(DriveBits) := GetLogicalDrives;
+ for DriveNum := 0 to 25 do
+ if (DriveNum in DriveBits) then
+ Add(TDrive.Create(Self,Char(DriveNum + Ord('a')) + ':\'));
+{$ELSE}
+ if FindFirst('/',faAnyFile,sr)=0 then
+ begin
+ repeat
+ If (sr.Attr and faDirectory) = faDirectory then
+ begin
+ if copy(sr.name,0,1) <> '.' then
+ Add(TDirectory.Create(Self,sr.Name))
+ end;
+ until FindNext(sr)<>0;
+ end;
+ SysUtils.FindClose(sr);
+{$ENDIF}
+end;
+
+constructor TComputerDirectory.Create;
+begin
+ FName := strComputer;
+ FList := TList.Create;
+end;
+
+{ TDrive }
+
+constructor TDrive.Create(Creator: TBaseEntry; Path: string);
+begin
+ FName := Path;
+ FFullPath := Path;
+ FParent := Creator;
+ FList := TList.Create;
+end;
+
+end.
+
diff --git a/Software/src/general/src/ugeneralstrconsts.pas b/Software/src/general/src/ugeneralstrconsts.pas
new file mode 100755
index 0000000..a17d24f
--- /dev/null
+++ b/Software/src/general/src/ugeneralstrconsts.pas
@@ -0,0 +1,121 @@
+unit uGeneralStrConsts;
+
+{$mode objfpc}{$H+}
+
+interface
+
+resourcestring
+ strBacktrace = 'Fehlerherkunft';
+ strAddBugToTracker = 'Fehler berichten';
+ strStackTrace = 'Stackverfolgung:';
+ strError = 'Error';
+ strExceptionclass = 'Errorclass: ';
+ strOriginalException = 'Original exception: ';
+ strExceptObject = 'Errorobject: ';
+ strExceptObjectclass = 'Errorobjectclass: ';
+{$ifdef CPU32}
+ strExceptPointer = 'Error adress: %.4x';
+{$endif}
+{$ifdef CPU64}
+ strExceptPointer = 'Error adress: %.8x';
+{$endif}
+ strAdd = 'Add';
+ strStatus = 'Status';
+ strFilter = 'Filter';
+ strNotice = 'Notice';
+ strLogintoBugtrackerfailed = 'Login on bugtracker failed!';
+ strAllOpen = 'All open entrys';
+ strAllOpenFeaturerequests = 'All open featurerequests';
+ strAllOpenBugs = 'All open bugreports';
+ strAllClosed = 'All closed entrys';
+ strAllAll = 'All entrys';
+ strAbort = 'Abort';
+ strBack = 'Back';
+ strNext = 'Next';
+ strHelpIndex = 'Help index';
+ strHelp = 'Help';
+ strNoHelpAvalible = 'No help avalible';
+ strHome = 'Index';
+ strSearch = 'Search';
+ strSearchresults = 'Searchresults';
+ strMatch = 'Match';
+ strNothingFound = 'No entrys found !';
+ strFilenotinrepositore = 'Your File: %s is not in the repositore ! Maybe its is external modified !';
+ strUpdate = 'Update';
+ strCheckingforUpdate = 'Checking for update ...';
+ strDoUpdate = 'Automatic online update active';
+ strPleaseWait = 'Please wait ...';
+ strFailedPatchingFile = 'Error patching the file';
+ strGettingUpdateFile = 'Getting update index ...';
+ strUpdateSourcenotthere = 'The update source dont anwer or isnt there';
+ strWaitingforFileAccess = 'Waiting for exclusive fileaccess';
+ strUpdatingFile = 'Updating file %s';
+ strCheckingForrevisions = 'Checking for new revisions';
+ strFileIsNewer = 'Your file is newer than the file on server, this error schouldnt be there, please inform the author';
+ strActualRevisionNotFound = 'Your file is newer than the file on server, Virus ??';
+ strTargetRevisionnotFound = 'Target revision not found';
+ strRevisions = 'Patching file from revision %d to %d';
+ strGettingRevision = 'Getting revision %d';
+ strErrorGettingFile = 'Coudnt load file from server';
+ strPatchingFile = 'Patching file';
+ strDone = 'Done.';
+ strPatchExedontexists = 'Bspatch or patch program dosend exists !';
+ strNoNetavalible = 'No network avalible, the online update is disabled !';
+ strAnNewUpdateisAvalible = 'Thers an new update avalible, download ind install now ?';
+ strDescription = 'Description';
+ strFieldReplicablecannotbeclear='Field reproduceable cannot be clear !';
+ strFieldSeveritycannotbeclear = 'Field severity cannot be clear';
+ strFieldDescriptioncannotbeclear='Field description cannot be clear !';
+ strFieldSummarycannotbeclear = 'Field summary cannot be clear !';
+ strFieldNamecannotbeclear = 'Field submittername cannot be clear !';
+ strFieldMailcannotbeclear = 'Field submittermail cannot be clear !';
+ strSubmittername = 'Submittername';
+ strSubmittermail = 'Submittermail';
+ strSummary = 'Summary';
+ strChange = 'Change';
+ strDate = 'Date';
+ strReplicable = 'Reproduceable';
+ strID = 'ID';
+ strSeverity = 'Severity';
+ strHistory = 'History';
+ strSubmit = 'Submit';
+ strAddNote = 'Add notice';
+ strClose = 'Close';
+ strAdditionalInfos = 'Additional information';
+ strViewFeatureRequestorBug = 'Show featurerequest/bugreport';
+ strAddFeatureRequestorBug = 'Add featurerequest/bugreport';
+ strBugtracker = 'Featurerequests/bugreports';
+ strMaximize = 'Maximize panel';
+ strMinimize = 'Minimize panel';
+ strRestore = 'Restore panel';
+ strUndock = 'Undock panel';
+ strDock = 'Dock panel';
+ strYes = 'Yes';
+ strNo = 'No';
+ strOK = 'OK';
+ strLanguage = 'Language';
+ strShortCuts = 'Shortcuts';
+ strShortCut = 'Shortcut';
+ strFunction = 'Function';
+ strGetKey = 'Get Key';
+ strDeletekey = 'Delete key';
+ strSystem = 'System';
+ strUnknownOS = 'Unknown OS';
+ strNox86CPU = 'No x86 compatible CPU';
+ strNottested = 'not tested';
+ strValue = 'Value';
+ strOperatingSystem = 'Operating System';
+ strCPU = 'CPU';
+ strHarddisk = 'Harddisk';
+ strType = 'Typ';
+ strRating = 'Rating';
+ strMemory = 'Memory';
+ strBenchmark = 'Benchmark';
+ strLicense = 'License';
+ strChanges = 'Changes';
+ strInfo = 'Info';
+ strTimedOut = 'Programtimeout';
+
+implementation
+end.
+
\ No newline at end of file
diff --git a/Software/src/general/src/umashineid.pas b/Software/src/general/src/umashineid.pas
new file mode 100755
index 0000000..b9884c9
--- /dev/null
+++ b/Software/src/general/src/umashineid.pas
@@ -0,0 +1,176 @@
+unit umashineid;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ELSE}
+ BaseUnix,
+ {$ENDIF}
+ Classes, SysUtils, LCLProc, ProcessUtils;
+
+function CreateUserID : LongInt;
+function CreateMachineID : LongInt;
+
+implementation
+
+function AddStringToLong(const Buf; BufSize : LongInt) : LongInt;
+var
+ BufBytes : TByteArray absolute Buf;
+ I: Integer;
+begin
+ Result := 0;
+ for I := 0 to BufSize - 1 do
+ Result := Result+BufBytes[i] shl I*4;
+end;
+
+{$IFDEF WIN32}
+function CreateUserID : LongInt;
+const
+ sCurVer = 'Software\Microsoft\Windows\CurrentVersion';
+ sCurVerNT = 'Software\Microsoft\Windows NT\CurrentVersion';
+ sRegOwner = 'RegisteredOwner';
+ sRegOrg = 'RegisteredOrganization';
+var
+ UserInfoFound: Boolean;
+ RegKey : HKEY;
+ Buf : array [0..1023] of Byte;
+ I: Integer;
+begin
+ Result := 0;
+ UserInfoFound := False;
+ { first look for registered info in \Windows\CurrentVersion }
+ if (RegOpenKeyEx(HKEY_LOCAL_MACHINE, sCurVer, 0, KEY_QUERY_VALUE, RegKey) = ERROR_SUCCESS) then
+ begin
+ I := SizeOf(Buf);
+ if RegQueryValueEx(RegKey, sRegOwner, nil, nil, @Buf, @I) = ERROR_SUCCESS then
+ begin
+ UserInfoFound := True;
+ Result := Result+AddStringToLong(Buf,I);
+ I := SizeOf(Buf);
+ if RegQueryValueEx(RegKey, sRegOrg, nil, nil, @Buf, @I) = ERROR_SUCCESS then
+ Result := result+AddStringToLong(Buf, I);
+ end;
+ RegCloseKey(RegKey);
+ end;
+ if not UserInfoFound then
+ if (RegOpenKeyEx(HKEY_LOCAL_MACHINE, sCurVerNT, 0, KEY_QUERY_VALUE, RegKey) = ERROR_SUCCESS) then
+ begin
+ I := SizeOf(Buf);
+ if RegQueryValueEx(RegKey, sRegOwner, nil, nil, @Buf, @I) = ERROR_SUCCESS then
+ begin
+ Result := Result+AddStringToLong(Buf, I);
+ I := SizeOf(Buf);
+ if RegQueryValueEx(RegKey, sRegOrg, nil, nil, @Buf, @I) = ERROR_SUCCESS then
+ Result := Result+AddStringToLong(Buf, I);
+ end;
+ RegCloseKey(RegKey);
+ end;
+end;
+{$ELSE}
+function CreateUserID : LongInt;
+var
+ tmp: String;
+ i: Integer;
+begin
+ tmp := GetEnvironmentVariable('USERNAME');
+ if tmp = '' then
+ tmp := GetEnvironmentVariable('USER');
+ Result := 0;
+ for i := 0 to length(tmp)-1 do
+ Result := Result+ord(tmp[i]);
+end;
+{$ENDIF}
+
+{$IFDEF WINDOWS}
+function CreateMachineID : LongInt;
+type
+ TUuidCreateSequential = function (lpGUID : Pointer): HResult; stdcall;
+var
+ hRPCTR4 : THandle;
+ UuidCreateSequential : TUuidCreateSequential;
+ I : DWord;
+ Drive : AnsiChar;
+ mDrive : string;
+ SysInfo : TSystemInfo;
+ UserInfoFound : Boolean;
+ Buf : array [0..1023] of Byte;
+begin
+ Result := 0;
+ {include system specific information}
+ GetSystemInfo(SysInfo);
+ {$IFDEF VER2_2_0}
+ PDWord(@Buf[0])^ := SysInfo.u.dwOemId;
+ {$ELSE}
+ PDWord(@Buf[0])^ := SysInfo.dwOemId;
+ {$ENDIF}
+ PDWord(@Buf[4])^ := SysInfo.dwProcessorType;
+ Result := Result+AddStringToLong(Buf, 8);
+
+ {include drive specific information}
+ for Drive := 'C' to 'D' do
+ begin
+ mDrive := Drive + ':\';
+ if (GetDriveType(PAnsiChar(mDrive)) = DRIVE_FIXED) then
+ begin
+ FillChar(Buf, Sizeof(Buf), 0);
+ Buf[0] := Byte(Drive);
+ GetVolumeInformation(PAnsiChar(mDrive), nil, 0, PDWord(@Buf[1]){serial number}, I{not used}, I{not used}, nil, 0);
+ Result := Result+AddStringToLong(Buf, 5);
+ end;
+ end;
+end;
+{$ENDIF}
+{$IFDEF UNIX}
+function CreateMachineID : LongInt;
+var
+ I : LongInt;
+ RegKey : DWord;
+ GUID1 : TGUID;
+ GUID2 : TGUID;
+ Drive : Integer;
+ Buf : array [0..2047] of Byte;
+ iFileHandle : LongInt;
+ tmp: String;
+begin
+ Result := 0;
+ {include system specific information}
+// iFileHandle := FileOpen('/proc/cpuinfo', fmopenRead or fmShareDenyNone);
+// I := FileRead(iFileHandle, Buf,2048);
+// if I > 0 then Result := Result+AddStringToLong(Buf, I-1);
+// FileClose(iFileHandle);
+
+ iFileHandle := FileOpen('/proc/sys/kernel/hostname', fmopenRead or fmShareDenyNone);
+ I := FileRead(iFileHandle, Buf, 2048);
+ if I > 0 then Result := result+AddStringToLong(Buf, I-1);
+ FileClose(iFileHandle);
+
+ {include network ID}
+ CreateGuid(GUID1);
+ CreateGuid(GUID2);
+ {check to see if "network" ID is available}
+ if (GUID1.D4[2] = GUID2.D4[2]) and
+ (GUID1.D4[3] = GUID2.D4[3]) and
+ (GUID1.D4[4] = GUID2.D4[4]) and
+ (GUID1.D4[5] = GUID2.D4[5]) and
+ (GUID1.D4[6] = GUID2.D4[6]) and
+ (GUID1.D4[7] = GUID2.D4[7]) then
+ Result := Result+AddStringToLong(GUID1.D4[2], 6);
+ {$IFDEF DARWIN}
+ tmp := ExecProcessEx('system_profiler -detailLevel minimal');
+ tmp := copy(tmp,pos('Serial Number',tmp)+13,length(tmp));
+ tmp := copy(tmp,pos(':',tmp)+1,length(tmp));
+ tmp := copy(tmp,0,pos(lineending,tmp)-1);
+ Result := result+AddStringToLong(tmp[1],length(tmp)-1);
+ {$ENDIF}
+
+end;
+{$ENDIF}
+
+
+end.
+
+
diff --git a/Software/src/general/src/umodifiedds.pas b/Software/src/general/src/umodifiedds.pas
new file mode 100644
index 0000000..aee08f1
--- /dev/null
+++ b/Software/src/general/src/umodifiedds.pas
@@ -0,0 +1,16 @@
+unit uModifiedDS;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils;
+type
+ IBaseModifiedDS = interface['{311D0DE7-9248-4412-8195-B69EAB813895}']
+ function IsChanged : Boolean;
+ end;
+implementation
+
+end.
+
diff --git a/Software/src/general/src/urtftotxt.pas b/Software/src/general/src/urtftotxt.pas
new file mode 100644
index 0000000..ef72b3f
--- /dev/null
+++ b/Software/src/general/src/urtftotxt.pas
@@ -0,0 +1,170 @@
+unit uRTFtoTXT;
+{$mode DELPHI}
+interface
+uses sysutils,math,LCLProc,LCLIntf,FileUtil;
+function RTF2Plain (const aSource: string): string;
+implementation
+function HexToInt(HexNum: string): LongInt;
+begin
+ Result:=StrToInt('$' + HexNum);
+end;
+{Convert RTF enabled text to plain.}
+function RTF2Plain (const aSource: string): string;
+var
+ Source: string;
+ NChar: Integer;
+function ProcessGroupRecursevly: string;
+ procedure SkipStar;
+ var
+ BracesOpened: Integer;
+ Escaped: Boolean;
+ begin
+ BracesOpened:=1;
+ Escaped:=false;
+ while BracesOpened>0
+ do begin
+ Inc (NChar);
+ case Source [NChar] of
+ '{': if Escaped
+ then Escaped:=false
+ else Inc (BracesOpened);
+ '}': if Escaped
+ then Escaped:=false
+ else Dec (BracesOpened);
+ '\': Escaped:=not Escaped;
+ else Escaped:=false;
+ end;
+ end;
+ end;
+ function UnicodeCharCode2ANSIChar (aCode: LongInt): Char;
+ type
+ TUnicode2ANSITable=array [$0410..$044f] of Char;
+ const
+ Unicode2ANSITable: TUnicode2AnsiTable=('À', 'Á', 'Â', 'Ã', 'Ä', 'Å', 'Æ', 'Ç', 'È', 'É', 'Ê', 'Ë', 'Ì', 'Í', 'Î', 'Ï', 'Ð', 'Ñ', 'Ò', 'Ó', 'Ô', 'Õ', 'Ö', '×', 'Ø', 'Ù', 'Ú', 'Û', 'Ü', 'Ý', 'Þ', 'ß',
+ 'à', 'á', 'â', 'ã', 'ä', 'å', 'æ', 'ç', 'è', 'é', 'ê', 'ë', 'ì', 'í', 'î', 'ï', 'ð', 'ñ', 'ò', 'ó', 'ô', 'õ', 'ö', '÷', 'ø', 'ù', 'ú', 'û', 'ü', 'ý', 'þ', 'ÿ');
+ begin
+ if (Low (Unicode2ANSITable)<=aCode) and (aCode<=High (Unicode2ANSITable))
+ then UnicodeCharCode2ANSIChar:=Unicode2ANSITable [aCode]
+ else UnicodeCharCode2ANSIChar:='?';
+ end;
+var
+ Control, NumericValue, TextValue: string;
+ tmp: String;
+begin
+ Result:='';
+ Inc (NChar);
+ while NChar<=Length (Source)
+ do case Source [NChar] of
+ '{': Result:=Result+ProcessGroupRecursevly;
+ '}': begin
+ Inc (NChar);
+ Break;
+ end;
+ '\': begin
+ Inc (NChar);
+ case Source [NChar] of
+ '''': begin
+ Result:=Result+Chr (HexToInt (Copy (Source, NChar+1, 2)));
+ Inc (NChar, 3);
+ end;
+ '~': Result:=Result+#$20;
+ '*': SkipStar;
+ 'a'..'z': begin
+ Control:='';
+ while Source [NChar] in ['a'..'z']
+ do begin
+ Control:=Control+Source [NChar];
+ Inc (NChar);
+ end;
+ if Source [NChar]='-'
+ then begin
+ NumericValue:=Source [NChar];
+ Inc (NChar);
+ end
+ else NumericValue:='';
+ while Source [NChar] in ['0'..'9']
+ do begin
+ NumericValue:=NumericValue+Source [NChar];
+ Inc (NChar);
+ end;
+ if Source [NChar]='{' then
+ tmp := ProcessGroupRecursevly;
+ TextValue:='';
+ if not (Source [NChar] in ['a'..'z', '{', '}', '\'])
+ then begin
+ Inc (NChar);
+ while not (Source [NChar] in ['{', '}', '\'])
+ do begin
+ TextValue:=TextValue+Source [NChar];
+ Inc (NChar);
+ end;
+ end;
+ if (Control='line') or (Control='par')
+ then Result:=Result+#$0D#$0A
+ else if Control='tab'
+ then Result:=Result+#$09
+ else if Control='u'
+ then Result:=Result+SysToUTF8(UnicodeCharCode2ANSIChar (StrToInt (NumericValue)))
+ else if Control='colortbl'
+ then TextValue:='';
+ if Length (TextValue)>0
+ then if (not ((TextValue [Length (TextValue)]=';') and (Source [NChar]='}')))
+ then begin
+ Result:=Result+TextValue;
+ TextValue:='';
+ end;
+ end;
+ else begin
+ Result:=Result+Source [NChar];
+ Inc (NChar);
+ end;
+ end;
+ end;
+ else begin
+ Result:=Result+Source [NChar];
+ Inc (NChar);
+ end;
+ end;
+end;
+function InitSource: Boolean;
+var
+ BracesCount: Integer;
+ Escaped: Boolean;
+begin
+ if Copy (aSource, 1, 5)<>'{\rtf'
+ then InitSource:=false
+ else begin
+ Source:='';
+ BracesCount:=0;
+ Escaped:=false;
+ NChar:=1;
+ while (NChar<=Length (aSource)) and (BracesCount>=0)
+ do begin
+ if not (aSource [NChar] in [#$0D, #$0A])
+ then begin
+ Source:=Source+aSource [NChar];
+ case aSource [NChar] of
+ '{': if not Escaped
+ then Inc (BracesCount)
+ else Escaped:=false;
+ '}': if not Escaped
+ then Dec (BracesCount)
+ else Escaped:=false;
+ '\': Escaped:=true;
+ else Escaped:=false;
+ end;
+ end;
+ Inc (NChar);
+ end;
+ InitSource:=BracesCount=0;
+ end;
+end;
+begin
+ if InitSource then
+ begin
+ NChar:=1;
+ Result:=ProcessGroupRecursevly;
+ end
+ else Result:=aSource;
+end;
+end.
diff --git a/Software/src/general/src/ushortcuts.lfm b/Software/src/general/src/ushortcuts.lfm
new file mode 100755
index 0000000..a9fb31e
--- /dev/null
+++ b/Software/src/general/src/ushortcuts.lfm
@@ -0,0 +1,105 @@
+object fShortcuts: TfShortcuts
+ Left = 407
+ Height = 321
+ Top = 254
+ Width = 372
+ HorzScrollBar.Page = 371
+ VertScrollBar.Page = 320
+ ActiveControl = tvMain
+ Caption = 'fShortcuts'
+ ClientHeight = 321
+ ClientWidth = 372
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnKeyUp = FormKeyUp
+ OnShow = FormShow
+ object Bevel1: TBevel
+ Left = 8
+ Height = 3
+ Top = 280
+ Width = 356
+ Anchors = [akLeft, akRight, akBottom]
+ Shape = bsTopLine
+ end
+ object tvMain: TVirtualStringTree
+ Left = 8
+ Height = 248
+ Top = 24
+ Width = 356
+ Anchors = [akTop, akLeft, akRight, akBottom]
+ Header.MainColumn = -1
+ Header.Options = [hoColumnResize, hoDrag]
+ TabOrder = 0
+ OnGetText = VirtualStringTree1GetText
+ OnResize = Splitter1Moved
+ Columns = <>
+ end
+ object pHeader: TPanel
+ Left = 8
+ Height = 18
+ Top = 8
+ Width = 356
+ Anchors = [akTop, akLeft, akRight]
+ BevelOuter = bvNone
+ Caption = 'pHeader'
+ ClientHeight = 18
+ ClientWidth = 356
+ TabOrder = 1
+ object pFunction: TPanel
+ Height = 18
+ Width = 189
+ Align = alClient
+ Caption = 'pFunction'
+ TabOrder = 0
+ end
+ object pShortcut: TPanel
+ Left = 194
+ Height = 18
+ Width = 162
+ Align = alRight
+ Caption = 'pShortcut'
+ TabOrder = 1
+ end
+ object Splitter1: TSplitter
+ Left = 189
+ Height = 18
+ Width = 5
+ Align = alRight
+ OnMoved = Splitter1Moved
+ ResizeAnchor = akRight
+ end
+ end
+ object bOK: TButton
+ Left = 268
+ Height = 25
+ Top = 288
+ Width = 96
+ Anchors = [akRight, akBottom]
+ BorderSpacing.InnerBorder = 4
+ Caption = 'bOK'
+ OnClick = bOKClick
+ TabOrder = 2
+ end
+ object bGetKey: TButton
+ Left = 8
+ Height = 25
+ Top = 288
+ Width = 131
+ Anchors = [akLeft, akBottom]
+ BorderSpacing.InnerBorder = 4
+ Caption = 'bGetKey'
+ OnClick = bGetKeyClick
+ TabOrder = 3
+ end
+ object bDeleteKey: TButton
+ Left = 144
+ Height = 25
+ Top = 288
+ Width = 120
+ Anchors = [akLeft, akBottom]
+ BorderSpacing.InnerBorder = 4
+ Caption = 'bDeleteKey'
+ OnClick = bDeleteKeyClick
+ TabOrder = 4
+ end
+end
diff --git a/Software/src/general/src/ushortcuts.lrs b/Software/src/general/src/ushortcuts.lrs
new file mode 100755
index 0000000..67b1b8f
--- /dev/null
+++ b/Software/src/general/src/ushortcuts.lrs
@@ -0,0 +1,32 @@
+LazarusResources.Add('TfShortcuts','FORMDATA',[
+ 'TPF0'#11'TfShortcuts'#10'fShortcuts'#4'Left'#3#151#1#6'Height'#3'A'#1#3'Top'
+ +#3#254#0#5'Width'#3't'#1#18'HorzScrollBar.Page'#3's'#1#18'VertScrollBar.Page'
+ +#3'@'#1#13'ActiveControl'#7#6'tvMain'#7'Caption'#6#10'fShortcuts'#12'ClientH'
+ +'eight'#3'A'#1#11'ClientWidth'#3't'#1#8'OnCreate'#7#10'FormCreate'#9'OnDestr'
+ +'oy'#7#11'FormDestroy'#7'OnKeyUp'#7#9'FormKeyUp'#6'OnShow'#7#8'FormShow'#0#6
+ +'TBevel'#6'Bevel1'#4'Left'#2#8#6'Height'#2#3#3'Top'#3#24#1#5'Width'#3'd'#1#7
+ +'Anchors'#11#6'akLeft'#7'akRight'#8'akBottom'#0#5'Shape'#7#9'bsTopLine'#0#0
+ +#18'TVirtualStringTree'#6'tvMain'#4'Left'#2#8#6'Height'#3#248#0#3'Top'#2#24#5
+ +'Width'#3'd'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'akBottom'#0#17
+ +'Header.MainColumn'#2#255#14'Header.Options'#11#14'hoColumnResize'#6'hoDrag'
+ +#0#8'TabOrder'#2#0#9'OnGetText'#7#25'VirtualStringTree1GetText'#8'OnResize'#7
+ +#14'Splitter1Moved'#7'Columns'#14#0#0#0#6'TPanel'#7'pHeader'#4'Left'#2#8#6'H'
+ +'eight'#2#18#3'Top'#2#8#5'Width'#3'd'#1#7'Anchors'#11#5'akTop'#6'akLeft'#7'a'
+ +'kRight'#0#10'BevelOuter'#7#6'bvNone'#7'Caption'#6#7'pHeader'#12'ClientHeigh'
+ +'t'#2#18#11'ClientWidth'#3'd'#1#8'TabOrder'#2#1#0#6'TPanel'#9'pFunction'#6'H'
+ +'eight'#2#18#5'Width'#3#189#0#5'Align'#7#8'alClient'#7'Caption'#6#9'pFunctio'
+ +'n'#8'TabOrder'#2#0#0#0#6'TPanel'#9'pShortcut'#4'Left'#3#194#0#6'Height'#2#18
+ +#5'Width'#3#162#0#5'Align'#7#7'alRight'#7'Caption'#6#9'pShortcut'#8'TabOrder'
+ +#2#1#0#0#9'TSplitter'#9'Splitter1'#4'Left'#3#189#0#6'Height'#2#18#5'Width'#2
+ +#5#5'Align'#7#7'alRight'#7'OnMoved'#7#14'Splitter1Moved'#12'ResizeAnchor'#7#7
+ +'akRight'#0#0#0#7'TButton'#3'bOK'#4'Left'#3#12#1#6'Height'#2#25#3'Top'#3' '#1
+ +#5'Width'#2'`'#7'Anchors'#11#7'akRight'#8'akBottom'#0#25'BorderSpacing.Inner'
+ +'Border'#2#4#7'Caption'#6#3'bOK'#7'OnClick'#7#8'bOKClick'#8'TabOrder'#2#2#0#0
+ +#7'TButton'#7'bGetKey'#4'Left'#2#8#6'Height'#2#25#3'Top'#3' '#1#5'Width'#3
+ +#131#0#7'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2
+ +#4#7'Caption'#6#7'bGetKey'#7'OnClick'#7#12'bGetKeyClick'#8'TabOrder'#2#3#0#0
+ +#7'TButton'#10'bDeleteKey'#4'Left'#3#144#0#6'Height'#2#25#3'Top'#3' '#1#5'Wi'
+ +'dth'#2'x'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#25'BorderSpacing.InnerBorde'
+ +'r'#2#4#7'Caption'#6#10'bDeleteKey'#7'OnClick'#7#15'bDeleteKeyClick'#8'TabOr'
+ +'der'#2#4#0#0#0
+]);
diff --git a/Software/src/general/src/ushortcuts.pas b/Software/src/general/src/ushortcuts.pas
new file mode 100755
index 0000000..1d13665
--- /dev/null
+++ b/Software/src/general/src/ushortcuts.pas
@@ -0,0 +1,231 @@
+unit uShortcuts;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
+ VirtualStringTree, ExtCtrls, Buttons, ActnList,dom,xmlread,xmlwrite,VirtualTrees,
+ uGeneralStrConsts,LCLProc,LCLType,utils;
+
+type
+
+ PSTreeEntry = ^TSTreeEntry;
+ TSTreeEntry = record
+ Obj : TAction;
+ Text : string;
+ end;
+
+ { TfShortcuts }
+
+ TfShortcuts = class(TForm)
+ Bevel1: TBevel;
+ bOK: TButton;
+ bGetKey: TButton;
+ bDeleteKey: TButton;
+ pFunction: TPanel;
+ pShortcut: TPanel;
+ pHeader: TPanel;
+ Splitter1: TSplitter;
+ tvMain: TVirtualStringTree;
+ procedure bDeleteKeyClick(Sender: TObject);
+ procedure bGetKeyClick(Sender: TObject);
+ procedure bOKClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure FormShow(Sender: TObject);
+ procedure Splitter1Moved(Sender: TObject);
+ procedure VirtualStringTree1GetText(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
+ var CellText: WideString);
+ private
+ { private declarations }
+ Lists : TList;
+ public
+ { public declarations }
+ procedure RegisterActionList(ActLst : TActionList);
+ procedure Load;
+ procedure Save;
+ procedure SetLanguage;
+ end;
+
+var
+ fShortcuts: TfShortcuts;
+
+implementation
+
+{ TfShortcuts }
+
+procedure TfShortcuts.FormCreate(Sender: TObject);
+begin
+ Lists := TList.Create;
+ tvMain.NodeDataSize := sizeof(TSTreeEntry);
+ tvMain.Header.Columns.Add;
+ tvMain.Header.Columns.Add;
+end;
+
+procedure TfShortcuts.bGetKeyClick(Sender: TObject);
+begin
+ if not bGetKey.Enabled then exit;
+ bGetKey.Enabled := False;
+end;
+
+procedure TfShortcuts.bDeleteKeyClick(Sender: TObject);
+begin
+ if Assigned(tvMain.FocusedNode) and Assigned(tvMain.GetNodeData(tvMain.FocusedNode)) then
+ PSTreeEntry(tvMain.GetNodeData(tvMain.FocusedNode))^.Obj.ShortCut := scNone;
+ tvMain.Invalidate;
+end;
+
+procedure TfShortcuts.bOKClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TfShortcuts.FormDestroy(Sender: TObject);
+begin
+ Lists.Free;
+end;
+
+procedure TfShortcuts.FormKeyUp(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if (not bGetKey.Enabled) and Assigned(tvMain.FocusedNode) and Assigned(tvMain.GetNodeData(tvMain.FocusedNode)) then
+ begin
+ PSTreeEntry(tvMain.GetNodeData(tvMain.FocusedNode))^.Obj.ShortCut := KeyToShortCut(Key, Shift);
+ tvMain.Invalidate;
+ bGetKey.Enabled := True;
+ end;
+end;
+
+procedure TfShortcuts.FormShow(Sender: TObject);
+var
+ i: Integer;
+ TN,TN2: PVirtualNode;
+ a: Integer;
+begin
+ tvMain.Clear;
+ for i := 0 to Lists.Count-1 do
+ begin
+ if TActionList(Lists[i]).Owner is TForm then
+ begin
+ TN := tvMain.AddChild(nil);
+ PSTreeEntry(tvMain.getNodeData(TN))^.Text := TForm(TActionList(Lists[i]).Owner).Caption;
+ for a := 0 to TActionList(Lists[i]).ActionCount-1 do
+ begin
+ TN2 := tvMain.AddChild(TN);
+ PSTreeEntry(tvMain.GetNodeData(TN2))^.Obj := TAction(TActionList(Lists[i]).Actions[a]);
+ PSTreeEntry(tvMain.GetNodeData(TN2))^.Text := TAction(TActionList(Lists[i]).Actions[a]).Caption;
+ end;
+ tvMain.Expanded[TN] := True;
+ end;
+ end;
+end;
+
+procedure TfShortcuts.Splitter1Moved(Sender: TObject);
+begin
+ tvMain.Header.Columns[0].Width := pFunction.Width;
+ tvMain.Header.Columns[1].Width := tvMain.Width-pFunction.Width;
+end;
+
+procedure TfShortcuts.VirtualStringTree1GetText(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
+ var CellText: WideString);
+var
+ Data : PSTreeEntry;
+begin
+ Data := Sender.GetNodeData(Node);
+ if not Assigned(Data) then
+ exit;
+ if Column = 0 then
+ CellText := Data^.Text
+ else
+ CellText := '';
+ if Assigned(Data^.Obj) and (Column = 1) then
+ CellText := ShortCutToText(Data^.Obj.ShortCut);
+end;
+
+procedure TfShortcuts.RegisterActionList(ActLst: TActionList);
+begin
+ Lists.Add(ActLst);
+end;
+
+procedure TfShortcuts.Load;
+var
+ i: Integer;
+ doc : TXMLDocument;
+ rootnode : TDOMNode;
+ listnode : TDOMNode;
+ shortnode : TDOMElement;
+ a: Integer;
+ Filename : string;
+begin
+ if Application.HasOption('c','config-path') then
+ FileName := Application.GetOptionValue('c','config-path')+DirectorySeparator+'shortcuts.xml'
+ else
+ FileName := GetConfigDir(copy(ExtractFileName(Application.Exename),0,length(ExtractFileName(Application.Exename))-length(ExtractFileExt(ExtractFileName(Application.Exename)))))+DirectorySeparator+'shortcuts.xml';
+ if not FileExists(Filename) then
+ exit;
+ ReadXMLFile(doc,GetConfigDir(copy(Application.Exename,0,length(Application.Exename)-length(ExtractFileExt(Application.Exename))))+Directoryseparator+'shortcuts.xml');
+ RootNode := doc.FindNode('ShortCuts');
+ if not Assigned(RootNode) then
+ exit;
+ for i := 0 to Lists.Count-1 do
+ with TActionList(Lists[i]) do
+ begin
+ listnode := rootnode.FindNode(Owner.Name+'.'+Name);
+ if Assigned(listnode) then
+ for a := 0 to ActionCount-1 do
+ if listnode.FindNode(Actions[a].Name) <> nil then
+ begin
+ shortnode := listnode.FindNode(Actions[a].Name) as TDomElement;
+ TAction(Actions[a]).ShortCut := StrToInt(shortnode.AttribStrings['ShortCut']);
+ end;
+ end;
+end;
+
+procedure TfShortcuts.Save;
+var
+ doc : TXMLDocument;
+ listnode : TDOMElement;
+ shortnode : TDOMElement;
+ rootnode : TDOMNode;
+ i: Integer;
+ a: Integer;
+begin
+ doc := TXMLDocument.Create;
+ rootNode := doc.CreateElement('ShortCuts');
+ doc.AppendChild(rootnode);
+ for i := 0 to Lists.Count-1 do
+ with TActionList(Lists[i]) do
+ begin
+ listNode := doc.CreateElement(TActionList(Lists[i]).Owner.Name+'.'+TActionList(Lists[i]).Name);
+ rootnode.AppendChild(listnode);
+ for a := 0 to ActionCount-1 do
+ if TAction(Actions[a]).Shortcut <> 0 then
+ begin
+ shortnode := doc.CreateElement(TAction(Actions[a]).Name);
+ shortnode.AttribStrings['ShortCut'] := IntToStr(TAction(Actions[a]).ShortCut);
+ listnode.AppendChild(shortnode);
+ end;
+ end;
+ WriteXMLFile(doc,GetConfigDir(copy(Application.Exename,0,length(Application.Exename)-length(ExtractFileExt(Application.Exename))))+Directoryseparator+'shortcuts.xml');
+end;
+
+procedure TfShortcuts.SetLanguage;
+begin
+ Caption := strShortcuts;
+ pFunction.Caption := strFunction;
+ pShortCut.Caption := strShortcut;
+ bOK.caption := strOK;
+ bGetKey.Caption := strGetKey;
+ bDeleteKey.Caption := strDeleteKey;
+end;
+
+initialization
+ {$I ushortcuts.lrs}
+
+end.
+
diff --git a/Software/src/general/src/uskype.pas b/Software/src/general/src/uskype.pas
new file mode 100755
index 0000000..235f7d1
--- /dev/null
+++ b/Software/src/general/src/uskype.pas
@@ -0,0 +1,146 @@
+//CALL 232 STATUS RINGING
+//CALL 232 STATUS INPROGRESS
+//CALL 232 STATUS FINISHED
+
+
+unit uSkype;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ {$IFDEF WINDOWS}
+ Windows,
+ {$ELSE}
+// dbus,
+ {$ENDIF}
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
+
+type
+ TAttachEvent = procedure (Sender: TObject; APIAttached : Integer)of object;
+ TAnswerEvent = procedure (Sender: TObject; Answer : String) of object;
+
+ { TSkypeMessageHandler }
+
+ TSkypeMessageHandler = class(TWinControl)
+ private
+ fOnAPIAttach : TAttachEvent;
+ fOnAnswer : TAnswerEvent;
+ {$IFDEF WINDOWS}
+ OldProc : Windows.WNDPROC;
+ {$ENDIF}
+ protected
+ WM_SkypeControlAPIDiscover: LongWord;
+ WM_SkypeControlAPIAttach: LongWord;
+ HWND_SkypeAPIWindowHandle: LongInt;
+ FParent : TWinControl;
+ public
+ destructor Destroy; override;
+ function Initiate : Boolean;
+ procedure Command(cmd : string);
+ published
+ constructor Create (AOwner : TWinControl);
+ property OnAPIAttach : TAttachEvent read fOnAPIAttach write fOnAPIAttach;
+ property OnAnswer : TAnswerEvent read fOnAnswer write fOnAnswer;
+ end;
+
+var
+ aSkype : TSkypeMessagehandler;
+
+implementation
+
+{$IFDEF WINDOWS}
+function HeaderProc(wnd: HWND; Msg: Cardinal; wParam: wParam; lParam: lParam): Longint;stdcall;
+var
+ hti: THDHitTestInfo;
+ data : PCopyDataStruct;
+begin
+ if Msg = aSkype.WM_SkypeControlAPIAttach then
+ begin
+ if LParam = 0 then
+ aSkype.HWND_SkypeAPIWindowHandle := WParam;
+ if Assigned(aSkype.fOnAPIAttach) then
+ aSkype.fOnAPIAttach(aSkype,wParam);
+ Result := 1;
+ end
+ else if (aSkype.HWND_SkypeAPIWindowHandle > 0) and (Msg = WM_COPYDATA) and (wParam = aSkype.HWND_SkypeAPIWindowHandle) then
+ begin
+ Data := PCopyDataStruct(lParam);
+ if Assigned(aSkype.fOnAnswer) then
+ aSkype.fOnAnswer(aSkype,PChar(Data^.lpData));
+ Result := 1
+ end
+ else
+ Result := CallWindowProc(aSkype.OldProc, wnd, Msg, wParam, lParam);
+end;
+{$ENDIF}
+
+constructor TSkypeMessageHandler.Create (AOwner : TWinControl);
+begin
+ inherited Create (AOwner);
+ FParent := AOwner;
+{$IFDEF WINDOWS}
+ Try
+ WM_SkypeControlAPIDiscover := RegisterWindowMessage('SkypeControlAPIDiscover');
+ WM_SkypeControlAPIAttach := RegisterWindowMessage('SkypeControlAPIAttach');
+ Except
+ WM_SkypeControlAPIDiscover := 0;
+ WM_SkypeControlAPIAttach:= 0;
+ End;
+{$ENDIF}
+ aSkype := Self;
+end;
+
+destructor TSkypeMessageHandler.Destroy;
+begin
+{$IFDEF WINDOWS}
+ WM_SkypeControlAPIDiscover := 0;
+ if LONG(OldProc) <> 0 then
+ SetWindowLong(FParent.Handle, GWL_WNDPROC, LONG(OldProc));
+{$ENDIF}
+ inherited
+end;
+
+function TSkypeMessageHandler.Initiate: Boolean;
+var
+ dwBSMRecipients: DWORD;
+begin
+{$IFDEF WINDOWS}
+ dwBSMRecipients := BSM_APPLICATIONS;
+ Try
+ If WM_SkypeControlAPIDiscover <> 0 then
+ begin
+ {$IFDEF CPUI386}
+ LONG(OldProc) := SetWindowLong(FParent.Handle, GWL_WNDPROC, Integer(@HeaderProc));
+ {$ELSE}
+ Int64(OldProc) := SetWindowLong(FParent.Handle, GWL_WNDPROC, Integer(@HeaderProc));
+ {$ENDIF}
+ dwBSMRecipients := BSM_APPLICATIONS;
+ BroadcastSystemMessage((BSF_FORCEIFHUNG Or BSF_IGNORECURRENTTASK Or BSF_POSTMESSAGE),@dwBSMRecipients, WM_SkypeControlAPIDiscover,FParent.Handle, 0);
+ end;
+ except
+ Result := False;
+ end;
+{$ENDIF}
+end;
+
+procedure TSkypeMessageHandler.Command(cmd: string);
+{$IFDEF WINDOWS}
+var
+ CopyData: CopyDataStruct;
+{$ENDIF}
+begin
+{$IFDEF WINDOWS}
+ if CMD <> '' then
+ begin
+ CopyData.dwData := 0;
+ CopyData.lpData := PChar(CMD);
+ CopyData.cbData := Length(CMD)+1;
+ Windows.SendMessage(HWND_SkypeAPIWindowHandle, WM_COPYDATA, FParent.Handle, LPARAM(@CopyData))
+ end
+{$ENDIF}
+end;
+
+
+end.
diff --git a/Software/src/general/src_vis/ubenchmark.pas b/Software/src/general/src_vis/ubenchmark.pas
new file mode 100755
index 0000000..3fe6229
--- /dev/null
+++ b/Software/src/general/src_vis/ubenchmark.pas
@@ -0,0 +1,739 @@
+unit ubenchmark;
+
+{$mode objfpc}{$H+}
+{$IFDEF CPU86}
+{$asmmode intel}
+{$ENDIF}
+
+interface
+
+uses
+ Forms,Classes, SysUtils, LCLIntf, Utils, uGeneralStrConsts
+{$IFDEF WINDOWS}
+ ,Windows
+{$ENDIF}
+ ;
+
+function CalcCPUSpeed: Extended;
+function GetOSVersion : string;
+function GetMemoryTransferRate(MbToTest : Integer) : Extended;
+procedure GetHardDiskTransferrates(MbToTest: Integer; var ReadRate,WriteRate: Extended);
+function GetWhetstone(NLoops : Integer = 50) : Extended;
+function GetDrystone(NLoops: Integer = 5000) : Int64;
+function GetMemorySize : LongInt;
+
+function GetProcessorRating(WKIPS : Extended;DryTime : Extended) : Extended;
+function GetHardDiskRating(fReadTime,fWriteTime : Extended) : Extended;
+function GetMemoryRating(TransferRate : Extended) : Extended;
+
+
+TYPE ARRAY4 = ARRAY [1..4] OF DOUBLE;
+
+ { TCPUBenchThread }
+
+ TCPUBenchThread = class(TThread)
+ private
+ FDryStoneResultTime: Integer;
+ FLoops : Integer;
+ FWhetstoneResult: Extended;
+ public
+ property WhetstoneResult : Extended read FWhetstoneResult;
+ property DrystoneResultTime : Integer read FDryStoneResultTime;
+ constructor Create(Loops : Integer);
+ procedure Execute;override;
+ end;
+
+VAR E1 : ARRAY4;
+ T, T1, T2 : DOUBLE;
+ J, K, L : LONGINT;
+ ptime, time0, time1 : DOUBLE;
+
+var
+(* With loopcount NLoop=10, one million Whetstone instructions
+ will be executed in each major loop.
+ A major loop is executed 'II' times to increase wall-clock timing accuracy *)
+ NLoopValue : Integer;
+
+implementation
+
+function GetMemoryTransferRate(MbToTest : Integer) : Extended;
+var
+ tm : Int64;
+ td : array [0..1023] of byte;
+ i: Integer;
+begin
+ tm := GetTickCount;
+ for i := 0 to (MbToTest div 2)*1023 do
+ begin
+ fillchar(td,1024,0);
+ fillchar(td,1024,$ff);
+ end;
+ tm := 1+GetTickCount-tm;
+ Result := 1/(tm/(MbToTest*1000));
+end;
+
+procedure GetHardDiskTransferrates(MbToTest: Integer; var ReadRate,
+ WriteRate: Extended);
+var
+ tm : Int64;
+ td : array [0..1023] of byte;
+ f: File;
+ i: Integer;
+begin
+ fillchar(td,1024,$ff);
+ AssignFile(f,GetTempDir+'ubench.tmp');
+ Rewrite(f,1024);
+ tm := GetTickCount;
+ for i := 0 to MbToTest*1023 do
+ blockwrite(f,td,1);
+ Closefile(f);
+ WriteRate := 1/((1+GetTickCount-tm)/(MbToTest*1000));
+ Reset(f,1024);
+ tm := GetTickCount;
+ for i := 0 to MbToTest*1023 do
+ blockread(f,td,1);
+ ReadRate := 1/((1+GetTickCount-tm)/(MbTotest*1000));
+ CloseFile(f);
+ SysUtils.DeleteFile(GetTempDir+'ubench.tmp');
+end;
+
+function GetOSVersion : string;
+{$IFDEF MSWINDOWS}
+ function IsWindows64: Boolean;
+ type
+ TIsWow64Process = function( // Type of IsWow64Process API fn
+ Handle: Windows.THandle; var Res: Windows.BOOL
+ ): Windows.BOOL; stdcall;
+ var
+ IsWow64Result: Windows.BOOL; // Result from IsWow64Process
+ IsWow64Process: TIsWow64Process; // IsWow64Process fn reference
+ begin
+ // Try to load required function from kernel32
+ IsWow64Process := TIsWow64Process(Windows.GetProcAddress(
+ Windows.GetModuleHandle('kernel32'), 'IsWow64Process'
+ ));
+ if Assigned(IsWow64Process) then
+ begin
+ // Function is implemented: call it
+ if not IsWow64Process(
+ Windows.GetCurrentProcess, IsWow64Result
+ ) then
+ raise SysUtils.Exception.Create('IsWindows64: bad process handle');
+ // Return result of function
+ Result := IsWow64Result;
+ end
+ else
+ // Function not implemented: can't be running on Wow64
+ Result := False;
+ end;
+{$ENDIF}
+begin
+ result:=strUnknownOS;
+{$IFDEF MSWINDOWS}
+ case Win32Platform of
+ 1:// 9x-Reihe
+ If Win32MajorVersion=4 Then Begin
+ Case Win32MinorVersion of
+ 0: result:='Windows 95';
+ 10: result:='Windows 98';
+ 90: result:='Windows Me';
+ end;
+ end;
+ 2: // NT-Reihe
+ Case Win32MajorVersion of
+ 3:IF Win32MinorVersion=51 then
+ result:='Windows NT 3.51';
+ 4:If Win32MinorVersion=0 then
+ result:='Windows NT 4';
+ 5:Case Win32MinorVersion of
+ 0: result:='Windows 2000';
+ 1: result:='Windows XP';
+ 2: result:='Windows .NET Server';
+ end;
+ 6:case Win32MinorVersion of
+ 0: result := 'Windows Vista';
+ 1: result := 'Windows 7';
+ end;
+ End;
+ end;
+ if IsWindows64 then
+ result := result+' 64bit'
+ else
+ result := result+' 32bit';
+ //Win32CSDVersion enthält Informationen zu Servicepacks
+ if Win32CSDVersion<>'' then
+ result:=result+' '+Win32CSDVersion;
+{$ENDIF}
+{$IFDEF LINUX}
+ result:='Linux';
+{$ENDIF}
+{$IFDEF DARWIN}
+ result:='MacOS(X)';
+{$ENDIF}
+end;
+
+function CalcCPUSpeed: Extended;
+const
+ DelayTime = 500; // measure time in ms
+var
+ TimerHi, TimerLo: DWord;
+ PriorityClass, Priority: Integer;
+begin
+ Result := -2;
+{$IFDEF CPU86}
+{$IFDEF WINDOWS}
+ try
+ PriorityClass := GetPriorityClass(GetCurrentProcess);
+ Priority := GetThreadPriority(GetCurrentThread);
+
+ SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
+ SetThreadPriority(GetCurrentThread,
+ THREAD_PRIORITY_TIME_CRITICAL);
+ try
+ Sleep(10);
+ asm
+ dw 310Fh // rdtsc
+ mov TimerLo, eax
+ mov TimerHi, edx
+ end;
+ Sleep(DelayTime);
+ asm
+ dw 310Fh // rdtsc
+ sub eax, TimerLo
+ sbb edx, TimerHi
+ mov TimerLo, eax
+ mov TimerHi, edx
+ end;
+ finally
+ SetThreadPriority(GetCurrentThread, Priority);
+ SetPriorityClass(GetCurrentProcess, PriorityClass);
+ end;
+ Result := TimerLo / (1000.0 * DelayTime);
+ except
+ Result := -2;
+ end;
+{$ENDIF}
+{$ELSE}
+ Result := -1;
+{$ENDIF}
+end;
+
+
+//Whetstone Test
+
+PROCEDURE PA (VAR E : ARRAY4);
+VAR J1 : LONGINT;
+BEGIN
+ J1 := 0;
+ REPEAT
+ E [1] := ( E [1] + E [2] + E [3] - E [4]) * T;
+ E [2] := ( E [1] + E [2] - E [3] + E [4]) * T;
+ E [3] := ( E [1] - E [2] + E [3] + E [4]) * T;
+ E [4] := (-E [1] + E [2] + E [3] + E [4]) / T2;
+ J1 := J1 + 1;
+ UNTIL J1 >= 6;
+END;
+
+PROCEDURE P0;
+BEGIN
+ E1 [J] := E1 [K]; E1 [K] := E1 [L]; E1 [L] := E1 [J];
+END;
+
+PROCEDURE P3 (X,Y : DOUBLE; VAR Z : DOUBLE);
+VAR X1, Y1 : DOUBLE;
+BEGIN
+ X1 := X;
+ Y1 := Y;
+ X1 := T * (X1 + Y1);
+ Y1 := T * (X1 + Y1);
+ Z := (X1 + Y1)/T2;
+END;
+
+function DoWhetstone : Longint;
+VAR NLoop, I, II, JJ : LONGINT;
+ N1, N2, N3, N4, N5, N6, N7, N8, N9, N10, N11 : LONGINT;
+ X1, X2, X3, X4, X, Y, Z : DOUBLE;
+BEGIN
+(* The actual benchmark starts here. *)
+ T := 0.499975;
+ T1 := 0.50025;
+ T2 := 2.0;
+ NLoop := NLoopValue;
+ II := 400;
+ FOR JJ:=1 TO II DO BEGIN
+(* Establish the relative loop counts of each module. *)
+ N1 := 0;
+ N2 := 12 * NLoop;
+ N3 := 14 * NLoop;
+ N4 := 345 * NLoop;
+ N5 := 0;
+ N6 := 210 * NLoop;
+ N7 := 32 * NLoop;
+ N8 := 899 * NLoop;
+ N9 := 616 * NLoop;
+ N10 := 0;
+ N11 := 93 * NLoop;
+(* Module 1: Simple identifiers *)
+ X1 := 1.0;
+ X2 := -1.0;
+ X3 := -1.0;
+ X4 := -1.0;
+ FOR I:=1 TO N1 DO BEGIN
+ X1 := (X1 + X2 + X3 - X4)*T;
+ X2 := (X1 + X2 - X3 + X4)*T;
+ X3 := (X1 - X2 + X3 + X4)*T;
+ X4 := (-X1 + X2 + X3 + X4)*T;
+ END;
+// IF (JJ = II) THEN BEGIN
+// POUT (N1, N1, N1, X1, X2, X3, X4);
+// END;
+(* Module 2: Array elements *)
+ E1 [1] := 1.0;
+ E1 [2] := -1.0;
+ E1 [3] := -1.0;
+ E1 [4] := -1.0;
+ FOR I:=1 TO N2 DO BEGIN
+ E1 [1] := (E1 [1] + E1 [2] + E1 [3] - E1 [4])*T;
+ E1 [2] := (E1 [1] + E1 [2] - E1 [3] + E1 [4])*T;
+ E1 [3] := (E1 [1] - E1 [2] + E1 [3] + E1 [4])*T;
+ E1 [4] := (-E1 [1] + E1 [2] + E1 [3] + E1 [4])*T;
+ END;
+// IF (JJ = II) THEN BEGIN
+// POUT (N2, N3, N2, E1 [1], E1 [2], E1 [3], E1 [4]);
+// END;
+(* Module 3: Array as parameter *)
+ FOR I:=1 TO N3 DO BEGIN
+ PA (E1);
+ END;
+// IF (JJ = II) THEN BEGIN
+// POUT(N3, N2, N2, E1 [1], E1 [2], E1 [3], E1 [4]);
+// END;
+(* Module 4: Conditional jumps *)
+ J := 1;
+ FOR I:=1 TO N4 DO BEGIN
+ IF (J <> 1) THEN J := 3 ELSE J := 2;
+ IF (J <= 2) THEN J := 1 ELSE J := 0;
+ IF (J >= 1) THEN J := 0 ELSE J := 1;
+ END;
+// IF (JJ = II) THEN BEGIN
+// POUT (N4, J, J, X1, X2, X3, X4)
+// END;
+(* Module 5: Omitted; Module 6: Integer arithmetic *)
+ J := 1;
+ K := 2;
+ L := 3;
+ FOR I:=1 TO N6 DO BEGIN
+ J := J * (K-J) * (L-K);
+ K := L * K - (L-J) * K;
+ L := (L - K) * (K + J);
+ E1 [L-1] := (J + K + L);
+ E1 [K-1] := (J * K * L);
+ END;
+// IF (JJ = II) THEN BEGIN
+// POUT (N6, J, K, E1 [1], E1 [2], E1 [3], E1 [4]);
+// END;
+(* Module 7: Trigonometric functions *)
+ X := 0.5;
+ Y := 0.5;
+ FOR I:=1 TO N7 DO BEGIN
+ X:=T*arctan(T2*sin(X)*cos(X)/(cos(X+Y)+cos(X-Y)-1.0));
+ Y:=T*arctan(T2*sin(Y)*cos(Y)/(cos(X+Y)+cos(X-Y)-1.0));
+ END;
+// IF (JJ = II) THEN BEGIN
+// POUT (N7, J, K, X, X, Y, Y);
+// END;
+(* Module 8: Procedure calls *)
+ X := 1.0;
+ Y := 1.0;
+ Z := 1.0;
+ FOR I:=1 TO N8 DO BEGIN
+ P3 (X,Y,Z);
+ END;
+// IF (JJ = II) THEN BEGIN
+// POUT (N8, J, K, X, Y, Z, Z);
+// END;
+(* Module 9: Array references *)
+ J := 1;
+ K := 2;
+ L := 3;
+ E1 [1] := 1.0;
+ E1 [2] := 2.0;
+ E1 [3] := 3.0;
+ FOR I:=1 TO N9 DO BEGIN
+ P0;
+ END;
+// IF (JJ = II) THEN BEGIN
+// POUT (N9, J, K, E1 [1], E1 [2], E1 [3], E1 [4])
+// END;
+(* Module 10: Integer arithmetic *)
+ J := 2;
+ K := 3;
+ FOR I:=1 TO N10 DO BEGIN
+ J := J + K;
+ K := J + K;
+ J := K - J;
+ K := K - J - J;
+ END;
+// IF (JJ = II) THEN BEGIN
+// POUT (N10, J, K, X1, X2, X3, X4)
+// END;
+(* Module 11: Standard functions *)
+ X := 0.75;
+ FOR I:=1 TO N11 DO BEGIN
+ X := sqrt (exp (ln (X)/T1))
+ // x:=sqrt(x);
+ END;
+// IF (JJ = II) THEN BEGIN
+// POUT (N11, J, K, X, X, X, X)
+// END;
+(* THIS IS THE END OF THE MAJOR LOOP. *)
+ END;
+ Result := II;
+END;
+
+function GetWhetstone(NLoops: Integer): Extended;
+var
+ tm : Int64;
+ CPUTime : Int64;
+ II: LongInt;
+begin
+ NLoopValue := NLoops;
+ tm := GetTickCount;
+ II := DoWhetstone;
+ CPUTime := GetTickCount-tm;
+ Result := 100.0*NLoopValue*II* 1000/CPUTime;
+end;
+
+
+//Drystone
+{$R- range checking off}
+
+var
+ LOOPS : Integer; { Use this for slow or 16 bit machines }
+
+
+CONST
+
+{ Set LOOPS to specify how many thousand drystones to perform.
+ LOOPS = 50 will perforum 50,000 drystones. Choose longer for
+ better precision and for fast machines.
+}
+
+ Ident1 = 1;
+ Ident2 = 2;
+ Ident3 = 3;
+ Ident4 = 4;
+ Ident5 = 5;
+
+type integer = longint;
+Type Enumeration = INTEGER;
+{ TYPE Enumeration = (Ident1, Ident2, Ident3, Ident4, Ident5); }
+
+TYPE OneToThirty = INTEGER;
+TYPE OneToFifty = INTEGER;
+TYPE CapitalLetter = CHAR;
+TYPE String30 = STRING[30]; { ARRAY[0..30] OF CHAR; }
+TYPE Array1Dim = ARRAY[0..50] OF INTEGER;
+TYPE Array2Dim = ARRAY[0..50,0..50] OF INTEGER;
+
+{ TYPE RecordPtr = ^RecordType; }
+ RecordType = RECORD
+ PtrComp : integer;
+ Discr : Enumeration;
+ EnumComp : Enumeration;
+ IntComp : OneToFifty;
+ StringComp : String30;
+ END;
+
+{
+ * Package 1
+ }
+VAR
+ IntGlob : INTEGER;
+ BoolGlob : BOOLEAN;
+ Char1Glob : CHAR;
+ Char2Glob : CHAR ;
+ Array1Glob : Array1Dim;
+ Array2Glob : Array2Dim;
+ MyRec : array[0..2] of RecordType;
+{ PtrGlb : RecordPtr; }
+{ PtrGlbNext : RecordPtr; }
+
+ Hour, Min, Sec, Hund : word;
+ TStart, TEnd : real;
+
+CONST
+ PtrGlb = 1;
+ PtrGlbNext = 2;
+
+PROCEDURE Proc7(IntParI1, IntParI2 : OneToFifty; VAR IntParOut : OneToFifty);
+VAR
+ IntLoc : OneToFifty;
+BEGIN
+ IntLoc:= IntParI1 + 2;
+ IntParOut:= IntParI2 + IntLoc;
+END ;
+
+PROCEDURE Proc3( var inRecIdx : integer );
+BEGIN
+ IF ( inRecIdx <> 0 ) THEN
+ inRecIdx := MyRec[PtrGlb].PtrComp
+ ELSE
+ IntGlob:= 100;
+ Proc7( 10, IntGlob, MyRec[PtrGlb].IntComp);
+END ;
+
+FUNCTION Func3(EnumParIn : Enumeration) : BOOLEAN;
+ VAR EnumLoc: Enumeration;
+BEGIN
+ EnumLoc:= EnumParIn;
+ Func3:= EnumLoc = Ident3;
+END ;
+
+PROCEDURE Proc6(EnumParIn : Enumeration; VAR EnumParOut : Enumeration);
+BEGIN
+ EnumParOut:= EnumParIn;
+ IF (NOT Func3(EnumParIn) ) THEN
+ EnumParOut:= Ident4;
+ CASE EnumParIn OF
+ Ident1: EnumParOut:= Ident1 ;
+ Ident2: IF (IntGlob > 100) THEN EnumParOut:= Ident1
+ ELSE EnumParOut:= Ident4;
+ Ident3: EnumParOut:= Ident2 ;
+ Ident4: ;
+ Ident5: EnumParOut:= Ident3;
+ END;
+END ;
+
+
+PROCEDURE Proc1( inIdx : integer );
+var
+ i : integer;
+BEGIN
+ i := MyRec[inIdx].PtrComp;
+
+ MyRec[i] := MyRec[PtrGlb];
+ MyRec[inIdx].IntComp := 5;
+ MyRec[i].IntComp:= MyRec[inIdx].IntComp;
+ MyRec[i].PtrComp:= i;
+ Proc3( MyRec[i].PtrComp );
+ IF ( MyRec[i].Discr = Ident1 ) THEN
+ BEGIN
+ MyRec[i].IntComp:= 6;
+ Proc6( MyRec[inIdx].EnumComp, MyRec[i].EnumComp );
+ MyRec[i].PtrComp:= MyRec[PtrGlb].PtrComp;
+ Proc7( MyRec[i].IntComp, 10, MyRec[i].IntComp );
+ END
+ ELSE
+ MyRec[inIdx] := MyRec[i];
+END;
+
+
+PROCEDURE Proc2(VAR IntParIO : OneToFifty);
+VAR
+ IntLoc : OneToFifty;
+ EnumLoc : Enumeration;
+BEGIN
+ IntLoc:= IntParIO + 10;
+ REPEAT
+ IF (Char1Glob = 'A') THEN
+ BEGIN
+ IntLoc:= IntLoc - 1;
+ IntParIO:= IntLoc - IntGlob;
+ EnumLoc:= Ident1;
+ END;
+ UNTIL EnumLoc = Ident1;
+END ;
+
+PROCEDURE Proc4;
+VAR
+ BoolLoc : BOOLEAN;
+BEGIN
+ BoolLoc:= Char1Glob = 'A';
+ BoolLoc:= BoolLoc OR BoolGlob;
+ Char2Glob:= 'B';
+END ;
+
+PROCEDURE Proc5;
+BEGIN
+ Char1Glob:= 'A';
+ BoolGlob:= FALSE;
+END ;
+
+PROCEDURE Proc8(VAR Array1Par : Array1Dim; VAR Array2Par : Array2Dim;
+ IntParI1, IntParI2 : OneToFifty);
+VAR
+ IntLoc : OneToFifty;
+ IntIndex : OneToFifty;
+BEGIN
+ IntLoc:= IntParI1 + 5;
+ Array1Par[IntLoc]:= IntParI2;
+ Array1Par[IntLoc+1]:= Array1Par[IntLoc];
+ Array1Par[IntLoc+30]:= IntLoc;
+ FOR IntIndex:= IntLoc TO (IntLoc+1) DO
+ Array2Par[IntLoc,IntIndex]:= IntLoc;
+ { Array2Par[IntLoc,IntLoc-1]:= Array2Par[IntLoc,IntLoc-1] + 1; }
+ Array2Par[IntLoc+20,IntLoc]:= Array1Par[IntLoc];
+ IntGlob:= 5;
+END ;
+
+FUNCTION Func1(CharPar1, CharPar2 : CapitalLetter) : Enumeration;
+VAR
+ CharLoc1, CharLoc2 : CapitalLetter;
+BEGIN
+ CharLoc1:= CharPar1;
+ CharLoc2:= CharLoc1;
+ IF (CharLoc2 <> CharPar2) THEN
+ Func1:= (Ident1)
+ ELSE
+ Func1:= (Ident2);
+END ;
+
+FUNCTION Func2(VAR StrParI1, StrParI2 : String30) : BOOLEAN;
+VAR
+ IntLoc : OneToThirty;
+ CharLoc : CapitalLetter;
+BEGIN
+ IntLoc := 2;
+ WHILE (IntLoc <= 2) DO
+ BEGIN
+ IF (Func1(StrParI1[IntLoc], StrParI2[IntLoc+1]) = Ident1) THEN
+ BEGIN
+ CharLoc := 'A';
+ IntLoc:= IntLoc + 1;
+ END;
+ END;
+ IF (CharLoc >= 'W') AND (CharLoc <= 'Z') THEN IntLoc:= 7;
+ IF CharLoc = 'X' THEN
+ Func2:= TRUE
+ ELSE IF StrParI1 > StrParI2 THEN
+ BEGIN
+ IntLoc:= IntLoc + 7;
+ Func2:= TRUE;
+ END
+ ELSE
+ Func2:= FALSE;
+END ;
+
+
+PROCEDURE Proc0;
+VAR
+ IntLoc1 : OneToFifty;
+ IntLoc2 : OneToFifty;
+ IntLoc3 : OneToFifty;
+ CharLoc : CHAR;
+ CharIndex : CHAR;
+ EnumLoc : Enumeration;
+ String1Loc,
+ String2Loc : String30;
+ i,
+ j : INTEGER;
+
+BEGIN
+{
+ NEW(PtrGlbNext);
+ NEW(PtrGlb);
+}
+
+ MyRec[PtrGlb].PtrComp:= PtrGlbNext;
+ MyRec[PtrGlb].Discr:= Ident1;
+ MyRec[PtrGlb].EnumComp:= Ident3;
+ MyRec[PtrGlb].IntComp:= 40;
+ MyRec[PtrGlb].StringComp := 'DHRYSTONE PROGRAM, SOME STRING';
+
+ String1Loc := 'DHRYSTONE PROGRAM, 1''ST STRING';
+
+FOR i := 1 TO LOOPS DO
+ FOR j := 1 TO 1000 DO
+ BEGIN
+ Proc5;
+ Proc4;
+ IntLoc1:= 2;
+ IntLoc2:= 3;
+ String2Loc := 'DHRYSTONE PROGRAM, 2''ND STRING';
+ EnumLoc:= Ident2;
+ BoolGlob:= NOT Func2(String1Loc, String2Loc);
+ WHILE (IntLoc1 < IntLoc2) DO
+ BEGIN
+ IntLoc3 := 5 * IntLoc1 - IntLoc2;
+ Proc7(IntLoc1, IntLoc2, IntLoc3);
+ IntLoc1:= IntLoc1 + 1;
+ END;
+ Proc8(Array1Glob, Array2Glob, IntLoc1, IntLoc3);
+ Proc1(PtrGlb);
+ CharIndex:= 'A';
+ WHILE CharIndex <= Char2Glob DO
+ BEGIN
+ IF (EnumLoc = Func1(CharIndex, 'C')) THEN
+ Proc6(Ident1, EnumLoc);
+ { CharIndex:= SUCC(CharIndex); }
+ inc(byte(charindex));
+ END;
+ IntLoc3:= IntLoc2 * IntLoc1;
+ IntLoc2:= IntLoc3 DIV IntLoc1;
+ IntLoc2:= 7 * (IntLoc3 - IntLoc2) - IntLoc1;
+ Proc2(IntLoc1);
+ END;
+END;
+
+function GetDrystone(NLoops: Integer = 5000) : Int64;
+var
+ tm: Int64;
+ CPUTime: Int64;
+begin
+ LOOPS := NLoops;
+ tm := GetTickCount;
+ Proc0;
+ CPUTime := GetTickCount-tm;
+ Result := CPUTime;
+end;
+
+function GetMemorySize: LongInt;
+{$IFDEF WINDOWS}
+var
+ Memory: TMemoryStatus;
+ r: Extended;
+{$ENDIF}
+begin
+ Result := 0;
+{$IFDEF WINDOWS}
+ Memory.dwLength := SizeOf(Memory);
+ GlobalMemoryStatus(Memory);
+ Result := Memory.dwTotalPhys;
+{$ENDIF}
+end;
+
+function GetProcessorRating(WKIPS: Extended; DryTime: Extended): Extended;
+begin
+ Result := ((((1/WKIPS)*1000000)/2.3)+((DryTime*1.4)*0.8))*0.5;
+end;
+
+function GetHardDiskRating(fReadTime, fWriteTime: Extended): Extended;
+begin
+ Result := ((fReadTime/400)+(fWriteTime/15))/2;
+end;
+
+function GetMemoryRating(TransferRate: Extended): Extended;
+begin
+ Result := TransferRate/5000;
+end;
+
+{ TCPUBenchThread }
+
+constructor TCPUBenchThread.Create(Loops: Integer);
+begin
+ FLoops := Loops;
+ FWhetstoneResult := -1;
+ FDrystoneResultTime := -1;
+ Priority := tpTimeCritical;
+ inherited Create(False);
+end;
+
+procedure TCPUBenchThread.Execute;
+begin
+ FWhetstoneResult := GetWhetstone(FLoops);
+ FDrystoneResultTime := GetDryStone(FLoops*20);
+end;
+
+end.
+
diff --git a/Software/src/general/src_vis/ucomport.pas b/Software/src/general/src_vis/ucomport.pas
new file mode 100755
index 0000000..9e0acc7
--- /dev/null
+++ b/Software/src/general/src_vis/ucomport.pas
@@ -0,0 +1,394 @@
+unit ucomport;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Forms,Classes, SysUtils,LCLIntf, Dialogs,LCLProc,
+ {$IFDEF DARWIN}
+ serial_osx
+ {$ELSE}
+ {$IFDEF MSWINDOWS}
+ Windows,serial_win
+ {$ELSE}
+ serial
+ {$ENDIF}
+ {$ENDIF}
+ ;
+
+type
+
+ TComport = class;
+
+ { TRecvThread }
+
+ TRecvThread = class(TThread)
+ private
+ {$IFDEF WINDOWS}
+ Overlapped: TOverlapped;
+ ex: DWord;
+ {$ENDIF}
+ FPort : TComPort;
+ FBuffer : string;
+ aBuffer : string;
+ procedure DirectDataReceived;
+ procedure DataReceived(Data: PtrInt);
+ procedure PutData;
+ procedure DoExit;
+ public
+ function SendData(aData : string) : LongInt;
+ procedure DoTerminate;
+ constructor Create(Port : TComPort);
+ procedure Execute;override;
+ destructor Destroy; override;
+ end;
+
+ TCharNotification = procedure(Port : TComport;c : char) of object;
+ TLineNotification = procedure(Port : TComport;line : string) of object;
+
+ { TComPort }
+
+ TComPort = class(TObject)
+ private
+ FActive: Boolean;
+ FBaudrate: Integer;
+ FCharReceived: TCharNotification;
+ FDatabits: Integer;
+ FHardflow: Boolean;
+ FLineReceived: TLineNotification;
+ FParity: char;
+ hPort : THandle;
+ FPortName : string;
+ FSoftflow: Boolean;
+ FStopbits: Integer;
+ FRecvThread : TRecvThread;
+ FTerminator: char;
+ procedure SetActive(const AValue: Boolean);
+ procedure SetDTR(const AValue: Boolean);
+ procedure SetRTS(const AValue: Boolean);
+ protected
+ FBuffer : string;
+ public
+ constructor Create(APortName : string);
+ destructor Destroy;override;
+ property Port : string read FPortName write FPortname;
+ property Baudrate : Integer read FBaudrate write FBaudrate;
+ property Parity : char read FParity write FParity;
+ property Stopbits : Integer read FStopbits write FStopbits;
+ property Databits : Integer read FDatabits write FDataBits;
+ property Hardflow : Boolean read FHardflow write FHardflow;
+ property Softflow : Boolean read FSoftflow write FSoftflow;
+ property DTR: Boolean write SetDTR;
+ property RTS: Boolean write SetRTS;
+ property Buffer : string read FBuffer;
+ property Active : Boolean read FActive write SetActive;
+ function SetParamsFromString(params : string) : Boolean;
+ property LineTerminator : char read FTerminator write FTerminator;
+ procedure Open;virtual;
+ procedure Close;virtual;
+ procedure ClearBuffer;
+ function ATCommand(cmd : string) : string;
+ function SendString(data : string) : Boolean;
+ property OnCharReceived : TCharNotification read FCharReceived write FCharReceived;
+ property OnLineReceived : TLineNotification read FLineReceived write FLineReceived;
+ function CheckLineReceived(var Line : string) : Boolean;
+ function CheckCharReceived(var c : char) : Boolean;
+ function RecivLine(Timeout : Integer) : string;
+ end;
+
+implementation
+
+{ TComPort }
+
+procedure TComPort.SetActive(const AValue: Boolean);
+begin
+ if FActive=AValue then exit;
+ FActive:=AValue;
+ if FActive then
+ Open
+ else
+ Close;
+end;
+
+procedure TComPort.SetDTR(const AValue: Boolean);
+begin
+ SerSetDTR(hPort,AValue);
+end;
+
+procedure TComPort.SetRTS(const AValue: Boolean);
+begin
+ SerSetRTS(hPort,AValue);
+end;
+
+constructor TComPort.Create(APortName: string);
+begin
+ FDatabits := 8;
+ FStopbits := 1;
+ FParity := 'N';
+ FBaudrate := 9600;
+ FPortname := APortName;
+ FHardFlow := True;
+ FSoftFlow := False;
+ hPort := 0;
+ FTerminator := #13;
+end;
+
+destructor TComPort.Destroy;
+begin
+ if Active then
+ Close;
+end;
+
+function TComPort.SetParamsFromString(params: string): Boolean;
+var
+ tmp: String;
+begin
+ Result := True;
+ try
+ if pos(',',Params) = 0 then
+ begin
+ Result := False;
+ exit;
+ end;
+ FBaudrate := StrToInt(copy(Params,0,pos(',',Params)-1));
+ tmp := copy(Params,pos(',',Params)+1,length(Params));
+ FDatabits := StrToInt(copy(tmp,0,1));
+ FParity := copy(tmp,2,1)[1];
+ FStopbits := StrToInt(copy(tmp,3,1));
+ except
+ result := False;
+ exit;
+ end;
+end;
+
+procedure TComPort.Open;
+begin
+ if not ((hPort = 0)
+{$IFDEF WINDOWS}
+ or (hport = INVALID_HANDLE_VALUE)
+{$ENDIF}
+ ) then
+ begin
+ FActive := True;
+ exit;
+ end;
+ FActive := False;
+{$IFDEF WINDOWS}
+ hPort := CreateFile(PChar('\\.\' + UpperCase(FPortName)),
+ GENERIC_READ or GENERIC_WRITE,
+ 0,
+ Nil,
+ OPEN_EXISTING,
+ FILE_FLAG_NO_BUFFERING or FILE_FLAG_OVERLAPPED,
+ 0);
+{$ELSE}
+ hPort := SerOpen(FPortName);
+{$ENDIF}
+ if (hPort = 0)
+{$IFDEF WINDOWS}
+ or (hport = INVALID_HANDLE_VALUE)
+{$ENDIF}
+ then exit;
+ FActive := True;
+ if FParity = 'N' then
+ SerSetParams(hPort,FBaudRate,FDataBits,NoneParity,FStopBits,[])
+ else
+ SerSetParams(hPort,FBaudRate,FDataBits,OddParity,FStopBits,[]);
+ if FActive then
+ FRecvThread := TRecvThread.Create(Self);
+end;
+
+procedure TComPort.Close;
+var
+ aPort: LongWord;
+begin
+ if not FActive then exit;
+ aPort := hPort;
+ hPort := 0;
+ if not Assigned(FRecvThread) then exit;
+ FRecvThread.DoTerminate;
+ FActive := False;
+ SerClose(aPort);
+end;
+
+procedure TComPort.ClearBuffer;
+begin
+ FBuffer := '';
+end;
+
+function TComPort.SendString(data : string) : Boolean;
+begin
+ Result := FRecvThread.SendData(data) = length(data);
+end;
+
+function TComPort.ATCommand(cmd: string): string;
+var
+ aBuffer: array[0..40] of char;
+ tmp: String;
+begin
+// Debugln('ATCommand:'+cmd);
+ tmp := cmd+#13;
+ SerWrite(hPort,PChar(tmp)^,length(tmp));
+ aBuffer[0] := #0;
+ aBuffer[SerRead(hPort,aBuffer, 40)] := #0;
+ Result := aBuffer;
+ Result := StringReplace(Result,#10,'',[rfReplaceAll]);
+ Result := StringReplace(Result,#13,'',[rfReplaceAll]);
+ if pos('OK',result) > 0 then
+ Result := copy(Result,0,pos('OK',Result)-1);
+end;
+
+function TComPort.CheckLineReceived(var Line: string): Boolean;
+begin
+ Result := false;
+ if pos(FTerminator,FBuffer) > 0 then
+ begin
+ Line := copy(FBuffer,0,pos(FTerminator,FBuffer));
+ Fbuffer := copy(FBuffer,pos(FTerminator,FBuffer)+1,length(FBuffer));
+ Result := True;
+ end;
+end;
+
+function TComPort.CheckCharReceived(var c: char): Boolean;
+begin
+ Result := False;
+ if length(FBuffer) > 0 then
+ begin
+ c := FBuffer[1];
+ FBuffer := copy(Fbuffer,2,length(FBuffer));
+ Result := True;
+ end;
+end;
+
+function TComPort.RecivLine(Timeout: Integer): string;
+var
+ atm: Int64;
+begin
+ atm := GetTickCount;
+ while (TimeOut) > (GetTickCount - atm) do
+ begin
+ if pos(FTerminator,FBuffer) > 0 then
+ begin
+ Result := copy(FBuffer,0,pos(FTerminator,FBuffer)-1);
+ FBuffer := copy(FBuffer,pos(FTerminator,FBuffer)+1,length(Fbuffer));
+ exit;
+ end;
+ Application.Processmessages;
+ end;
+end;
+
+{ TRecvThread }
+procedure TRecvThread.DirectDataReceived;
+begin
+ DataReceived(PtrInt(@FPort));
+end;
+procedure TRecvThread.DataReceived(Data: PtrInt);
+var
+ i: Integer;
+ aPort : TComPort;
+begin
+ aPort := TComPort(Pointer(Data)^);
+ if not Assigned(aPort) then exit;
+ if (length(aPort.Fbuffer) > 0) or (length(FBuffer) > 0) then
+ begin
+ if Assigned(aPort.OnCharReceived) then
+ for i := 0 to length(FBuffer) do
+ aPort.OnCharReceived(aPort,FBuffer[i]);
+ if Assigned(aPort.OnLineReceived) then
+ begin
+ while (pos(aPort.FTerminator,FBuffer) > 0) and Assigned(aPort.OnLineReceived) do
+ begin
+ aPort.OnLineReceived(aPort,StringReplace(copy(FBuffer,0,pos(aPort.FTerminator,FBuffer)),#10,'',[rfReplaceAll]));
+ FBuffer := copy(FBuffer,pos(aPort.FTerminator,FBuffer)+1,length(FBuffer));
+ end;
+ end
+ else
+ begin
+ if Assigned(aPort.OnCharReceived) then
+ FBuffer := ''
+ else
+ begin
+ aPort.FBuffer := aPort.FBuffer+FBuffer;
+ FBuffer := '';
+ end;
+ end;
+ end;
+end;
+procedure TRecvThread.PutData;
+begin
+ FBuffer := FBuffer+aBuffer;
+end;
+procedure TRecvThread.DoExit;
+begin
+ FPort.FRecvThread := nil;
+end;
+function TRecvThread.SendData(aData: string): LongInt;
+begin
+// Debugln('SendString:'+aData);
+ {$IFDEF WINDOWS}
+ ResetEvent(Overlapped.hEvent);
+ if not WriteFile(FPort.hPort, aData[1], length(aData), DWord(Result), @Overlapped) then Result := -1;
+ {$ELSE}
+ Result := SerWrite(FPort.hPort,aData[1],length(aData));
+ {$ENDIF}
+end;
+procedure TRecvThread.DoTerminate;
+begin
+ Terminate;
+ {$IFDEF WINDOWS}
+ SetEvent(Overlapped.hEvent);
+ {$ENDIF}
+ WaitFor;
+end;
+constructor TRecvThread.Create(Port : TComPort);
+begin
+ FPort := Port;
+ FBuffer := '';
+ inherited Create(False);
+ FreeOnTerminate := True;
+end;
+
+procedure TRecvThread.Execute;
+var
+ alen: LongInt;
+begin
+ {$IFDEF WINDOWS}
+ FillChar(Overlapped, Sizeof(Overlapped), 0);
+ Overlapped.hEvent := CreateEvent(nil, True, False, nil);
+// SetCommMask(FPort.hPort, EV_RXCHAR);
+ {$ENDIF}
+ while not Terminated do
+ begin
+ Setlength(aBuffer,40);
+ {$IFDEF WINDOWS}
+// WaitCommEvent(FPort.hPort, ex, @Overlapped);
+ ReadFile(FPort.hPort, aBuffer[1], 39, Dword(aLen), @Overlapped);
+ WaitForSingleObject(Overlapped.hEvent, INFINITE);
+ ResetEvent(Overlapped.hEvent);
+ GetOverlappedResult(FPort.hPort, Overlapped, DWord(aLen), False);
+ {$ELSE}
+ alen := SerRead(FPort.hPort,aBuffer[1], 39);
+ {$ENDIF}
+ if aLen > 0 then
+ begin
+ Setlength(aBuffer,alen);
+ PutData;
+ Application.QueueAsyncCall(@DataReceived,PtrInt(@FPort));
+ end
+ else sleep(1);
+ end;
+end;
+
+destructor TRecvThread.Destroy;
+begin
+ {$IFDEF WINDOWS}
+// SetCommMask(FPort.hPort,0);
+ CloseHandle(Overlapped.hEvent);
+ {$ENDIF}
+ DoExit;
+ inherited Destroy;
+end;
+
+end.
+
diff --git a/Software/src/general/src_vis/uerror.lfm b/Software/src/general/src_vis/uerror.lfm
new file mode 100755
index 0000000..12be0c8
--- /dev/null
+++ b/Software/src/general/src_vis/uerror.lfm
@@ -0,0 +1,62 @@
+object fError: TfError
+ Left = 396
+ Height = 151
+ Top = 350
+ Width = 525
+ Caption = 'fError'
+ ClientHeight = 151
+ ClientWidth = 525
+ KeyPreview = True
+ OnKeyDown = FormKeyDown
+ Position = poScreenCenter
+ LCLVersion = '1.3'
+ object mError: TMemo
+ Left = 8
+ Height = 134
+ Top = 8
+ Width = 320
+ Anchors = [akTop, akLeft, akRight, akBottom]
+ Font.Color = clRed
+ Lines.Strings = (
+ 'Memo1'
+ )
+ ParentFont = False
+ ReadOnly = True
+ TabOrder = 0
+ end
+ object bOK: TBitBtn
+ Left = 338
+ Height = 40
+ Top = 8
+ Width = 180
+ Anchors = [akTop, akRight]
+ BorderSpacing.InnerBorder = 4
+ Caption = '&Ok'
+ Default = True
+ Kind = bkOK
+ ModalResult = 1
+ OnClick = bOKClick
+ TabOrder = 1
+ end
+ object bBacktrace: TBitBtn
+ Left = 338
+ Height = 30
+ Top = 80
+ Width = 180
+ Anchors = [akRight, akBottom]
+ Caption = 'bBacktrace'
+ OnClick = bBacktraceClick
+ TabOrder = 2
+ end
+ object bSendToAdmin: TBitBtn
+ Left = 338
+ Height = 29
+ Top = 112
+ Width = 180
+ Anchors = [akRight, akBottom]
+ Caption = 'an Administrator melden'
+ Enabled = False
+ OnClick = bBacktraceClick
+ TabOrder = 3
+ end
+end
\ No newline at end of file
diff --git a/Software/src/general/src_vis/uerror.lrs b/Software/src/general/src_vis/uerror.lrs
new file mode 100755
index 0000000..d2e1e83
--- /dev/null
+++ b/Software/src/general/src_vis/uerror.lrs
@@ -0,0 +1,21 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TfError','FORMDATA',[
+ 'TPF0'#7'TfError'#6'fError'#4'Left'#3#140#1#6'Height'#3#151#0#3'Top'#3'^'#1#5
+ +'Width'#3#13#2#7'Caption'#6#6'fError'#12'ClientHeight'#3#151#0#11'ClientWidt'
+ +'h'#3#13#2#10'KeyPreview'#9#9'OnKeyDown'#7#11'FormKeyDown'#8'Position'#7#14
+ +'poScreenCenter'#10'LCLVersion'#6#3'1.3'#0#5'TMemo'#6'mError'#4'Left'#2#8#6
+ +'Height'#3#134#0#3'Top'#2#8#5'Width'#3'@'#1#7'Anchors'#11#5'akTop'#6'akLeft'
+ +#7'akRight'#8'akBottom'#0#10'Font.Color'#7#5'clRed'#13'Lines.Strings'#1#6#5
+ +'Memo1'#0#10'ParentFont'#8#8'ReadOnly'#9#8'TabOrder'#2#0#0#0#7'TBitBtn'#3'bO'
+ +'K'#4'Left'#3'R'#1#6'Height'#2'('#3'Top'#2#8#5'Width'#3#180#0#7'Anchors'#11#5
+ +'akTop'#7'akRight'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#3'&Ok'#7
+ +'Default'#9#4'Kind'#7#4'bkOK'#11'ModalResult'#2#1#7'OnClick'#7#8'bOKClick'#8
+ +'TabOrder'#2#1#0#0#7'TBitBtn'#10'bBacktrace'#4'Left'#3'R'#1#6'Height'#2#30#3
+ +'Top'#2'P'#5'Width'#3#180#0#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'
+ +#6#10'bBacktrace'#7'OnClick'#7#15'bBacktraceClick'#8'TabOrder'#2#2#0#0#7'TBi'
+ +'tBtn'#12'bSendToAdmin'#4'Left'#3'R'#1#6'Height'#2#29#3'Top'#2'p'#5'Width'#3
+ +#180#0#7'Anchors'#11#7'akRight'#8'akBottom'#0#7'Caption'#6#23'an Administrat'
+ +'or melden'#7'Enabled'#8#7'OnClick'#7#15'bBacktraceClick'#8'TabOrder'#2#3#0#0
+ +#0
+]);
diff --git a/Software/src/general/src_vis/uerror.lrt b/Software/src/general/src_vis/uerror.lrt
new file mode 100755
index 0000000..f688c6e
--- /dev/null
+++ b/Software/src/general/src_vis/uerror.lrt
@@ -0,0 +1,3 @@
+TFERROR.CAPTION=fError
+TFERROR.BOK.CAPTION=bOK
+TFERROR.BBUGTRACKER.CAPTION=bBugtracker
diff --git a/Software/src/general/src_vis/uerror.pas b/Software/src/general/src_vis/uerror.pas
new file mode 100644
index 0000000..461d519
--- /dev/null
+++ b/Software/src/general/src_vis/uerror.pas
@@ -0,0 +1,221 @@
+unit uError;
+
+
+{$mode objfpc}{$H+}
+
+
+interface
+
+
+uses
+
+ Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
+ Buttons,uGeneralStrConsts,LCLProc, LCLType,FileUtil,LConvEncoding;
+
+type
+ { TfError }
+ TfError = class(TForm)
+ bBacktrace: TBitBtn;
+ bSendToAdmin: TBitBtn;
+ bOK: TBitBtn;
+ mError: TMemo;
+ procedure bBacktraceClick(Sender: TObject);
+ procedure bOKClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ private
+ { private declarations }
+ function GetMessage(aFile : string;aMessage : string) : string;
+ public
+ { public declarations }
+ procedure ShowError(Msg : string = '');
+ procedure ShowWarning(Msg : string = '');
+ procedure SetLanguage;
+ end;
+
+var
+ fError: TfError;
+
+implementation
+
+{ TfError }
+procedure TfError.bOKClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TfError.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
+ );
+begin
+ if Key = VK_ESCAPE then
+ begin
+ Key := 0;
+ Close;
+ end;
+end;
+
+function TfError.GetMessage(aFile: string; aMessage: string): string;
+var
+ sl: TStringList;
+ tmp: String;
+ varname: String;
+ tmp1: String;
+ aRes: String;
+ i: Integer;
+ varvalue: String;
+begin
+ try
+ aRes := ConvertEncoding(aMessage,GuessEncoding(aMessage),EncodingUTF8);
+ Result := aRes;
+ if FileExistsUTF8(AppendPathDelim(Application.Location)+aFile) then
+ begin
+ sl := TStringList.Create;
+ sl.LoadFromFile(UTF8ToSys(AppendPathDelim(Application.Location)+aFile));
+ for i := 0 to sl.Count-1 do
+ begin
+ aMessage:=ConvertEncoding(aMessage,GuessEncoding(aMessage),EncodingUTF8);
+ aMessage := StringReplace(aMessage,#10,'',[rfReplaceAll]);
+ aMessage := StringReplace(aMessage,#13,'',[rfReplaceAll]);
+ tmp := sl.Names[i];
+ Result := sl.ValueFromIndex[i];
+ while pos('@',tmp)>0 do
+ begin
+ if pos('@',copy(tmp,pos('@',tmp)+1,length(tmp)))>0 then
+ begin
+ if copy(tmp,0,pos('@',tmp)-1) = copy(aMessage,0,pos('@',tmp)-1) then
+ begin
+ aMessage := copy(aMessage,pos('@',tmp),length(aMessage));
+ tmp := copy(tmp,pos('@',tmp)+1,length(tmp));
+ varname := copy(tmp,0,pos('@',tmp)-1);
+ tmp := copy(tmp,pos('@',tmp)+1,length(tmp));
+ if pos('@',tmp)>0 then
+ tmp1 := copy(tmp,0,pos('@',tmp)-1)
+ else
+ tmp1 := tmp;
+ varvalue := copy(aMessage,0,pos(tmp1,aMessage)-1);
+ aMessage:=copy(aMessage,length(varvalue)+1,length(aMessage));
+ Result := StringReplace(Result,'@'+varname+'@',varvalue,[rfReplaceAll])
+ end
+ else
+ begin
+ Result := aRes;
+ break;
+ end;
+ end
+ else
+ begin
+ Result := aRes;
+ break;
+ end;
+ end;
+ if (aMessage='') or (aMessage=tmp) then break
+ else
+ begin
+ aMessage:=aRes;
+ Result := aRes;
+ end;
+ end;
+ sl.Free;
+ end;
+ except
+ Result := aRes;
+ end;
+end;
+
+procedure TfError.ShowError(Msg: string = '');
+var
+ aMsg : string;
+begin
+ if not Assigned(Self) then
+ begin
+ Application.CreateForm(TfError,fError);
+ Self := fError;
+ end;
+ try
+ bBacktrace.Visible:=ExceptObject <> nil;
+ except
+ end;
+ SetLanguage;
+ mError.Lines.Clear;
+ mError.Font.Color:=clred;
+ bSendToAdmin.Visible:=True;
+ if Msg <> '' then
+ aMsg := GetMessage('errors.txt',Msg)+lineending;
+ if ExceptObject <> nil then
+ begin
+ aMsg := aMsg+lineending+strOriginalException+Exception(ExceptObject).Message;
+ aMsg := aMsg+lineending+strExceptObjectclass+ExceptObject.ClassName;
+ aMsg := aMsg+lineending+strDescription;
+ end;
+ Debugln(aMsg);
+ mError.Lines.Text := trim(aMsg);
+ Showmodal;
+end;
+
+procedure TfError.ShowWarning(Msg: string);
+var
+ aMsg: String;
+begin
+ if not Assigned(Self) then
+ begin
+ Application.CreateForm(TfError,fError);
+ Self := fError;
+ end;
+ SetLanguage;
+ mError.Lines.Clear;
+ mError.Font.Color:=clWindowText;
+ bBacktrace.Visible:=False;
+ bSendToAdmin.Visible:=False;
+ if Msg <> '' then
+ aMsg := GetMessage('warnings.txt',Msg)+lineending;
+ Debugln(aMsg);
+ mError.Lines.Text := trim(aMsg);
+ Showmodal;
+end;
+
+procedure TfError.SetLanguage;
+begin
+ if not Assigned(Self) then
+ begin
+ Application.CreateForm(TfError,fError);
+ Self := fError;
+ end;
+ try
+ bOK.Caption := strOK;
+ bBacktrace.Caption := strBacktrace;
+
+ Caption := strError;
+ except
+ end;
+end;
+
+procedure TfError.bBacktraceClick(Sender: TObject);
+var
+ aMsg : string = '';
+ FrameCount: LongInt;
+ Frames: PPointer;
+ FrameNumber: Integer;
+begin
+ try
+ if ExceptAddr <> nil then
+ begin
+ aMsg := aMsg+lineending+strStackTrace;
+ aMsg := aMsg+lineending+BackTraceStrFunc(ExceptAddr);
+ FrameCount:=ExceptFrameCount;
+ Frames:=ExceptFrames;
+ for FrameNumber := 0 to FrameCount-1 do
+ aMsg := aMsg+lineending+BackTraceStrFunc(Frames[FrameNumber]);
+ end;
+ except
+ end;
+ mError.Lines.Text:=mError.Lines.Text+lineending+aMsg;
+end;
+
+initialization
+ {$I uerror.lrs}
+
+end.
+
+
+
+
+
\ No newline at end of file
diff --git a/Software/src/general/src_vis/uextcontrols.lfm b/Software/src/general/src_vis/uextcontrols.lfm
new file mode 100644
index 0000000..6cf4e96
--- /dev/null
+++ b/Software/src/general/src_vis/uextcontrols.lfm
@@ -0,0 +1,10 @@
+object ExtControlFrame: TExtControlFrame
+ Left = 0
+ Height = 240
+ Top = 0
+ Width = 320
+ LCLVersion = '1.1'
+ TabOrder = 0
+ DesignLeft = 671
+ DesignTop = 294
+end
diff --git a/Software/src/general/src_vis/uextcontrols.lrs b/Software/src/general/src_vis/uextcontrols.lrs
new file mode 100755
index 0000000..bcc6672
--- /dev/null
+++ b/Software/src/general/src_vis/uextcontrols.lrs
@@ -0,0 +1,7 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TExtControlFrame','FORMDATA',[
+ 'TPF0'#16'TExtControlFrame'#15'ExtControlFrame'#4'Left'#2#0#6'Height'#3#240#0
+ +#3'Top'#2#0#5'Width'#3'@'#1#10'LCLVersion'#6#3'1.1'#8'TabOrder'#2#0#10'Desig'
+ +'nLeft'#3#159#2#9'DesignTop'#3'&'#1#0#0
+]);
diff --git a/Software/src/general/src_vis/uextcontrols.pas b/Software/src/general/src_vis/uextcontrols.pas
new file mode 100644
index 0000000..0600e67
--- /dev/null
+++ b/Software/src/general/src_vis/uextcontrols.pas
@@ -0,0 +1,1148 @@
+unit uExtControls;
+{$mode objfpc}{$H+}
+interface
+uses
+ Classes, SysUtils, db, DbCtrls, DBGrids, Controls, Grids, Dialogs, LCLType,
+ StdCtrls, Graphics, LMessages, LCLProc, LCLIntf, ComCtrls, Menus, Forms,
+ ExtCtrls,uModifiedDS;
+type
+ THackDBGrid = class(TDBGrid);
+ THackGrid = class(TCustomGrid);
+ TExtRotatedLabel = class(TLabel)
+ protected
+ procedure Loaded; override;
+ published
+ constructor Create(TheOwner: TComponent); override;
+ end;
+ TExtDBCombobox = class(TDBComboBox)
+ private
+ FCol,FRow : Integer;
+ FGrid: TCustomGrid;
+ protected
+ procedure DropDown; override;
+ procedure KeyDown(var Key : Word; Shift : TShiftState); override;
+ procedure UpdateData(Sender: TObject); override;
+ procedure DataChange(Sender: TObject); override;
+ procedure Select;override;
+ procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE;
+ procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
+ procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
+ published
+ constructor Create(TheOwner: TComponent); override;
+ end;
+
+ { TExtCombobox }
+
+ TExtCombobox = class(TComboBox)
+ private
+ FCol,FRow : Integer;
+ FGrid: TCustomGrid;
+ protected
+ procedure DropDown; override;
+ procedure KeyDown(var Key : Word; Shift : TShiftState); override;
+ procedure Select;override;
+ procedure msg_GetValue(var Msg: TGridMessage); message GM_GETVALUE;
+ procedure msg_SetPos(var Msg: TGridMessage); message GM_SETPOS;
+ procedure msg_SetGrid(var Msg: TGridMessage); message GM_SETGRID;
+ published
+ constructor Create(TheOwner: TComponent); override;
+ end;
+
+ { TExtDBGrid }
+
+ TExtDBGrid = class(TDBGrid)
+ procedure FDownTimerTimer(Sender: TObject);
+ procedure FExtEditorExit(Sender: TObject);
+ procedure FExtPickListEditorExit(Sender: TObject);
+ private
+ FCachedEditing: Boolean;
+ FExtPickListEditor : TExtDBComboBox;
+ FScrollSyncControl: TWinControl;
+ FUseExtPicklist: Boolean;
+ FWantReturns: Boolean;
+ FOldEditor : TWinControl;
+ FMouseDowns : Integer;
+ FDownTimer : TTimer;
+ protected
+ procedure EditorShow(const SelAll: boolean); override;
+ procedure KeyDown(var Key : Word; Shift : TShiftState); override;
+ procedure DrawRow(ARow: Integer); override;
+ procedure WMHScroll(var Message : TLMHScroll); message LM_HScroll;
+ procedure MoveSelection; override;
+ function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean;override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer
+ ); override;
+ function EditingAllowed(ACol: Integer=-1): Boolean; override;
+ procedure DblClick; override;
+ procedure SelectEditor;override;
+ function SelectCell(aCol, aRow: Integer): boolean; override;
+ public
+ property Editor;
+ property ScrollSyncControl : TWinControl read FScrollSyncControl write FScrollSyncControl;
+ property UseExtPicklist : Boolean read FUseExtPicklist write FUseExtPicklist;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy;override;
+ published
+ property WantReturns : Boolean read FWantReturns write FWantReturns;
+ property OnMouseWheel;
+ property OnMouseWheelDown;
+ property OnMouseWheelUp;
+ property CachedEditing : Boolean read FCachedEditing write FCachedEditing;
+ end;
+ TExtDBEdit = class(TDBEdit)
+ private
+ FCanvas : TControlCanvas;
+ protected
+ procedure Paint; virtual;
+ procedure PaintWindow(DC: HDC); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy;override;
+ end;
+ TGetCellWidth = procedure(aCol : Integer;var aNewWidth : Integer) of Object;
+
+ { TExtStringgrid }
+
+ TExtStringgrid = class(TStringGrid)
+ procedure FDownTimerTimer(Sender: TObject);
+ procedure FExtEditorExit(Sender: TObject);
+ private
+ FAfterDrawCell: TOnDrawCell;
+ FBeforeEnterEdit: TNotifyEvent;
+ FEnterEdit: TNotifyEvent;
+ FExtPickListEditor : TExtComboBox;
+ FCachedEditing: Boolean;
+ FGetCellWidth: TGetCellWidth;
+ FMouseDowns : Integer;
+ FDownTimer : TTimer;
+ FUseExtPicklist: Boolean;
+ protected
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer
+ ); override;
+ function EditingAllowed(ACol: Integer=-1): Boolean; override;
+ procedure SelectEditor;override;
+ procedure DblClick; override;
+ procedure AutoAdjustColumn(aCol: Integer); override;
+ procedure DrawCell(aCol,aRow:Integer; aRect:TRect; aState:TGridDrawState); override;
+ function CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean;override;
+ function SelectCell(aCol, aRow: Integer): boolean; override;
+ procedure EditordoSetValue; override;
+ procedure EditorShow(const SelAll: boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property UseExtPicklist : Boolean read FUseExtPicklist write FUseExtPicklist;
+ published
+ property OnAfterDrawCell: TOnDrawCell read FAfterDrawCell write FAfterDrawCell;
+ property OnGetCellWidth: TGetCellWidth read FGetCellWidth write FGetCellWidth;
+ property CachedEditing : Boolean read FCachedEditing write FCachedEditing;
+ property OnEnterEdit : TNotifyEvent read FEnterEdit write FEnterEdit;
+ property BeforeEnterEdit : TNotifyEvent read FBeforeEnterEdit write FBeforeEnterEdit;
+ end;
+ TFrameClass = class of TFrame;
+
+ TFrameRecord = record
+ FrameClass : TFrameClass;
+ Name : string;
+ AddFunction : TNotifyEvent;
+ MultiblePages : Boolean;
+ end;
+ TExtControlFrame = class(TFrame)
+ private
+ FTabCaption: string;
+ procedure SetTabCaption(const AValue: string);
+ protected
+ public
+ constructor Create(AOwner: TComponent); override;
+ property TabCaption : string read FTabCaption write SetTabCaption;
+ procedure ShowFrame;virtual;
+ procedure FrameAdded;virtual;
+ procedure DoRefresh;virtual;
+ end;
+
+ { TExtMenuPageControl }
+
+ TExtMenuPageControl = class(TPageControl)
+ procedure CloseFrameClick(Sender: TObject);
+ procedure ExtMenuPageControlContextPopup(Sender: TObject; MousePos: TPoint;
+ var Handled: Boolean);
+ procedure FFrameClassesMenuItemClick(Sender: TObject);
+ procedure FMenuClose(Sender: TObject);
+ private
+ FMenu: TPopupMenu;
+ FCloseMenu : TPopupMenu;
+ FNewPage: TTabSheet;
+ FNewCustomPage: TMenuItem;
+ FMoveTab : Boolean;
+ FFrameClasses : array of TFrameRecord;
+ FDontChange : Boolean;
+ FNewTabImageIndex: Integer;
+ FTabTypes: string;
+ procedure SetNewTabImageIndex(const AValue: Integer);
+ procedure RefreshMenue;
+ protected
+ procedure Change; override;
+ procedure InsertControl(AControl: TControl; Index: integer); override;
+ procedure DoAutoSize; override;
+ procedure Loaded; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy;override;
+ function AddTab(aFrame : TFrame;SetActive : Boolean = True;NewName : string = '';aImageIndex : Integer = -1;UseFunction : Boolean = True) : Integer;
+ function GetTab(aFrameClass : TFrameClass) : TTabSheet;
+ procedure AddTabClass(aFrameClass : TFrameClass;aName : string;aAddFunction : TNotifyEvent = nil;aImageIndex : Integer = -1;aMultiblePages : Boolean = False);
+ procedure CanHaveCustomTabs(aAddFunction : TNotifyEvent = nil);
+ procedure ClearTabClasses;
+ procedure CloseAll;
+ procedure WillRemoveTab(aPage : TTabSheet);
+ property TabTypes : string read FTabTypes write FTabTypes;
+ published
+ property NewTabImageIndex : Integer read FNewTabImageIndex write SetNewTabImageIndex;
+ end;
+
+procedure Register;
+implementation
+{$IFDEF WINDOWS}
+uses Windows;
+{$ENDIF}
+resourcestring
+ strNewTab = 'Neues Tab';
+ strClose = 'Schließen';
+ strNewCustomPage = 'Tab erzeugen';
+
+procedure Register;
+begin
+ RegisterComponents('Data Controls',[TExtDBComboBox]);
+ RegisterComponents('Data Controls',[TExtDBGrid]);
+ RegisterComponents('Data Controls',[TExtDBEdit]);
+ RegisterComponents('Additional',[TExtStringGrid]);
+ RegisterComponents('Additional',[TExtRotatedLabel]);
+ RegisterComponents('Common Controls',[TExtMenuPageControl]);
+end;
+procedure AutoSizeComboboxList(Targetbox: TCustomComboBox);
+var temp, max, itemscounter: integer;
+ bmp : Graphics.TBitmap;
+begin
+ bmp := Graphics.TBitmap.Create;
+ try
+ bmp.Canvas.Font.Assign(Targetbox.Font);
+ max :=Targetbox.width;
+ for itemscounter := 0 to Targetbox.Items.count-1 do begin
+ temp := bmp.Canvas.TextWidth(Targetbox.Items[itemscounter]);
+ if temp > max then
+ max := temp;
+ end;
+ {$IFDEF WINDOWS}
+ if Targetbox.Items.Count > Targetbox.DropDownCount then //wenn eine Scrollbar auf der seite benötigt wird dann
+ Inc(max, GetSystemMetrics(SM_CXVSCROLL)); //verbreitere die combobox um breite der scrollbar
+ Sendmessage(Targetbox.Handle, CB_SETDROPPEDWIDTH, max+20,0); //ich hab +20 genommen da es sonst direkt am letzten buchstaben pickt und das sieht hässlich aus. Natürlich kann man auch das +20 ganz weg lassen oder nur die zahl verändern.
+ {$ENDIF}
+ finally
+ bmp.Free;
+ end;
+end;
+
+{ TExtCombobox }
+
+procedure TExtCombobox.DropDown;
+begin
+ AutoSizeComboboxList(Self);
+ inherited DropDown;
+end;
+
+procedure TExtCombobox.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ inherited KeyDown(Key, Shift);
+ case Key of
+ VK_RETURN:
+ if DroppedDown then
+ begin
+ if (FGrid=nil) then
+ Key := 0;
+ DroppedDown := False;
+ if Key<>0 then
+ begin
+ if FGrid<>nil then
+ FGrid.EditorkeyDown(Self, key, shift);
+ Key:=0;
+ end;
+ end
+ else
+ begin
+ if FGrid<>nil then
+ FGrid.EditorkeyDown(Self, key, shift);
+ FGrid.SetFocus;
+ end;
+ else if FGrid<>nil then
+ FGrid.EditorkeyDown(Self, key, shift);
+ end;
+end;
+
+procedure TExtCombobox.Select;
+begin
+ if FGrid<>nil then
+ begin
+ if THackDBGrid(FGrid).EditorIsReadOnly then
+ exit;
+ if (pos(' ',Text) > 0) and (copy(Text,0,pos(' ',Text)-1) = UpperCase(copy(Text,0,pos(' ',Text)-1))) then
+ THackDBGrid(FGrid).SetEditText(FCol, FRow, copy(Text,0,pos(' ',text)-1))
+ else
+ THackDBGrid(FGrid).SetEditText(FCol, FRow, Text);
+ THackDBGrid(FGrid).PickListItemSelected(Self);
+ end;
+ inherited Select;
+end;
+
+procedure TExtCombobox.msg_GetValue(var Msg: TGridMessage);
+begin
+ Msg.Col := FCol;
+ Msg.Row := FRow;
+ Msg.Value:=Text;
+end;
+
+procedure TExtCombobox.msg_SetPos(var Msg: TGridMessage);
+begin
+ FCol := Msg.Col;
+ FRow := Msg.Row;
+end;
+
+procedure TExtCombobox.msg_SetGrid(var Msg: TGridMessage);
+begin
+ FGrid:=Msg.Grid;
+ Msg.Options:=EO_AUTOSIZE or EO_SELECTALL or EO_HOOKKEYPRESS or EO_HOOKKEYUP;
+end;
+
+constructor TExtCombobox.Create(TheOwner: TComponent);
+begin
+ inherited Create(TheOwner);
+ Self.Sorted:=True;
+end;
+
+procedure TExtRotatedLabel.Loaded;
+begin
+ inherited Loaded;
+ {$IFDEF WINDOWS}
+ Font.Orientation:=900;
+ Self.Layout := tlBottom;
+ {$ELSE}
+ Font.Orientation:=-900;
+ Self.Layout := tlTop;
+ {$ENDIF}
+end;
+
+constructor TExtRotatedLabel.Create(TheOwner: TComponent);
+begin
+ inherited Create(TheOwner);
+ Autosize := False;
+end;
+procedure TExtControlFrame.SetTabCaption(const AValue: string);
+begin
+ if FTabCaption=AValue then exit;
+ FTabCaption:=AValue;
+ if Parent is TTabSheet then
+ TTabSheet(Parent).Caption:=FTabCaption;
+end;
+
+constructor TExtControlFrame.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ Name := '';
+end;
+procedure TExtControlFrame.ShowFrame;
+begin
+end;
+
+procedure TExtControlFrame.FrameAdded;
+begin
+
+end;
+
+procedure TExtControlFrame.DoRefresh;
+begin
+end;
+procedure TExtMenuPageControl.FFrameClassesMenuItemClick(Sender: TObject);
+var
+ aFrameClass: TFrameRecord;
+ aFrame: TFrame;
+ aNewPage: TTabSheet;
+begin
+ aNewPage := TTabSheet.Create(Self);
+ Self.Visible:=False;
+ aNewPage.PageControl := Self;
+ aNewPage.Parent := Self;
+ aFrameClass := FFrameClasses[TMenuItem(Sender).Tag];
+ aNewPage.ImageIndex:=TMenuItem(Sender).ImageIndex;
+ aNewPage.Caption := aFrameClass.Name;
+ aFrame := aFrameClass.FrameClass.Create(nil);
+ if Assigned(aFrame) and (aFrame is TExtControlFrame) then
+ TExtControlFrame(aFrame).TabCaption:=aFrameClass.Name;
+ FDontChange := True;
+ FNewPage.PageIndex:=Self.PageCount-1;
+ FDontChange := False;
+ FMenu.Close;
+ Self.ActivePage := aNewPage;
+ aFrame.Parent := aNewPage;
+ aFrame.Align:=alClient;
+ aFrame.Show;
+ if Assigned(aFrameClass.AddFunction) then
+ aFrameClass.AddFunction(aFrame);
+ if not aFrameClass.MultiblePages then
+ TMenuItem(Sender).Enabled:=False;
+ FNewPage.ImageIndex:=FNewTabImageIndex;
+ Self.Visible:=True;
+ if ActivePage.Controls[0] is TExtControlFrame then
+ TExtControlFrame(ActivePage.Controls[0]).ShowFrame;
+ RefreshMenue;
+ Self.SetFocus;
+end;
+procedure TExtMenuPageControl.CloseFrameClick(Sender: TObject);
+var
+ aPage: TTabSheet;
+ aCont: TControl;
+ i: Integer;
+ aMenu: TMenuItem;
+ aControl: TComponent;
+begin
+ if Sender = nil then exit; //Bug with ActionLists
+ try
+ if Sender is TTabSheet then
+ aPage := Sender as TTabSheet
+ else
+ aPage := Self.ActivePage;
+ except
+ exit;
+ end;
+ for i := 0 to FMenu.Items.Count-1 do
+ if Fmenu.Items[i].Caption = aPage.Caption then
+ FMenu.Items[i].Enabled := True;
+ Self.TabIndex:=Self.TabIndex-1;
+ if (aPage.ControlCount > 0) and (aPage.Controls[0] is TFrame) then
+ begin
+ aCont := aPage.Controls[0];
+ aCont.Hide;
+ aCont.Parent := nil;
+ FreeAndNil(aCont);
+ end;
+ FreeAndNil(aPage);
+ if not Assigned(ActivePage) then exit;
+ if (ActivePage.ControlCount > 0) and (ActivePage.Controls[0] is TFrame) then
+ begin
+ if TFrame(ActivePage.Controls[0]).CanFocus then
+ TFrame(ActivePage.Controls[0]).SetFocus;
+ if (ActivePage.Controls[0] is TExtControlFrame) then
+ TExtControlFrame(ActivePage.Controls[0]).ShowFrame;
+ end;
+end;
+
+procedure TExtMenuPageControl.ExtMenuPageControlContextPopup(Sender: TObject;
+ MousePos: TPoint; var Handled: Boolean);
+var
+ TH: SmallInt;
+ Y: LongInt;
+begin
+ Y := Self.ScreenToControl(Mouse.CursorPos).Y;
+ TH := Self.TabHeight;
+ if TH= 0 then TH := 25;
+ Handled := not (Y <= TH);
+end;
+procedure TExtMenuPageControl.FMenuClose(Sender: TObject);
+begin
+ Self.PageIndex:=0;
+end;
+procedure TExtMenuPageControl.SetNewTabImageIndex(const AValue: Integer);
+begin
+ if FNewTabImageIndex=AValue then exit;
+ FNewTabImageIndex:=AValue;
+ FNewPage.ImageIndex:=FNewTabImageIndex;
+end;
+procedure TExtMenuPageControl.RefreshMenue;
+begin
+ if (Assigned(ActivePage) and (ActivePage.TabIndex = 0))
+ or (ActivePage = FNewPage)
+ or (Assigned(ActivePage) and (ActivePage.Tag = 1))
+ then
+ Self.Popupmenu := nil
+ else
+ Self.PopupMenu := FCloseMenu;
+end;
+procedure TExtMenuPageControl.Change;
+var
+ x: LongInt;
+ i: Integer;
+begin
+ inherited Change;
+ if FDontChange then exit;
+ if Self.ActivePage = FNewPage then
+ begin
+ x := TabRect(ActivePage.TabIndex).Left;
+ {$IFDEF LCLCARBON}
+ for i := 0 to PageCount-1 do
+ begin
+ x += length(Pages[i].Caption)*6;
+ x += 20;
+ end;
+ x := x div 2;
+ x := x+Width div 2;
+ x -= (length(FnewPage.Caption)*6)+20;
+ x := Self.ClientToScreen(Classes.Point(x,0)).x-1;
+ {$ENDIF}
+ {$IFNDEF LCLCarbon}
+ x := Self.ClientToScreen(Classes.Point(x,0)).x-1;
+ {$ENDIF}
+ {$IFDEF LCLGtk2}
+ x := x-Left;
+ {$ENDIF}
+ FMenu.PopUp(x,Self.ClientToScreen(Classes.Point(0,0)).y-2);
+ end
+ else if Assigned(ActivePage) and (ActivePage.ControlCount > 0) and (ActivePage.Controls[0] is TFrame) then
+ begin
+ if TFrame(ActivePage.Controls[0]).CanFocus then
+ TFrame(ActivePage.Controls[0]).SetFocus;
+ if (ActivePage.Controls[0] is TExtControlFrame) then
+ TExtControlFrame(ActivePage.Controls[0]).ShowFrame;
+ RefreshMenue;
+ end;
+end;
+procedure TExtMenuPageControl.InsertControl(AControl: TControl; Index: integer
+ );
+begin
+ inherited InsertControl(AControl, Index);
+ if Assigned(FnewPage) then
+ FMoveTab := True;
+end;
+procedure TExtMenuPageControl.DoAutoSize;
+begin
+ inherited DoAutoSize;
+end;
+procedure TExtMenuPageControl.Loaded;
+begin
+ inherited Loaded;
+ if FMoveTab then
+ FNewPage.PageIndex:=Self.PageCount-1;
+end;
+constructor TExtMenuPageControl.Create(AOwner: TComponent);
+var
+ aNewItem: TMenuItem;
+begin
+ inherited Create(AOwner);
+ FNewCustomPage:=nil;
+ FNewTabImageIndex := 0;
+ FMenu := TPopupMenu.Create(Self);
+ Fmenu.OnClose:=@FMenuClose;
+ FNewPage := TTabSheet.Create(Self);
+ FNewPage.PageControl := Self;
+ FNewPage.Caption:=strNewTab;
+
+ FCloseMenu := TPopupMenu.Create(Self);
+ aNewItem := TMenuItem.Create(FCloseMenu);
+ aNewItem.Caption:=strClose;
+ aNewItem.OnClick:=@CloseFrameClick;
+ FCloseMenu.Items.Add(aNewItem);
+ Self.OnContextPopup:=@ExtMenuPageControlContextPopup;
+end;
+destructor TExtMenuPageControl.Destroy;
+begin
+ CloseAll;
+ FMenu.Free;
+ inherited Destroy;
+end;
+function TExtMenuPageControl.AddTab(aFrame: TFrame;SetActive : Boolean = True;NewName : string = '';aImageIndex : Integer = -1;UseFunction : Boolean = True) : Integer;
+var
+ aNewPage: TTabSheet;
+ i: Integer;
+ OldIndex: LongInt;
+ Found: Boolean;
+ a: Integer;
+begin
+ Result := -1;
+ if not SetActive then
+ Visible := False;
+ OldIndex := Self.PageIndex;
+ aNewPage := TTabSheet.Create(Self);
+ aNewPage.PageControl := Self;
+ aNewPage.ImageIndex := aImageIndex;
+ FDontChange := True;
+ FNewPage.PageIndex:=Self.PageCount-1;
+ try
+ aNewPage.PageIndex:=OldIndex+1;
+ except
+ aNewPage.PageIndex:=OldIndex+1;
+ end;
+ FDontChange := False;
+ if SetActive then
+ Self.ActivePage := aNewPage;
+ aFrame.Parent := aNewPage;
+ aFrame.Align:=alClient;
+ aFrame.Show;
+ Found := False;
+ if UseFunction then
+ for i := 0 to length(FFrameClasses)-1 do
+ if aFrame.ClassName = FFrameClasses[i].FrameClass.ClassName then
+ begin
+ if NewName = '' then
+ aNewPage.Caption:=FFrameClasses[i].Name
+ else
+ begin
+ aNewPage.Caption := NewName;
+ TExtControlFrame(aFrame).TabCaption := NewName;
+ end;
+ if Assigned(FFrameClasses[i].AddFunction) then
+ begin
+ FFrameClasses[i].AddFunction(aFrame);
+ end;
+ if not FFrameClasses[i].MultiblePages then
+ for a := 0 to FMenu.Items.Count-1 do
+ if Fmenu.Items[a].Caption = aNewPage.Caption then
+ FMenu.Items[a].Enabled := False;
+ Found := True;
+ end;
+ if not Found then
+ begin
+ if (NewName = '') and (aFrame is TExtControlFrame) then
+ aNewPage.Caption:=TExtControlFrame(aFrame).TabCaption
+ else
+ aNewPage.Caption := NewName;
+ end;
+ if not SetActive then
+ PageIndex := OldIndex;
+ Result := Self.PageIndex;
+ FNewPage.ImageIndex:=FNewTabImageIndex;
+ Visible := True;
+ FNewPage.ImageIndex:=FNewTabImageIndex;
+ if (aFrame is TExtControlFrame) then
+ TExtControlFrame(aFrame).ShowFrame;
+ if (aFrame is TExtControlFrame) then
+ TExtControlFrame(aFrame).FrameAdded;
+ RefreshMenue;
+end;
+function TExtMenuPageControl.GetTab(aFrameClass: TFrameClass): TTabSheet;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to Self.PageCount-1 do
+ if (Self.Pages[i].ControlCount > 0) and (Self.Pages[i].Controls[0] is aFrameClass) then
+ begin
+ Result := Self.Pages[i];
+ break;
+ end;
+end;
+procedure TExtMenuPageControl.AddTabClass(aFrameClass : TFrameClass;
+ aName : string;aAddFunction : TNotifyEvent = nil;aImageIndex : Integer = -1;aMultiblePages : Boolean = False);
+var
+ MenuItem: TMenuItem;
+begin
+ Setlength(FFrameClasses,length(FFrameClasses)+1);
+ FMenu.Images := Images;
+ with FFrameClasses[length(FFrameClasses)-1] do
+ begin
+ FrameClass := aFrameClass;
+ Name := aName;
+ AddFunction := aAddFunction;
+ MultiblePages := aMultiblePages;
+ MenuItem := TMenuItem.Create(FMenu);
+ MenuItem.Caption:=aName;
+ MenuItem.OnClick:=@FFrameClassesMenuItemClick;
+ MenuItem.Tag:=length(FFrameClasses)-1;
+ MenuItem.ImageIndex:=aImageIndex;
+ FMenu.Items.Add(MenuItem);
+ FNewPage.TabVisible:=True;
+ end;
+end;
+
+procedure TExtMenuPageControl.CanHaveCustomTabs(aAddFunction: TNotifyEvent);
+begin
+ if not Assigned(FNewCustomPage) then
+ begin
+ FNewCustomPage := TMenuItem.Create(FMenu);
+ FNewCustomPage.Caption:=strNewCustomPage;
+ FNewCustomPage.OnClick:=aAddFunction;
+ FMenu.Items.Add(FNewCustomPage);
+ end;
+end;
+
+procedure TExtMenuPageControl.ClearTabClasses;
+begin
+ Setlength(FFrameClasses,0);
+ FMenu.Items.Clear;
+ FNewPage.TabVisible:=False;
+end;
+procedure TExtMenuPageControl.CloseAll;
+var
+ i: Integer;
+ aPage: TTabSheet;
+begin
+ Fmenu.Items.Clear;
+ TabIndex:=0;
+ i := 1;
+ while i < Self.PageCount-1 do
+ begin
+ try
+ if Pages[i].ControlCount > 0 then
+ Pages[i].Controls[0].Free;
+ except
+ on e : exception do
+ debugln('Error during Page.Close: '+e.Message);
+ end;
+ aPage := Pages[i];
+ aPage.Free;
+ end;
+end;
+procedure TExtMenuPageControl.WillRemoveTab(aPage: TTabSheet);
+var
+ i: Integer;
+begin
+ for i := 0 to FMenu.Items.Count-1 do
+ if Fmenu.Items[i].Caption = aPage.Caption then
+ FMenu.Items[i].Enabled := True;
+end;
+constructor TExtDBCombobox.Create(TheOwner: TComponent);
+begin
+ inherited Create(TheOwner);
+ Self.Sorted:=True;
+end;
+procedure TExtDBCombobox.DropDown;
+begin
+ AutoSizeComboboxList(Self);
+ inherited DropDown;
+end;
+procedure TExtDBCombobox.KeyDown(var Key: Word; Shift: TShiftState);
+begin
+ inherited KeyDown(Key, Shift);
+ case Key of
+ VK_RETURN:
+ if DroppedDown then
+ begin
+ if (FGrid=nil) then
+ Key := 0;
+ DroppedDown := False;
+ if Key<>0 then
+ begin
+ if FGrid<>nil then
+ FGrid.EditorkeyDown(Self, key, shift);
+ Key:=0;
+ end;
+ end
+ else
+ begin
+ if FGrid<>nil then
+ FGrid.EditorkeyDown(Self, key, shift);
+ FGrid.SetFocus;
+ end;
+ else if FGrid<>nil then
+ FGrid.EditorkeyDown(Self, key, shift);
+ end;
+end;
+procedure TExtDBCombobox.UpdateData(Sender: TObject);
+begin
+ if (pos(' ',Text) > 0) and (copy(Text,0,pos(' ',Text)-1) = UpperCase(copy(Text,0,pos(' ',Text)-1))) then
+ Text := copy(Text,0,pos(' ',Text)-1);
+ inherited UpdateData(Sender);
+ DataChange(Sender);
+end;
+procedure TExtDBCombobox.DataChange(Sender: TObject);
+var
+ i: Integer;
+begin
+ inherited DataChange(Sender);
+ if not Assigned(Field) then exit;
+ for i := 0 to Items.Count-1 do
+ if trim(copy(Items[i],0,Field.Size)) = trim(Text) then
+ Text := items[i];
+end;
+procedure TExtDBCombobox.Select;
+begin
+ if FGrid<>nil then
+ begin
+ if THackDBGrid(FGrid).EditorIsReadOnly then
+ exit;
+ if Assigned(Field) then
+ begin
+ if (pos(' ',Text) > 0) and (copy(Text,0,pos(' ',Text)-1) = UpperCase(copy(Text,0,pos(' ',Text)-1))) then
+ THackDBGrid(FGrid).SetEditText(FCol, FRow, copy(Text,0,pos(' ',text)-1))
+ else
+ THackDBGrid(FGrid).SetEditText(FCol, FRow, Text);
+ end;
+ THackDBGrid(FGrid).PickListItemSelected(Self);
+ end;
+ inherited Select;
+end;
+procedure TExtDBCombobox.msg_GetValue(var Msg: TGridMessage);
+begin
+ Msg.Col := FCol;
+ Msg.Row := FRow;
+ if Assigned(Field) then
+ Msg.Value:=copy(Text,0,Field.Size);
+end;
+procedure TExtDBCombobox.msg_SetPos(var Msg: TGridMessage);
+begin
+ FCol := Msg.Col;
+ FRow := Msg.Row;
+end;
+procedure TExtDBCombobox.msg_SetGrid(var Msg: TGridMessage);
+begin
+ FGrid:=Msg.Grid;
+ Msg.Options:=EO_AUTOSIZE or EO_SELECTALL or EO_HOOKKEYPRESS or EO_HOOKKEYUP;
+end;
+procedure TExtDBGrid.FDownTimerTimer(Sender: TObject);
+begin
+ FDownTimer.Enabled:=False;
+ if FMouseDowns = 1 then
+ begin
+ if EditingAllowed(Col) and CanEditShow then
+ begin
+ SelectEditor;
+ if (Editor<>nil) and (not Editor.Visible) then
+ EditorMode:=True;
+ end;
+ end;
+ FMouseDowns:=0;
+end;
+procedure TExtDBGrid.FExtEditorExit(Sender: TObject);
+begin
+ UpdateData;
+// EditorMode := false;
+ if Sender is TCustomEdit then
+ TCustomEdit(Sender).MaxLength:=0;
+ TWinControl(Sender).OnExit:=nil;
+end;
+procedure TExtDBGrid.FExtPickListEditorExit(Sender: TObject);
+begin
+ UpdateData;
+// EditorMode := false;
+ if Sender is TCustomEdit then
+ TCustomEdit(Sender).MaxLength:=0;
+ TWinControl(Sender).OnExit:=nil;
+end;
+procedure TExtDBGrid.SelectEditor;
+begin
+ inherited SelectEditor;
+ if FUseExtPicklist then
+ begin
+ if Assigned(SelectedColumn) and Assigned(Editor) and (Editor is TPickListCellEditor) then
+ Editor := FExtPickListEditor;
+ if Assigned(FExtPickListEditor) and (Editor = FExtPickListEditor) then
+ begin
+ FExtPickListEditor.DataField := SelectedColumn.FieldName;
+ FExtPickListEditor.DataSource := DataSource;
+ FExtPickListEditor.Items.Assign(SelectedColumn.PickList);
+ Editor.BoundsRect := CellRect(Col,Row);
+ FExtPickListEditor.Text := SelectedColumn.Field.AsString;
+ end;
+ end;
+// if Assigned(FOldEditor) and (FOldEditor is TCustomEdit) then
+// TCustomEdit(FOldEditor).MaxLength := 0;
+ if Assigned(Editor) and (SelectedColumn.ButtonStyle <> cbsEllipsis) then
+ begin
+// FOldEditor := Editor;
+ Editor.OnExit:=@FExtPickListEditorExit;
+ end;
+end;
+function TExtDBGrid.SelectCell(aCol, aRow: Integer): boolean;
+begin
+ if (aRow <> Row) or (aCol <> Col) then
+ FMouseDowns:=0;
+ Result:=inherited SelectCell(aCol, aRow);
+end;
+procedure TExtDBGrid.EditorShow(const SelAll: boolean);
+begin
+ if Assigned(DataSource) and Assigned(DataSource.DataSet) and DataSource.DataSet.Active then
+ if (DataSource.DataSet.State <> dsEdit) and (DataSource.DataSet.State <> dsInsert) then
+ DataSource.DataSet.Edit;
+ inherited EditorShow(SelAll);
+ if Assigned(Editor) then
+ begin
+ Editor.OnExit:=@FExtEditorExit;
+ end;
+end;
+procedure TExtDBGrid.KeyDown(var Key: Word; Shift: TShiftState);
+var
+ SetNull: Boolean = False;
+ IManage : IBaseModifiedDS;
+begin
+ case KEY of
+ VK_DELETE:exit;
+ VK_RETURN:
+ if not FWantReturns then
+ begin
+ if not Datasource.DataSet.EOF then
+ DataSource.DataSet.MoveBy(1);
+ if not Self.ReadOnly then
+ if DataSource.DataSet.EOF then
+ DataSource.DataSet.Append;
+ SetNull := True;
+ end;
+// Key := VK_DOWN;
+ VK_ESCAPE:
+ begin
+ if (DataSource.DataSet.State = dsInsert) or (DataSource.DataSet.State = dsEdit) then
+ SetNull := True;
+ end;
+ VK_UP:
+ begin
+ if (DataSource.DataSet.State = dsInsert) and (DataSource.DataSet.Modified) then
+ begin
+ if Supports(DataSource.DataSet,IBaseModifiedDS,IManage) then
+ begin
+ if not IManage.IsChanged then
+ begin
+ DataSource.DataSet.Delete;
+ Key := 0;
+ end;
+ end;
+ end;
+ end;
+ VK_DOWN:
+ begin
+ if (DataSource.DataSet.State = dsInsert) and (DataSource.DataSet.Modified) then
+ begin
+ if Supports(DataSource.DataSet,IBaseModifiedDS,IManage) then
+ begin
+ if not IManage.IsChanged then
+ begin
+ Key := 0;
+ end;
+ end;
+ end;
+ end;
+ end;
+ inherited KeyDown(Key, Shift);
+// if Assigned(FScrollSyncControl) and (THackDBGrid(FScrollSyncControl).LeftCol <> LeftCol) then
+// THackDBGrid(FScrollSyncControl).LeftCol:=LeftCol;
+ if SetNull then Key := 0;
+end;
+procedure TExtDBGrid.DrawRow(ARow: Integer);
+begin
+ inherited DrawRow(ARow);
+end;
+procedure TExtDBGrid.WMHScroll(var Message: TLMHScroll);
+begin
+ if Assigned(FScrollSyncControl) then
+ FScrollSyncControl.Dispatch(Message);
+ inherited;
+end;
+procedure TExtDBGrid.MoveSelection;
+begin
+ inherited MoveSelection;
+ if Assigned(FScrollSyncControl) and (THackDBGrid(FScrollSyncControl).LeftCol <> LeftCol) then
+ THackDBGrid(FScrollSyncControl).LeftCol:=LeftCol;
+end;
+function TExtDBGrid.CanGridAcceptKey(Key: Word; Shift: TShiftState): Boolean;
+begin
+ Result:=inherited CanGridAcceptKey(Key, Shift);
+ if Key = 16 then Result := False;
+end;
+procedure TExtDBGrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
+ Y: Integer);
+begin
+ if Y > GCache.GridHeight then exit;
+ if (Button <> mbRight) and FCachedEditing then
+ begin
+ Inc(FMouseDowns);
+ //debugln(IntToStr(FMouseDowns)+' clicks');
+ if not Assigned(FDownTimer) then
+ begin
+ FDownTimer:=TTimer.Create(Self);
+ FDownTimer.Interval:=300;
+ FDownTimer.OnTimer:=@FDownTimerTimer;
+ FDownTimer.Enabled:= False;
+ end;
+ if (FDownTimer.Enabled = False) and (FMouseDowns > 0) then
+ if MouseToCell(Classes.Point(X,Y)).Y=Row then
+ begin
+ FDownTimer.Enabled:=True;
+ end;
+ end;
+ inherited MouseDown(Button, Shift, X, Y);
+end;
+function TExtDBGrid.EditingAllowed(ACol: Integer): Boolean;
+begin
+ Result:=inherited EditingAllowed(ACol);
+ if Result and (FMouseDowns > 0) and (Assigned(FDownTimer)) and (FDownTimer.Enabled)
+ and (ACol > 0) and (ACol < Columns.Count) and (Columns[ACol-1].ButtonStyle <> cbsCheckboxColumn)
+ and (Columns[ACol-1].PickList.Count = 0) then
+ Result := False;
+end;
+procedure TExtDBGrid.DblClick;
+begin
+ if FCachedEditing and Assigned(FDownTimer) then
+ FDownTimer.Enabled:=False;
+ inherited DblClick;
+end;
+constructor TExtDBGrid.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FCachedEditing := True;
+ FExtPickListEditor := TExtDBComboBox.Create(Self);
+ FWantReturns := False;
+ FExtPickListEditor.Visible:=False;
+ FUseExtPicklist := True;
+end;
+destructor TExtDBGrid.Destroy;
+begin
+ FExtPickListEditor.Free;
+ inherited Destroy;
+end;
+procedure TExtStringgrid.FDownTimerTimer(Sender: TObject);
+begin
+ FDownTimer.Enabled:=False;
+ if FMouseDowns = 1 then
+ EditorMode:=True;
+ FMouseDowns:=0;
+end;
+procedure TExtStringgrid.FExtEditorExit(Sender: TObject);
+begin
+ if Visible and EditorMode then
+ EditorMode := false;
+ TWinControl(Sender).OnExit:=nil;
+end;
+procedure TExtStringgrid.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
+ Y: Integer);
+begin
+ if Y > GCache.GridHeight then exit;
+ if (Button <> mbRight) and FCachedEditing then
+ begin
+ Inc(FMouseDowns);
+ if not Assigned(FDownTimer) then
+ begin
+ FDownTimer:=TTimer.Create(Self);
+ FDownTimer.Interval:=300;
+ FDownTimer.OnTimer:=@FDownTimerTimer;
+ FDownTimer.Enabled:= False;
+ end;
+ if (FDownTimer.Enabled = False) and (FMouseDowns > 0) then
+ if (MouseToCell(Classes.Point(X,Y)).Y=Row) and (MouseToCell(Classes.Point(X,Y)).X=Col) then
+ begin
+ FDownTimer.Enabled:=True;
+ end;
+ end;
+ inherited MouseDown(Button, Shift, X, Y);
+end;
+function TExtStringgrid.EditingAllowed(ACol: Integer): Boolean;
+begin
+ Result:=inherited EditingAllowed(ACol);
+ if (FMouseDowns > 0) and (Assigned(FDownTimer)) and (FDownTimer.Enabled)
+ and (Col < ColCount) and (Columns[Col-1].ButtonStyle <> cbsCheckboxColumn) then
+ Result := False;
+end;
+procedure TExtStringgrid.AutoAdjustColumn(aCol: Integer);
+var
+ aNewWidth : Integer = 0;
+begin
+ inherited AutoAdjustColumn(aCol);
+ if Assigned(FGetCellWidth) then
+ begin
+ FGetCellWidth(aCol,aNewWidth);
+ if aNewWidth > ColWidths[aCol] then
+ ColWidths[aCol] := aNewWidth;
+ Self.HeaderSized(True,aCol);
+ end;
+end;
+procedure TExtStringgrid.SelectEditor;
+begin
+ inherited SelectEditor;
+ if FUseExtPicklist then
+ begin
+ if Assigned(SelectedColumn) and Assigned(Editor) and (Editor is TPickListCellEditor) then
+ Editor := FExtPickListEditor;
+ if Assigned(FExtPickListEditor) and (Editor = FExtPickListEditor) then
+ begin
+ FExtPickListEditor.Items.Assign(SelectedColumn.PickList);
+ Editor.BoundsRect := CellRect(Col,Row);
+ FExtPickListEditor.Text := Cells[Col,Row];
+ end;
+ end;
+ if Assigned(Editor) then
+ begin
+ Editor.OnExit:=@FExtEditorExit;
+ end;
+end;
+procedure TExtStringgrid.DrawCell(aCol, aRow: Integer; aRect: TRect;
+ aState: TGridDrawState);
+begin
+ inherited DrawCell(aCol, aRow, aRect, aState);
+ if Assigned(FAfterDrawCell) then
+ FAfterDrawCell(Self,aCol,aRow,aRect,aState);
+end;
+
+function TExtStringgrid.CanGridAcceptKey(Key: Word; Shift: TShiftState
+ ): Boolean;
+begin
+ Result:=inherited CanGridAcceptKey(Key, Shift);
+ if Key = 16 then Result := False;
+end;
+function TExtStringgrid.SelectCell(aCol, aRow: Integer): boolean;
+begin
+ if (aRow <> Row) or (aCol <> Col) then
+ FMouseDowns:=0;
+ Result:=inherited SelectCell(aCol, aRow);
+end;
+procedure TExtStringgrid.EditordoSetValue;
+begin
+ inherited EditordoSetValue;
+ SetEditText(Col,Row,GetEditText(Col,Row));
+end;
+
+procedure TExtStringgrid.EditorShow(const SelAll: boolean);
+begin
+ if Assigned(FBeforeEnterEdit) then FBeforeEnterEdit(Self);
+ inherited EditorShow(SelAll);
+ if Assigned(FEnterEdit) then FEnterEdit(Self);
+end;
+
+procedure TExtStringgrid.DblClick;
+begin
+ if Assigned(FDownTimer) then
+ FDownTimer.Enabled:=False;
+ inherited DblClick;
+end;
+constructor TExtStringgrid.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FCachedEditing := True;
+ FDownTimer := nil;
+ FExtPickListEditor := TExtComboBox.Create(Self);
+ FExtPickListEditor.Visible:=False;
+ FUseExtPicklist := True;
+end;
+destructor TExtStringgrid.Destroy;
+begin
+ FreeAndNil(FDownTimer);
+ inherited Destroy;
+end;
+procedure TExtDBEdit.Paint;
+begin
+ with FCanvas do
+ begin
+ Brush.Color := clRed;
+ Polygon([Classes.Point(Width-4,0),Classes.Point(Width,0),Classes.Point(Width,4)]);
+ end;
+end;
+procedure TExtDBEdit.PaintWindow(DC: HDC);
+begin
+ FCanvas.Lock;
+ try
+ FCanvas.Handle := DC;
+ try
+// TControlCanvas(FCanvas).UpdateTextFlags;
+ Paint;
+ finally
+ FCanvas.Handle := 0;
+ end;
+ finally
+ FCanvas.Unlock;
+ end;
+end;
+constructor TExtDBEdit.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FCanvas := TControlCanvas.Create;
+ TControlCanvas(FCanvas).Control := Self;
+end;
+destructor TExtDBEdit.Destroy;
+begin
+ inherited;
+ FCanvas.Free;
+end;
+end.
+
diff --git a/Software/src/general/src_vis/uinfo.lfm b/Software/src/general/src_vis/uinfo.lfm
new file mode 100755
index 0000000..21db7aa
--- /dev/null
+++ b/Software/src/general/src_vis/uinfo.lfm
@@ -0,0 +1,257 @@
+object fInfo: TfInfo
+ Left = 404
+ Height = 264
+ Top = 229
+ Width = 525
+ ActiveControl = PageControl1
+ Caption = 'Info'
+ ClientHeight = 264
+ ClientWidth = 525
+ OnCreate = FormCreate
+ Position = poScreenCenter
+ LCLVersion = '1.1'
+ object lName: TLabel
+ Left = 0
+ Height = 29
+ Top = 0
+ Width = 525
+ Align = alTop
+ Caption = 'programname'
+ Font.Height = -25
+ Font.Style = [fsBold]
+ ParentColor = False
+ ParentFont = False
+ end
+ object lCopyright: TLabel
+ Left = 4
+ Height = 17
+ Top = 243
+ Width = 192
+ Anchors = [akLeft, akBottom]
+ Caption = 'Copyright 2004-2012 C.Ulrich'
+ ParentColor = False
+ end
+ object lTimeout: TLabel
+ Left = 4
+ Height = 17
+ Top = 227
+ Width = 89
+ Anchors = [akLeft, akBottom]
+ Caption = 'Ablaufdatum'
+ ParentColor = False
+ end
+ object lVersion: TLabel
+ Left = 0
+ Height = 23
+ Top = 29
+ Width = 525
+ Align = alTop
+ Caption = 'V1.1 Build 10'
+ Font.Height = -20
+ ParentColor = False
+ ParentFont = False
+ end
+ object PageControl1: TPageControl
+ Left = 8
+ Height = 160
+ Top = 64
+ Width = 509
+ ActivePage = tsLicense
+ Anchors = [akTop, akLeft, akRight, akBottom]
+ TabIndex = 0
+ TabOrder = 0
+ object tsLicense: TTabSheet
+ Caption = 'tsLicense'
+ ClientHeight = 129
+ ClientWidth = 505
+ object mInfo: TMemo
+ Left = 0
+ Height = 129
+ Top = 0
+ Width = 505
+ Align = alClient
+ ScrollBars = ssAutoBoth
+ TabOrder = 0
+ WordWrap = False
+ end
+ end
+ object tsChanges: TTabSheet
+ Caption = 'tsChanges'
+ ClientHeight = 129
+ ClientWidth = 505
+ object mChanges: TMemo
+ Left = 0
+ Height = 132
+ Top = 0
+ Width = 468
+ Align = alClient
+ ScrollBars = ssAutoBoth
+ TabOrder = 0
+ WordWrap = False
+ end
+ end
+ object tsSystem: TTabSheet
+ Caption = 'tsSystem'
+ ClientHeight = 129
+ ClientWidth = 505
+ object lOperatingSystem: TLabel
+ Left = 4
+ Height = 17
+ Top = 26
+ Width = 121
+ Caption = 'lOperatingSystem'
+ ParentColor = False
+ end
+ object lOperatingSystemValue: TLabel
+ Left = 156
+ Height = 17
+ Top = 26
+ Width = 159
+ Caption = 'lOperatingSystemValue'
+ ParentColor = False
+ end
+ object lCPU: TLabel
+ Left = 4
+ Height = 17
+ Top = 42
+ Width = 32
+ Caption = 'lCPU'
+ ParentColor = False
+ end
+ object lCPUValue: TLabel
+ Left = 156
+ Height = 17
+ Top = 42
+ Width = 70
+ Caption = 'lCPUValue'
+ ParentColor = False
+ end
+ object lMemory: TLabel
+ Left = 4
+ Height = 17
+ Top = 58
+ Width = 60
+ Caption = 'lMemory'
+ ParentColor = False
+ end
+ object lMemoryValue: TLabel
+ Left = 156
+ Height = 17
+ Top = 58
+ Width = 98
+ Caption = 'lMemoryValue'
+ ParentColor = False
+ end
+ object lLanguage: TLabel
+ Left = 4
+ Height = 17
+ Top = 90
+ Width = 68
+ Caption = 'lLanguage'
+ ParentColor = False
+ end
+ object lLanguageValue: TLabel
+ Left = 156
+ Height = 17
+ Top = 90
+ Width = 106
+ Caption = 'lLanguageValue'
+ ParentColor = False
+ end
+ object lHarddisk: TLabel
+ Left = 4
+ Height = 17
+ Top = 74
+ Width = 65
+ Caption = 'lHarddisk'
+ ParentColor = False
+ end
+ object lHarddiskValue: TLabel
+ Left = 156
+ Height = 1
+ Top = 74
+ Width = 1
+ ParentColor = False
+ end
+ object lValue: TLabel
+ Left = 156
+ Height = 17
+ Top = 2
+ Width = 42
+ Caption = 'lValue'
+ ParentColor = False
+ end
+ object lRating: TLabel
+ Left = 339
+ Height = 16
+ Top = 2
+ Width = 1203
+ Anchors = [akTop, akRight]
+ AutoSize = False
+ Caption = 'lRating'
+ ParentColor = False
+ end
+ object lCPURating: TLabel
+ Left = 339
+ Height = 16
+ Top = 42
+ Width = 1203
+ Anchors = [akTop, akRight]
+ AutoSize = False
+ Caption = 'lCPURating'
+ ParentColor = False
+ end
+ object lMemoryRating: TLabel
+ Left = 339
+ Height = 16
+ Top = 58
+ Width = 1203
+ Anchors = [akTop, akRight]
+ AutoSize = False
+ Caption = 'lMemoryRating'
+ ParentColor = False
+ end
+ object lHarddiskrating: TLabel
+ Left = 339
+ Height = 16
+ Top = 74
+ Width = 1203
+ Anchors = [akTop, akRight]
+ AutoSize = False
+ Caption = 'lHarddiskrating'
+ ParentColor = False
+ end
+ object Bevel1: TBevel
+ Left = 3
+ Height = 10
+ Top = 21
+ Width = 497
+ Anchors = [akTop, akLeft, akRight]
+ Shape = bsTopLine
+ end
+ object bBenchmark: TButton
+ Left = 339
+ Height = 26
+ Top = 100
+ Width = 122
+ Anchors = [akRight, akBottom]
+ BorderSpacing.InnerBorder = 4
+ Caption = 'bBenchmark'
+ OnClick = bBenchmarkClick
+ TabOrder = 0
+ end
+ end
+ end
+ object bClose: TBitBtn
+ Left = 409
+ Height = 30
+ Top = 230
+ Width = 108
+ Anchors = [akRight, akBottom]
+ BorderSpacing.InnerBorder = 4
+ Caption = '&Schließen'
+ Kind = bkClose
+ OnClick = bCloseClick
+ TabOrder = 1
+ end
+end
\ No newline at end of file
diff --git a/Software/src/general/src_vis/uinfo.lrs b/Software/src/general/src_vis/uinfo.lrs
new file mode 100755
index 0000000..3636c8b
--- /dev/null
+++ b/Software/src/general/src_vis/uinfo.lrs
@@ -0,0 +1,67 @@
+{ This is an automatically generated lazarus resource file }
+
+LazarusResources.Add('TfInfo','FORMDATA',[
+ 'TPF0'#6'TfInfo'#5'fInfo'#4'Left'#3#148#1#6'Height'#3#8#1#3'Top'#3#229#0#5'Wi'
+ +'dth'#3#13#2#13'ActiveControl'#7#12'PageControl1'#7'Caption'#6#4'Info'#12'Cl'
+ +'ientHeight'#3#8#1#11'ClientWidth'#3#13#2#8'OnCreate'#7#10'FormCreate'#8'Pos'
+ +'ition'#7#14'poScreenCenter'#10'LCLVersion'#6#3'1.1'#0#6'TLabel'#5'lName'#4
+ +'Left'#2#0#6'Height'#2#29#3'Top'#2#0#5'Width'#3#13#2#5'Align'#7#5'alTop'#7'C'
+ +'aption'#6#11'programname'#11'Font.Height'#2#231#10'Font.Style'#11#6'fsBold'
+ +#0#11'ParentColor'#8#10'ParentFont'#8#0#0#6'TLabel'#10'lCopyright'#4'Left'#2
+ +#4#6'Height'#2#17#3'Top'#3#243#0#5'Width'#3#192#0#7'Anchors'#11#6'akLeft'#8
+ +'akBottom'#0#7'Caption'#6#28'Copyright 2004-2012 C.Ulrich'#11'ParentColor'#8
+ +#0#0#6'TLabel'#8'lTimeout'#4'Left'#2#4#6'Height'#2#17#3'Top'#3#227#0#5'Width'
+ +#2'Y'#7'Anchors'#11#6'akLeft'#8'akBottom'#0#7'Caption'#6#11'Ablaufdatum'#11
+ +'ParentColor'#8#0#0#6'TLabel'#8'lVersion'#4'Left'#2#0#6'Height'#2#23#3'Top'#2
+ +#29#5'Width'#3#13#2#5'Align'#7#5'alTop'#7'Caption'#6#13'V1.1 Build 10'#11'Fo'
+ +'nt.Height'#2#236#11'ParentColor'#8#10'ParentFont'#8#0#0#12'TPageControl'#12
+ +'PageControl1'#4'Left'#2#8#6'Height'#3#160#0#3'Top'#2'@'#5'Width'#3#253#1#10
+ +'ActivePage'#7#9'tsLicense'#7'Anchors'#11#5'akTop'#6'akLeft'#7'akRight'#8'ak'
+ +'Bottom'#0#8'TabIndex'#2#0#8'TabOrder'#2#0#0#9'TTabSheet'#9'tsLicense'#7'Cap'
+ +'tion'#6#9'tsLicense'#12'ClientHeight'#3#129#0#11'ClientWidth'#3#249#1#0#5'T'
+ +'Memo'#5'mInfo'#4'Left'#2#0#6'Height'#3#129#0#3'Top'#2#0#5'Width'#3#249#1#5
+ +'Align'#7#8'alClient'#10'ScrollBars'#7#10'ssAutoBoth'#8'TabOrder'#2#0#8'Word'
+ +'Wrap'#8#0#0#0#9'TTabSheet'#9'tsChanges'#7'Caption'#6#9'tsChanges'#12'Client'
+ +'Height'#3#129#0#11'ClientWidth'#3#249#1#0#5'TMemo'#8'mChanges'#4'Left'#2#0#6
+ +'Height'#3#132#0#3'Top'#2#0#5'Width'#3#212#1#5'Align'#7#8'alClient'#10'Scrol'
+ +'lBars'#7#10'ssAutoBoth'#8'TabOrder'#2#0#8'WordWrap'#8#0#0#0#9'TTabSheet'#8
+ +'tsSystem'#7'Caption'#6#8'tsSystem'#12'ClientHeight'#3#129#0#11'ClientWidth'
+ +#3#249#1#0#6'TLabel'#16'lOperatingSystem'#4'Left'#2#4#6'Height'#2#17#3'Top'#2
+ +#26#5'Width'#2'y'#7'Caption'#6#16'lOperatingSystem'#11'ParentColor'#8#0#0#6
+ +'TLabel'#21'lOperatingSystemValue'#4'Left'#3#156#0#6'Height'#2#17#3'Top'#2#26
+ +#5'Width'#3#159#0#7'Caption'#6#21'lOperatingSystemValue'#11'ParentColor'#8#0
+ +#0#6'TLabel'#4'lCPU'#4'Left'#2#4#6'Height'#2#17#3'Top'#2'*'#5'Width'#2' '#7
+ +'Caption'#6#4'lCPU'#11'ParentColor'#8#0#0#6'TLabel'#9'lCPUValue'#4'Left'#3
+ +#156#0#6'Height'#2#17#3'Top'#2'*'#5'Width'#2'F'#7'Caption'#6#9'lCPUValue'#11
+ +'ParentColor'#8#0#0#6'TLabel'#7'lMemory'#4'Left'#2#4#6'Height'#2#17#3'Top'#2
+ +':'#5'Width'#2'<'#7'Caption'#6#7'lMemory'#11'ParentColor'#8#0#0#6'TLabel'#12
+ +'lMemoryValue'#4'Left'#3#156#0#6'Height'#2#17#3'Top'#2':'#5'Width'#2'b'#7'Ca'
+ +'ption'#6#12'lMemoryValue'#11'ParentColor'#8#0#0#6'TLabel'#9'lLanguage'#4'Le'
+ +'ft'#2#4#6'Height'#2#17#3'Top'#2'Z'#5'Width'#2'D'#7'Caption'#6#9'lLanguage'
+ +#11'ParentColor'#8#0#0#6'TLabel'#14'lLanguageValue'#4'Left'#3#156#0#6'Height'
+ +#2#17#3'Top'#2'Z'#5'Width'#2'j'#7'Caption'#6#14'lLanguageValue'#11'ParentCol'
+ +'or'#8#0#0#6'TLabel'#9'lHarddisk'#4'Left'#2#4#6'Height'#2#17#3'Top'#2'J'#5'W'
+ +'idth'#2'A'#7'Caption'#6#9'lHarddisk'#11'ParentColor'#8#0#0#6'TLabel'#14'lHa'
+ +'rddiskValue'#4'Left'#3#156#0#6'Height'#2#1#3'Top'#2'J'#5'Width'#2#1#11'Pare'
+ +'ntColor'#8#0#0#6'TLabel'#6'lValue'#4'Left'#3#156#0#6'Height'#2#17#3'Top'#2#2
+ +#5'Width'#2'*'#7'Caption'#6#6'lValue'#11'ParentColor'#8#0#0#6'TLabel'#7'lRat'
+ +'ing'#4'Left'#3'S'#1#6'Height'#2#16#3'Top'#2#2#5'Width'#3#179#4#7'Anchors'#11
+ +#5'akTop'#7'akRight'#0#8'AutoSize'#8#7'Caption'#6#7'lRating'#11'ParentColor'
+ +#8#0#0#6'TLabel'#10'lCPURating'#4'Left'#3'S'#1#6'Height'#2#16#3'Top'#2'*'#5
+ +'Width'#3#179#4#7'Anchors'#11#5'akTop'#7'akRight'#0#8'AutoSize'#8#7'Caption'
+ +#6#10'lCPURating'#11'ParentColor'#8#0#0#6'TLabel'#13'lMemoryRating'#4'Left'#3
+ +'S'#1#6'Height'#2#16#3'Top'#2':'#5'Width'#3#179#4#7'Anchors'#11#5'akTop'#7'a'
+ +'kRight'#0#8'AutoSize'#8#7'Caption'#6#13'lMemoryRating'#11'ParentColor'#8#0#0
+ +#6'TLabel'#15'lHarddiskrating'#4'Left'#3'S'#1#6'Height'#2#16#3'Top'#2'J'#5'W'
+ +'idth'#3#179#4#7'Anchors'#11#5'akTop'#7'akRight'#0#8'AutoSize'#8#7'Caption'#6
+ +#15'lHarddiskrating'#11'ParentColor'#8#0#0#6'TBevel'#6'Bevel1'#4'Left'#2#3#6
+ +'Height'#2#10#3'Top'#2#21#5'Width'#3#241#1#7'Anchors'#11#5'akTop'#6'akLeft'#7
+ +'akRight'#0#5'Shape'#7#9'bsTopLine'#0#0#7'TButton'#10'bBenchmark'#4'Left'#3
+ +'S'#1#6'Height'#2#26#3'Top'#2'd'#5'Width'#2'z'#7'Anchors'#11#7'akRight'#8'ak'
+ +'Bottom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#10'bBenchmark'#7'O'
+ +'nClick'#7#15'bBenchmarkClick'#8'TabOrder'#2#0#0#0#0#0#7'TBitBtn'#6'bClose'#4
+ +'Left'#3#153#1#6'Height'#2#30#3'Top'#3#230#0#5'Width'#2'l'#7'Anchors'#11#7'a'
+ +'kRight'#8'akBottom'#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#11'&Sc'
+ +'hlie'#195#159'en'#4'Kind'#7#7'bkClose'#7'OnClick'#7#11'bCloseClick'#8'TabOr'
+ +'der'#2#1#0#0#0
+]);
\ No newline at end of file
diff --git a/Software/src/general/src_vis/uinfo.pas b/Software/src/general/src_vis/uinfo.pas
new file mode 100755
index 0000000..22dd53e
--- /dev/null
+++ b/Software/src/general/src_vis/uinfo.pas
@@ -0,0 +1,161 @@
+unit uInfo;
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,uGeneralStrConsts,
+ ComCtrls,Utils,ubenchmark,ExtCtrls;
+
+type
+ { TfInfo }
+ TfInfo = class(TForm)
+ bClose: TBitBtn;
+ Bevel1: TBevel;
+ bBenchmark: TButton;
+ lHarddiskrating: TLabel;
+ lMemoryRating: TLabel;
+ lCPURating: TLabel;
+ lRating: TLabel;
+ lValue: TLabel;
+ lHarddiskValue: TLabel;
+ lHarddisk: TLabel;
+ lLanguageValue: TLabel;
+ lLanguage: TLabel;
+ lMemoryValue: TLabel;
+ lMemory: TLabel;
+ lCPUValue: TLabel;
+ lCPU: TLabel;
+ lOperatingSystemValue: TLabel;
+ lOperatingSystem: TLabel;
+ lVersion: tlabel;
+ lTimeout: TLabel;
+ lName: TLabel;
+ lCopyright: TLabel;
+ mChanges: TMemo;
+ mInfo: TMemo;
+ PageControl1: TPageControl;
+ tsSystem: TTabSheet;
+ tsChanges: TTabSheet;
+ tsLicense: TTabSheet;
+ procedure bBenchmarkClick(Sender: TObject);
+ procedure bCloseClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ private
+ { private declarations }
+ public
+ { public declarations }
+ Version : real;
+ Revision : Integer;
+ Timeout : TDate;
+ ProgramName : string;
+ Copyright,
+ InfoText : string;
+ procedure SetLanguage;
+ function Execute : Boolean;
+ end;
+
+var
+ fInfo: TfInfo;
+
+implementation
+
+uses LCLIntf;
+
+{ TfInfo }
+
+procedure TfInfo.bCloseClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TfInfo.bBenchmarkClick(Sender: TObject);
+var
+ mTransferRate: Extended;
+ fReadTime: Extended = 0;
+ fWriteTime: Extended = 0;
+ WKIPS: Extended;
+ DryTime: Int64;
+begin
+ bBenchmark.Enabled := False;
+ mTransferRate := GetMemoryTransferRate(100000);
+ lMemoryRating.Caption := FormatFloat('0.0',getMemoryRating(mTransferRate))+' ('+FormatFloat('0.0',mTransferRate)+'Mb/s)';
+ Application.Processmessages;
+ GetHardDiskTransferRates(50,fReadTime,fWriteTime);
+ lHarddiskRating.Caption := FormatFloat('0.0',GetHardDiskRating(fReadTime,fWriteTime))+' ('+FormatFloat('0.0',fReadTime)+' Mb/s,'+FormatFloat('0.0',fWriteTime)+' Mb/s)';
+ Application.Processmessages;
+ WKIPS := GetWhetstone(10);
+ DryTime := GetDryStone(10*20);
+ if WKIPS > 10000 then
+ lCPURating.Caption := FormatFloat('0.0',GetProcessorRating(WKIPS,(DryTime/(200))))+' ('+FormatFloat('0.0',WKIPS/10)+' WMIPS,'+IntToStr(DryTime)+'ms)'
+ else
+ lCPURating.Caption := FormatFloat('0.0',GetprocessorRating(WKIPS,(DryTime/(200))))+' ('+FormatFloat('0.0',WKIPS)+' WKIPS,'+IntToStr(DryTime)+'ms)';
+ bBenchmark.Enabled := True;
+end;
+
+procedure TfInfo.FormCreate(Sender: TObject);
+var
+ r: Extended;
+begin
+ if FileExists(ExtractFilePath(Application.Exename)+'changes.txt') then
+ mChanges.Lines.LoadFromFile(ExtractFilePath(Application.Exename)+'changes.txt');
+ lMemoryValue.Caption := SizeToText(GetMemorySize);
+ lOperatingSystemValue.Caption := getOSVersion;
+ r := CalcCPUSpeed;
+ if r > -1 then
+ lCPUValue.Caption := FormatFloat('0.0',r)+' Mhz'
+ else if r = -1 then
+ lCPUValue.Caption := strNoX86CPU
+ else
+ lCPUValue.Caption := strNottested;
+ lCPURating.Caption := FormatFloat('0.0',r*0.001);
+ lLanguageValue.Caption := GetSystemLang;
+ lMemoryRating.Caption := strNotTested;
+ lHarddiskRating.Caption := strNotTested;
+ lCPURating.Caption := strNotTested;
+end;
+
+procedure TfInfo.SetLanguage;
+begin
+ if not Assigned(Self) then
+ begin
+ Application.CreateForm(TfInfo,fInfo);
+ Self := fInfo;
+ end;
+ lVersion.Caption := StringReplace(Format('Version %f Build %d',[Version,Revision]),',','.',[rfReplaceAll]);
+ lName.Caption := ProgramName;
+ tsLicense.caption := strLicense;
+ tsChanges.Caption := strChanges;
+ if Timeout <> 0 then
+ lTimeout.Caption := strTimedOut+DateToStr(Timeout)
+ else
+ lTimeOut.Caption := '';
+ lCopyright.Caption := Copyright;
+ mInfo.Lines.Text := InfoText;
+ lValue.Caption := strValue;
+ lOperatingSystem.Caption := strOperatingSystem;
+ lCPU.Caption := strCPU;
+ lHarddisk.Caption := strHarddisk;
+ lMemory.Caption := strMemory;
+ lRating.Caption := strRating;
+ bBenchmark.Caption := strBenchmark;
+ tsSystem.Caption := strSystem;
+ lLanguage.Caption := strLanguage;
+end;
+
+function TfInfo.Execute: Boolean;
+begin
+ if not Assigned(Self) then
+ begin
+ Application.CreateForm(TfInfo,fInfo);
+ Self := fInfo;
+ end;
+ SetLanguage;
+ Result := Showmodal = mrOK;
+end;
+
+initialization
+ {$I uinfo.lrs}
+
+end.
+
\ No newline at end of file
diff --git a/Software/src/ubootloader.pas b/Software/src/ubootloader.pas
index 27eb363..82e4f36 100644
--- a/Software/src/ubootloader.pas
+++ b/Software/src/ubootloader.pas
@@ -61,7 +61,7 @@ TfBootloader = class(TForm)
implementation
-uses uMain,uIntfStrConsts,Utils,uToolHelp,uLibUsbDevice,htmlconvert,uInfo;
+uses uMain,uIntfStrConsts,Utils,uToolHelp,uLibUsbDevice,uInfo;
{ TfBootloader }
@@ -236,7 +236,7 @@ procedure TfBootloader.lbProgramsSelectionChange(Sender: TObject; User: boolean
begin
sl := TStringList.Create;
sl.LoadFromFile(fToolHelp.Filename);
- sl.Text:=HTMLtoTXT(sl.text);
+ sl.Text := StripHTML(sl.text);
while (sl.Count > 0) and (uppercase(trim(sl[0])) <> 'BETRIEBSYSTEME') do
sl.Delete(0);
if (sl.Count > 0) and (uppercase(trim(sl[0])) = 'BETRIEBSYSTEME') then
diff --git a/Software/src/umain.pas b/Software/src/umain.pas
index 3df5df1..3d6d8c1 100644
--- a/Software/src/umain.pas
+++ b/Software/src/umain.pas
@@ -79,7 +79,7 @@ TfMain = class(TForm)
implementation
uses uBootloader,uBitbanging,uUSBasp,uI2CLogger,uToolHelp
- ,uInfo,uLibUSBDevice,uUSBSerialDevice,htmlconvert;
+ ,uInfo,uLibUSBDevice,uUSBSerialDevice;
{ TfMain }
@@ -445,4 +445,4 @@ initialization
{$I umain.lrs}
end.
-
\ No newline at end of file
+