RealICQClient/Client/Group/TeamShareAdapter.pas

unit TeamShareAdapter;

interface

uses
  GroupConfig, RealICQClient, Classes, StrUtils, SysUtils, Dialogs, RealICQModel;

type
  TTeamShareAdapter = class
  private
    class procedure SendUploadedEventToServer(AJson: string; ARealICQClient: TRealICQClient);
  public
    class procedure UploadFile(ATeamID, AFileName: string; ATeamForm: TComponent; ARealICQClient: TRealICQClient; IsNeedNotify: Boolean); overload;
    class function GetTheFileSize(AFileName: string): Int64;
    class function GetShareURL(ATeamID, ALoginName, ADisplayName, AIsAdmin: string): string;
    class procedure UploadedNotifyToMembers(ASender, AMembers, AFileMd5, AFileName: string; AFileSize: Integer; ARealICQClient: TRealICQClient);
  end;

implementation

uses
  MainFrm, Windows, TalkingFrm, HTTPApp, RealICQUtils, LoggerImport, superobject,
  md5, UploadOrDownloadFileMission, TransmitDirection, Forms;

const
  DOWN_URL: string = 'http://%s:%d/home/down/%s?%s';
  UP_URL: string = 'http://%s:%d/Home/Create?use=%s&groupid=%s&displayname=%s';
  SHARE_URL: string = 'http://%s:%d/home/index?loginname=%s&teamid=%s&displayname=%s&isAdmin=%s';
  OLD_SHARE_URL: string = '%s/share/Default.aspx?TeamID=%s&LoginName=%s&password=%s&tick=%s'; // + IntToStr(GetTickCount)

  NOTIFY_JSON: string = '{sender:"", receivers:[], sendtime:"", url:"", fileSize:""}';
{ TTeamShareAdapter }


class function TTeamShareAdapter.GetShareURL(ATeamID, ALoginName, ADisplayName, AIsAdmin: string): string;
var
  AConfig: TGroupShareConfig;
begin
  AConfig := TGroupShareConfig.GetConfig;
  if AConfig.GroupShareVersion = gsvNew then
    Result := Format(SHARE_URL, [AConfig.IP, AConfig.Port, ALoginName, ATeamID, HttpEncode(AnsiToUtf8(ADisplayName)), AIsAdmin])
  else if AConfig.GroupShareVersion = gsvOld then
    Result := Format(OLD_SHARE_URL, [AConfig.URL, ATeamID, ALoginName, MD5En(MainForm.RealICQClient.Password), IntToStr(GetTickCount)]);
end;

class function TTeamShareAdapter.GetTheFileSize(AFileName: string): Int64;
var
  FileHandle: THandle;
  MapHandle: THandle;
  ViewPointer: pointer;
begin
  Result := 0;
  FileHandle := CreateFile(pChar(AFileName), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL or FILE_FLAG_SEQUENTIAL_SCAN, 0);
  if FileHandle <> INVALID_HANDLE_VALUE then
  try
    MapHandle := CreateFileMapping(FileHandle, nil, PAGE_READONLY, 0, 0, nil);
    if MapHandle <> 0 then
    try
      ViewPointer := MapViewOfFile(MapHandle, FILE_MAP_READ, 0, 0, 0);
      if ViewPointer <> nil then
      try
        Result := GetFileSize(FileHandle, nil);
      finally
        UnmapViewOfFile(ViewPointer);
      end;
    finally
      CloseHandle(MapHandle);
    end;
  finally
    CloseHandle(FileHandle);
  end;
end;

class procedure TTeamShareAdapter.SendUploadedEventToServer(AJson: string; ARealICQClient: TRealICQClient);
var
  nIndex, AJsonLength, IIDLength, BufferLength: SmallInt;
  SendBuffer: array of Byte;
begin
  AJsonLength := Length(AJson);
  BufferLength := 5 + Length(AJson);
  SetLength(SendBuffer, BufferLength);
  nIndex := 0;

     //填充 (1)协议类型（0xD3）            1byte
  SendBuffer[nIndex] := $D3;
  Inc(nIndex, 1);

    //填充 (2)消息总长度                  2byte
  CopyMemory(@SendBuffer[nIndex], @BufferLength, 2);
  Inc(nIndex, 2);
    
    //填充 (2)JSON总长度                  2byte
  CopyMemory(@SendBuffer[nIndex], @AJsonLength, 2);
  Inc(nIndex, 2);

    //填充（4）JSON                    动态长度
  CopyMemory(@SendBuffer[nIndex], PChar(AJson), AJsonLength);

  ARealICQClient.TCPClient.SendBuffer(SendBuffer[0], BufferLength);   
end;

//sender:"%s", receivers:"[%s]", sendtime:"%f", url:"%s", fileSize
class procedure TTeamShareAdapter.UploadedNotifyToMembers(ASender, AMembers, AFileMd5, AFileName: string; AFileSize: Integer; ARealICQClient: TRealICQClient);
var
  AJson, ADownUrl: string;
  AReceivers: TStringList;
  AConfig: TGroupShareConfig;
  iLoop, iMax: Integer;
  jo: ISuperObject;
begin
  AConfig := TGroupShareConfig.GetConfig;
  if AConfig.GroupShareVersion <> gsvNew then
    Exit;
  AReceivers := SplitString(AMembers, Chr(10));
  ADownUrl := Format(DOWN_URL, [AConfig.IP, AConfig.Port, AFileMd5, AFileName]);
  jo := SO(NOTIFY_JSON);
  jo.S['sender'] := ASender;
  jo.D['sendtime'] := Now;
  jo.S['url'] := ADownUrl;
  jo.I['fileSize'] := AFileSize;
  iMax := 10;

  for iLoop := 0 to AReceivers.Count - 1 do
  begin
    if iLoop >= iMax then
    begin
      AJson := jo.AsJSon(False, False);
      SendUploadedEventToServer(AJson, ARealICQClient);
      Jo.A['receivers'].Clear;
      Inc(iMax, 10);
    end;
    jo.A['receivers'].Add(TSuperObject.Create(AReceivers[iLoop]))
  end;
  if jo.A['receivers'].Length > 0 then
  begin
    AJson := jo.AsJSon(False, False);
    SendUploadedEventToServer(AJson, ARealICQClient);
  end;
  AReceivers.Free;
end;

class procedure TTeamShareAdapter.UploadFile(ATeamID, AFileName: string; ATeamForm: TComponent; ARealICQClient: TRealICQClient; IsNeedNotify: Boolean);
var
  AConfig: TGroupShareConfig;
  AUpUrl: string;
  AFileSize: int64;
  strMissionID, js: string;
begin
  AConfig := TGroupShareConfig.GetConfig;
  if (not ARealICQClient.Connected) or (not ARealICQClient.Logined) then
     Exit;

  if IsNeedNotify and not (MessageBox(0, '确认要群发文件吗？', '提示', MB_OKCANCEL + MB_ICONQUESTION) = ID_OK) then
     Exit;

  if DirectoryExists(AFileName) then
  begin
    MessageBox(0, PChar('您上传的是目录，请压缩后上传！'), '提示', MB_ICONINFORMATION);
    Exit;
  end;

  if FileExists(AFileName) then
  begin
    TTalkingForm(ATeamForm).spbTeamNetWorkDisk.OnClick(Nil);
    AFileSize := GetTheFileSize(AFileName);
    if AFileSize > 100 * 1024 * 1024 then
    begin
      MessageBox(0, PChar('文件(' + AFileName + ')大小超过:' + IntToStr(100) + 'M ！'), '提示', MB_ICONINFORMATION);
      Exit;
    end;
  end
  else
  begin
    MessageBox(0, PChar('文件不存在！ '), '提示', MB_ICONINFORMATION);
    Exit;
  end;

  if AConfig.GroupShareVersion = gsvNew then
  begin
    try
      AUpUrl := Format(UP_URL, [AConfig.IP, AConfig.Port, ARealICQClient.LoginName, ATeamID, HttpEncode(AnsiToUtf8(ARealICQClient.Me.DisplayName))]);
      TTalkingForm(ATeamForm).spbUploadTeamFileProcess.Visible := True;
      TTalkingForm(ATeamForm).TeamUpLoadFile.ThreadDownFile(AUpUrl, AFileName, AFileSize, IsNeedNotify);
    except
      on E: Exception do
        MessageBox(0, PChar(E.Message), '发送文件时出错', MB_ICONINFORMATION);
    end;
  end
  else if AConfig.GroupShareVersion = gsvOld then
  begin
    try
      strMissionID := '1|' + IntToStr(GetTickCount) + ',' + ATeamID + ',' + MainForm.RealICQClient.LoginName;
      js := format('ReadyToUpload("%s", "%s", %d)', [strMissionID, ReplaceStr(AFileName, '\', '\\'), GetTheFileSize(AFileName)]);
      (ATeamForm as TTalkingForm).WebBrowserForTeamDisk.OleObject.Document.parentWindow.execScript(js, 'JavaScript');
    except
      on E: Exception do
        MessageBox(0, PChar(E.Message), '上传文件时出错', MB_ICONINFORMATION);
    end;
  end;
end;

end.