Measure/Units/UpFileManageUnit.pas

{*******************************************************************************
  单元名称：  UpFileManageUnit.pas

  单元说明：  计量支付附件，数据模块。云版和单机版区别很大。

  作者时间：  Chenshilong, 2015-01-16
*******************************************************************************}
unit UpFileManageUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  ExtCtrls, StdCtrls, ShellAPI, ADODB;

type

  TUpFileStatus = (ufsNormal, ufsNeedUp, ufsUping, ufsDowning, ufsDownFail);    // 控制界面显示：常规、等待上传、上传中、下载中
  TStatusChangeEvent = procedure (AStatus: TUpFileStatus) of object;

  TUpFiles = class;

  TUpFile = class(TObject)
  private
    FUperName: string;
    FUpTime: string;
    FWebFile: string;
    FMemo: string;
    FStatus: TUpFileStatus;
    //FIcon: TIcon;
    FBillID: Integer;
    FID: Integer;
    FCategory: string;
    FDisplayName: string;
    FWebID: Integer;
    FUperID: Integer;
    FOwner: TUpFiles;
    FDownURL: string;
    FLocalFile: string;
    FOnStatusChange: TStatusChangeEvent;
    FOrgFile: string;
    FPhase: Integer;
    FNo: Integer;

    procedure SetWebFile(const Value: string);
    procedure SetMemo(const Value: string);
    procedure SetStatus(const Value: TUpFileStatus);
    procedure SetUperName(const Value: string);
    procedure SetUpTime(const Value: string);
    procedure SetBillID(const Value: Integer);
    procedure SetID(const Value: Integer);
    procedure SetCategory(const Value: string);
    procedure SetDisplayName(const Value: string);
    procedure SetWebID(const Value: Integer);
    procedure SetUperID(const Value: Integer);
    procedure SetOwner(const Value: TUpFiles);
    procedure SetDownURL(const Value: string);
    procedure SetLocalFile(const Value: string);
    procedure SetOrgFile(const Value: string);
    procedure SetPhase(const Value: Integer);
    procedure SetNo(const Value: Integer);
    function GetExt: string;

  public
    procedure AssignIcon(APicture: TPicture);

    property No: Integer read FNo write SetNo;                                  // 索引号，进入TList的顺序号。
    property ID: Integer read FID write SetID;                                  // ID，主键
    property WebID: Integer read FWebID write SetWebID;                         // 服务器端的标段ID
    property Phase: Integer read FPhase write SetPhase;                         // 期号
    property BillID: Integer read FBillID write SetBillID;                      // 用于关联清单
    property UperID: Integer read FUperID write SetUperID;                      // 上传者ID
    property UperName: string read FUperName write SetUperName;                 // 上传者姓名
    property UpTime: string read FUpTime write SetUpTime;                       // 上传时间
    property Category: string read FCategory write SetCategory;                 // 所属分类：清单附件、台帐附件等
    property OrgFile: string read FOrgFile write SetOrgFile;                    // 原始文件：随意放在硬盘某个角落，即将用来上传或用来本地统一管理的文件。（含路径）
    property WebFile: string read FWebFile write SetWebFile;                    // 网络文件：原始文件上传到服务器后，PHP因安全因素重新编码文件名后生成新的文件名，如"20150201.jpg"。（路径+编码文件名）
    property LocalFile: string read FLocalFile write SetLocalFile;              // 本地文件：原始文件被统一管理后(单机版)或网络文件下载到本地后的文件。（完整路径+本地文件文件名）
    property DisplayName: string read FDisplayName write SetDisplayName;        // 本地显示给用户看的文件名。
    property DownURL: string read FDownURL write SetDownURL;                    // 下载链接，用于从服务器下载文件到本地
    property Memo: string read FMemo write SetMemo;                             // 上传者的备注
    property Status: TUpFileStatus read FStatus write SetStatus;                // 状态信息，用于控制界面的显示
    property Ext: string read GetExt;
    property Owner: TUpFiles read FOwner write SetOwner;
    property OnStatusChange: TStatusChangeEvent read FOnStatusChange write FOnStatusChange;


    constructor Create;
    destructor Destroy; override;
  end;


  TUpFiles = class(TObject)
  private
    FList: TList;
    FProjectData: TObject;
    FPath: string;

    // -------------业务扩展，单机版本地也要存储管理附件，以下这部分适用于单机版。
//    FLocalCon: TADOConnection;
//    FLocalQue: TADOQuery;
//    FLocalQue2: TADOQuery;

    function GetItem(Index: Integer): TUpFile;
    procedure Clear;
    function GetCount: Integer;
    procedure SetProjectData(const Value: TObject);
  public
    constructor Create;
    destructor Destroy; override;
    function Add(AUpFile: TUpFile): Integer; overload;                          // 返回索引号
    function Add(ABillID: Integer): TUpFile; overload;
    function Find(AID: Integer): TUpFile;
    procedure Delete(AIndex: Integer); overload;
    procedure Delete(AUpFile: TUpFile); overload;
    procedure Exchange(AUpFile1, AUpFile2: TUpFile);
    procedure LoadDatas;
//    function LocalSaveToDB(AUpFile: TUpFile): Integer;                          // 返回ID

    property Item[Index: Integer]: TUpFile read GetItem; default;
    property Count: Integer read GetCount;
    property ProjectData: TObject read FProjectData write SetProjectData;
    property Path: string read FPath;
    property List: TList read FList;
  end;


implementation

uses ProjectData, Forms, PHPWebDm, CslJson, ConstUnit, UtilMethods,
  StdConvs, superobject;

{ TUpFile }

procedure TUpFile.SetWebFile(const Value: string);
begin
  FWebFile := Value;
end;

procedure TUpFile.SetBillID(const Value: Integer);
begin
  FBillID := Value;
end;

procedure TUpFile.SetMemo(const Value: string);
begin
  FMemo := Value;
end;

procedure TUpFile.SetStatus(const Value: TUpFileStatus);
begin
  FStatus := Value;
  if Assigned(FOnStatusChange) then
    FOnStatusChange(FStatus);
end;

procedure TUpFile.SetUperName(const Value: string);
begin
  FUperName := Value;
end;

procedure TUpFile.SetUpTime(const Value: string);
begin
  FUpTime := Value;
end;

{ TUpFileList }

function TUpFiles.Add(AUpFile: TUpFile): Integer;
begin
  Result := FList.Add(AUpFile);
end;

procedure TUpFiles.Clear;
var 
  i: Integer;
begin
  for i := 0 to FList.Count - 1 do
    TUpFile(FList[i]).Free;

  FList.Clear;
end;

constructor TUpFiles.Create;
begin
  FList := TList.Create;

//  if not G_IsCloud then
//  begin
//    FLocalCon := TADOConnection.Create(nil);
//    FLocalCon.LoginPrompt := False;
//
//    FLocalQue := TADOQuery.Create(nil);
//    FLocalQue.Connection := FLocalCon;
//
//    FLocalQue2 := TADOQuery.Create(nil);
//    FLocalQue2.Connection := FLocalCon;
//  end;
end;

procedure TUpFiles.Delete(AUpFile: TUpFile);
begin
  if AUpFile = nil then Exit;
  FList.Remove(AUpFile);
end;

procedure TUpFiles.Delete(AIndex: Integer);
begin
  TUpFile(FList[AIndex]).Free;
  FList.Delete(AIndex);
end;

destructor TUpFiles.Destroy;
begin
  Clear;
  FList.Free;

//  if not G_IsCloud then
//  begin
//    FLocalQue.Close;
//    FLocalQue.Free;
//    FLocalQue2.Close;
//    FLocalQue2.Free;
//    FLocalCon.Close;
//    FLocalCon.Free;
//  end;

  inherited;
end;

procedure TUpFiles.Exchange(AUpFile1, AUpFile2: TUpFile);
var
  idx1, idx2: Integer;
begin
  idx1 := FList.IndexOf(AUpFile1);
  idx2 := FList.IndexOf(AUpFile2);
  if idx1 < 0 then Exit;
  if idx2 < 0 then Exit;

  FList.Exchange(idx1, idx2);
end;

function TUpFiles.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TUpFiles.GetItem(Index: Integer): TUpFile;
begin
  Result := TUpFile(FList[Index]);
end;

procedure TUpFiles.LoadDatas;

  procedure LoadData(AFile: ISuperObject);
  var
    vFile: TUpFile;
  begin
    vFile := Add(AFile.I['itemid']);
    vFile.DownURL := AFile.S['downurl'];
    vFile.DisplayName := AFile.S['filename'];
    vFile.LocalFile := FPath + vFile.DisplayName;
    vFile.UperName := AFile.S['ownerName'];
    vFile.Category := AFile.S['Category'];
    vFile.Memo := AFile.S['Memo'];
    vFile.UperID := AFile.I['owmerid'];
    vFile.UpTime := AFile.S['uptime'];
    vFile.ID := AFile.I['fileid'];
    vFile.Phase := AFile.I['phase'];
    vFile.WebID := TProjectData(FProjectData).WebID;
    vFile.Status := ufsNormal;
  end;

var
  i, iCount: Integer;
  sUrl, sInfo: string;
  vJ: ISuperObject;
begin
  if not G_IsCloud then Exit;

  sUrl := Format('%stender/attachment/%d/list', [PHPWeb.MeasureURL, TProjectData(FProjectData).WebID]);
  if PHPWeb.UrlGet(sUrl, nil, sInfo) = 1 then
  begin
    vJ := SO(sInfo);
    try
      if not Assigned(vJ.AsArray) then Exit;
      iCount := vJ.AsArray.Length;
      for i := 0 to iCount - 1 do
        LoadData(vJ.AsArray.O[i]);
    finally
      vJ := nil;
    end;
  end;
end;

procedure TUpFile.SetID(const Value: Integer);
begin
  FID := Value;
end;

procedure TUpFile.SetCategory(const Value: string);
begin
  FCategory := Value;
end;

procedure TUpFile.SetDisplayName(const Value: string);
begin
  FDisplayName := Value;
end;


procedure TUpFile.SetWebID(const Value: Integer);
begin
  FWebID := Value;
end;

procedure TUpFile.SetUperID(const Value: Integer);
begin
  FUperID := Value;
end;

procedure TUpFiles.SetProjectData(const Value: TObject);
var sLAFM, sModelFile: string;
begin
  FProjectData := Value;

  if G_IsCloud then
  begin
    FPath := PHPWeb.WebPath + 'Projects\' + IntToStr(TProjectData(FProjectData).WebID) + '\Attachment\';
    if not DirectoryExists(FPath) then
      ForceDirectories(FPath);
  end;
//  else
//  begin
//    FPath := ExtractFilePath(Application.ExeName) + '我的项目\Attachment\' + ExtractFileName(TProjectData(FProjectData).FileName) + '\';
//    if not DirectoryExists(FPath) then
//      ForceDirectories(FPath);
//
//    sLAFM := FPath + 'LocalAttachmentFileManager.dat';
//    sModelFile := ExtractFilePath(Application.ExeName) + 'Data\LocalAttachmentFileManager.dat';
//    if not FileExists(sLAFM) then
//      if not CopyFile(PChar(sModelFile), PChar(sLAFM), True) then
//      begin
//        Application.MessageBox(PChar('本地附件管理库模板文件“' + sModelFile + '”丢失或被占用无法复制。'), '警告', MB_OK + MB_ICONWARNING);
//        Exit;
//      end;
//
//    FLocalCon.ConnectionString := Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;Persist Security Info=False;', [sLAFM]);
//  end;
end;

procedure TUpFile.SetOwner(const Value: TUpFiles);
begin
  FOwner := Value;
end;

procedure TUpFile.SetDownURL(const Value: string);
begin
  FDownURL := Value;
end;

procedure TUpFile.SetLocalFile(const Value: string);
begin
  FLocalFile := Value;
end;

function TUpFiles.Add(ABillID: Integer): TUpFile;
var vFile: TUpFile;
begin
  vFile := TUpFile.Create;
  vFile.No := Add(vFile);
  vFile.Owner := Self;
  vFile.BillID := ABillID;
  Result := vFile;
end;

procedure TUpFile.SetOrgFile(const Value: string);
begin
  FOrgFile := Value;
end;

//function TUpFiles.LocalSaveToDB(AUpFile: TUpFile): Integer;
//begin
//  try
//    FLocalQue2.Close;
//    FLocalQue2.SQL.Text := 'Select * from AttachmentFile where 1 < 0';
//    FLocalQue2.Open;
//    FLocalQue2.Append;
//    FLocalQue2.FieldByName('BillID').AsInteger := AUpFile.BillID;
//    FLocalQue2.FieldByName('Phase').AsInteger := AUpFile.Phase;
//    FLocalQue2.FieldByName('FileName').AsString := AUpFile.DisplayName;
//    FLocalQue2.Post;
//    Result := FLocalQue2.FieldByName('ID').AsInteger;
//    FLocalQue2.Close;
//  except
//    Result := -1;
//    Application.MessageBox('本地保存失败，请重试！', '警告', MB_OK + MB_ICONWARNING);
//  end;
//end;

procedure TUpFile.SetPhase(const Value: Integer);
begin
  FPhase := Value;
end;

procedure TUpFile.SetNo(const Value: Integer);
begin
  FNo := Value;
end;

function TUpFile.GetExt: string;
begin
  Result := ExtractFileExt(DisplayName);
end;

function TUpFiles.Find(AID: Integer): TUpFile;
var i: Integer;
  vUpFile: TUpFile;
begin
  vUpFile := nil;
  for i := 0 to FList.Count - 1 do
  begin
   vUpFile := TUpFile(FList[i]);
   if vUpFile.ID = AID then
   begin
     Result := vUpFile;
     Break;
   end;
  end;
end;


procedure TUpFile.AssignIcon(APicture: TPicture);
var
  vIcon: TIcon;
  sExt: string;
  sInfo: SHFILEINFO;
begin
  // 系统图标
  sExt := ExtractFileExt(FLocalFile);
  if sExt = '' then Exit;
  FillChar(sInfo, SizeOf(sInfo), 0);
  SHGetFileInfo(PChar(sExt), FILE_ATTRIBUTE_NORMAL, sInfo, SizeOf(sInfo),
    SHGFI_USEFILEATTRIBUTES or SHGFI_ICON or SHGFI_LARGEICON);
  if sInfo.hIcon > 0 then
  begin
    vIcon := TIcon.Create;
    try
      vIcon.Handle := sInfo.hIcon;
      APicture.Graphic := vIcon;
    finally
      vIcon.Free;
    end;
  end;
end;

end.