Este codigo talvez nem seja novidade, mas para quem queira usar esta ai:
Código: Selecionar todos
/*
** Purpose : Windows compatible INI file access
** Author : Darren Martz
** Date : Feb 16 1994
**
** Compiler: Authored under Clipper 5.01 linking with Blinker 3.0
** on a trashy machine after a long day.
**
** Cost : Send me a note via email.
** CompuServe : 72674,510
** Internet : DMartz@HealthVISION.ca
**
** Warranty: No warranty or guarantee of any sort. If you don't
** like it, don't use it. Remember WYSIWYG!
** (What You See Is What You Get), you have the source
** work with it.
**
**
** Comments:
**
** If you do not pass the [cFileName], then a default of
** "myapp.ini" is used.
**
** The function names have been shorten to accomidate Clippers
** short naming restrictions. The real windows function names are
** to large for coding anyways, so I usually use a define to shorten
** them to this size.
**
** Clipper does not respond well to this type of file access, so speed
** is an issue here. Just be smart at how you cross reference your
** accesses, and the speed should be fine.
**
** There are a few handy function's below the Windows flavoured code,
** that are some of my coding utilities, that I use in replace of a
** debugger.
**
**
**
** Functions:
**
** //Get Private Profile Integer
** GPPI( cSection, cEntry, nDefault, [cFileName] ) --> nNumeric
**
** //Get Private Profile String
** GPPS( cSection, cEntry, cDefault, [cFileName] ) --> cString
**
** //Get Private Profile Boolean (Logical in Clipper)
** GPPB( cSection, cEntry, lDefault, cFileName )
**
** //Write Private Profile String
** WPPS( cSection, cEntry, cString, [cFileName] ) --> lBoolean
**
**
** Example INI File:
**
** [TEST]
** String = Big John
** Number = 50
** Lg Str = This is a larger style string.
**
**
** Example Gets:
**
** nNumber := GPPI("TEST","Number",0)
** cString := GPPS("TEST","String","Little Joe")
**
**
** Example Write:
**
** if WPPS("TEST","John","Doe")
** cString := GPPS("Test","John","")
** endif
*/
#include "Inkey.ch"
#include "fileio.ch"
#define inifile "MYAPP.INI" //*****CHANGE THIS TO YOUR OWN DEFAULT*****
#define F_BLOCK 512
*
* GetPrivateProfileBool()
*
function GPPB( cSection, cEntry, lDefault, cFileName )
local cLine := GPPS(cSection,cEntry,iif(lDefault,"TRUE","FALSE"),cFileName )
cLine := strtran(" ",upper(alltrim(cLine)))
//Uses False to compare due to the 0 as false and >0 is true
return !(cLine $ "FALSE NO OFF 0")
*
* GetPrivateProfileInt()
*
function GPPI( cSection, cEntry, nDefault, cFileName )
local cLine := GPPS(cSection,cEntry,str(nDefault),cFileName )
return val(cLine)
*
* GetPrivateProfileString()
*
function GPPS( cSection, cEntry, cDefault, cFileName )
local nFile := -1
local cLine := ""
local cTemp := ""
cSection := "[" + upper(alltrim(cSection)) + "]"
cEntry := upper(alltrim(cEntry))
cFileName:= iif(valtype(cFileName)=="C",cFileName,inifile)
nFile := fOpen(cFilename,0)
if fError() == 2
nFile := fCreate(cFileName,0)
endif
if fError() != 0 .or. nFile == -1
return cDefault
endif
do while .t.
if !read_line(nFile,@cLine)
fClose(nFile)
return cDefault
endif
if upper(alltrim(cLine)) == cSection
exit
endif
enddo
do while .t.
if !read_line(nFile,@cLine) .or. Empty(cLine)
fClose(nFile)
return cDefault
endif
cTemp := upper(alltrim( left(cLine,at("=",cLine)-1) ))
if cTemp == cEntry
exit
endif
enddo
cLine := allTrim( substr( cLine,at("=",cLine)+1 ) )
fClose(nFile)
return cLine
*
* WritePrivateProfileString()
*
function WPPS( cSection, cEntry, cString, cFileName )
local nFile := -1
local bExit := .t.
local cLine := ""
local cTemp := ""
local cBuff := ""
local nTemp
cSection := "[" + upper(alltrim(cSection)) + "]"
cEntry := upper(alltrim(cEntry))
cFileName:= iif(valtype(cFileName)=="C",cFileName,inifile)
nFile := fOpen(cFileName,2)
if fError() == 2
nFile := fCreate(cFileName,0)
if fError() == 0 .and. nFile != -1
fWrite(nFile,cSection)
fWrite(nFile,chr(13)+chr(10))
fWrite(nFile,cEntry + "=" + cString)
fWrite(nFile,chr(13)+chr(10))
fClose()
return .t.
endif
endif
if fError() != 0 .or. nFile == -1
return .f.
endif
//Create a temporary inifile
cTemp := cFileName
nTemp := TmpName(@cTemp)
do while bExit
if !read_line(nFile,@cLine)
fWrite(nTemp,chr(13)+chr(10))
fWrite(nTemp,cSection)
fWrite(nTemp,chr(13)+chr(10))
fWrite(nTemp,cEntry + "=" + cString)
fWrite(nTemp,chr(13)+chr(10))
fClose(nTemp)
fClose(nFile)
if (fRename(cTemp,cFileName) != -1) .or. copyini(cTemp,cFileName)
Erase(cTemp)
endif
return .t.
endif
fWrite(nTemp,cLine)
fWrite(nTemp,chr(13)+chr(10))
if upper(alltrim(cLine)) == cSection
exit
endif
enddo
do while bExit
if !read_line(nFile,@cLine)
fWrite(nTemp,cEntry + "=" + cString)
fWrite(nTemp,chr(13)+chr(10))
fClose(nTemp)
fClose(nFile)
if (fRename(cTemp,cFileName) != -1) .or. copyini(cTemp,cFileName)
Erase(cTemp)
endif
return .t.
endif
cBuff := upper(alltrim( left(cLine,at("=",cLine)-1) ))
if cBuff == cEntry .or. Empty(cLine)
exit
endif
fWrite(nTemp,cLine)
fWrite(nTemp,chr(13)+chr(10))
enddo
fWrite(nTemp,cEntry + "=" + cString)
fWrite(nTemp,chr(13)+chr(10))
if Empty(cLine)
fWrite(nTemp,chr(13)+chr(10))
endif
do while bExit
bExit := read_line(nFile,@cLine)
fWrite(nTemp,cLine)
fWrite(nTemp,chr(13)+chr(10))
enddo
fClose(nTemp)
fClose(nFile)
if (fRename(cTemp,cFileName) != -1) .or. copyini(cTemp,cFileName)
Erase(cTemp)
endif
return .t.
*
* Read_Line( nFile, cChar )
*
static function read_line( nFile, cChar )
local cBuffer := space(1)
cChar := ""
do while .t.
cBuffer := fReadStr(nFile,1)
//EOF
if cBuffer == ""
return .f.
endif
//EOL
if cBuffer == chr(13)
fReadStr(nFile,1)
exit
endif
cChar += cBuffer
enddo
return .t.
*
* TmpName()
*
static function TmpName( cFile )
local cPath := "~T"
local cTime := ""
local nFile := -1
//Take the path of the given filename
cPath := left( cFile, rat("\",cFile) )
cPath += "~T"
// ~t<hrs><min><sec>.tmp
do while .t.
cTime := time()
cTime := left(cTime,2) + substr(cTime,4,2) + right(cTime,2)
cFile := cPath + cTime + ".tmp"
if !file(cFile)
nFile := fCreate(cFile,0)
if fError() == 0 .and. nFile != -1
exit
elseif fError() == 3
cPath := "~T"
endif
endif
enddo
return nFile
*
* CopyIni()
*
static function copyini(cSrc,cDst)
local nBuffer := 512
local cBuffer := space(nBuffer)
local lDone := .f.
local nBytes := 0
local nSrc := -1
local nDst := -1
nSrc := fOpen(cSrc,0)
if fError() != 0 .or. nSrc == -1
return .f.
endif
nDst := fCreate(cDst,0)
if fError() != 0 .or. nDst == -1
return .f.
endif
do while !lDone
nBytes := fRead(nSrc,@cBuffer,nBuffer)
if fWrite(nDst,cBuffer,nBytes) < nBytes
exit
else
lDone := (nBytes == 0)
endif
enddo
fClose(nSrc)
fClose(nDst)
return lDone
//**************************************************************************
//**************************************************************************
//**************************************************************************
*
* dbDump()-->NIL
*
function dbdump()
if !used()
dump("dbDump(*empty*)")
return NIL
endif
dump("")
dump("["+alias()+"]")
dump(select(),, "Area=")
dump(recno(),, "RecNo=")
dump(lastrec(),, "LastRec=")
dump(dbfilter(),,"Filter=")
dump(indexord(),,"Index Ord=")
dump(indexkey(),,"Index Key=")
dump(indexext(),,"index Ext=")
dump(fcount(),, "fields=")
dump(eof(),, "EOF=")
dump(bof(),, "BOF=")
return NIL
//**************************************************************************
//**************************************************************************
//**************************************************************************
*
* DUMP( uValue , [cPicture], [cBeforeText], [cAfterText] )
*
* creates and updates a file called DUMP.TXT
* for internal use only (development).
*
function Dump(uValue,cPicture,cBefore,cAfter)
local hHandle
local cString
hHandle := fopen("DUMP.TXT",2)
if ferror() != 0
hHandle := fcreate("DUMP.TXT")
endif
if ferror() != 0
return
endif
fseek(hHandle,0,2)
if valtype(cPicture) == "C"
cString := transform(uValue,cPicture)
elseif valtype(uValue) == "A"
cString := "** DUMP(array["
cString += alltrim( str(len(uValue)) )
cString += "]) **"
elseif valtype(uValue) == "B"
cString := "** DUMP(block) **"
elseif valtype(uValue) $ "CM"
cString := uValue
elseif valtype(uValue) == "D"
cString := sDate(uValue)
elseif valtype(uValue) == "L"
cString := iif(uValue,"True","False")
elseif valtype(uValue) == "N"
cString := alltrim(str(uValue))
elseif valtype(uValue) == "O"
cString := "** DUMP(object) **"
elseif valtype(uValue) == "U"
cString := "** DUMP(nul) **"
endif
if valtype(cBefore)=="C"
cString := cBefore + cString
endif
if valtype(cAfter)=="C"
cString += cAfter
endif
fwrite(hHandle,cString+chr(13))
fclose(hHandle)
return NIL
//**************************************************************************
//**************************************************************************
//**************************************************************************
*
* CopyRecord()
*
function CopyRecord(hSrc,hDst,bAppend)
local hBuffer := select()
local i := 0
local j := (hDst)->(fCount())
local nPos := 0
local cFld := ""
local bSuccess
select( hDst )
bSuccess := iif(valtype(bAppend)=="L" .and. bAppend,add_rec(5),rec_lock(5))
if bSuccess
for i := 1 to j step 1
cFld := FieldName(i)
nPos := (hSrc)->(FieldPos(cFld))
if nPos > 0
FieldPut(i, (hSrc)->(FieldGet(nPos)) )
endif
next
dbunlock()
endif
select( hBuffer )
return bSuccess
//**************************************************************************
//**************************************************************************
//**************************************************************************
*
* CopyDBF()
*
* hSrc -- Handle to the Source File
* cDst -- Path and Filename
* bTop -- Start copying from dbgotop()
*
function copydbf(hSrc,cDst,bTop)
local hBuffer := select()
local aDbf := (hSrc)->(dbstruct())
local cFilter := (hSrc)->(dbfilter())
local nRecNum := (hSrc)->(recno())
local hDst
do clear_msg
(hSrc)->(afields(aFld))
dbcreate(cDst,aDbf)
select 0
if net_use(cDst, .t., 0)
hDst := select()
select(hSrc)
set filter to
if valtype(bTop) != "L"
bTop := .t.
endif
if bTop
dbgotop()
endif
do while !eof()
if empty(cFilter) .or. &cFilter
CopyRecord(hSrc,hDst,.t.)
endif
dbskip(1)
enddo
set filter to cFilter
(hDst)->(dbclosearea())
endif
(hSrc)->(dbgoto(nRecNum))
select(hBuffer)
return NIL
//**************************************************************************
//**************************************************************************
//**************************************************************************
*
* CopyFile()
*
function copyfile(cSrc,cDst,bDisplay)
local cBuffer := space(F_BLOCK)
local nInFile := -1
local nOutFile := -1
local cScreen := saveScreen(6,10,12,70)
local cColor := setColor("W+/R")
local nCursor := setCursor(0)
local bDone := .f.
local bSuccess := .t.
local nBytes := 0
local nLength := 0
local nWriten := 0
local nKey := 0
cSrc := alltrim(cSrc)
cDst := alltrim(cDst)
if valtype(bDisplay) != "L"
bDisplay := .t.
endif
nInFile := fOpen(cSrc,FO_READ)
if nInFile != -1
nOutFile := fCreate(cDst,FC_NORMAL)
endif
if nInFile == -1
if bDisplay
alert("Unable to open;" + cSrc)
endif
bSuccess := .f.
elseif nOutFile == -1
if bDisplay
alert("Unable to create;" + cDst)
endif
bSuccess := .f.
else
if bDisplay
@ 6,10 clear to 12,70
dispBox(6,10,12,70,1)
endif
//Find File Length
nLength := fSeek(nInFile,0,FS_END)
fSeek(nInFile,0)
if bDisplay
@ 7,12 say "Source : " + right(cSrc,43)
@ 8,12 say "Destination : " + right(cDst,43)
@ 11,37 say "Cancel" color "W+/B"
endif
endif
do while !bDone .and. bSuccess
nKey := inkey()
if bDisplay .and. (nKey == K_RETURN .or. nKey == K_ESC)
tone(100,3)
if alert("Copy File Paused",{"Abort","Continue"}) == 1
bSuccess := .f.
exit
endif
endif
if bDisplay
@ 9,12 say replicate("þ",(57/nLength)*nWriten)
endif
nBytes := fRead(nInFile,@cBuffer,F_BLOCK)
if fWrite(nOutFile,cBuffer,nBytes) < nBytes
tone(100,3)
alert("Write fault #" + alltrim(str(fError())) )
bSuccess := .f.
else
nWriten += nBytes
bDone := (nBytes == 0)
endif
enddo
if nInFile >= 0
fClose(nInFile )
endif
if nOutFile >= 0
fClose(nOutFile)
endif
setCursor(nCursor)
setColor(cColor)
restScreen(6,10,12,70,cScreen)
return bSuccess
//**************************************************************************
//**************************************************************************
//**************************************************************************
*
* sDate()
*
function sDate(dDate,cPicture)
local cDate := "Error"
if valtype(cPicture) == "C"
cDate := cPicture
else
cDate := "@W @M @D, @Y"
endif
if valtype(dDate) != "D"
dDate := date()
endif
cDate := strtran(cDate,"@W",cdow(dDate))
cDate := strtran(cDate,"@w",transform(dow(dDate),"99"))
cDate := strtran(cDate,"@M",cmonth(dDate))
cDate := strtran(cDate,"@m",transform(month(dDate),"99"))
cDate := strtran(cDate,"@D",strtran(str(day(dDate),2,0)," ","0"))
cDate := strtran(cDate,"@d",alltrim(str(day(dDate),2,0)))
cDate := strtran(cDate,"@Y",transform(year(dDate),"9999"))
cDate := strtran(cDate,"@y",transform(year(dDate),"99"))
return cDate
//**************************************************************************
//**************************************************************************
//**************************************************************************