RealICQClient/CopyScreen/CopyScreen.pas

unit CopyScreen;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, Graphics, Shdocvw, Registry, IETools_TLB,
  StdVcl, CopyScreenFrm, Unit1, Forms, Controls, SysUtils, IdMultipartFormData,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

type
  TCopyScreen = class(TAutoObject, ICopyScreen, IObjectSafety)
  private
    FObjectSafetyFlags: DWORD;  
  protected
    function Get_FileName: OleVariant; safecall;
    procedure Start; safecall;

    function GetInterfaceSafetyOptions(const IID: TIID; pdwSupportedOptions,
      pdwEnabledOptions: PDWORD): HResult; stdcall;
    function SetInterfaceSafetyOptions(const IID: TIID; dwOptionSetMask,
      dwEnabledOptions: DWORD): HResult; stdcall;
    procedure Upload(URL: OleVariant); safecall;
  end;

implementation

uses ComServ;
//------------------------------------------------------------------------------
function TCopyScreen.GetInterfaceSafetyOptions(const IID: TIID;
  pdwSupportedOptions, pdwEnabledOptions: PDWORD): HResult;
var
  Unk: IUnknown;
begin
  if (pdwSupportedOptions = nil) or (pdwEnabledOptions = nil) then
  begin
    Result := E_POINTER;
    Exit;
  end;
  Result := QueryInterface(IID, Unk);
  if Result = S_OK then
  begin
    pdwSupportedOptions^ := INTERFACESAFE_FOR_UNTRUSTED_CALLER or
      INTERFACESAFE_FOR_UNTRUSTED_DATA;
    pdwEnabledOptions^ := FObjectSafetyFlags and
      (INTERFACESAFE_FOR_UNTRUSTED_CALLER or INTERFACESAFE_FOR_UNTRUSTED_DATA);
  end
  else begin
    pdwSupportedOptions^ := 0;
    pdwEnabledOptions^ := 0;
  end;
end;

//------------------------------------------------------------------------------
function TCopyScreen.SetInterfaceSafetyOptions(const IID: TIID;
  dwOptionSetMask, dwEnabledOptions: DWORD): HResult;
var
  Unk: IUnknown;
begin
  Result := QueryInterface(IID, Unk);
  if Result <> S_OK then Exit;
  FObjectSafetyFlags := dwEnabledOptions and dwOptionSetMask;
end;

function TCopyScreen.Get_FileName: OleVariant;
begin
  Result := ExtractFileName(ScreenFileName);
end;

procedure TCopyScreen.Start;
begin
  Form1 := TForm1.Create(nil);
  Form1.Show;

  while Form1 <> nil do
  begin
    Application.ProcessMessages;
    Sleep(10);
  end;
end;

procedure TCopyScreen.Upload(URL: OleVariant);
var
  IdHTTP: TIdHTTP;
  mp: TIdMultiPartFormDataStream ;
begin
  URL := 'http://220.191.211.21/WebScreenCut/recv.asp';

  mp:= TIdMultiPartFormDataStream.Create ;
  mp.AddFile('UpFile', ScreenFileName, 'multipart/form-data');
  IdHTTP := TIdHTTP.Create(nil);
  try
    try
      IdHTTP.Post(URL, mp);

      //MessageBox(0, PChar(IdHTTP.Response.ResponseText), '', MB_OK);
    except
      on E: Exception do
      begin
        MessageBox(0, PChar('´«ÉÏʧ°Ü£º' + E.Message), '', MB_OK);
      end;
    end
  finally
    IdHTTP.Free;
    mp.Free;
  end;
end;


initialization
  TAutoObjectFactory.Create(ComServer, TCopyScreen, Class_CopyScreen,
    ciMultiInstance, tmApartment);
end.