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.