'File source from Holyguard.net
' ======================================= '
' About QSavePlus
' ======================================= '
'-- QSavePlus is extends from QSaveDialog ,
'-- 1) If don't found any extension or found unusual extension in FileName,
'-- will show Add Extension Confirm Dialog.
'-- 2) Plus directory and FileName Checking.
'-- 3) show Confirm Dialog before save exist file.
'-- This code only test on Win98.
' Author : Suchart Chokphichitchai
' E-mail : dragon_html@yahoo.com
' My skillfull about English Language is very weak.
' If you don't understand the description,
' or you found bug of this code.
' Please contact me to modify it.
$TYPECHECK ON
$ESCAPECHARS ON
' ======================================= '
' CONST
' ======================================= '
CONST dot = "." :CONST Quo$ = CHR$(39)
CONST false = 0 :CONST true = 1
CONST mtWarning = 0 :CONST mtConfirmation = 3
CONST mbYes = 1 :CONST mbNo = 2
CONST mbOK = 4 :CONST mbCancel = 8
CONST mrYes = 6 :CONST mrNo = 7
CONST mrCancel = 2 :CONST mrOK = 1
FUNCTION delMark$( s AS STRING ) AS STRING
s=REPLACESUBSTR$(s," ","")
s=REPLACESUBSTR$(s,"\t","")
delMark$=REPLACESUBSTR$(s,"*.","")
END FUNCTION
' ======================================= '
' OBJECT Extends
' ======================================= '
TYPE QSaveplus EXTENDS QSAVEDIALOG
Private:
saveDialogRet AS INTEGER
goOut AS INTEGER
FUNCTION item( i AS INTEGER ) AS STRING
' Result example '
'-- item(1)="*.*"
'-- item(2)="*.js"
'-- item(3)="*.php3;*.php"
Result = FIELD$( QSaveplus.Filter, "|", i*2 )
END FUNCTION
FUNCTION itemCount AS INTEGER
' Result example ' ( value of number of all item )
'-- itemCount = 7
Result = TALLY(QSaveplus.Filter,"|")\2
END FUNCTION
FUNCTION extCount( i AS INTEGER ) AS INTEGER
' Result example ' ( value of number of extension in one item)
'-- extCount(1) = 1 [ *.* ]
'-- extCount(2) = 1 [ *.js ]
'-- extCount(3) = 2 [ *.php3;*.php ]
Result = TALLY( QSaveplus.item( i ), "*." )
END FUNCTION
FUNCTION ext( t AS INTEGER, i AS INTEGER ) AS STRING
DIM e AS STRING
' Result example '
'-- ext(3,1) = "php3"
'-- ext(3,2) = "php"
e = FIELD$( QSaveplus.item( t ), ";", i )
Result = delMark$( e )
END FUNCTION
FUNCTION Exten$ AS STRING
' Result example '
'-- if FilterIndex = 4
'-- Exten$ = "pl"
'-- if FilterIndex = 2
'-- Exten$ = "js"
Result = QSaveplus.ext( QSaveplus.FilterIndex, 1 )
END FUNCTION
FUNCTION DirExist AS INTEGER
DIM fileDir$ AS STRING
DIM BslPos AS INTEGER
' Result example '
'-- if dir of FileName is exist.
'-- DirExist=1
'-- if dir of FileName is not exist.
'-- DirExist=0
BslPos = RINSTR(QSaveplus.Filename,"\\")
fileDir$ = DELETE$(QSaveplus.Filename, BslPos+1, LEN(QSaveplus.Filename)-BslPos)
'ShowMessage "DirName="+fileDir$
Result = DIREXISTS(fileDir$)
END FUNCTION
FUNCTION NoExten AS INTEGER
DIM FileLC$ AS STRING
DIM EachExt$ AS STRING
DIM FoundExt AS INTEGER
DIM cou AS INTEGER
' Result example '
'-- if FilterIndex = 2
'-- if not found extension (Ex. c:\abc )
'-- or if found unusual extension. (Ex. c:\abc.ss)
'-- NoExten=1
'-- but if found usual extension. (Ex c:\abc.js)
'-- NoExten=0
FoundExt=False
FileLC$ = LCASE$(QSaveplus.FileName)
FOR cou = 1 TO QSaveplus.ExtCount( QSaveplus.FilterIndex ) '-- EXTCOUNT
EachExt$ = dot+LCASE$( QSaveplus.Ext( QSaveplus.FilterIndex, cou ) ) '-- EXT
' ShowMessage "right str= "+Right$(FileLC$,LEN(EachExt$))+_
' "\r\extension"+str$(cou)+"= "+EachExt$
IF RIGHT$(FileLC$,LEN(EachExt$)) = EachExt$ THEN
FoundExt = True
EXIT FOR
END IF
NEXT
IF FoundExt = False THEN
Result = True
ELSE
Result = False
END IF
END FUNCTION
FUNCTION PlusExt AS STRING
' Result example '
'-- if FilterIndex=2
'-- if FileName="c:\abc."
'-- add only "js"
'-- if FileName="c:\abc"
'-- add ".js"
IF RIGHT$(QSaveplus.Filename,1) = dot THEN
Result = QSaveplus.Filename+QSavePlus.Exten$
ELSE
Result = QSaveplus.Filename+dot+QSavePlus.Exten$
END IF
END FUNCTION
FUNCTION Validname AS INTEGER
' Result example '
'-- if found ">" in FileName
'-- Validname=0
IF INSTR(QSaveplus.Filename,">") <> 0 THEN
Result = False
ELSE
Result = True
END IF
END FUNCTION
SUB goOutTrue
'-- go out the loop. by set goOut=1
QSavePlus.goOut = True
END SUB
SUB FileExistDlg
'-- if FileName is exist, show Confirm Dialog.
IF FILEEXISTS(QSaveplus.Filename) THEN
'-- FileName is exist.
IF MESSAGEDLG(Quo$+QSaveplus.FileName+Quo$+_
" already exists.\r\nDo you want to replace it?",_
mtConfirmation, mbYes OR mbNo, 0) = mrYes THEN
'-- if select Yes
QSavePlus.goOutTrue
END IF
ELSE
'-- FileName is not exist.
QSavePlus.goOutTrue
END IF '-- if not cancel
END SUB
Public:
FUNCTION Execute2 AS INTEGER
DIM mrValue AS INTEGER
QSavePlus.goOut = False
DO
'-- Execute and keep value in saveDialogRet.
QSavePlus.saveDialogRet = QSaveplus.Execute
IF QSavePlus.saveDialogRet = False THEN '-- Click Cancel button.
QSavePlus.goOutTrue
ELSE '-- Click Save button.
IF QSavePlus.Validname = True THEN '-- FileName is valid.
IF QSavePlus.dirExist = False THEN ' === Directory of FileName is not exist. === '
MESSAGEDLG(QSaveplus.Filename+_
"\r\nPath does not exist."+_
"\r\nPlease verify the correct path was given.",_
mtWarning, mbOK, 0)
QSaveplus.Filename=CURDIR$+"\\*."+QSavePlus.Exten$
ELSEIF QSavePlus.NoExten = True THEN ' === No extension or False extension. === '
IF QSaveplus.FilterIndex = 1 THEN '-- FilterIndex is "All Files"
QSavePlus.FileExistDlg
ELSE '-- FilterIndex is not "All Files", Select add extension or not.
mrValue=MESSAGEDLG(QSaveplus.FileName+_
"\r\nThere is no file extension in the file name."+_
"\r\nDo you want to add '"+QSavePlus.Exten$+"' extension automatically?",_
mtConfirmation, mbYes OR mbNo OR mbCancel, 0)
IF (mrValue = mrYes) OR (mrValue = mrNo) THEN
IF mrValue = mrYes THEN
QSaveplus.Filename = QSavePlus.PlusExt
END IF
QSavePlus.FileExistDlg
END IF
END IF
ELSE ' === Found usual extension of Filter. === '
QSavePlus.FileExistDlg
END IF
ELSE '-- FileName is invalid.
MESSAGEDLG(QSaveplus.Filename+_
"\r\nThe above file name is invalid.",_
mtWarning, mbOK, 0)
END IF
END IF '-- saveDialogRet
LOOP UNTIL QSavePlus.goOut = True
Result = QSavePlus.saveDialogRet
END FUNCTION
END TYPE
' - - - - - - - - - - - - - - - - - - - - End QSavePlus - - - - - - - - - - - - - - - - - - - - '
' ======================================= '
' EXAMPLE
' ======================================= '
DECLARE SUB formClick
CREATE form AS QFORM
CREATE R AS QRICHEDIT
Text="abc\r\n123"
END CREATE
Center
OnClick = formClick
END CREATE
CREATE saveDlg AS QSaveplus
Filter = _
"All Files (*.*)" + "|*.*|"+_
"JavaScript (*.js)" + "|*.js|"+_
"PHP (*.php3,*.php)" + "|*.php3;*.php|"+_
"Perl (*.pl,*.pm,*.cgi)" + "|*.pl;*.pm;*.cgi|"+_
"Rapid-Q BASIC (*.rq,*.bas)" + "|*.rq;*.bas|"+_
"Html (*.html,*.htm)" + "|*.html;*.htm|"+_
"Text (*.txt)" + "|*.txt|"
'-- it can change to other extension.
' Compatible Filter. '
' 1) [ Filter 1 ] must be only [ All Files |*.*| ]
' Ex:
' " Javascript |*.js|" ...Not OK
' " All Files |*.*|" ...OK
' " All Files |*.*| Javascript |*.js|" ...OK
' 2) It must not have blank-ascii or tab-ascii at end of extension.
' Ex:
' " All Files |*.* | " ...Not OK
' " All Files |*.* | " ...Not OK
' " All Files | *.*|" ...OK
' " All Files |*.*|" ...OK
' " All Files |*.*| PHP |*.php3;*.php |" ...Not OK
' " All Files |*.*| PHP |*.php3 ;*.php|" ...Not OK
' " All Files |*.*| PHP | *.php3; *.php|" ...OK
' 3) Positions of |-ascii only must be last of each text.
' Ex:
' " All Files |*.*" ...Not OK ( Don't have |-ascii at end of *.* )
' "| All Files |*.*|" ...Not OK ( Have |-ascii at begin of " All Files" )
' "| All Files |*.*" ...Not OK ( Don't have |-ascii at end of *.* , and Have |-ascii at begin of " All Files" )
' " All Files |*.*|" ...OK
' " All Files |*.*| JavaScript |*.js" ...Not OK ( Don't have |-ascii at end of *.js )
' "| All Files |*.*| JavaScript |*.js|" ...Not OK ( Have |-ascii at begin of " All Files" )
' "| All Files |*.*| JavaScript |*.js" ...Not OK ( Don't have |-ascii at end of *.js , and Have |-ascii at begin of " All Files" )
' " All Files |*.*| JavaScript |*.js|" ...OK
END CREATE
SUB formClick
IF saveDlg.Execute2 = 1 THEN
SHOWMESSAGE "Save File.. "+saveDlg.FileName
'-- when you sure that all code is not dangerous.
'-- and you want to save file really, delete ' of below line
' r.savetofile( saveDlg.FileName )
ELSE
SHOWMESSAGE "No Save"
END IF
END SUB
form.ShowModal