Utilizamos cookies propias y de terceros. [Más información sobre las cookies].
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Wiki
Obtener información de un fichero Microsoft Word - Delphi
Lenguaje de programación Borland Delphi


Un ejemplo en Delphi que, utilizando "StgOpenStorage" (ActiveX - Ole32), obtiene información sobre ficheros de Microsoft Word (título, asunto, autor, palabras clave, comentarios, plantilla, número de páginas, número de palabras, número de caracteres, ...). Para ello hemos utilizado un TLabel, un TEdit, dos TButton y un TOpenDialog:

unit UnidadMenuPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComObj, ActiveX, StdCtrls;

type
  TformMenuPrincipal = class(TForm)
    Label1: TLabel;
    txtFichero: TEdit;
    bInfo: TButton;
    txtDatos: TMemo;
    bSeleccion: TButton;
    dlAbrir: TOpenDialog;
    procedure bInfoClick(Sender: TObject);
    procedure bSeleccionClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formMenuPrincipal: TformMenuPrincipal;

const
  FmtID_SummaryInformation: TGUID =
    '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';

implementation

{$R *.dfm}


function FileTimeToDateTimeStr(F: TFileTime): string;
var
  LocalFileTime: TFileTime;
  SystemTime: TSystemTime;
  DateTime: TDateTime;
begin
  if Comp(F) = 0 then Result := '-'
  else 
  begin
    FileTimeToLocalFileTime(F, LocalFileTime);
    FileTimeToSystemTime(LocalFileTime, SystemTime);
    with SystemTime do
      DateTime := EncodeDate(wYear, wMonth, wDay) +
        EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
    Result := DateTimeToStr(DateTime);
  end;
end;

function GetDocInfo(const FileName: WideString): TStringList;
var
  I: Integer;
  PropSetStg: IPropertySetStorage;
  PropSpec: array[2..19] of TPropSpec;
  PropStg: IPropertyStorage;
  PropVariant: array[2..19] of TPropVariant;
  Rslt: HResult;
  S: string;
  Stg: IStorage;
  lista : TStringList;
begin
  lista := TStringList.Create;
  Result := lista;
  try
    OleCheck(StgOpenStorage(PWideChar(FileName), nil, STGM_READ or
      STGM_SHARE_DENY_WRITE,
      nil, 0, Stg));
    PropSetStg := Stg as IPropertySetStorage;
    OleCheck(PropSetStg.Open(FmtID_SummaryInformation,
      STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg));
    for I := 2 to 19 do
    begin
      PropSpec[I].ulKind := PRSPEC_PROPID;
      PropSpec[I].PropID := I;
    end;
    Rslt := PropStg.ReadMultiple(18, @PropSpec, @PropVariant);
    OleCheck(Rslt);
    if Rslt <> S_FALSE then for I := 2 to 19 do
      begin
        S := '';
        if PropVariant[I].vt = VT_LPSTR then
          if Assigned(PropVariant[I].pszVal) then
            S := PropVariant[I].pszVal;
        case I of
          2:  S  := Format('Título: %s', [S]);
          3:  S  := Format('Asunto: %s', [S]);
          4:  S  := Format('Autor: %s', [S]);
          5:  S  := Format('Palabras clave: %s', [S]);
          6:  S  := Format('Comentarios: %s', [S]);
          7:  S  := Format('Plantilla: %s', [S]);
          8:  S  := Format('Guardado por última vez por: %s', [S]);
          9:  S  := Format('Nº de revisión: %s', [S]);
          10: S := Format('Tiempo total de edición: %g sec', 
              [Comp(PropVariant[I].filetime) / 1.0E9]);
          11: S := Format('Última impresión: %s', 
              [FileTimeToDateTimeStr(PropVariant[I].filetime)]);
          12: S := Format('Fecha/Hora de creación: %s', 
              [FileTimeToDateTimeStr(PropVariant[I].filetime)]);
          13: S := Format('Fecha/Hora último cambio guardado: %s', 
              [FileTimeToDateTimeStr(PropVariant[I].filetime)]);
          14: S := Format('Número de páginas: %d', [PropVariant[I].lVal]);
          15: S := Format('Número de palabras: %d', [PropVariant[I].lVal]);
          16: S := Format('Número de caracteres: %d', [PropVariant[I].lVal]);
          17:; //miniaturas
          18: S := Format('Aplicación: %s', [S]);
          19: S := Format('Seguridad: %.8x', [PropVariant[I].lVal]);
        end;
        if S <> '' then
          lista.Add (S);
      end;
  finally
  end;
end;


procedure TformMenuPrincipal.bInfoClick(Sender: TObject);
begin
  txtDatos.Clear;
  if FileExists(txtFichero.text) then
    txtDatos.Lines := GetDocInfo(txtFichero.Text);
end;

procedure TformMenuPrincipal.bSeleccionClick(Sender: TObject);
begin
  if dlAbrir.Execute then
  begin
    txtFichero.Text := dlAbrir.FileName;
    bInfoClick(Self);
  end;
end;

end.




Publicado el: 2005-10-01

Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A