;;; ===================================================================================================
;;;					Funktionen für MySQL-Datenbank				       
;;; ===================================================================================================









; *****************************************************************************************************
; Funktion:	conv_atol
; Zweck:	Wandelt eine Zeichenkette in eine Liste
; Autor:	Fred Tomke
; Datum:	31.05.2010
; Argumente:	strText = Zu splittender Text
;		strDel = Trennzeichen als Text
; Rückgabewert:	Liste von Texten
; Änderungen:	keine


(defun conv_atol (strText strDel / lstErg intPos intLen)
  (if strText
    (progn
      (setq intPos (vl-string-search strDel strText)
	    intLen (1+ (strlen strDel)))
      (while intPos
	(setq lstErg (cons (substr strText 1 pos) lstErg)
	      strText (substr strText (+ intPos intLen))
	      intPos (vl-string-search strDel strText))
      ); while
      (if (> (strlen strText) 0)
	(setq lstErg (cons strText lstErg))
      ); if
    ); progn
  ); if
  (reverse lstErg)
); conv_atol









; *****************************************************************************************************
; Funktion:	odbc_is64bit
; Zweck:	Prüft, ob das System ein 64-Bit-System ist
; Autor:	Fred Tomke
; Datum:	12.03.2012
; Argumente:	keine
; Rückgabewert:	T, wenn es ein 64-Bit-System ist
; Änderungen:	keine


(defun odbc_is64bit (/ bErg) (not (= (getenv "PROCESSOR_ARCHITECTURE") "x86")))










; *****************************************************************************************************
; Funktion:	odbc_init
; Zweck:	Initialisiert ADO
; Autor:	Fred Tomke
; Datum:	31.05.2010
; Argumente:	keine
; Rückgabewert:	T, wenn installiert und geladen
; Änderungen:	keine


(defun odbc_init (/ bErg)
  (if (null adom-Append)
    (progn
      (if (and (setq strClsId (vl-registry-read "HKEY_CLASSES_ROOT\\ADODB.Parameter\\CLSID"))
	       (setq strServer (vl-registry-read (strcat "HKEY_CLASSES_ROOT\\CLSID\\" strClsId "\\InprocServer32")))
	       (cond
		 ((not (listp strServer)) strServer)
		 ((odbc_is64bit) (setq strServer (strcat (getenv "CommonProgramFiles(x86)") (last (conv_atol (cdr strServer) "%")))))
		 ((cdr strServer) (setq strServer (strcat (getenv "CommonProgramFiles") (last (conv_atol (cdr strServer) "%")))))
	       ); cond
	       (findfile strServer))
	(setq bErg (vlax-Import-Type-Library
		     :tlb-filename strServer
		     :methods-prefix    "adom-"
		     :properties-prefix "adop-"
		     :constants-prefix  "adok-"))
	(alert "ADO ist nicht initialisiert. Bitte installieren Sie die Datenbanktreiber von der Microsoft Homepage!")
      ); if
    ); progn
    (setq bErg T)
  ); if
  bErg
); odbc_init









; *****************************************************************************************************
; Funktion:	mysql_open
; Zweck:	Öffnet Verbindung zu MySQL-Datenbank
; Autor:	Fred Tomke
; Datum:	31.05.2010
; Argumente:	keine
; Rückgabewert:	Connection-Objekt als VLA-Objekt
; Änderungen:	08.09.2010 - FT - Überprüfung des Internetzugangs


(defun mysql_open (/ strConnection strServer strUser strPass strDb)
  (if (odbc_is64bit)
    (progn
      (setq oConnection (vlax-get-or-create-object "ADODB.Connection"))
      (setq strServer "gisserver")
      (setq strUser "admin")
      (setq strPass "root")
      (setq strDb "mysqldb")

      (vlax-put-property oConnection 'CursorLocation adok-adUseClient)
      (setq strConnection (strcat "DRIVER={MySQL ODBC 5.1 Driver};Server=" strServer ";DATABASE=" strDb ";UID=" strUser ";PWD=" strPass ";OPTION=" (itoa (+ 1 2 8 32 2048 163841)) ";"))

      (vlax-put-property oConnection "ConnectionString" strConnection)
      (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke-method (list oConnection 'Open strConnection strUser strPass adok-adConnectUnspecified)))
	(progn
	  (vlax-release-object oConnection)
	  (setq oConnection nil)
	); progn
      ); if
    ); progn
  ); if
  oConnection
); mysql_open










; *****************************************************************************************************
; Funktion:	mysql_test
; Zweck:	Testet die Verbindung zur MySQL-Datenbank
; Autor:	Fred Tomke
; Datum:	08.09.2010
; Argumente:	keine
; Rückgabewert:	T, wenn Internetverbindung besteht
; Änderungen:	keine


(defun mysql_test (/ oConn bErg)
  (if (setq oConn (mysql_open))
    (progn
      (vlax-invoke-method oConn 'Close)
      (vlax-release-object oConn)
      (setq bErg T)
    ); progn
    (setq bErg nil)
  ); if
  bErg
); mysql_test










; *****************************************************************************************************
; Funktion:	mysql_query
; Zweck:	Sendet eine SQL-Abfrage an die MySQL-Datenbank
; Autor:	Fred Tomke
; Datum:	31.05.2010
; Argumente:	strSQL = SQL-String als Zeichenkette (keine Vorab-Validierung!)
; Rückgabewert:	Ergebnis der Abfrage als Boole oder Liste von Datensätzen
; Änderungen:	keine


(defun mysql_query (strSQL / oConn oRS uErg oFields oField strField lstFields create_lists create_list convert_value intCnt)
  (princ "\r\nOnline-Datenbank öffnen...")
  (setq oConn (mysql_open))
  (setq oRS (vlax-get-or-create-object "ADODB.Recordset"))
  (vlax-Put-Property oRS 'CursorType 1)
  (vlax-put-property oRS 'LockType 3)
  (princ (strcat "\r\nAbfrage ausführen (" strSQL ")"))
  (vlax-invoke-method oRS 'Open strSQL oConn nil nil 1)

  (if (not (setq uErg (zerop (vlax-get-property oRs 'State))))
    (progn
      
      ;; abgefragte Datenfelder auslesen
      
      (setq oFields (vlax-get-property oRS 'Fields))
      (repeat (setq intFields (vlax-get-property oFields 'Count))
	(setq oField (vlax-get-property oFields 'Item (setq intFields (1- intFields))))
	(setq strField (vlax-get-property oField 'Name))
	(setq lstFields (cons strField lstFields))
	(vlax-release-object oField)
      ); repeat
      (vlax-release-object oFields)

      ;; Datenwerte auslesen

      (defun create_lists (lstValues) (mapcar 'create_list lstFields lstValues))
      (defun create_list (strField uValue) (cons strField (convert_value uValue)))
      (defun convert_value (uValue)
	(if (= (vlax-variant-type uValue) 14)
	  (vlax-variant-value (vlax-variant-change-type uValue vlax-vbLong))
	  (vlax-variant-value uValue)
	); if
      ); convert_value

      (setq intCnt (vlax-Get-Property oRS "RecordCount"))
      (if (= (type intCnt) 'Variant) (setq intCnt (vlax-variant-value intCnt)))
      
      (if (and lstFields (> intCnt 0))
	(setq uErg (apply 'mapcar (cons 'list (vlax-safearray->list (vlax-variant-value (vlax-invoke-method oRS "GetRows" -1)))))
	      uErg (mapcar 'create_lists uErg))
      ); if
      (vlax-invoke-method oRs 'Close)
    ); progn
  ); if
  (vlax-release-object oRs)
  (vlax-invoke-method oConn 'Close)
  (vlax-release-object oConn)
  (princ "\r\nOnline-Datenbank geschlossen...")
  uErg
); mysql_query