Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

rename file to datestamp 2

Status
Not open for further replies.

friend01

Programmer
Jun 4, 2009
94
CA
Hi,

I have a bunch of files (2,043) in a folder (C:\test\) which I would like to rename them to the date it was created+filename. Anyway of doing this? Here's 2 examples:

OLD NAME DATE CREATED NEW NAME
-------------------------------------------
TTY1.TXT 05/12/2009 05/12/2009TTY1.TXT
SKIP.FRT 10/10/2008 10/10/2008SKIP.FRT

anyway of doing this?

Please help.


Thanks,
F1

 
Code:
lnFiles = ADIR(aFiles, "c:\Test\*.*")
FOR lnFor = 1 TO lnFiles
    IF LEFT(aFiles[lnFor, 1], 1) == "."
       LOOP
    ENDIF
    lcSource = "c:\Test\"+aFiles[lnFor, 1]
    lcTarget = "c:\Test\"+DTOS(aFiles[lnFor, 3]) + aFiles[lnFor, 1]
    RENAME (lcSource) TO (lcTarget)
NEXT
That will give you names lie:
20091126TTY1.TXT



Borislav Borissov
VFP9 SP2, SQL Server 2000/2005.
 
F1,

You can't name a file "05/12/2009TTY1.TXT". Windows would confuse the forward slash with a separator.

But stripping out the slashes (as in Borislav's code) would be fine.

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro tips, advice, training, consultancy
Custom software for your business
 
Hmmm, I just realized something I would need the timestamp field as well BUT the tricky part is I need it in military time (instead of AM/PM).

Example:

OLD NAME DATE TIME CREATED NEW NAME
--------------------------------------------------
TTY1.TXT 05/12/2009 8:50AM 20091205-0850-TTY1.TXT
SKIP.FRT 10/10/2008 1:05PM 20081010-1305-SKIP.FRT

Any help?


Thanks,
F1
 
Check Borislav's answer and just add 4th member. The time is in military format:

Code:
lcTarget = Dtos(aFiles[m.lnFor, 3]) + ;
 CHRTRAN(aFiles[m.lnFor, 4],':','') + aFiles[m.lnFor, 1]


Cetin Basoz
MS Foxpro MVP, MCP
 
I get a 'file already exists error'.

This is the code I have:

lnFiles = ADIR(aFiles, "c:\Pics\*.*")
FOR lnFor = 1 TO lnFiles
IF LEFT(aFiles[lnFor, 1], 1) == "."
LOOP
ENDIF
lcSource = "c:\Pics\"+aFiles[lnFor, 1]
lcTarget = Dtos(aFiles[m.lnFor, 3]) + CHRTRAN(aFiles[m.lnFor, 4],':','') + aFiles[m.lnFor, 1]
RENAME (lcSource) TO (lcTarget)
NEXT

any help on why it would say ''file already exists error' in vfp? I think it has to do with the RENAME command.

Also, finally, I just realized that it's not the date modified that I need, it's actually the "date taken" field (as this is a picture folder". any help?
thanks,
f1
 
actually, i found the error but I have alittle bug.

when it's "am", there should be a zero instead of a space in the filenamae.


also, as i mentioned, I need to get the "date taken" field (as this is a picture folder". any help?

here;s the code so far:

lnFiles = ADIR(aFiles, "c:\Test\*.*")
FOR lnFor = 1 TO lnFiles
IF LEFT(aFiles[lnFor, 1], 1) == "."
LOOP
ENDIF
lcSource = "c:\Test\"+aFiles[lnFor, 1]
lcTarget = "c:\Test\"+Dtos(aFiles[m.lnFor, 3]) + CHRTRAN(aFiles[m.lnFor, 4],':','') + aFiles[m.lnFor, 1]
RENAME (lcSource) TO (lcTarget)
NEXT


any help? thanks.
f1
 
I've checked the link you sent & I don't read russian unfortunately. can anybody help?
 
"I need to get the 'date taken' field"

I assume that the File Creation Date/Time will coincide with the 'date taken'.

If so the ADIR() approach above will probably not work since, according to the VFP Help on the function, it returns the File Modified Date/Time.

Instead the link referenced above appears to give you what you are looking for.

While the dialog is in Russian, the code is VFP code and should be easily understandable. If you really need the Russian dialog translated consider putting the text into something like: babelfish.yahoo.com
However you might just try experimenting with the code to see if it gives you what you are looking for.

You can also do a Google search for VFP "Filer.dll" and you will get a lot of search results including:

Good Luck,
JRB-Bldr
 
Russian??? I don't know Russian either. I hope you are not trying to be funny.


Cetin Basoz
MS Foxpro MVP, MCP
 
Hi,

Unfortunately, your assumption is incorrect. The File Creation Date/Time does not coincide with the 'date picture taken' column.

Any help?

Thanks,
F1
 
If the file's Create Date/Time and the Modified Date/Time do not coincide with the 'Date Picture Taken', then where is this information supposed to come from?

If it is part of the picture image (such as a Date/Time stamp on the photo itself) then you are out of luck. That information would not be separately available to acquire and use.

If someone has 'catalogued' the photos such that a Create Date/Time is associated with a Photo filename and that 'catalogue' has been saved in some electronic form and it is available for application interrogation then you have something that can be used to meet your goals.

Good Luck,
JRB-Bldr
 
I guess I am out of luck. :(

I really thought there would be something / somehow I could get the "Date Picture Taken" property.

If not with VFP can anybody recommend another way of doing this?

Any help would be greatly appreciated.


Thanks,
F1
 
OK, admittedly I am not 100% up to speed in regards to Digital Photography and the resultant image files.

After some investigation on the web I have found that there is "Date Picture Taken" information saved as part of the image file - in something referred to as Photo 'Metadata' and that it is accessible via Windows (maybe MAX also).
See references like:

Now, with that being understood, it still remains how to extract that info from the file itself. Obviously if Windows can do it so can VFP. It only remains to be determined where and how to find it.

One way might be to utilize an API utility to 'harvest' Metadata from the files.
A Google search for Photo Metadata API turned up a number of search results that might some some promise.

Again if Windows can do it, there is most likely some Windows dll's out there which can do the trick (for free?).

Something possibly worth looking at would be the results of a Google Search for:
"date picture taken" windows dll

One of the search results which might offer some clues is:

Perhaps one of the other guru's can suggest something.

Good Luck,
JRB-Bldr
 
Following up with the investigation on the web I have found non-VFP applications which might do what you want.

Such as:
Then if the photo files were already named as desired, your VFP application could do whatever else was needed.

Good Luck,
JRB-Bldr
 
You're looking for information embedded within the pictures themselves, which is also read out partly depending on filetype, like mp3 tags are also read from mp3 files, windows also reads 'date taken' from photos, if these dates are included in EXIF-Tags within the file.

I think there was some thread about how to read in EXIF tags from a file here on tek-tips, but I don't find that right now.

Bye, Olaf.
 
Hi,

I've copied/pasted the code:
PUBLIC oform1

oform1=NEWOBJECT("form1")
oform1.SHOW
RETURN

DEFINE CLASS form1 AS FORM

gdiplusToken = ''
TOP = 0
LEFT = 17
HEIGHT = 350
WIDTH = 400
DOCREATE = .T.
CAPTION = "Get Image Properties (EXIF)"
NAME = "Form1"
gpImageHandle = 0


ADD OBJECT grid1 AS GRID WITH ;
ANCHOR = 14, ;
HEIGHT = 351, ;
LEFT = 0, ;
TOP = 0, ;
WIDTH = 400, ;
NAME = "Grid1"

*************************
PROCEDURE createpropertycursor
*************************
CREATE CURSOR crsProps (PropName C(50), IDValue I)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsVer", 0x0000)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsLatitudeRef", 0x0001)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsLatitude", 0x0002)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsLongitudeRef", 0x0003)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsLongitude", 0x0004)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsAltitudeRef", 0x0005)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsAltitude", 0x0006)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsGpsTime", 0x0007)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsGpsSatellites", 0x0008)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsGpsStatus", 0x0009)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsGpsMeasureMode", 0x000A)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsGpsDop", 0x000B)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsSpeedRef", 0x000C)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsSpeed", 0x000D)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsTrackRef", 0x000E)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsTrack", 0x000F)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsImgDirRef", 0x0010)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsImgDir", 0x0011)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsMapDatum", 0x0012)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestLatRef", 0x0013)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestLat", 0x0014)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestLongRef", 0x0015)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestLong", 0x0016)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestBearRef", 0x0017)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestBear", 0x0018)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestDistRef", 0x0019)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsDestDist", 0x001A)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagNewSubfileType", 0x00FE)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSubfileType", 0x00FF)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagImageWidth", 0x0100)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagImageHeight", 0x0101)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagBitsPerSample", 0x0102)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagCompression", 0x0103)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPhotometricInterp", 0x0106)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThreshHolding", 0x0107)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagCellWidth", 0x0108)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagCellHeight", 0x0109)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagFillOrder", 0x010A)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagDocumentName", 0x010D)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagImageDescription", 0x010E)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagEquipMake", 0x010F)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagEquipModel", 0x0110)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagStripOffsets", 0x0111)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagOrientation", 0x0112)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSamplesPerPixel", 0x0115)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagRowsPerStrip", 0x0116)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagStripBytesCount", 0x0117)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagMinSampleValue", 0x0118)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagMaxSampleValue", 0x0119)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagXResolution", 0x011A)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagYResolution", 0x011B)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPlanarConfig", 0x011C)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPageName", 0x011D)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagXPosition", 0x011E)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagYPosition", 0x011F)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagFreeOffset", 0x0120)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagFreeByteCounts", 0x0121)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGrayResponseUnit", 0x0122)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGrayResponseCurve", 0x0123)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagT4Option", 0x0124)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagT6Option", 0x0125)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagResolutionUnit", 0x0128)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPageNumber", 0x0129)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTransferFunction", 0x012D)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSoftwareUsed", 0x0131)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagDateTime", 0x0132)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagArtist", 0x013B)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHostComputer", 0x013C)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPredictor", 0x013D)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagWhitePoint", 0x013E)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrimaryChromaticities", 0x013F)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagColorMap", 0x0140)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneHints", 0x0141)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTileWidth", 0x0142)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTileLength", 0x0143)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTileOffset", 0x0144)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTileByteCounts", 0x0145)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagInkSet", 0x014C)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagInkNames", 0x014D)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagNumberOfInks", 0x014E)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagDotRange", 0x0150)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTargetPrinter", 0x0151)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExtraSamples", 0x0152)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSampleFormat", 0x0153)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSMinSampleValue", 0x0154)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSMaxSampleValue", 0x0155)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagTransferRange", 0x0156)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGProc", 0x0200)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGInterFormat", 0x0201)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGInterLength", 0x0202)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGRestartInterval", 0x0203)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGLosslessPredictors", 0x0205)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGPointTransforms", 0x0206)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGQTables", 0x0207)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGDCTables", 0x0208)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGACTables", 0x0209)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagYCbCrCoefficients", 0x0211)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagYCbCrSubsampling", 0x0212)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagYCbCrPositioning", 0x0213)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagREFBlackWhite", 0x0214)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGamma", 0x0301)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagICCProfileDescriptor", 0x0302)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagSRGBRenderingIntent", 0x0303)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagImageTitle", 0x0320)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagResolutionXUnit", 0x5001)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagResolutionYUnit", 0x5002)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagResolutionXLengthUnit", 0x5003)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagResolutionYLengthUnit", 0x5004)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrintFlags", 0x5005)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrintFlagsVersion", 0x5006)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrintFlagsCrop", 0x5007)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrintFlagsBleedWidth", 0x5008)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPrintFlagsBleedWidthScale", 0x5009)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneLPI", 0x500A)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneLPIUnit", 0x500B)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneDegree", 0x500C)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneShape", 0x500D)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneMisc", 0x500E)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagHalftoneScreen", 0x500F)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagJPEGQuality", 0x5010)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGridSize", 0x5011)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailFormat", 0x5012)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailWidth", 0x5013)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailHeight", 0x5014)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailColorDepth", 0x5015)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailPlanes", 0x5016)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailRawBytes", 0x5017)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailSize", 0x5018)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailCompressedSize", 0x5019)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagColorTransferFunction", 0x501A)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailData", 0x501B)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailImageWidth", 0x5020)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailImageHeight", 0x5021)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailBitsPerSample", 0x5022)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailCompression", 0x5023)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailPhotometricInterp", 0x5024)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailImageDescription", 0x5025)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailEquipMake", 0x5026)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailEquipModel", 0x5027)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailStripOffsets", 0x5028)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailOrientation", 0x5029)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailSamplesPerPixel", 0x502A)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailRowsPerStrip", 0x502B)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailStripBytesCount", 0x502C)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailResolutionX", 0x502D)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailResolutionY", 0x502E)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailPlanarConfig", 0x502F)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailResolutionUnit", 0x5030)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailTransferFunction", 0x5031)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailSoftwareUsed", 0x5032)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailDateTime", 0x5033)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailArtist", 0x5034)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailWhitePoint", 0x5035)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailPrimaryChromaticities", 0x5036)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailYCbCrCoefficients", 0x5037)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailYCbCrSubsampling", 0x5038)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailYCbCrPositioning", 0x5039)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailRefBlackWhite", 0x503A)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagThumbnailCopyRight", 0x503B)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagLuminanceTable", 0x5090)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagChrominanceTable", 0x5091)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagFrameDelay", 0x5100)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagLoopCount", 0x5101)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGlobalPalette", 0x5102)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagIndexBackground", 0x5103)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagIndexTransparent", 0x5104)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPixelUnit", 0x5110)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPixelPerUnitX", 0x5111)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPixelPerUnitY", 0x5112)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagPaletteHistogram", 0x5113)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagCopyright", 0x8298)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifExposureTime", 0x829A)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFNumber", 0x829D)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifIFD", 0x8769)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagICCProfile", 0x8773)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifExposureProg", 0x8822)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSpectralSense", 0x8824)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagGpsIFD", 0x8825)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifISOSpeed", 0x8827)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifOECF", 0x8828)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifVer", 0x9000)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifDTOrig", 0x9003)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifDTDigitized", 0x9004)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifCompConfig", 0x9101)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifCompBPP", 0x9102)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifShutterSpeed", 0x9201)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifAperture", 0x9202)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifBrightness", 0x9203)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifExposureBias", 0x9204)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifMaxAperture", 0x9205)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSubjectDist", 0x9206)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifMeteringMode", 0x9207)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifLightSource", 0x9208)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFlash", 0x9209)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFocalLength", 0x920A)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifMakerNote", 0x927C)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifUserComment", 0x9286)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifDTSubsec", 0x9290)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifDTOrigSS", 0x9291)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifDTDigSS", 0x9292)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFPXVer", 0xA000)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifColorSpace", 0xA001)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifPixXDim", 0xA002)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifPixYDim", 0xA003)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifRelatedWav", 0xA004)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifInterop", 0xA005)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFlashEnergy", 0xA20B)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSpatialFR", 0xA20C)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFocalXRes", 0xA20E)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFocalYRes", 0xA20F)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFocalResUnit", 0xA210)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSubjectLoc", 0xA214)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifExposureIndex", 0xA215)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSensingMethod", 0xA217)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifFileSource", 0xA300)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifSceneType", 0xA301)
INSERT INTO crsProps (PropName, IDValue) VALUES("PropertyTagExifCfaPattern", 0xA302)
INDEX ON IDValue TO IDValue
ENDPROC

*************************
PROCEDURE retrievepropname
*************************
LPARAMETERS tnPropertyID
LOCAL lcReturn
lcReturn = "Unknown"
IF SEEK(tnPropertyID, "crsProps", "IDValue")
lcReturn = crsProps.PropName
ENDIF
RETURN lcReturn
ENDPROC

*************************
PROCEDURE getimageproperties
*************************
LOCAL lnMax
DIMENSION aryProps(1)
aryProps(1) = NULL
WITH THIS
lnMax = .GGetPropertyIDList(@aryProps)
CREATE CURSOR crsEXIF (Property C(50), DATA C(100))
FOR lnCounter = 1 TO lnMax
INSERT INTO crsEXIF (Property, DATA) VALUES (.retrievepropname(aryProps(lnCounter)), TRANSFORM(.GGetPropertyItem(aryProps(lnCounter))))
ENDFOR
GO TOP IN crsEXIF
ENDWITH
ENDPROC

*************************
PROCEDURE fillpropertygrid
*************************
WITH THIS
.createpropertycursor()
.getimageproperties()
.grid1.RECORDSOURCE = "crsEXIF"
.grid1.REFRESH()
* .grid1.AUTOFIT()
ENDWITH
ENDPROC

*************************
PROCEDURE INIT
*************************
LOCAL lcImageFile
lcImageFile = GETPICT()
IF EMPTY(lcImageFile)
RETURN .F.
ENDIF
THIS.DeclareAPIs()
IF This.GdipStartup()
THIS.gpImageHandle = THIS.GGetImageHandle(lcImageFile)
THIS.fillpropertygrid()
ELSE
RETURN .F.
ENDIF
ENDPROC

*************************
PROCEDURE DESTROY
*************************
This.GdipShutdown()
USE IN SELECT("crsProps")
USE IN SELECT("crsEXIF")
ENDPROC

*************************
FUNCTION GGetPropertyCount()
*************************
LOCAL lnCount
m.lnCount = 0
GdipGetPropertyCount(THIS.gpImageHandle, @m.lnCount)
RETURN m.lnCount
ENDFUNC

*************************
FUNCTION GGetPropertyIDList(aryPropIDList)
*************************
LOCAL lnCount, lcIdList, lnIndex
m.lnCount = THIS.GGetPropertyCount()
IF ISNULL(m.lnCount) OR m.lnCount < 1
RETURN m.lnCount
ENDIF

m.lcIdList = REPLICATE(CHR(0), 4 * m.lnCount)
GdipGetPropertyIdList(THIS.gpImageHandle, m.lnCount, @m.lcIdList)

DIMENSION aryPropIDList(m.lnCount)
FOR m.lnIndex = 1 TO m.lnCount
aryPropIDList(m.lnIndex) = THIS.buf2num(SUBSTR(m.lcIdList, m.lnIndex * 4 - 3, 4))
ENDFOR
RETURN m.lnCount
ENDFUNC

*************************
FUNCTION GGetPropertyItem(tnPropID)
*************************
LOCAL lnBufferSize, lnBufferPtr, lnStringPtr, ;
lnPropertyTagType, lnValueLen, lnValuePtr, lvReturn

m.lnBufferSize = 0

GdipGetPropertyItemSize(THIS.gpImageHandle, m.tnPropID, @lnBufferSize)

m.lnBufferPtr = GlobalAlloc(64, m.lnBufferSize)

IF 0 == m.lnBufferPtr
RETURN ""
ENDIF

GdipGetPropertyItem(THIS.gpImageHandle, m.tnPropID, ;
m.lnBufferSize, m.lnBufferPtr)

lnPropertyTagType = THIS.buf2num(THIS.GetMemString(m.lnBufferPtr + 8, 4))
lnValueLen = THIS.buf2num(THIS.GetMemString(m.lnBufferPtr + 4, 4))
lnValuePtr = THIS.buf2num(THIS.GetMemString(m.lnBufferPtr + 12, 4))

DO CASE
CASE INLIST(m.lnPropertyTagType,0,6,7,8)
lvReturn = NULL
CASE 1 == m.lnPropertyTagType
lvReturn = ASC(THIS.GetMemString(m.lnValuePtr, 1))
CASE 2 == m.lnPropertyTagType
lvReturn = STREXTRACT(THIS.GetMemString(m.lnValuePtr, m.lnValueLen),'',CHR(0),1,2)
CASE 3 == m.lnPropertyTagType
lvReturn = ASC(THIS.GetMemString(m.lnValuePtr, 1)) + 256 * ASC(THIS.GetMemString(m.lnValuePtr + 1, 1))
CASE 4 == m.lnPropertyTagType
lvReturn = THIS.buf2num(THIS.GetMemString(m.lnValuePtr, 4))
CASE 5 == m.lnPropertyTagType
lvReturn = LTRIM(STR(THIS.buf2num(THIS.GetMemString(m.lnValuePtr, 4)))) + '/' ;
+ LTRIM(STR(THIS.buf2num(THIS.GetMemString(m.lnValuePtr + 4, 4))))
CASE 9 == m.lnPropertyTagType
lvReturn = THIS.buf2num(THIS.GetMemString(m.lnValuePtr, 4))
IF m.lvReturn > 2147483647
lvReturn = m.lvReturn - 4294967296
ENDIF
CASE 10 == m.lnPropertyTagType
LOCAL lnNum, lnDen
lnNum = THIS.buf2num(THIS.GetMemString(m.lnValuePtr, 4))
lnDen = THIS.buf2num(THIS.GetMemString(m.lnValuePtr + 4, 4))
IF m.lnNum > 2147483647
lnNum = m.lnNum - 4294967296
ENDIF
IF m.lnDen >2147483647
lnDen = m.lnDen - 4294967296
ENDIF
lvReturn = LTRIM(STR(m.lnNum)) +'/'+LTRIM(STR(m.lnDen))
OTHERWISE
GlobalFree(m.lnBufferPtr)
RETURN ""
ENDCASE
GlobalFree(m.lnBufferPtr)
RETURN m.lvReturn
ENDFUNC

*************************
FUNCTION GGetImageHandle(tcFilename)
*************************
LOCAL lnHandle
m.lnHandle = 0
GdipLoadImageFromFile(THIS.a2u(m.tcFilename), @m.lnHandle)
RETURN m.lnHandle
ENDFUNC

************************
FUNCTION buf2num(tcBuffer)
************************
RETURN ASC(SUBSTR(tcBuffer, 1,1)) + ;
ASC(SUBSTR(tcBuffer, 2,1)) * 2^8 + ;
ASC(SUBSTR(tcBuffer, 3,1)) * 2^16 + ;
ASC(SUBSTR(tcBuffer, 4,1)) * 2^24
ENDFUNC

*************************
FUNCTION GetMemString(tnString, tnMaxLength)
*************************
LOCAL lcRet, lnNulfoundAt, lcReturn
lcReturn = ""
IF tnString != 0
lcRet = SPACE(tnMaxLength)
CopyMemory(@lcRet, tnString, LEN(lcRet))
lnNulfoundAt = AT(CHR(0), lcRet)
IF lnNulfoundAt > 0
lcRet = LEFT(lcRet, lnNulfoundAt - 1)
ENDIF
lcReturn = lcRet
ENDIF
RETURN lcReturn
ENDFUNC

******************************
FUNCTION a2u(tcStr)
******************************
#if Version(5) >= 700
Return Strconv(tcStr + Chr(0), 5)
#else
Local lnLen, lcWideStr
lnLen = 2 * (Len(tcStr) + 1)
lcWideStr = Replicate(Chr(0), lnLen)
MultiByteToWideChar(0, 0, @tcStr, Len(tcStr), @lcWideStr, lnLen)
Return lcWideStr
#endif
ENDFUNC


*************************
PROCEDURE DeclareAPIs()
*************************
Declare Long GdipLoadImageFromFile in GdiPlus.dll ;
String FileName, Long @ GpImage
*!* DECLARE INTEGER GdipLoadImageFromFile IN GDIPLUS.DLL ;
*!* STRING wFilename, INTEGER @ nImage
DECLARE INTEGER GdipGetPropertyCount IN GDIPLUS.DLL ;
INTEGER nImage, INTEGER @nCount
DECLARE INTEGER GdipGetPropertyIdList IN GDIPLUS.DLL ;
INTEGER nImage, INTEGER nCount, STRING @ LIST
DECLARE INTEGER GlobalAlloc IN kernel32.DLL ;
INTEGER nFlags, INTEGER nSize
DECLARE INTEGER GlobalFree IN kernel32.DLL ;
INTEGER nHandle
DECLARE INTEGER lstrlenA IN kernel32.DLL AS __win32_lstrlenA_ptr INTEGER
DECLARE INTEGER GdipGetPropertyItemSize IN GDIPLUS.DLL ;
INTEGER nImage, INTEGER nPropID, INTEGER @ nBufSize
DECLARE INTEGER GdipGetPropertyItem IN GDIPLUS.DLL ;
INTEGER nImage, INTEGER nPropID, INTEGER nBufSize, INTEGER nBufferPtr
DECLARE RtlMoveMemory IN kernel32 AS CopyMemory;
STRING @ Destination, INTEGER SOURCE, INTEGER nLength
DECLARE INTEGER WideCharToMultiByte IN kernel32;
INTEGER CodePg, INTEGER dwFlags,;
STRING lpWideCharStr, INTEGER cchWideChar,;
STRING @lpMultiByteStr, INTEGER cbMultiByte,;
STRING lpDefaultChar, INTEGER lpUsedDefaultChar
DECLARE INTEGER MultiByteToWideChar IN kernel32;
INTEGER CODEPAGE, LONG dwFlags, STRING lpMultiByteStr,;
INTEGER cbMultiByte, STRING @lpWCharStr, INTEGER cchWChar

Declare Long GdiplusStartup in GdiPlus.dll ;
Long @ token, String @ input, Long @ output
Declare Long GdiplusShutdown in GdiPlus.dll ;
Long token
ENDPROC

PROCEDURE GdipStartup()

Local gdiplusStartupInput, lcToken
* struct GdiplusStartupInput
* {
* UINT32 GdiplusVersion; // Must be 1
* DebugEventProc DebugEventCallback; // Ignored on free builds
* BOOL SuppressBackgroundThread; // FALSE unless you're prepared to call
* // the hook/unhook functions properly
* BOOL SuppressExternalCodecs; // FALSE unless you want GDI+ only to use
* // its internal image codecs.
* }
gdiplusStartupInput = Chr(1) + Replicate(Chr(0), 15) && GdiplusStartupInput structure (sizeof = 16)

* Initialize GDI+.
lcToken = 0
If GdiplusStartup(@lcToken, @gdiplusStartupInput, 0) != 0
Return .F.
EndIf
This.gdiplusToken = lcToken

ENDPROC

PROCEDURE GdipShutdown()
GdiplusShutdown(This.gdiplusToken)
ENDPROC
ENDDEFINE

in a prg but it just hangs.

any help on what I want to acheive?

thanks,
f1
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top