Detect old Office files

[Ericktux]

Good afternoon, friends. I have a question: if I have three files named:

example1.doc
example2.xls
example3.ppt

and I rename them to:

example1.ole
example2.ole
example3.ole

Is there a way to detect the extension or Office type of each one? 

example1.ole ==> example1.doc
example2.ole ==> example2.xls
example3.ole ==> example3.ppt

[Wallaby]

Yep, you can totally figure out what kind of old Office file it is, even if you renamed the extensions to .ole. These older .doc, .xls, and .ppt files use a special OLE format internally, kinda like a mini file system inside the file.

Each type has a unique stream name inside it:

* Word files have a stream called WordDocument
* Excel files use Workbook or Book
* PowerPoint files have PowerPoint Document

So, you can just peek inside the file and look for those names — no need to rely on the extension at all:

Code: Pascal  [Select][+][-]

1. function GetOfficeFileType(const FileName: string): string;
2. var
3.   Storage: IStorage;
4.   EnumStat: IEnumStatStg;
5.   StatStg: TStatStg;
6.   NumFetched: ULONG;
7.   FileType: string;
8. begin
9.   FileType := 'Unknown';
10.   OleCheck(StgOpenStorage(PWideChar(WideString(FileName)), nil,
11.     STGM_READ or STGM_SHARE_DENY_WRITE, nil, 0, Storage));
12.  
13.   if Assigned(Storage) then
14.   begin
15.     OleCheck(Storage.EnumElements(0, nil, 0, EnumStat));
16.     while EnumStat.Next(1, StatStg, @NumFetched) = S_OK do
17.     begin
18.       if StatStg.pwcsName <> nil then
19.       begin
20.         if WideSameText(StatStg.pwcsName, 'WordDocument') then
21.           FileType := 'DOC'
22.         else if WideSameText(StatStg.pwcsName, 'Workbook') or
23.                 WideSameText(StatStg.pwcsName, 'Book') then
24.           FileType := 'XLS'
25.         else if WideSameText(StatStg.pwcsName, 'PowerPoint Document') then
26.           FileType := 'PPT';
27.         CoTaskMemFree(StatStg.pwcsName);
28.       end;
29.     end;
30.   end;
31.  
32.   Result := FileType;
33. end;

[wp]

This brings me to a cross-platform solution because FPSpreadsheet contains routines to read the OLE file format. Add the laz_fpspreadsheet package to the project requirements (or copy the files "uvirtual*.pas" from the fpspreadsheet/source/common folder into your project), and you'll be able to use the following code without having to install the Microsoft Office suite:

Code: Pascal  [Select][+][-]

1. uses
2.   [...], uVirtualLayer_OLE, [...];
3.  
4. // AStreamName = 'Book' --> Excel BIFF 5 file
5. //               'Workbook' --> Excel BIFF 8 file (Excel 97)
6. //               'WordDocument' --> Word file .doc
7. //               'PowerPoint Document' --> Powerpoint file .ppt
8. function IsOLEStream(AStream: TStream; const AStreamName: String): Boolean;
9. var
10.   fsOLE: TVirtualLayer_OLE;
11.   VLAbsolutePath: UTF8String;
12. begin
13.   VLAbsolutePath := '/' + AStreamName; //Virtual layer always use absolute paths.
14.   fsOLE := TVirtualLayer_OLE.Create(AStream);
15.   try
16.     fsOLE.Initialize(); //Initialize the OLE container.
17.     Result := fsOLE.FileExists(VLAbsolutePath);
18.   finally
19.     fsOLE.Free;
20.   end;
21. end;    

[Ericktux]

Thanks a lot, my friend. It worked perfectly  . I added these units to the first example:

Code: Pascal  [Select][+][-]

1. Uses Windows, ActiveX, ComObj. . . .