Получить свойства Word-сервера с помощью Delphi

Question

Благодаря приведенным ниже функциям я успешно извлекаю из документа Word, хранящегося локально (синхронизируемого с сервером через OneDrive), его свойства сервера (те, которые хранятся в виде столбцов SharePoint), и все это без автоматизации Ole.Структура функций:

• Поскольку документ Word представляет собой архивированный файл, разархивируйте файл, в котором хранятся такие свойства.

• Извлекитесодержимое файла в строку.

• Загрузка строки в документ XML.

• Передача имен полей и их содержимого в StringList.

``

function WordGetServerProperties (FName:string):TStringList;
var
s,ss:string;
i,ii:integer;
St:TStringList;
XML:IXMLDocument;
N,NN: IXMLNode;
begin

s:=ExtractZipToStr(FName,'customXml/item1.xml',ExtractFilePath(FName));

if StrContains('<p:properties',s)=False then
 s:=ExtractZipToStr(FName,'customXml/item2.xml',ExtractFilePath(FName));
if StrContains('<p:properties',s)=False then
 s:=ExtractZipToStr(FName,'customXml/item3.xml',ExtractFilePath(FName));

XML:=NewXMLDocument;
St:=TStringList.Create;
XML.Active := True;
XML.LoadFromXML(s);
  N:=xml.DocumentElement;
  try
  for i := 0 to N.ChildNodes.Count -1 do
  begin
    if N.ChildNodes[i].NodeName = 'documentManagement' then
    begin
    NN:=N.ChildNodes[i];
    for ii := 0 to NN.ChildNodes.Count -1 do
     begin
     ss:=AnsiReplaceStr(NN.ChildNodes[ii].NodeName,'_x0020_',' ');
     if ss='SharedWithUsers' then continue;
     ss:=ss+'='+NN.ChildNodes[ii].Text;
     st.Add(ss)
     end;
    end;
  end;
   finally
    XML.Active := False;
   end;
Result:=st;
end;


function ExtractZipToStr(const ZipFileName: string; const ZippedFileName, ExtractedFileName: string): widestring;
var
  ZipFile: TZipFile;
  F,s:string;
  i:integer;
  Exists:Boolean;
  LStream: TStream;
  FStream:TFileStream;
  LocalHeader: TZipHeader;
begin
  Exists:=False;
  ZipFile := TZipFile.Create;
  LStream := TStream.Create;
  try
  try
   ZipFile.Open(ZipFileName,zmRead);
  except on EZipException do begin Result:='noprops'; ZipFile.Close; ZipFile.Free;  LStream.Free; exit; end; end;
  for i := 0 to ZipFile.FileCount - 1 do
          begin
            F:= ZipFile.FileNames[i];
            if F='docProps/custom.xml' then begin Exists:=True; system.Break; end;
          end;
  if exists=True then
    begin
    ZipFile.Read(ZippedFileName, LStream, LocalHeader);
    LStream.Position:=0;
    Result:=StreamToString(LStream);
    end
  else Result:='noprops';
  finally
  ZipFile.Close;
  ZipFile.Free;
  LStream.Free;
  end;
end;

function StreamToString(aStream: TStream): widestring;
var
  SS: TStringStream;
begin
  if aStream <> nil then
  begin
    SS := TStringStream.Create('');
    try
      SS.CopyFrom(aStream, 0);
      Result := SS.DataString;
    finally
      SS.Free;
    end;
  end else
  begin
    Result := '';
  end;
end;

Это относительно быстро, но не так много, как хотелось бы.Надеюсь, я показал, что (будучи любителем в этом) я нахожусь в конце своего ума.Не могли бы вы найти способ улучшить или полностью заменить эти процедуры чем-то более эффективным?