ABADev blog

var
  CF_FILECONTENTS,
  CF_FILEDESCRIPTOR: Integer;initialization
 
  // Initialize the OLE libraries
  OleInitialize(nil);
 
  // Register the clipboard formats that we need to handle in the
  // OLE drag drop operation
  CF_FILECONTENTS := RegisterClipboardFormat(CFSTR_FILECONTENTS);
  CF_FILEDESCRIPTOR := RegisterClipboardFormat(CFSTR_FILEDESCRIPTOR);
 
finalization
  OleUninitialize;

OleCheck(RegisterDragDrop(Handle, Self));

type
  TfrmOrderWizard = class(TForm, IDropTarget)
  ...
  private
    { IDropTarget }
    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
                       var dwEffect: Longint): HResult; stdcall;
    function DragOver(grfKeyState: Longint; pt: TPoint;
                      var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject;
                  grfKeyState: Longint; pt: TPoint;
                  var dwEffect: Longint): HResult; stdcall;
    { IUnknown
     Ignore referance counting }
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    ...

function TfrmOrderWizard.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
     var dwEffect: Longint): HResult;
begin
  dwEffect := DROPEFFECT_COPY;
  Result  := S_OK;
end;
 
function TfrmOrderWizard.DragOver(grfKeyState: Longint; pt: TPoint;
     var dwEffect: Longint): HResult;
begin
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;
 
function TfrmOrderWizard.DragLeave: HResult;
begin
  Result := S_OK;
end;
 
function TfrmOrderWizard._AddRef: Integer;
begin
   Result := 1;
end;
 
function TfrmOrderWizard._Release: Integer;
begin
  Result := 1;
end;
 
function TfrmOrderWizard.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
  var dwEffect: Longint): HResult;
const
  PT_TSTRING = ULONG(30);
  PT_UNICODE = ULONG(31);
  PR_BODY    = PT_TSTRING or ($1000 shl 16);
  PR_BODY_W  = PT_UNICODE or ($1000 shl 16);
var
  aFmtEtc: TFORMATETC;
  aStgMed, stgmitem: TSTGMEDIUM;
  pData: PChar;
  pfgd: PFileGroupDescriptor;
  dwCount, dwfetch: Integer;
 
  stat: STATSTG;
  pstg: IStorage;
  pstm: IStream;
begin
  {Make certain the data rendering is available}
  if (dataObj = nil) then
    raise Exception.Create('IDataObject-Pointer is not valid!');
  with aFmtEtc do
  begin
    cfFormat := CF_TEXT;
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  {Get the data}
  OleCheck(dataObj.GetData(aFmtEtc, aStgMed));
  try
    {Lock the global memory handle to get a pointer to the data}
    pData := GlobalLock(aStgMed.hGlobal);
    { Replace Text }
    MemoOrder.Text := pData;
  finally
    {Finished with the pointer}
    GlobalUnlock(aStgMed.hGlobal);
    {Free the memory}
    ReleaseStgMedium(aStgMed);
  end;
 
  // Get the file descriptors
  with aFmtEtc do
  begin
    cfFormat := CF_FILEDESCRIPTOR;
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  OleCheck(dataObj.GetData(aFmtEtc, aStgMed));
  try
    pfgd := PFileGroupDescriptor(GlobalLock(aStgMed.hGlobal));
    // Iterate each of the files
    for dwCount := 0 to pfgd.cItems-1 do
    begin
      // Set up for getting the file data
      with aFmtEtc do
      begin
        cfFormat := CF_FILECONTENTS;
        ptd := nil;
        dwAspect := DVASPECT_CONTENT;
        lindex := dwCount;
        tymed := TYMED_ISTORAGE;
      end;
      if (dataObj.GetData(aFmtEtc, stgmitem) = S_OK) then
      begin
        // IStorage (handle the outlook item)
        pstg := IStorage(stgmitem.stg);
        // Hard coded to open the outlook message item stream
        if (pstg.OpenStream('__substg1.0_1000001F', nil, STGM_SHARE_EXCLUSIVE or STGM_READ, 0, pstm) = S_OK) or
           (pstg.OpenStream('__substg1.0_1000001E', nil, STGM_SHARE_EXCLUSIVE or STGM_READ, 0, pstm) = S_OK) then
        begin
          pstm.Stat(stat, STATFLAG_DEFAULT);
          pData := AllocMem(stat.cbSize);
          try
            pstm.Read(pData, stat.cbSize, @dwFetch);
            // Set the msg body
            MemoOrder.Lines.Add(String(pData));
          finally
            // Free buffer memory
            FreeMem(pData);
          end;
          // Free the stream
          pstm := nil;
        end;
        // Free the storage
        pstg := nil;
        // Release the storage medium
        ReleaseStgMedium(stgmitem);
      end;
    end;
  finally
    // Unlock the memory
    GlobalUnLock(aStgMed.hGlobal);
    // Release the storage medium
    ReleaseStgMedium(aStgMed);
  end;
 
  Result := S_OK;
end;

function IsDotNetAssembly(const AFileName: string): Boolean;
var
  fs: TFileStream;
  peHeader, peHeaderSignature,
  timestamp, pSymbolTable, noOfSymbol: dWord;
  machine, sections, optionalHeaderSize, characteristics: Word;
  dataDictionaryRVA: array[0..14] of dWord;
  dataDictionarySize: array[0..14] of dWord;
  i: Integer;
begin
  fs := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
  try
    //PE Header starts @ 0x3C (60). Its a 4 byte header.
    fs.Seek($3C, soFromBeginning);
    fs.Read(peHeader, SizeOf(peHeader));
    //Moving to PE Header start location...
    fs.Position := peHeader;
    fs.Read(peHeaderSignature, SizeOf(peHeaderSignature));
    //We can also show all these value, but we will be
    //limiting to the CLI header test.
    fs.Read(machine, SizeOf(machine));
    fs.Read(sections, SizeOf(sections));
    fs.Read(timestamp, SizeOf(timestamp));
    fs.Read(pSymbolTable, SizeOf(pSymbolTable));
    fs.Read(noOfSymbol, SizeOf(noOfSymbol));
    fs.Read(optionalHeaderSize, SizeOf(optionalHeaderSize));
    fs.Read(characteristics, SizeOf(characteristics));
 
    { Now we are at the end of the PE Header and from here, the
    PE Optional Headers starts...
    To go directly to the datadictionary, we'll increase the
    stream's current position to with 96 (0x60). 96 because,
    28 for Standard fields
    68 for NT-specific fields
    From here DataDictionary starts...and its of total 128 bytes.
    DataDictionay has 16 directories in total,
    doing simple maths 128/16 = 8.
    So each directory is of 8 bytes.
 
    In this 8 bytes, 4 bytes is of RVA and 4 bytes of Size.
    btw, the 15th directory consist of CLR header! if its 0,
    it is not a CLR file }
 
    fs.Seek($60, soFromCurrent);
    for i := 0 to 14 do
    begin
      fs.Read(dataDictionaryRVA[i], SizeOf(dataDictionaryRVA[i]));
      fs.Read(dataDictionarySize[i], SizeOf(dataDictionarySize[i]));
    end;
  finally
    fs.Free
  end;
  Result := (dataDictionaryRVA[14] <> 0)
end;