10
lokalnej stacji roboczej Win 7operacje schowka w Delphi
Terminal Server: Win 2008 Server
Outlook 2003 uruchomiony na lokalnej stacji roboczej.
Próbuję zaimplementować kopiowanie i wklejanie wiadomości programu Outlook z lokalnej stacji roboczej do serwera terminali.
Korzystanie poniższy kod, jestem w stanie skopiować i wkleić pliki z lokalnej stacji roboczej do serwera ...
TmyMemoryStream = class(TMemoryStream);
...
procedure TmyMemoryStream.LoadFromIStream(AStream : IStream);
var
iPos : Int64;
aStreamStat : TStatStg;
oOLEStream: TOleStream;
begin
AStream.Seek(0, STREAM_SEEK_SET, iPos);
AStream.Stat(aStreamStat, STATFLAG_NONAME);
oOLEStream := TOLEStream.Create(AStream);
try
Self.Clear;
Self.Position := 0;
Self.CopyFrom(oOLEStream, aStreamStat.cbSize);
Self.Position := 0;
finally
oOLEStream.Free;
end;
end;
... ale gdy próbuję skopiować i wkleić wiadomość Outlook, wielkość strumienia (aStreamStat.cbSize) wynosi 0. Jestem w stanie uzyskać temat wiadomości (nazwa pliku), ale nie mogę odczytać zawartości strumienia.
Co jest nie tak z moim kodem?
Kompletny kod jednostki:
unit Unit1;
interface
uses
dialogs,
Windows, ComCtrls, ActiveX, ShlObj, ComObj, StdCtrls, AxCtrls,
SysUtils, Controls, ShellAPI, Classes, Forms;
type
{****************************************************************************}
TMyDataObjectHandler = class;
PFileDescriptorArray = Array of TFileDescriptor;
{****************************************************************************}
TMyDataObjectHandler = class(TObject)
strict private
CF_FileContents : UINT;
CF_FileGroupDescriptorA : UINT;
CF_FileGroupDescriptorW : UINT;
CF_FileDescriptor : UINT;
FDirectory : string;
function _CanCopyFiles(const ADataObject : IDataObject) : boolean;
function _DoCopyFiles(const ADataObject : IDataObject) : HResult;
//function _ExtractFileNameWithoutExt(const FileName: string): string;
function _CopyFiles(AFileNames: TStringList): HResult;
procedure _GetFileNames(AGroup: PDropFiles; var AFileNames: TStringList);
procedure _ProcessAnsiFiles(ADataObject: IDataObject; AGroup: PFileGroupDescriptorA);
function _ProcessDropFiles(ADataObject: IDataObject; AGroup: PDropFiles): HResult;
procedure _ProcessFileContents(ADataObject: IDataObject; Index: UINT; AFileName: string; AFileSize : Cardinal);
function _ProcessStorageMedium(ADataObject: IDataObject; AMedium: STGMEDIUM; AFilename: string; AFileSize : Cardinal): HResult;
function _ProcessStreamMedium(ADataObject: IDataObject; AMedium: STGMEDIUM; AFileName: String; AFileSize : Cardinal): HResult;
procedure _ProcessUnicodeFiles(ADataObject: IDataObject; AGroup: PFileGroupDescriptorW);
function _CanCopyFile(AFileName: string): boolean;
public
constructor Create; reintroduce;
destructor Destroy; override;
function CanCopyFiles(const ADataObject : IDataObject; const ADirectory : string) : boolean;
procedure CopyFiles(const ADataObject : IDataObject; const ADirectory : string);
end;
{****************************************************************************}
TMyMemoryStream = class(TMemoryStream)
public
procedure LoadFromIStream(AStream : IStream; AFileSize : Cardinal);
function GetIStream : IStream;
end;
{****************************************************************************}
implementation
{------------------------------------------------------------------------------}
{ TMyDataObjectHandler }
function TMyDataObjectHandler.CanCopyFiles(const ADataObject : IDataObject; const ADirectory : string): boolean;
begin
Result := IsDirectoryWriteable(ADirectory);
if Result then
begin
Result := _CanCopyFiles(ADataObject);
end;
end;
{------------------------------------------------------------------------------}
constructor TMyDataObjectHandler.Create;
begin
inherited Create;
CF_FileContents := $8000 OR RegisterClipboardFormat(CFSTR_FILECONTENTS) AND $7FFF;
CF_FileGroupDescriptorA := $8000 OR RegisterClipboardFormat(CFSTR_FILEDESCRIPTORA) AND $7FFF;
CF_FileGroupDescriptorW := $8000 OR RegisterClipboardFormat(CFSTR_FILEDESCRIPTORW) AND $7FFF;
CF_FileDescriptor := $8000 OR RegisterClipboardFormat(CFSTR_FILEDESCRIPTOR) AND $7FFF;
end;
{------------------------------------------------------------------------------}
destructor TMyDataObjectHandler.Destroy;
begin
//
inherited;
end;
{------------------------------------------------------------------------------}
procedure TMyDataObjectHandler.CopyFiles(const ADataObject : IDataObject; const ADirectory : string);
begin
FDirectory := ADirectory;
_DoCopyFiles(ADataObject);
end;
{------------------------------------------------------------------------------}
function TMyDataObjectHandler._CanCopyFiles(const ADataObject : IDataObject) : boolean;
var
eFORMATETC : IEnumFORMATETC;
OLEFormat : TFormatEtc;
iFetched : Integer;
begin
Result := false;
if Succeeded(ADataObject.EnumFormatEtc(DATADIR_GET, eFormatETC)) then
begin
if Succeeded(eFormatETC.Reset) then
begin
while(eFORMATETC.Next(1, OLEFormat, @iFetched) = S_OK) and (not Result) do
begin
Result := (OLEFormat.cfFormat = CF_FileGroupDescriptorW)
or
(OLEFormat.cfFormat = CF_FileGroupDescriptorA)
or
(OLEFormat.cfFormat = CF_HDROP);
end;
end;
end;
end;
{------------------------------------------------------------------------------}
function TMyDataObjectHandler._CanCopyFile(AFileName : string) : boolean;
begin
Result := not FileExists(ExpandUNCFileName(FDirectory + ExtractFileName(AFileName)));
end;
{------------------------------------------------------------------------------}
function TMyDataObjectHandler._CopyFiles(AFileNames : TStringList) : HResult;
var
i: Integer;
begin
Result := S_OK;
i := 0;
while(i < AFileNames.Count) do
begin
if _CanCopyFile(AFileNames[i]) then
begin
Copyfile(Application.MainForm.Handle, PChar(AFileNames[i]), PChar(FDirectory + ExtractFileName(AFileNames[i])), false);
end;
inc(i);
end;
end;
{------------------------------------------------------------------------------}
procedure TMyDataObjectHandler._GetFileNames(AGroup: PDropFiles; var AFileNames : TStringList);
var
sFilename : PAnsiChar;
s : string;
begin
sFilename := PAnsiChar(AGroup) + AGroup^.pFiles;
while (sFilename^ <> #0) do
begin
if (AGroup^.fWide) then
begin
s := PWideChar(sFilename);
Inc(sFilename, (Length(s) + 1) * 2);
end
else
begin
s := PWideChar(sFilename);
Inc(sFilename, Length(s) + 1);
end;
AFileNames.Add(s);
end;
end;
{------------------------------------------------------------------------------}
function TMyDataObjectHandler._ProcessDropFiles(ADataObject: IDataObject; AGroup: PDropFiles) : HResult;
var
sFiles : TStringList;
begin
Result := S_OK;
sFiles := TStringList.Create;
try
_GetFileNames(AGroup, sFiles);
if (sFiles.Count > 0) then
begin
Result := _CopyFiles(sFiles);
end;
finally
sFiles.Free;
end;
end;
{------------------------------------------------------------------------------}
function TMyDataObjectHandler._ProcessStorageMedium(ADataObject: IDataObject; AMedium: STGMEDIUM; AFilename : string; AFileSize : Cardinal) : HResult;
var
StorageInterface : IStorage;
FileStorageInterface : IStorage;
sGUID : PGuid;
iCreateFlags : integer;
begin
Result := S_OK;
if _CanCopyFile(AFileName) then
begin
sGUID := nil;
StorageInterface := IStorage(AMedium.stg);
iCreateFlags := STGM_CREATE OR STGM_READWRITE OR STGM_SHARE_EXCLUSIVE;
Result := StgCreateDocfile(PWideChar(ExpandUNCFileName(FDirectory + AFilename)), iCreateFlags, 0, FileStorageInterface);
if Succeeded(Result) then
begin
Result := StorageInterface.CopyTo(0, sGUID, nil, FileStorageInterface);
if Succeeded(Result) then
begin
Result := FileStorageInterface.Commit(0);
end;
FileStorageInterface := nil;
end;
StorageInterface := nil;
end;
end;
{------------------------------------------------------------------------------}
function TMyDataObjectHandler._ProcessStreamMedium(ADataObject: IDataObject; AMedium: STGMEDIUM; AFileName : String; AFileSize : Cardinal) : HResult;
var
Stream : IStream;
myStream: TMyMemoryStream;
begin
Result := S_OK;
if _CanCopyFile(AFileName) then
begin
Stream := ISTREAM(AMedium.stm);
if (Stream <> nil) then
begin
myStream := TMyMemoryStream.Create;
try
myStream.LoadFromIStream(Stream, AFileSize);
myStream.SaveToFile(ExpandUNCFileName(FDirectory + AFileName));
finally
myStream.Free;
end;
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TMyDataObjectHandler._ProcessFileContents(ADataObject: IDataObject; Index: UINT; AFileName : string; AFileSize : Cardinal);
var
Fetc: FORMATETC;
Medium: STGMEDIUM;
begin
Fetc.cfFormat := CF_FILECONTENTS;
Fetc.ptd := nil;
Fetc.dwAspect := DVASPECT_CONTENT;
Fetc.lindex := Index;
Fetc.tymed := TYMED_HGLOBAL or TYMED_ISTREAM or TYMED_ISTORAGE;
if SUCCEEDED(ADataObject.GetData(Fetc, Medium)) then
begin
try
case Medium.tymed of
TYMED_HGLOBAL : ;
TYMED_ISTREAM : _ProcessStreamMedium(ADataObject, Medium, AFileName, AFileSize);
TYMED_ISTORAGE : _ProcessStorageMedium(ADataObject, Medium, AFileName, AFileSize);
else ;
end;
finally
ReleaseStgMedium(Medium);
end;
end;
end;
{------------------------------------------------------------------------------}
procedure TMyDataObjectHandler._ProcessAnsiFiles(ADataObject: IDataObject; AGroup: PFileGroupDescriptorA);
var
I : UINT;
sFileName : AnsiString;
iSize : Cardinal;
begin
for I := 0 to AGroup^.cItems-1 do
begin
sFileName := AGroup^.fgd[I].cFileName;
if (AGroup^.fgd[I].dwFlags and FD_FILESIZE) = FD_FILESIZE then
begin
iSize := (AGroup^.fgd[I].nFileSizeLow and $7FFFFFFF);
end
else
begin
iSize := 0;
end;
_ProcessFileContents(ADataObject, I, string(sFileName), iSize);
end;
end;
{------------------------------------------------------------------------------}
procedure TMyDataObjectHandler._ProcessUnicodeFiles(ADataObject : IDataObject;
AGroup : PFileGroupDescriptorW);
var
I: UINT;
sFileName: WideString;
iSize: Cardinal;
begin
for I := 0 to AGroup^.cItems-1 do
begin
sFileName := AGroup^.fgd[I].cFileName;
if (AGroup^.fgd[I].dwFlags and FD_FILESIZE) = FD_FILESIZE then
begin
iSize := (AGroup^.fgd[I].nFileSizeLow and $7FFFFFFF);
end
else
begin
iSize := 0;
end;
_ProcessFileContents(ADataObject, I, sFileName, iSize);
end;
end;
{------------------------------------------------------------------------------}
function TMyDataObjectHandler._DoCopyFiles(const ADataObject : IDataObject) : HResult;
var
Fetc : FORMATETC;
Medium : STGMEDIUM;
Enum : IEnumFORMATETC;
Group : Pointer;
begin
Result := ADataObject.EnumFormatEtc(DATADIR_GET, Enum);
if FAILED(Result) then
Exit;
while (true) do
begin
Result := (Enum.Next(1, Fetc, nil));
if (Result = S_OK) then
begin
if (Fetc.cfFormat = CF_FILEGROUPDESCRIPTORA) or
(Fetc.cfFormat = CF_FILEGROUPDESCRIPTORW) or
(Fetc.cfFormat = CF_HDROP) then
begin
Result := ADataObject.GetData(Fetc, Medium);
if FAILED(Result) then
Exit;
try
if (Medium.tymed = TYMED_HGLOBAL) then
begin
Group := GlobalLock(Medium.hGlobal);
try
if Fetc.cfFormat = CF_FILEGROUPDESCRIPTORW then
begin
_ProcessUnicodeFiles(ADataObject, PFileGroupDescriptorW(Group));
break;
end
else if Fetc.cfFormat = CF_FILEGROUPDESCRIPTORA then
begin
_ProcessAnsiFiles(ADataObject, PFileGroupDescriptorA(Group));
break;
end
else if Fetc.cfFormat = CF_HDROP then
begin
_ProcessDropFiles(ADataObject, PDropFiles(Group));
break;
end;
finally
GlobalUnlock(Medium.hGlobal);
end;
end;
finally
ReleaseStgMedium(Medium);
end;
end;
end
else
break;
end;
end;
{------------------------------------------------------------------------------}
//function TMyDataObjectHandler._ExtractFileNameWithoutExt(const FileName: string): string;
//begin
// Result := ChangeFileExt(ExtractFileName(FileName), EmptyStr);
//end;
{------------------------------------------------------------------------------}
{ TMyMemoryStream }
function TMyMemoryStream.GetIStream: IStream;
var
oStreamAdapter : TStreamAdapter;
tPos : Int64;
begin
oStreamAdapter := TStreamAdapter.Create(Self);
oStreamAdapter.Seek(0, 0, tPos);
Result := oStreamAdapter as IStream;
end;
procedure TMyMemoryStream.LoadFromIStream(AStream : IStream; AFileSize : Cardinal);
var
iPos : Int64;
aStreamStat : TStatStg;
oOLEStream: TOleStream;
HR: Int64;
begin
oOLEStream := TOLEStream.Create(AStream);
try
Self.Clear;
Self.Position := 0;
try
HR := Self.CopyFrom(oOLEStream, 0);
except
on E : Exception do
begin
showMessage(E.ClassName + ' ' + E.Message);
end;
end;
Self.Position := 0;
finally
oOLEStream.Free;
end;
end;
end.
Zauważam, że zignorowałeś zwracaną wartość z 'Stat'. Czy ta funkcja się powiodła? Możesz pominąć oba wywołania 'Seek' i' Stat', jeśli po prostu przekazałeś 0 dla drugiego parametru 'CopyFrom'. Przekazanie 0 automatycznie rozpoczyna się od początku strumienia źródłowego i kopiuje całą rzecz. –
@Rob Kennedy: Próbowałem usunąć wywołania Seek i Stat oraz 0 jako drugi parametr do CopyFrom. Mimo to wywołanie funkcji CopyFrom kończy się niepowodzeniem z wyjątkiem. EOleSysError - Parametr jest niepoprawny. – Pavan
@Rob Kennedy: Załączam pełny kod jednostki. Jednak ten kod nie jest przeznaczony do użytku produkcyjnego, ponieważ zawiera oczywiste problemy, chociaż niewielkie. – Pavan