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
  try
    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);
  except
    on E: Exception do
      Log(E.Message, 'TTeamShareAdapter.SendUploadedEventToServer('+AJson+')');
  end;
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=0 then
    begin
      MessageBox(0, PChar('发送文件大小不允许超过 ' + IntToStr(20) + 'M ！'), '提示', MB_ICONINFORMATION);
      Exit;
    end;
    if AFileSize >200 * 1024 * 1024 then
    begin
      MessageBox(0, PChar('发送文件大小不允许超过 ' + IntToStr(20) + '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.