Sorry your browser is not supported!

REM
REM   DBClassic V1.13
REM


print get_dbc_install_path()
print get_dbpro_install_path()


end
FUNCTION get_dbc_install_path()
   Folder_Name$="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\3D Games Creator"
   Key_Name$="UninstallString"
   tmpip$=GET_REGISTRY(Folder_Name$, Key_Name$, 0)
	ip$=left$(tmpip$,len(tmpip$)-13)
ENDFUNCTION ip$


FUNCTION get_dbpro_install_path()
   Folder_Name$="HKEY_LOCAL_MACHINE\SOFTWARE\Dark Basic\Dark Basic Pro"
   Key_Name$="INSTALL-PATH"
   tmpip$=GET_REGISTRY(Folder_Name$, Key_Name$, 0)
	ip$=tmpip$
ENDFUNCTION ip$


FUNCTION GET_REGISTRY(Folder_Name$, Key_Name$, case_sensitive)

registry$=createRegistry$(Folder_Name$)

tmpfile=freefile()
memblock_1=free_memblock()
OPEN TO READ tmpfile,registry$
MAKE MEMBLOCK FROM FILE memblock_1,tmpfile
CLOSE FILE tmpfile
tai_max=GET MEMBLOCK SIZE(memblock_1)-2
tmpc$=""
i=-2
memblock_2=free_memblock()
foundroot=0
foundcle=0
ridk=0
oldridk=0

rem cherche la root
Folder_Name$=Folder_Name$+CHR$(93)
ln=LEN(Folder_Name$)
MAKE MEMBLOCK memblock_2,ln*2
FOR j=1 TO ln
   kr=ASC(MID$(Folder_Name$,j))
   offset=(j-1)*2
   WRITE MEMBLOCK WORD memblock_2,offset,upper(kr,case_sensitive)
NEXT j

WHILE foundroot=0
   WHILE ridk<>91 AND i<tai_max
      INC i,2
      ridk=upper(MEMBLOCK WORD(memblock_1,i),case_sensitive)
   ENDWHILE
   IF i>=tai_max THEN foundroot=0 : EXIT

   ridk=0 : k=0
   depar=i+2
   WHILE k<>93
      INC i,2
      k=upper(MEMBLOCK WORD(memblock_1,i),case_sensitive)
      l=upper(MEMBLOCK WORD(memblock_2,i-depar),case_sensitive)
      IF k<>l
         foundroot=0
         EXIT
      ELSE
         foundroot=1
      ENDIF
   ENDWHILE
ENDWHILE



rem cherche la cle
IF MEMBLOCK EXIST(memblock_2) THEN DELETE MEMBLOCK memblock_2
Key_Name$=Key_Name$+CHR$(34)
ln=LEN(Key_Name$)
MAKE MEMBLOCK memblock_2,ln*2
FOR j=1 TO ln
   kr=ASC(MID$(Key_Name$,j))
   offset=(j-1)*2
   WRITE MEMBLOCK WORD memblock_2,offset,upper(kr,case_sensitive)
NEXT j

WHILE foundcle=0
   WHILE ridk<>10 AND i<tai_max
      INC i,2
      ridk=upper(MEMBLOCK WORD(memblock_1,i),case_sensitive)
   ENDWHILE
   IF i>=tai_max THEN foundcle=0 : EXIT

   INC i,2
   ridk=0 : k=0
   depar=i+2

   WHILE k<>34
      INC i,2
      IF i>=tai_max THEN foundcle=0 : EXIT
      k=upper(MEMBLOCK WORD(memblock_1,i),case_sensitive)
      l=upper(MEMBLOCK WORD(memblock_2,i-depar),case_sensitive)
      IF k<>l
         foundcle=0
         EXIT
      ELSE
         foundcle=1
      ENDIF
   ENDWHILE
ENDWHILE



rem lit la cle
IF foundcle
   INC i,4
   ridk=upper(MEMBLOCK WORD(memblock_1,i),case_sensitive)
   WHILE ridk<>13 AND i<tai_max
      IF ridk<>34
         IF oldridk <> ridk
               tmpc$ = tmpc$ + CHR$(ridk)
         ELSE
            IF ridk <> 92 THEN tmpc$ = tmpc$ + CHR$(ridk)
         ENDIF
         oldridk=ridk
      ENDIF
      INC i,2
      ridk=upper(MEMBLOCK WORD(memblock_1,i),case_sensitive)
   ENDWHILE
ENDIF
IF (foundroot&foundcle)=0 THEN tmpc$="???"

DELETE MEMBLOCK memblock_1
DELETE MEMBLOCK memblock_2
DELETE FILE registry$

ENDFUNCTION tmpc$


FUNCTION upper(value,case_sensitive)
   IF case_sensitive<>1
      tmp=(value&223)
      IF tmp>=65 AND tmp<=90
         returnvalue=tmp
      ELSE
         returnvalue=value
      ENDIF
   ELSE
      returnvalue=value
   ENDIF
ENDFUNCTION returnvalue


FUNCTION free_memblock()
   found=1
   i=0
   REPEAT
      INC i
      IF i=256
         found=0
         EXIT
      ENDIF
   UNTIL MEMBLOCK EXIST(i)=0
   IF found=0 THEN BREAK "no memblock available!" : END
ENDFUNCTION i


FUNCTION freefile()
   found=1
   i=0
   REPEAT
      INC i
      IF i=33
         found=0
         EXIT
      ENDIF
   UNTIL FILE OPEN(i)=0
   IF found=0 THEN BREAK "no file available!" : END
ENDFUNCTION i


FUNCTION createRegistry$(keyPath$)
   systemPath$ = WINDIR$()+"\system32\"
   driv$=LEFT$(WINDIR$(),3)
   registry$ = driv$+"registry"+STR$(TIMER())+".txt"
   COMMND$ = "/E "+registry$+" "+CHR$(34)+keyPath$+CHR$(34)

   IF FILE EXIST(registry$) THEN DELETE FILE registry$
   EXECUTE FILE "regedit.exe", COMMND$,systemPath$,1

   timestamp = TIMER() : REPEAT : UNTIL FILE EXIST(registry$) OR timestamp+1000 < TIMER()
ENDFUNCTION registry$

set window on

kernel32=1
load dll "kernel32.dll",kernel32

rem get handle
mhnd=call dll(kernel32,"GetModuleHandleA",0)

rem size a$ appropriately to return the file name so we avoid memory corruption
rem the limit is 255 characters for DBC.  Use a memblock if more
rem characters are needed to be returned
for n=1 to 255
   a$=a$+" "
next n
nsize=len(a$)

rem get path
call dll kernel32,"GetModuleFileNameA",mhnd,a$,nsize
print a$