Sorry your browser is not supported!

Rem *** Include File: FileReq_Include.dba ***
Rem Created: 17/01/01 14:42:40  with Patch 3.1

remstart
  REQUIREMENTS:
  1) reqptr as REQUESTER_PTRDATA  and  InitFileReq()  should both be placed
     at the top of your program. InitFileReq() only needs to be called once.

  LIMITATIONS:
  1) Cannot be used in Fullscreen Exclusive Mode. You won't see anything if
     you try because the requester will open behind these displays, if that
     happens then press the Escape key to cancel the requester.
  2) Moving the requester will upset the DBPro display underneath it until
     the next SYNC/FASTSYNC call. A bit annoying that.
remend

#CONSTANT MAXSTRINGSIZE 256

TYPE REQUESTER_PTRDATA
  ReqInit as integer
  DllUser32 as integer
  DllComdlg32 as integer
  ptrRequester as dword
  ptrFilter as dword
  ptrCustomFilter as dword
  ptrFile as dword
  ptrFileTitle as dword
  ptrInitialDir as dword
  ptrTitle as dword
  ptrDefExt as dword
  ptrTemplateName as dword
ENDTYPE

` ---------------------------------------------------------------------------
function ReqError(e$)
  set current bitmap 0 : cls rgb(0,0,0) : ink rgb(255,255,255),0
  print "File Requester Error!"
  print e$ : print
  print "Press any key to exit."
  sync : wait key : end
endfunction

function GetFreeDll()
  rem --- finds a free dll slot
  dllnum = 256
  repeat : dec dllnum,1 : until dll exist(dllnum) = 0 or dllnum = 0
endfunction dllnum

Function InitFileReq()
  rem --- check if we have not initailised already
  if reqptr.ReqInit = 0
    reqptr.DllUser32 = GetFreeDll()
    if reqptr.DllUser32 = 0 then ReqError("Unable to find free Dll slot for User32.dll")
    load dll "User32.dll",reqptr.DllUser32

    reqptr.DllComdlg32 = GetFreeDll()
    if reqptr.DllComdlg32 = 0 then ReqError("Unable to find free Dll slot for Comdlg32.dll")
    load dll "Comdlg32.dll",reqptr.DllComdlg32

    if dll exist(reqptr.DllUser32) = 0 then ReqError("Unable to load User32.dll")
    if dll exist(reqptr.DllComdlg32) = 0 then ReqError("Unable to load Comdlg32.dll")

    rem --- store memory pointers
    reqptr.ptrRequester = make memory(80)
    reqptr.ptrFilter = make memory(MAXSTRINGSIZE)
    reqptr.ptrCustomFilter = make memory(MAXSTRINGSIZE)
    reqptr.ptrFile = make memory(MAXSTRINGSIZE)
    reqptr.ptrFileTitle = make memory(MAXSTRINGSIZE)
    reqptr.ptrInitialDir = make memory(MAXSTRINGSIZE)
    reqptr.ptrTitle = make memory(MAXSTRINGSIZE)
    reqptr.ptrDefExt = make memory(MAXSTRINGSIZE)
    reqptr.ptrTemplateName = make memory(MAXSTRINGSIZE)

    rem --- set values in memory (ptrRequester)
    SetReqLongValue(0,76)
    SetReqLongValue(2, 0)
    SetReqLongValue(3,reqptr.ptrFilter)
    SetReqLongValue(4,reqptr.ptrCustomFilter)
    SetReqLongValue(5,255)
    SetReqLongValue(6,0)
    SetReqLongValue(7,reqptr.ptrFile)
    SetReqLongValue(8,255)
    SetReqLongValue(9,reqptr.ptrFileTitle)
    SetReqLongValue(10,255)
    SetReqLongValue(11,reqptr.ptrInitialDir)
    SetReqLongValue(12,reqptr.ptrTitle)
    SetReqLongValue(13,0)

    reqptr.ReqInit = 1
  endif
endfunction

function UnloadFileReq()
  rem --- erase memory
  delete memory reqptr.ptrRequester
  delete memory reqptr.ptrFilter
  delete memory reqptr.ptrCustomFilter
  delete memory reqptr.ptrFile
  delete memory reqptr.ptrFileTitle
  delete memory reqptr.ptrInitialDir
  delete memory reqptr.ptrTitle
  delete memory reqptr.ptrDefExt
  delete memory reqptr.ptrTemplateName

  delete dll reqptr.DllUser32
  delete dll reqptr.DllComdlg32
  reqptr.ReqInit = 0
endfunction
` ---------------------------------------------------------------------------
function StringToMemory(ptr,s$,zerochr$)
  fill memory ptr, 0, MAXSTRINGSIZE

  if len(s$) = 0 then exitfunction 0
  if zerochr$="" then zero = 0 else zero = asc(zerochr$)

  bt as byte
  index = 1

  repeat
    bt = asc(mid$(s$,index))
    if bt <> zero then *ptr = bt
    inc index,1 : inc ptr,1
  until index > len(s$) or index = MAXSTRINGSIZE
endfunction 1
` ---------------------------------------------------------------------------
function ReadMemoryString(ptr)
  bt as byte
  s$ = "" : index = 1
  repeat
    bt = *ptr
    if bt > 0 then s$ = s$ + chr$(bt)
    inc index,1 : inc ptr,1
  until bt = 0 or index = MAXSTRINGSIZE
endfunction s$
` ---------------------------------------------------------------------------
function SetReqLongValue(pos, v as dword)
  ptr as dword
  ptr = reqptr.ptrRequester + (pos * 4)
  *ptr = v
endfunction
` ---------------------------------------------------------------------------
function PrepareReq(title$,path$,filter$)
  StringToMemory(reqptr.ptrTitle, title$, "")
  if path$="" or StringToMemory(reqptr.ptrInitialDir, path$, "")= 0
    StringToMemory(reqptr.ptrInitialDir, "C:\", "")
  endif
  if filter$="" or StringToMemory(reqptr.ptrFilter, filter$, "|")= 0
    StringToMemory(reqptr.ptrFilter, "All Files (*.*)|*.*", "|")
  endif

`  StringToMemory(reqptr.ptrCustomFilter, "", "")
  StringToMemory(reqptr.ptrFile, space$(254), "")
  StringToMemory(reqptr.ptrFileTitle, space$(254), "")

  hwnd as dword
  hwnd = call dll(reqptr.DllUser32, "GetActiveWindow")
  SetReqLongValue(1, hwnd)
endfunction

function FileReqOpen(title$,path$,filter$)
  PrepareReq(title$,path$,filter$)
  r = call dll(reqptr.DllComdlg32, "GetOpenFileNameA", reqptr.ptrRequester)
endfunction r

function FileReqSave(title$,path$,filter$)
  PrepareReq(title$,path$,filter$)
  r = call dll(reqptr.DllComdlg32, "GetSaveFileNameA", reqptr.ptrRequester)
endfunction r
` ---------------------------------------------------------------------------
function ReqFileName()
  f$ = ReadMemoryString(reqptr.ptrFile)
endfunction f$

function ReqFileTitle()
  f$ = ReadMemoryString(reqptr.ptrFileTitle)
endfunction f$

function ReqFolderName()
  fn$ = ReqFileName() : ft$ = ReqFileTitle()
  f$ = left$(fn$,len(fn$) - len(ft$))
endfunction f$

function ReqFileExt()
endfunction f$

function ReqFileExt()
  fn$ = ReqFileName()
  f$ = mid$(fn$,len(fn$) - len("."))
endfunction f$

function ReqFileExt()
  fn$ = ReqFileName()
  f$ = mid$(fn$,len(fn$) - len("."))
  f$="."+f$
endfunction f$

f$=right$(fn$,4)

function ReqFileExt()

 fn$ = ReqFileName()

 ` Split the filename by .
 split string fn$,"."

 ` Make f$ equal . + the last split word
 f$="."+get split word$(split count())

endfunction f$

function ReqFileExt()
	fn$ = "file.extension"
	
	count=0
	ext$=""
	
	repeat
		inc count
		if mid$(fn$,len(fn$)-count,1)="."
			ext$=right$(fn$,count)
		endif
	until ext$<>""

endfunction ext$

print "somefilename.ext = ", Extension("somefilename.ext")  ` Full filename with extension
print ".ext = ", Extension(".ext")                          ` Filename that is all extension
print "aaaa = ", Extension("aaaa")                          ` Filename without extension
wait key
end

function Extension(s as string)
   local Pos as integer
   
   Pos = last instr(s, ".")                  ` find the dot
   if Pos = 0 then Pos = len(s)+1            ` not found, so set position past end of string
   if Pos > 1 then s = remove$(s, 1, Pos-1)  ` remove the first part of the string, up to the extension
endfunction s

fn$="test.txt"
print "fn$=";fn$
l=len(fn$)
ptr=l
found=0
repeat
   a$=mid$(fn$,ptr)
   if a$="." then found=1
   dec ptr,1
until found=1 or ptr<=0
if ptr>0
   ext$=right$(fn$,l-ptr)
   print "ext$='";ext$;"'"
else
   print "No extension in filename"
endif

wait key
end

function ReqFileExt()

 fn$ = ReqFileName()

 ` Leave the function if there is no extension
 if instr(fn$, ".")=0 then exitfunction "."

 ` Split the filename by .
 split string fn$,"."

 ` Make f$ equal . + the last split word
 f$="."+get split word$(split count())

endfunction f$

print "Extension: "+ReqFileExt()
wait key
end


function ReqFileExt()

 `fn$ = ReqFileName()
 fn$="test"

 ` Leave if there is no extension
 if instr(fn$, ".")=0 then exitfunction "."

 ` Split the filename by .
 split string fn$,"."

 ` Make f$ equal . + the last split word
 f$="."+get split word$(split count())

endfunction f$

function ReqFileExt()

 fn$ = ReqFileName()

 ` Split the filename by .
 split string fn$,"."

 ` Make f$ equal . + the last split word
  if split count()>0
 f$="."+get split word$(split count())
  endif

endfunction f

ext$ = fast right$(filename$, len(filename$) - last instr(filename$, ".") + 1)

exitfunction "." + ""   `Generates a temporary

function ReqFileExt()

 fn$ = ReqFileName()

 if fn$ <> ""
  ` Split the filename by .
  split string fn$,"."

  ` Make f$ equal . + the last split word
  if split count() > 1
   f$="."+get split word$(split count())
  else
   f$="."
  endif
 endif
endfunction f$