ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Взаимодействие с Microsoft Outlook
26 сообщений из 26, показаны все 2 страниц
  все  
Взаимодействие с Microsoft Outlook
    #39251333
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Дано.
Открыто приложение Microsoft Outlook, в нём открыто письмо с двумя приаттаченными файлами. Пользователь выделяет эти два приаттаченных файла и нажимает кнопку "копировать" или ctrl+C. Если он сейчас перейдёт в проводник и нажмёт ctrl+V, то в каталог вставятся эти два файла.

Мне, в своей программе надо понять, что в буфере обмена находятся два файла (или сколько было скопировано) и по нажатию на свою кнопку, сохранить их в свой каталог.

Что было для этого проделано.
С помощью вот этого кода:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
  Memo1.Lines.Clear;
    for j := 0 to Clipboard.FormatCount do
    begin
      frm := Clipboard.Formats[j];
      tmp := '';
      if Clipboard.HasFormat(frm) then
      begin
        if GetclipboardFormatName(frm, buf, Pred(Sizeof(buf))) <> 0 then
          tmp := StrPas(buf);
        tmp := tmp + ' clipboard format: ' + IntToStr(frm);
        memo1.Lines.Add(tmp);
     end;
   end;


я получил, что содержится в буфере:
DataObject clipboard format: 49161
FileGroupDescriptorW clipboard format: 49395
FileGroupDescriptor clipboard format: 49394
RenPrivateItem clipboard format: 49912
FileContents clipboard format: 49393
Ole Private Data clipboard format: 49171

Далее, при помощи такого кода
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
        f := Clipboard.GetAsHandle(frm);
        if f <> 0 then
        begin
          OleCheck(OleGetClipboard(DataObject));
          FETC.cfFormat := 49394;//;FileGroupDescriptor 49394;//DataObject 49161; FileContents 49393
          FETC.ptd      := Nil;
          FETC.dwAspect := DVASPECT_CONTENT;
          FETC.lindex   := -1;
          FETC.tymed    := TYMED_HGLOBAL;
          rslt := DataObject.GetData(FETC, Medium);
          if rslt = S_OK then
          ...


Я пытаюсь нащупать путь работы с содержимым. Но при этом не могу понять, в каком формате буфера хранятся эти файлы, и как мне их обработать. Буду признателен, если кто-нибудь подскажет, что и где копать.

С уважением, Александр.
...
Рейтинг: 0 / 0
06.06.2016, 15:56
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39251384
Фотография wadman
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
wadman
Участник
ShurakenБуду признателен, если кто-нибудь подскажет, что и где копать.
https://msdn.microsoft.com/en-us/library/windows/desktop/bb776905(v=vs.85).aspx
...
Рейтинг: 0 / 0
06.06.2016, 16:50
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39251388
Aniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Aniskin
Гость
Shuraken,
Как-то так:
 

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
uses
  ActiveX, ShlObj, ComObj, ShlwApi;

const
  shlwapi32 = 'shlwapi.dll';

function SHCreateStreamOnFileEx(pszFile: LPCWSTR; grfMode: DWORD; dwAttributes: DWORD; fCreate: BOOL;
  pstmTemplate: Pointer; out ppstm: IStream): HRESULT; stdcall; external shlwapi32 name 'SHCreateStreamOnFileEx';

var
  CF_FILECONTENTS: UINT;
  CF_FILEDESCRIPTORA: UINT;
  CF_FILEDESCRIPTORW: UINT;

function ContainFormat(ADataObject: IDataObject; AFormat: TClipFormat; ATymed: Longint;
  AAspect: LongInt = DVASPECT_CONTENT; AIndex: LongInt = -1): Boolean;
var
  Format: TFormatEtc;
begin
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := AFormat;
  Format.dwAspect := AAspect;
  Format.lindex := AIndex;
  Format.tymed := ATymed;
  Result := ADataObject.QueryGetData(Format) = S_OK;
end;

procedure RaiseInvalidMedium;
begin
  raise EOleSysError.Create('Invalid medium', E_INVALIDARG, 0);
end;

function GetFileContent(ADataObject: IDataObject; AIndex: Integer): IStream;
var
  Format: TFormatEtc;
  Medium: TStgMedium;
begin
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := CF_FILECONTENTS;
  Format.dwAspect := DVASPECT_CONTENT;
  Format.lindex := AIndex;
  Format.tymed := TYMED_ISTREAM;
  ZeroMemory(@Medium, SizeOf(Medium));
  OleCheck(ADataObject.GetData(Format, Medium));
  try
    if (Medium.tymed and TYMED_ISTREAM = 0) or (Medium.stm = nil) then
      RaiseInvalidMedium;
    Result := IStream(Medium.stm);
  finally
    ReleaseStgMedium(Medium);
  end
end;

procedure SaveFileDescriptorWToDir(ADataObject: IDataObject; const ADir: string);
var
  Format: TFormatEtc;
  Medium: TStgMedium;
  GroupDescriptor: PFileGroupDescriptorW;
  FileDescriptorW: PFileDescriptorW;
  ItemIndex: Integer;
  DestFileName: UnicodeString;
  DestStream: IStream;
  SourceStream: IStream;
  Read: Int64;
  Written: Int64;
begin
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := CF_FILEDESCRIPTORW;
  Format.dwAspect := DVASPECT_CONTENT;
  Format.lindex := -1;
  Format.tymed := TYMED_HGLOBAL;
  ZeroMemory(@Medium, SizeOf(Medium));
  OleCheck(ADataObject.GetData(Format, Medium));
  try
    if (Medium.tymed and TYMED_HGLOBAL = 0) or (Medium.hGlobal = 0) then
      RaiseInvalidMedium;
    GroupDescriptor := GlobalLock(Medium.hGlobal);
    if not Assigned(GroupDescriptor) then
      RaiseLastOSError;
    try
      if GroupDescriptor.cItems = 0 then Exit;
      for ItemIndex := 0 to GroupDescriptor.cItems - 1 do
        begin
          FileDescriptorW := @GroupDescriptor.fgd[ItemIndex];

          // По правильному нужно проверить корректность имени на отсутствие недопустимых символов
          DestFileName := FileDescriptorW.cFileName;

          DestFileName := IncludeTrailingPathDelimiter(ADir) + DestFileName;

          if (FileDescriptorW.dwFlags and FD_ATTRIBUTES <> 0) and (FileDescriptorW.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) then
            begin
              ForceDirectories(DestFileName);
              // По правильному нужно установить даты и аттрибуты директории на основе FileDescriptorW
            end
          else
            begin
              ForceDirectories(ExtractFilePath(DestFileName));
              OleCheck(SHCreateStreamOnFileEx(PWideChar(DestFileName), STGM_CREATE or STGM_READWRITE, FILE_ATTRIBUTE_NORMAL, True, nil, DestStream));
              try
                SourceStream := GetFileContent(ADataObject, ItemIndex);
                try
                  OleCheck(SourceStream.CopyTo(DestStream, -1, Read, Written));
                  // По правильному нужно установить даты и аттрибуты файла на основе FileDescriptorW
                finally
                  SourceStream := nil;
                end;
              finally
                DestStream := nil;
              end;
            end;
        end;
    finally
      GlobalUnlock(Medium.hGlobal);
    end;
  finally
    ReleaseStgMedium(Medium);
  end
end;

procedure SaveClipboardToDir(const ADir: string);
var
  DataObject: IDataObject;
begin
  OleCheck(OleGetClipboard(DataObject));
  try
    if ContainFormat(DataObject, CF_FILEDESCRIPTORW, TYMED_HGLOBAL) then
      SaveFileDescriptorWToDir(DataObject, ADir)
    else

    {if ContainFormat(DataObject, CF_FILEDESCRIPTORA, TYMED_HGLOBAL) then
      SaveFileDescriptorAToDir(DataObject, ADir)
    else}

      raise Exception.Create('Data not found');
  finally
    DataObject := nil;
  end;
end;

initialization
  CF_FILECONTENTS               := RegisterClipboardFormat(CFSTR_FILECONTENTS);
  CF_FILEDESCRIPTORA            := RegisterClipboardFormat(CFSTR_FILEDESCRIPTORA);
  CF_FILEDESCRIPTORW            := RegisterClipboardFormat(CFSTR_FILEDESCRIPTORW);

end.


...
Рейтинг: 0 / 0
06.06.2016, 16:52
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39251401
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Огромное спасибо Wadman, Aniskin. То, что надо.
...
Рейтинг: 0 / 0
06.06.2016, 17:05
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39251853
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Aniskin, благодарю за код, но возникла какая-то непонятка. Вываливаюсь на попытке получить данные
Код: pascal
1.
SourceStream := GetFileContent(ADataObject, ItemIndex);

- "ошибка в структуре FORMATETC". Причём заголовки файлов видны, но содержимого нет. Причём проверку через функцию ContainFormat(DataObject, CF_FILECONTENTS, TYMED_ISTREAM) с отрицательным индексом проходит нормально.
...
Рейтинг: 0 / 0
07.06.2016, 12:55
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39251857
Aniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Aniskin
Гость
Shuraken,

В какой строке ошибка? Код ошибки?
...
Рейтинг: 0 / 0
07.06.2016, 12:58
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39251866
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Aniskin,

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
function GetFileContent(ADataObject: IDataObject; AIndex: Integer): IStream;
var
  Format: TFormatEtc;
  Medium: TStgMedium;
begin
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := CF_FILECONTENTS;
  Format.dwAspect := DVASPECT_CONTENT;
  Format.lindex := AIndex; // нулевой индекс. Файл уже создан в директории
  Format.tymed := TYMED_ISTREAM;
  ZeroMemory(@Medium, SizeOf(Medium));
  OleCheck(ADataObject.GetData(Format, Medium)); //здесь ошибка
  try
    if (Medium.tymed and TYMED_ISTREAM = 0) or (Medium.stm = nil) then
      RaiseInvalidMedium;
    Result := IStream(Medium.stm);
  finally
    ReleaseStgMedium(Medium);
  end
end;
...
Рейтинг: 0 / 0
07.06.2016, 13:04
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39251871
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Ошибку выдаёт OleCheck - "ошибка в структуре FORMATETC"
...
Рейтинг: 0 / 0
07.06.2016, 13:06
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39251880
Aniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Aniskin
Гость
Shuraken,

Мне лень ставить Outlook для экспериментов. Поэтому эксперименты (три штуки) ставь сам. Замени в строке

Код: pascal
1.
Format.tymed := TYMED_ISTREAM


значение TYMED_ISTREAM на

1) TYMED_HGLOBAL
2) TYMED_FILE
3) TYMED_ISTORAGE

В каких ситуациях ошибки в строке OleCheck(ADataObject.GetData(Format, Medium)) не будет?
...
Рейтинг: 0 / 0
07.06.2016, 13:15
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39252081
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Aniskin,

везде ошибка. Посмотрел, что содержится в FileDescriptor, оказалось, что только название файла и всё, другой информации нет. Попробую копать в другом месте. Благодарю за помощь.
...
Рейтинг: 0 / 0
07.06.2016, 15:35
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39252139
Aniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Aniskin
Гость
Shuraken,

Специально установил Outlook (2007) - у меня мой исходный код работает корректно.
...
Рейтинг: 0 / 0
07.06.2016, 16:13
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39252140
Aniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Aniskin
Гость
ShurakenПосмотрел, что содержится в FileDescriptor, оказалось, что только название файла и всё, другой информации нет.А другая информация там НЕ обязана быть.
...
Рейтинг: 0 / 0
07.06.2016, 16:15
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39252192
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Aniskin,
здорово.

Можете взглянуть, у Вас такой код работает?

С уважением, Александр
...
Рейтинг: 0 / 0
07.06.2016, 16:59
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39252201
Aniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Aniskin
Гость
Shuraken,

В какой версии Delphi пишешь?
...
Рейтинг: 0 / 0
07.06.2016, 17:09
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39252239
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Aniskin, Delphi 7
...
Рейтинг: 0 / 0
07.06.2016, 17:39
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39252270
Aniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Aniskin
Гость
ShurakenDelphi 7Вот тут то собака и порылась. Обнови код:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
procedure SaveClipboardToDir(const ADir: string);
var
  OleInitializeSuccess: Boolean;
  DataObject: IDataObject;
begin
  OleInitializeSuccess := OleInitialize(nil) = S_OK;
  try
    OleCheck(OleGetClipboard(DataObject));
    try
      if ContainFormat(DataObject, CF_FILEDESCRIPTORW, TYMED_HGLOBAL) then
        SaveFileDescriptorWToDir(DataObject, ADir)
      else

      {if ContainFormat(DataObject, CF_FILEDESCRIPTORA, TYMED_HGLOBAL) then
        SaveFileDescriptorAToDir(DataObject, ADir)
      else}

        raise Exception.Create('Data not found');
    finally
      DataObject := nil;
    end;
  finally
    if OleInitializeSuccess then
      OleUninitialize;
  end;
end;
...
Рейтинг: 0 / 0
07.06.2016, 18:09
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39252528
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Aniskin, шикарно. Благодарю. С меня пиво (если пьёшь его, конечно).
...
Рейтинг: 0 / 0
08.06.2016, 10:10
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39254198
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Продолжая тему, столкнулся со следующей проблемой. Всё хорошо, когда копируешь файлы в буфер обмена, и затем вставляешь их куда требуется. Но вышеприведённый способ не сработал, когда я стал копировать не приаттаченные файлы из Outlook-а, а само сообщение с приаттаченными файлами, чтобы сохранить его на диск. Немного покопавшись, понял, что с сообщениями Outlook надо работать не через IStream, а через IStorage. Взяв за основу код, любезно предоставленный Aniskin-ым, попытался сохранить сообщение следующим образом. (Весь код целиком, красным выделена работа для сообщений Outlook)

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
uses
  ActiveX, ShlObj, ComObj, ShellApi;
{$R *.dfm}

const
  shlwapi32 = 'shlwapi.dll';

function SHCreateStreamOnFileEx(pszFile: LPCWSTR; grfMode: DWORD; dwAttributes: DWORD; fCreate: BOOL;
  pstmTemplate: Pointer; out ppstm: IStream): HRESULT; stdcall; external shlwapi32 name 'SHCreateStreamOnFileEx';

var
  CF_FILECONTENTS: UINT;
  CF_FILEDESCRIPTORA: UINT;
  CF_FILEDESCRIPTORW: UINT;

function ContainFormat(ADataObject: IDataObject; AFormat: TClipFormat; ATymed: Longint;
  AAspect: LongInt = DVASPECT_CONTENT; AIndex: LongInt = -1): Boolean;
var
  Format: TFormatEtc;
begin
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := AFormat;
  Format.dwAspect := AAspect;
  Format.lindex := AIndex;
  Format.tymed := ATymed;
  Result := ADataObject.QueryGetData(Format) = S_OK;
end;

procedure RaiseInvalidMedium;
begin
  raise EOleSysError.Create('Invalid medium', E_INVALIDARG, 0);
end;

function FillFormat(ADataObject: IDataObject; var Format: TFormatEtc; var Medium: TStgMedium;
                    AFormat: TClipFormat; ATymed: Longint;
                    AAspect: LongInt = DVASPECT_CONTENT; AIndex: LongInt = -1): boolean;
begin
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := AFormat;
  Format.dwAspect := AAspect;
  Format.lindex := AIndex;
  Format.tymed := ATymed;
  ZeroMemory(@Medium, SizeOf(Medium));
  Result := ADataObject.GetData(Format, Medium) = S_OK;
end;

procedure SaveFileDescriptorWToDir(ADataObject: IDataObject; const ADir: string);
var
  Formatetc: TFormatEtc;
  Medium, StreamMedium, StorageMedium: TStgMedium;
  GroupDescriptor: PFileGroupDescriptorW;
  FileDescriptorW: PFileDescriptorW;
  ItemIndex: Integer;
  DestFileName: Widestring;
  DestStream: IStream;
  SourceStream: IStream;
  Read: Int64;
  Written: Int64;
  b: boolean;
  Storage: IStorage;
  stgType: string;
  stgLockType: string;
  msg: string;
  StreamSize: Int64;
  AllSize: integer;

[color=red]  procedure RecurFillStream(AStorage: IStorage);
  var
    Data: TStatStg;
    SubStorage: IStorage;
    EnumStorage: IEnumStatStg;
  begin
    OleCheck(AStorage.EnumElements(0, nil, 0, EnumStorage));
    while EnumStorage.Next(1, Data, nil) = S_OK do
    begin
      if Data.dwType = STGTY_STREAM then
      begin
        OleCheck(AStorage.OpenStream(Data.pwcsName, nil, STGM_SHARE_EXCLUSIVE or STGM_READWRITE, 0, SourceStream));
        AllSize := AllSize + Data.cbSize;
        OleCheck(SourceStream.CopyTo(DestStream, Data.cbSize, Read, Written));
      end
        else if Data.dwType = STGTY_STORAGE then
      begin
        OleCheck(Storage.OpenStorage(Data.pwcsName, nil, STGM_SHARE_EXCLUSIVE or STGM_READWRITE, nil, 0, SubStorage));
        RecurFillStream(SubStorage);
      end;
    end;
  end;[/color]

begin
  if FillFormat(ADataObject, Formatetc, Medium, CF_FILEDESCRIPTORW, TYMED_HGLOBAL) then
  try
    if (Medium.tymed and TYMED_HGLOBAL = 0) or (Medium.hGlobal = 0) then
      RaiseInvalidMedium;
    GroupDescriptor := GlobalLock(Medium.hGlobal);
    if not Assigned(GroupDescriptor) then
      RaiseLastOSError;
    try
      if GroupDescriptor.cItems = 0 then
        Exit;
      for ItemIndex := 0 to GroupDescriptor.cItems - 1 do
      begin
        FileDescriptorW := @GroupDescriptor.fgd[ItemIndex];
        DestFileName := FileDescriptorW.cFileName;
        DestFileName := IncludeTrailingPathDelimiter(ADir) + DestFileName;
        if SHCreateStreamOnFileEx(PWideChar(DestFileName), STGM_CREATE or STGM_READWRITE, FILE_ATTRIBUTE_NORMAL, True, nil, DestStream) = S_OK then
        try
          b := FillFormat(ADataObject, Formatetc, StreamMedium, CF_FILECONTENTS, TYMED_ISTREAM, DVASPECT_CONTENT, ItemIndex);
          try
            if b then
            begin
              if (StreamMedium.tymed and TYMED_ISTREAM = 0) or (StreamMedium.stm = nil) then
                RaiseInvalidMedium;
              SourceStream := IStream(StreamMedium.stm);
              try
                if SourceStream.CopyTo(DestStream, -1, Read, Written) = S_OK then
                  ShowMessage('Файл '+ DestFileName + ' успешно скопирован')
              finally
                SourceStream := nil;
              end;
            end
              else
            begin
              b := FillFormat(ADataObject, Formatetc, StorageMedium, CF_FILECONTENTS, TYMED_ISTORAGE, DVASPECT_CONTENT, ItemIndex);
              try
                if b then
                begin
                  [color=red]if (StorageMedium.tymed and TYMED_ISTORAGE = 0) or (StorageMedium.stg = nil) then
                    RaiseInvalidMedium;
                  Storage := IStorage(StorageMedium.stg);
                  OleCheck(Storage.CreateStream('SourceStream', STGM_SHARE_EXCLUSIVE or STGM_READWRITE, 0, 0, SourceStream));
                  try
                    AllSize := 0;
                    RecurFillStream(Storage);
                    ShowMessage(IntToStr(AllSize));
                    ShowMessage('Файл '+ DestFileName + ' успешно скопирован')
                  finally
                    SourceStream := nil;
                  end;[/color]
                end;
              finally
                ReleaseStgMedium(StorageMedium);
              end;
            end;
          finally
            ReleaseStgMedium(StreamMedium);
          end;
        finally
          DestStream := nil;
        end;
      end;
    finally
      GlobalUnlock(Medium.hGlobal);
    end;
  finally
    ReleaseStgMedium(Medium);
  end
end;

procedure SaveClipboardToDir(const ADir: string);
var
  DataObject: IDataObject;
  OleInitializeSuccess: Boolean;
begin
  OleInitializeSuccess := OleInitialize(nil) = S_OK;
  try
    OleCheck(OleGetClipboard(DataObject));
    try
      if ContainFormat(DataObject, CF_FILEDESCRIPTORW, TYMED_HGLOBAL) then
        SaveFileDescriptorWToDir(DataObject, ADir)
      else
        raise Exception.Create('Data not found');
    finally
      DataObject := nil;
    end;
  finally
    if OleInitializeSuccess then
      OleUninitialize;
  end;
end;



В результате файл сохраняется на диск, но он в несколько раз меньшего размера. То есть, если я копирую сообщение в буфер обмена и просто вставляю его в проводнике, то оно весит, скажем, 100 Кб. Если же я это делаю через код, то оно весит 25 Кб, и, естественно, открыть его нельзя. И почему так получается, мне непонятно. Может кто-нибудь подсказать, где искать потерянную часть данных?
...
Рейтинг: 0 / 0
10.06.2016, 12:49
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39254259
Aniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Aniskin
Гость
Shurakenгде искать потерянную часть данных?

Вот и второе пиво я заработал:

 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
199.
200.
201.
uses
  ActiveX, ShlObj, ComObj, ShlwApi;

const
  shlwapi32 = 'shlwapi.dll';
  ole32     = 'ole32.dll';

function SHCreateStreamOnFileEx(pszFile: LPCWSTR; grfMode: DWORD; dwAttributes: DWORD; fCreate: BOOL;
  pstmTemplate: Pointer; out ppstm: IStream): HRESULT; stdcall; external shlwapi32 name 'SHCreateStreamOnFileEx';

type
  STGFMT = type Integer;

const
  STGFMT_STORAGE  = 0;
  STGFMT_FILE     = 3;
  STGFMT_ANY      = 4;
  STGFMT_DOCFILE  = 5;

function StgCreateStorageEx(pwcsName: PWideChar; grfMode: DWORD; stgfmt: STGFMT; grfAttrs: DWORD;
  pStgOptions: Pointer {STGOPTIONS}; pSecurityDescriptor: PSecurityDescriptor; const riid: TIID; out ppObjectOpen): HRESULT; stdcall; external ole32 name 'StgCreateStorageEx';

var
  CF_FILECONTENTS: UINT;
  CF_FILEDESCRIPTORA: UINT;
  CF_FILEDESCRIPTORW: UINT;

function ContainFormat(ADataObject: IDataObject; AFormat: TClipFormat; ATymed: Longint;
  AAspect: LongInt = DVASPECT_CONTENT; AIndex: LongInt = -1): Boolean;
var
  Format: TFormatEtc;
begin
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := AFormat;
  Format.dwAspect := AAspect;
  Format.lindex := AIndex;
  Format.tymed := ATymed;
  Result := ADataObject.QueryGetData(Format) = S_OK;
end;

procedure RaiseInvalidMedium;
begin
  raise EOleSysError.Create('Invalid medium', E_INVALIDARG, 0);
end;

function GetFileContentAsStream(ADataObject: IDataObject; AIndex: Integer; out AStream: IStream): Boolean;
var
  Format: TFormatEtc;
  Medium: TStgMedium;
begin
  Result := False;
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := CF_FILECONTENTS;
  Format.dwAspect := DVASPECT_CONTENT;
  Format.lindex := AIndex;
  Format.tymed := TYMED_ISTREAM;
  ZeroMemory(@Medium, SizeOf(Medium));
  if Succeeded(ADataObject.GetData(Format, Medium)) then
    try
      if (Medium.tymed and TYMED_ISTREAM = 0) or (Medium.stm = nil) then
        RaiseInvalidMedium;

      AStream := IStream(Medium.stm);
      Result := True;
    finally
      ReleaseStgMedium(Medium);
    end
end;

function GetFileContentAsStorage(ADataObject: IDataObject; AIndex: Integer; out AStream: IStorage): Boolean;
var
  Format: TFormatEtc;
  Medium: TStgMedium;
begin
  Result := False;
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := CF_FILECONTENTS;
  Format.dwAspect := DVASPECT_CONTENT;
  Format.lindex := AIndex;
  Format.tymed := TYMED_ISTORAGE;
  ZeroMemory(@Medium, SizeOf(Medium));
  if Succeeded(ADataObject.GetData(Format, Medium)) then
    try
      if (Medium.tymed and TYMED_ISTORAGE = 0) or (Medium.stm = nil) then
        RaiseInvalidMedium;

      AStream := IStorage(Medium.stg);
      Result := True;
    finally
      ReleaseStgMedium(Medium);
    end
end;

procedure SaveFileDescriptorWToDir(ADataObject: IDataObject; const ADir: string);
var
  Format: TFormatEtc;
  Medium: TStgMedium;
  GroupDescriptor: PFileGroupDescriptorW;
  FileDescriptorW: PFileDescriptorW;
  ItemIndex: Integer;
  DestFileName: UnicodeString;
  DestStream: IStream;
  SourceStream: IStream;
  Read: Int64;
  Written: Int64;
  DestStorage: IStorage;
  SourceStorage: IStorage;
begin
  ZeroMemory(@Format, SizeOf(Format));
  Format.cfFormat := CF_FILEDESCRIPTORW;
  Format.dwAspect := DVASPECT_CONTENT;
  Format.lindex := -1;
  Format.tymed := TYMED_HGLOBAL;
  ZeroMemory(@Medium, SizeOf(Medium));
  OleCheck(ADataObject.GetData(Format, Medium));
  try
    if (Medium.tymed and TYMED_HGLOBAL = 0) or (Medium.hGlobal = 0) then
      RaiseInvalidMedium;
    GroupDescriptor := GlobalLock(Medium.hGlobal);
    if not Assigned(GroupDescriptor) then
      RaiseLastOSError;
    try
      if GroupDescriptor.cItems = 0 then Exit;
      for ItemIndex := 0 to GroupDescriptor.cItems - 1 do
        begin
          FileDescriptorW := @GroupDescriptor.fgd[ItemIndex];

          // По правильному нужно проверить корректность имени на отсутствие недопустимых символов
          DestFileName := FileDescriptorW.cFileName;

          DestFileName := IncludeTrailingPathDelimiter(ADir) + DestFileName;

          if (FileDescriptorW.dwFlags and FD_ATTRIBUTES <> 0) and (FileDescriptorW.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY <> 0) then
            begin
              ForceDirectories(DestFileName);
              // По правильному нужно установить даты и аттрибуты директории на основе FileDescriptorW
            end
          else
            begin
              ForceDirectories(ExtractFilePath(DestFileName));

              if GetFileContentAsStream(ADataObject, ItemIndex, SourceStream) then
                try
                  OleCheck(SHCreateStreamOnFileEx(PWideChar(DestFileName), STGM_CREATE or STGM_READWRITE, FILE_ATTRIBUTE_NORMAL, True, nil, DestStream));
                  try
                    OleCheck(SourceStream.CopyTo(DestStream, -1, Read, Written));
                    // По правильному нужно установить даты и аттрибуты файла на основе FileDescriptorW
                  finally
                    DestStream := nil;
                  end;
                finally
                  SourceStream := nil;
                end
              else
                if GetFileContentAsStorage(ADataObject, ItemIndex, SourceStorage) then
                  try
                    OleCheck(StgCreateStorageEx(PWideChar(DestFileName), STGM_CREATE or STGM_SHARE_EXCLUSIVE or STGM_READWRITE, STGFMT_STORAGE, 0, nil, nil, IStorage, DestStorage));
                    try
                      OleCheck(SourceStorage.CopyTo(0, nil, 0, DestStorage));
                    finally
                      DestStorage := nil;
                    end;
                  finally
                    SourceStorage := nil;
                  end;
            end;
        end;
    finally
      GlobalUnlock(Medium.hGlobal);
    end;
  finally
    ReleaseStgMedium(Medium);
  end
end;

procedure SaveClipboardToDir(const ADir: string);
var
  DataObject: IDataObject;
  OleInitializeSuccess: Boolean;
begin
  OleInitializeSuccess := OleInitialize(nil) = S_OK;
  try
    OleCheck(OleGetClipboard(DataObject));
    try
      if ContainFormat(DataObject, CF_FILEDESCRIPTORW, TYMED_HGLOBAL) then
        SaveFileDescriptorWToDir(DataObject, ADir)
      else
        raise Exception.Create('Data not found');
    finally
      DataObject := nil;
    end;
  finally
    if OleInitializeSuccess then
      OleUninitialize;
  end;
end;

initialization
  CF_FILECONTENTS               := RegisterClipboardFormat(CFSTR_FILECONTENTS);
  CF_FILEDESCRIPTORA            := RegisterClipboardFormat(CFSTR_FILEDESCRIPTORA);
  CF_FILEDESCRIPTORW            := RegisterClipboardFormat(CFSTR_FILEDESCRIPTORW);

...
Рейтинг: 0 / 0
10.06.2016, 14:04
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39254297
Shuraken
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shuraken
Участник
Aniskin, благодарю. Пиши, куда высылать пиво.
...
Рейтинг: 0 / 0
10.06.2016, 14:43
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39254312
Aniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Aniskin
Гость
Shurakenкуда высылать пиво.
Ящик наберется, тогда и вышлешь, сэкономишь на транспортных расходах.
...
Рейтинг: 0 / 0
10.06.2016, 15:03
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Взаимодействие с Microsoft Outlook
    #39722728
Hadroran
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hadroran
Гость
Всем, привет.
Ребята, подскажите. Когда выполняю процедуру SaveClipboardToDir('d:\') то в эту директорию копируются пустые файлы. Подскажите, что не так?
...
Рейтинг: 0 / 0
25.10.2018, 12:06
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39722779
Hadroran
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hadroran
Гость
Немного разобрался...
В команде
SourceStream.CopyTo(DestStream, 0, Read, Written); значение 0 является размером копируемого файла.
Как подставить сюда размер файла?
...
Рейтинг: 0 / 0
25.10.2018, 13:05
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39722785
Ghost Writer
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Ghost Writer
Участник
SourceStream.Size
...
Рейтинг: 0 / 0
25.10.2018, 13:17
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39722852
Hadroran
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Hadroran
Гость
Ghost Writer,

Не угадал :)
...
Рейтинг: 0 / 0
25.10.2018, 14:30
| Ответить | Цитировать | Написать  
Взаимодействие с Microsoft Outlook
    #39722856
Aniskin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Aniskin
Гость
Aniskin
Код: pascal
1.
  OleInitializeSuccess := OleInitialize(nil) = S_OK;



Должно быть OleInitializeSuccess := Successed(OleInitialize(nil));
...
Рейтинг: 0 / 0
25.10.2018, 14:32
| Ответить | Цитировать | Написать  
26 сообщений из 26, показаны все 2 страниц
  все  
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Взаимодействие с Microsoft Outlook
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?all=1&fid=58&tid=2040228]:
 0ms
get settings:
 11ms
get forum list:
 18ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 171ms
get topic data:
 11ms
get forum data:
 3ms
get page messages:
 81ms
get tp. blocked users:
 1ms
others: 227ms
total:  531ms
созд. / загр.: 531ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]