Inoffizielles deutsches Xbase-Forum

Code: Alles auswählen

FUNCTION HX_VERSION(cVersion)
LOCAL cOldVersion
//
// STATIC hold Version Number
//
STATIC scVersion

   IF Empty(scVersion)
      scVersion := GetEnv('CODEJOCK_VERSION')
      IF Empty(scVersion)
         scVersion := SearchOCX()
         IF Empty(scVersion)
            Msgbox("Envioment SET 'CODEJOCK_VERSION'= xx.x.x not set")
            QUIT
         ENDIF
      ENDIF
   ENDIF

   cOldVersion := scVersion

   IF PCount() > 0
      scVersion := cVersion
   ENDIF

RETURN '.' + cOldVersion


FUNCTION SearchOCX()
LOCAL lDemo    := .F.
LOCAL lRelease := .F.
LOCAL aCJKeys
LOCAL aSubkeys
LOCAL oReg     := ""
LOCAL nPosi    := 0
LOCAL nLen     := 0
LOCAL cRet     := ""
LOCAL i, iMax,j
LOCAL aDir
LOCAL uVal
LOCAL aCJVer   := {"Codejock.Calendar.Unicode.v",;
                   "Codejock.Calendar.v",;
                   "Codejock.CommandBars.Unicode.v",;
                   "Codejock.CommandBars.v",;
                   "Codejock.Controls.Unicode.v",;
                   "Codejock.Controls.v",;
                   "Codejock.DockingPane.Unicode.v",;
                   "Codejock.DockingPane.v",;
                   "Codejock.Markup.Unicode.v",;
                   "Codejock.Markup.v",;
                   "Codejock.PropertyGrid.Unicode.v",;
                   "Codejock.PropertyGrid.v",;
                   "Codejock.ReportControl.Unicode.v",;
                   "Codejock.ReportControl.v",;
                   "Codejock.ShortcutBar.Unicode.v",;
                   "Codejock.ShortcutBar.v",;
                   "Codejock.SkinFramework.Unicode.v",;
                   "Codejock.SkinFramework.v",;
                   "Codejock.SyntaxEdit.Unicode.v",;
                   "Codejock.SyntaxEdit.v",;
                   "Codejock.TaskPanel.Unicode.v",;
                   "Codejock.TaskPanel.v"}

   oReg     := XbpReg():NEW("HKEY_CURRENT_USER\Software\Codejock Software")
   IF oReg:Status()
   ELSE
      MSGBOX("no Codejock Software installed ?")
      RETURN cRet
   ENDIF

   aCJKeys  := oReg:KeyList()
   iMax     := LEN(aCJKeys)
   i        := 1
   FOR i := 1 TO iMax
      oReg := XbpReg():NEW("HKEY_CURRENT_USER\Software\Codejock Software\"+aCJKeys[i])
      IF oReg:Status()

         IF "30 Day Trial" $ aCJKeys[i]
            lDemo := .T.
         ENDIF
         aSubkeys := oReg:ValueList(.T.)

         nLen     := LEN(aSubkeys)
         j := 1
         FOR j := 1 TO nLen
            IF "Installation Directory" $ aSubkeys[j][1]
               uVal := aSubkeys[j][2]
               aDir := Directory(uVal+"\Bin\*.ocx")
               IF LEN(aDir) > 0
                  IF "30 Day Trial" $ uVal
                     lDemo := .T.
                  ELSE
                     lDemo := .F.
                     lRelease := .T.
                  ENDIF

                  nPosi    := AT(" v",uVal)
                  IF nPosi > 0
                     cRet  := ALLTRIM(SUBSTR(uVal,nPosi+2,LEN(uVal)-nPosi+2))
                  ENDIF
               ENDIF
            ENDIF
         NEXT
      ENDIF
   NEXT

   IF !EMPTY(cRet)
      IF "30 Day Trial" $ cRet
         cRet := StrTran( cRet,"30 Day Trial","")
      ENDIF
      Msgbox("your Envioment is not SET corecct,please use"+CRLF+;
             "SET 'CODEJOCK_VERSION'="+cRet,"SET 'CODEJOCK_VERSION'")
   ENDIF

RETURN cRet

Code: Alles auswählen

#include "dll.ch"

#define WAIT_ABANDONED            0x80
#define WAIT_FAILED               0xFFFFFFFF
#define WAIT_OBJECT_0             0x0
#define WAIT_TIMEOUT              0x102
#define INFINITE                  0xFFFF

DLLFUNCTION LoadLibraryA(cFileName) USING STDCALL from kernel32.dll
DLLFUNCTION FreeLibrary(hModule) USING STDCALL from kernel32.dll
DLLFUNCTION GetProcAddress(hModule, ProcedureName) USING STDCALL from kernel32.dll
DLLFUNCTION CreateThread(ThreadAttributes, nStackSize, nStartAddress, nParameter, nCreationFlags, nThreadID) USING STDCALL from kernel32.dll
DLLFUNCTION GetExitCodeThread(hThread, @nExitCode) USING STDCALL from kernel32.dll
DLLFUNCTION WaitForSingleObject(hObject, nTimeOut) USING STDCALL from kernel32.dll
DLLFUNCTION CloseHandle(hObject) USING STDCALL from kernel32.dll


function RegisterServer(cPathToFile, lRegister, nTimeOut)
* Registriert oder deregistriert eine ActiveX-DLL oder ein OCX
* --------------------------------------------------------------------------------
* Parameterinformation:
* --------------------------------------------------------------------------------
*
* - PathToFile:   Vollst„ndiger Pfad zur Datei, die den COM-Server enth„lt.
*
* - Register:     TRUE, um den COM-Server zu registrieren.
*   (optional)    FALSE, um den COM-Server zu deregistrieren.
*                 Standardwert: TRUE (Registrierung des COM-Servers)
*
* - TimeOut:      Zeit in Millisekunden, die maximal auf den Vorgang
*   (optional)    verwendet werden soll. Im Regelfall gibt die Funktion
*                 sofort nach erledigter Registrierung/Deregistrierung
*                 oder nach erkannter Unmöglichkeit der Aktion die Ablauf-
*                 kontrolle an den Aufrufer zurück.
*                 Standardwert: 5000 (maximal 5 Sekunden)
*
* Rückgabewert:   TRUE bei erfolgreicher Aktion, FALSE bei erfolgloser Aktion.
*
* --------------------------------------------------------------------------------
local hModule       // Handle auf ein geladenes Modul
local lProcAddress  // Adresse einer Funktion in einem geladenen Modul
local hThread       // Handle auf einen Thread
local nThreadID     // ID eines Threads
local lResult       // Rückgabewert für WaitForSingleObject
local nExitCode := 0     // Exit-Code des erzeugten Threads
local lRet := .f.

  if valtype(lRegister) # "L"
    lRegister := .t.
  endif

  if valtype(nTimeOut) # "N"
    nTimeOut := 5000
  endif


  // Versuchen, die angegebene Datei als Modul zu laden
  hModule := LoadLibraryA(cPathToFile)
  // Wenn kein Modul-Handle vorliegt, war LoadLibrary erfolglos:
  If hModule == 0
    return .f.
  Endif

  // Versuchen, die Adresse der Funktion DllRegisterServer (bzw.
  // DllUnregisterServer) zu ermitteln:
  lProcAddress := GetProcAddress(hModule, IIf(lRegister, "DllRegisterServer", "DllUnregisterServer"))
  // Sofern Funktionsadresse = 0, war GetProcAddress erfolglos:
  If lProcAddress == 0
    FreeLibrary(hModule) // Bereits geladenes Modul freigeben
    return .f.
  Endif

  // Versuchen, die Funktion aufzurufen:
  hThread := CreateThread(NIL, 0, lProcAddress, 0, 0, nThreadID)
  // Liegt kein Thread-Handle vor, war CreateThread erfolglos:
  If hThread == 0
    FreeLibrary(hModule) // Bereits geladenes Modul freigeben
    return .f.
  Endif

  // Auf Abarbeitung der Ausfhrung (oder auf TimeOut) warten:
  lResult := WaitForSingleObject(hThread, nTimeOut)

  // Liefert WaitForSingleObject WAIT_OBJECT_0 zurck, war
  // die Abarbeitung vor Erreichen des TimeOuts erfolgreich:
  If lResult = WAIT_OBJECT_0
    // ExitCode des Threads ermitteln - bei Rckgabe von 0
    // hat die aufgerufene Funktion die Aktion erfolgreich
    // durchgefhrt:
    GetExitCodeThread(hThread, @nExitCode)
    If nExitCode == 0
      lRet := .t.
    EndIf
  EndIf

  CloseHandle(hThread) // Handle auf den erzeugten Thread freigeben
  FreeLibrary(hModule) // Geladenes Modul freigeben

return lRet